Home > AS/400 Tips > iSeries programmer tips > DAYSPAST CLLE program for AS/400: Compares object creation date with today's date
iSeries 400 Tips:
EMAIL THIS
 TIPS & NEWSLETTERS TOPICS 

ISERIES PROGRAMMER TIPS

DAYSPAST CLLE program for AS/400: Compares object creation date with today's date


Raymond Johnson, Contributor
07.31.2008
Rating: -3.64- (out of 5)


iSeries news and advice
Digg This!    StumbleUpon Toolbar StumbleUpon    Bookmark with Delicious Del.icio.us    Add to Google


Raymond Johnson
If you are not an RPG programmer and still need to do date calculations, here is a CLLE program that I built to tell me how many days old an object was by comparing the created date of an object with today's date.

This code was modified from an IBM-supplied example to make it simple for me to use.

I use it in programs where I interrogate the creation date of an object then use an "IF" statement to determine whether or not to delete it. I call my DAYSPAST program and if the returned numeric value is greater than the number of days old that I want to keep, I can delete the object.

As a side note, here is some technical information for the curious geek: The LILIAN routine is an IBM-supplied routine that will tell you the precise number of days between that date and October 14, 1582. If you're wondering who picked that date, I have no idea. The good news is that it doesn't change -- which is different than most everything else in this world.

The procedure CEEDAYS returns a 32-bit binary integer representing the Lilian date, the number of days since 14 October 1582.

/******************************************************************************/

/* Program name . . . . . . . . . . . . . . : DAYSPAST */
/* Author . . . . . . . . . . . . . . . . . : Raymond G. Johnson */
/* Date created . . . . . . . . . . . . . . : 05/06/2008 QED */
/* */
/* Program information: Return the number of days that have past since */
/* a given date. */
/* Pass date in YYYYMMDD format */
/* Return numeric value of days passed. */
/* */
/* Required call format: CALL PGM(DAYSPAST) PARM('20080502' 1 )
       */

/* *CHAR *DEC (10.0) */
/* */
/* Parameter 1 is an 8 position character field for the date in question. */
/* Parameter 2 is 10 position decimal field to return the number of days past.*/
/* Must be compiled as CLLE program. */
/******************************************************************************/

/* Jim Sloan Error recovery procedure. */
/******************************************************************************/
/* Change log: */
/******************************************************************************/
/* Date Initials Change Description */
/******************************************************************************/
/* xx/xx/200x XXX */
/* */
/******************************************************************************/
             PGM        PARM(&date2 &dayspastd)                                 

DCL VAR(&ERRORSW) TYPE(*LGL) /*Std Error */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /*Std Error */
DCL VAR(&MSG) TYPE(*CHAR) LEN(512) /*Std Error */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512) /*Std Error */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /*Std Error */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /*Std Error */
DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4) /*Std Error */
DCL VAR(&KEYVAR2) TYPE(*CHAR) LEN(4) /*Std Error */
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2) /*Std Error */
DCL VAR(&DATETIME ) TYPE(*CHAR) LEN(17)
DCL VAR(&DATE1 ) TYPE(*CHAR) LEN(8) /* Today */
DCL VAR(&DATE2 ) TYPE(*CHAR) LEN(8) /* past date */
DCL VAR(&DAYSpastD) TYPE(*DEC) LEN(10 0)
DCL VAR(&DAYSpastC ) TYPE(*CHAR) LEN(10)
           DCL        VAR(&LILDAT1c  ) TYPE(*CHAR) LEN(4)                     

DCL VAR(&LILDAT1d ) TYPE(*DEC) LEN(10 0)
DCL VAR(&LILDAT2d ) TYPE(*DEC) LEN(10 0)
           DCL        VAR(&RC) TYPE(*CHAR) LEN(4) VALUE(X'00000000')          

DCL VAR(&MSGTXT ) TYPE(*CHAR) LEN(50)
DCL VAR(&FORMAT ) Type(*CHAR) Len(8) +
VALUE('YYYYMMDD')

/******************************************************************************/
/* Start of program. */
/******************************************************************************/
 /* Get current system date and time in YYYYMMDD. */                

CALL PGM(QWCCVTDT) PARM('*CURRENT' ' ' '*YYMD' +
&DATETIME &RC)
/* Parse the date portion of the system date and time. */
CHGVAR VAR(&DATE1) VALUE(%SST(&DATETIME 1 8))
            /* Get Lilian date for current date in character format. */        

CALLPRC PRC(CEEDAYS) PARM((&DATE1) ('YYYYMMDD') +
(&LILDAT1c) (&RC))
             CHGVAR     VAR(&LILDAT1d) VALUE(%BIN(&LILDAT1c))                   
             /* Get Lilian date for past date. */                               

CALLPRC PRC(CEEDAYS) PARM((&DATE2) ('YYYYMMDD') +
(&LILDAT2c) (&RC))
             /* Get Lilian date for past date in decimal format */              

CHGVAR VAR(&LILDAT2d) VALUE(%BIN(&LILDAT2c ))
            /* Calculate number of days different.             */              

