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

Raymond Johnson

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     Del.icio.us    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.