Problem solve Get help with specific problems with your technologies, process and projects.

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

A CLLE program for AS/400 to determine the number of days that have passed since an object was created.

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.

This was last published in July 2008

Start the conversation

Send me notifications when other members comment.

By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close