CHGVAR VAR(&DAYSPASTD) VALUE(&LILDAT1d - &LILDAT2d)
             /* Place value in Data area for validation and testing.          */

CRTDTAARA DTAARA(ADMIN400/DAYSPASTD) TYPE(*DEC) LEN(10 0) +
TEXT('Days past in decimal')
MONMSG CPF1023
CHGDTAARA ADMIN400/DAYSPASTD &DAYSPASTD
 RETURN:     RETURN      /* Normal end of program. */                           

/******************************************************************************/
/* END OF PROGRAM / ERROR EXIT */
/******************************************************************************/
IF COND(&ERRORSW) THEN(SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE))
CHGVAR VAR(&ERRORSW) VALUE('1') /* Set to FAIL on error */
RCVMSG MSGTYPE(*EXCP) RMV(*NO) KEYVAR(&KEYVAR)
  STDERR2:                                                                       

RCVMSG MSGTYPE(*PRV) MSGKEY(&KEYVAR) RMV(*NO) +
KEYVAR(&KEYVAR2) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) RTNTYPE(&RTNTYPE) MSGF(&MSGF) +
SNDMSGFLIB(&MSGFLIB)
IF COND(&RTNTYPE *NE '02') THEN(GOTO STDERR3)
IF COND(&MSGID *NE ' ') THEN(SNDPGMMSG MSGID(&MSGID) +
MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) +
MSGTYPE(*DIAG))
IF COND(&MSGID *EQ ' ') THEN(SNDPGMMSG MSG(&MSG) +
MSGTYPE(*DIAG))
RMVMSG MSGKEY(&KEYVAR2)
 STDERR3:    RCVMSG     MSGKEY(&KEYVAR) MSGDTA(&MSGDTA) MSGID(&MSGID) +         

MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) MSGDTA(&MSGDTA) +
MSGTYPE(*ESCAPE)
****************** End of data *************************************************

ABOUT THE AUTHOR: Raymond G. Johnson is owner of and consulant at iSolutions Consulting Inc. in Eugene, Ore. He has over 30 years of experience with IBM hardware and software systems and provides technical support for i5, System i, iSeries and/or AS/400.

Rate this Tip
To rate tips, you must be a member of Search400.com.
Register now to start rating these tips. Log in if you are already a member.




Digg This!    StumbleUpon Toolbar StumbleUpon    Bookmark with Delicious Del.icio.us    Add to Google



RELATED CONTENT
iSeries CL programming
Taking advantage of CL advancements, starting with V5R3
Checking in on your IBM i authorization lists
Running PHP open source applications: NOBODY needs authority
Simplify the process of converting a spool file from iSeries into an Excel spreadsheet
CL program for daily backups
An automated CL method of moving a query from AS/400 to Excel
Changing user password expiration
Eight steps for creating program documentation using AS/400 utilities
Advanced Job Scheduler help
How do I retrieve the source for an output queue description to put in to a CL program?

Systems Management Tools
Strategies for securing IBM i production files
Legacy AS/400 and new IBM i products both featured at COMMON
Translating Linux for IBM i admins: User profile commands
AS/400 lessons from the past, present, and future: A holiday tale
How to: Monitoring job activity on the AS/400
Checking if a local port is used by another job on AS/400
How to: Reduce the percentage of ASP used on the AS/400
Changing BRMS configurations for new naming conventions for i5
AS/400 system values quiz
Checking on System i disk space requires creating a new command: XRTVSYSSTS

iSeries programmer tips
Enhancing RPG with external SQL stored procedures
Tracking data changes on IBM i with triggers
Introduction to SQLRPGLE on IBM i: Making a report
Implementing a browser interface in COBOL: Displaying database fields
Taking advantage of CL advancements, starting with V5R3
TAATOOL: Useful tools for programmers on IBM i
Implementing a browser interface in COBOL: Creating your graphic Web page
Implementing a browser interface in COBOL: Getting started
Making the most of RPG data handling on IBM i
Groovy programming on IBM i

RELATED RESOURCES
2020software.com, trial software downloads for accounting software, ERP software, CRM software and business software systems
Search Bitpipe.com for the latest white papers and business webcasts
Whatis.com, the online computer dictionary

DISCLAIMER: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.



iSeries Security - Security Tools, Physical Security and System Security
HomeNewsTopicsITKnowledge ExchangeTipsBlogsAsk the ExpertsMultimediaWhite PapersProducts
About Us  |  Contact Us  |  For Advertisers  |  For Business Partners  |  Site Index  |  RSS
SEARCH 
TechTarget provides technology professionals with the information they need to perform their jobs - from developing strategy, to making cost-effective purchase decisions and managing their organizations' technology projects - with its network of technology-specific websites, events and online magazines.

TechTarget Corporate Web Site  |  Media Kits  |  Site Map




All Rights Reserved, Copyright 1999 - 2009, TechTarget | Read our Privacy Policy
  TechTarget - The IT Media ROI Experts