CL program to calculate 31 days less than system date

750 pts.
Tags:
AS 400
CL Program
iSeries
I want to write a CL program that will calculate 31 days less than the system date. If a journal receiver is 31 days older than the system date I want to delete it. I already have the logic in another program to also test on whether or not commands SAVCHGOBJ and SAVLIB were used. I normally use query to test out my logic and produce a report so I know that what I want to delete is valid before I go into the code and add the delete process. Can you provide a code example that could help me? Thank you!


Software/Hardware used:
V7R1M0
1

Answer Wiki

Thanks. We'll let you know when a new response is added.

Coding for dates and differences in a CL has never been easy. In a case like this I would call a RPG program that takes the current date and does your calculation and stores your new date in a data area or passes it back to your CL as a variable. 

Discuss This Question: 14  Replies

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.
  • azohawk
    Since CL is not really date friendly. I would recommend creating a program in a date friendly language (i.e. RPG) that accepts parms of base date and days to add/subtract and returns the revised date. So your CL program would call DATEPGM Parm('20180320', -31, &newdate) and would return to &newdate as '20180217'.
    4,055 pointsBadges:
    report
  • Splat
    Try this:

    DCL        VAR(&Qdate) TYPE(*CHAR) LEN(6)  
    DCL        VAR(&YyMD) TYPE(*CHAR) LEN(8)   
    DCL        VAR(&Lilian) TYPE(*INT)         
    DCL        VAR(&MDYy) TYPE(*CHAR) LEN(8)   
    
    RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&Qdate)                 
                                                            
    CVTDAT     DATE(&Qdate) TOVAR(&YyMD) FROMFMT(*SYSVAL) + 
                 TOFMT(*YYMD) TOSEP(*NONE)                  
    CALLPRC    PRC(CEEDAYS) PARM((&YyMD) ('YYYYMMDD') +     
                 (&Lilian) (*OMIT))                         
    CHGVAR     VAR(&Lilian) VALUE(&Lilian - 31)              
    CALLPRC    PRC(CEEDATE) PARM((&LILIAN) ('MMDDYYYY') +   
                 (&MDYy) (*OMIT))                           

    12,895 pointsBadges:
    report
  • Rrbond07
    Awesome, now I just have to include the code into my CL and it should work great. I can then automate the process with the code. Thank you for your help. Steve
    750 pointsBadges:
    report
  • GregManzo
    Don't forget that you can only delete the LAST receiver in the chain. Provided your program runs often enough that the last receiver is the only one older than 31 days, you're ok. Otherwise you might need to consider some logic to 'walk' the chain from *CURRENT by fetching the PR entry until you get to a point where the previous receiver no longer exists - then you can delete.
    We have a procedure that does this automatically whenever ASP2 goes over 89% full.
    2,960 pointsBadges:
    report
  • Rrbond07
    I also check on SAVED status of the receiver. So if the saved date NE 0's, the saved command is either SAVLIB or SAVCHGOBJ, the status of the receiver is SAVED and now checking to see if the receiver is older than 31 days from the system date, I need to delete the receiver. I am looking to run the program once a month, toward the end of the month.
    750 pointsBadges:
    report
  • Rrbond07
    The procedure you use that automatically runs when the ASP goes over 89% full, is this something you wrote or an API that I can use?
    750 pointsBadges:
    report
  • Rrbond07
    One last question, once I calculate the date after subtracting 31, do I have to convert the date to a digit? I will then use this date as a test against the create date of the receiver. Currently both dates are in *CHAR format. Won't I have to convert these dates to digits so I can do my compare? Lets say my new date after subtracting 31 is 052317 in *CHAR format and any of my receivers less than this date I want deleted. The create date of the receiver is in 6 *CHAR format. So in my code I would say If Create date is less than 052317 delete the receiver. Thanks for any additional help you can offer.
    750 pointsBadges:
    report
  • Splat
    You're going to want the dates to be compared in a format that allows for greater than / less than comparison. My preference is for YYMD.
    12,895 pointsBadges:
    report
  • GregManzo
    @Rrbond07: I wrote a wrapper around the IBM 'QYASPOL' API to return a percentage full for the ASP. It checks one an hour, when above 89% it calls the purge CL that walks the chain and deletes just the last receiver. If that isn't enough to bring it below 89% it will check again in an hour. Given that we roll to a new receiver once a day (just before backups) then on average it will delete one per day. Sometimes 22 hrs, sometimes 26 hrs depends on data volumes. The ASP ID and threshold% are config parameters because they differ on each production box & dev.
    2,960 pointsBadges:
    report
  • Rrbond07
    Thanks Splat for your input. Going to try it one way and see what my results are. I will put together a query to list the receivers it is catching first. Once I see my logic is working I can replace the query with the deletion process. Doing my work on test systems first before they are promoted to production LPARs. Thanks Again!
    750 pointsBadges:
    report
  • Rrbond07
    Well, I'm spinning my wheels here.
    Once I get the system date converted and into a variable, right now my &LILIAN has a value such as 159009 and wanted to place it into another variable as a holding value for once I go into my file read.
    Now I wanted to convert the value in variable &odcdat which is the creation date of the receiver.  Don't I need to get the &LILIAN value on this character date so I can do my compare?  The first &LILIAN date is 31 days less from the current system date.  I now need to see if the created date from the receiver is less than the first &LILIAN value.  If it is, I want to delete it.  I am providing my CL.  Hopefully it is not too confusing.  Thanks for any help you can offer-
    PGM                                                      
                                                             
    DCLF FILE(BONDELIB/RCVFILE)                              
                                                             
    DCL  VAR(&QDATE)   TYPE(*CHAR) LEN(6)                    
                                                             
    DCL  VAR(&YYMD)   TYPE(*CHAR)  LEN(8)                    
    DCL  VAR(&YYMD2)  TYPE(*DEC)   LEN(6)                    
    DCL  VAR(&YYMD3)  TYPE(*CHAR)   LEN(8)                   
    DCL  VAR(&YYMD4)  TYPE(*DEC)   LEN(6)                    
                                                             
    DCL  VAR(&LILIAN) TYPE(*INT)                             
                                                             
    DCL  VAR(&MDYY)  TYPE(*CHAR) LEN(6)                      
                                                             
      CLRPFM FILE(BONDELIB/RCVFILE)                          
                                                             
    RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&QDATE)                  
    DCL  VAR(&YYMD4)  TYPE(*DEC)   LEN(6)                                
                                                                         
    DCL  VAR(&LILIAN) TYPE(*INT)                                         
                                                                         
    DCL  VAR(&MDYY)  TYPE(*CHAR) LEN(6)                                  
                                                                         
      CLRPFM FILE(BONDELIB/RCVFILE)                                      
                                                                         
    RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&QDATE)                              
                                                                         
    CVTDAT DATE(&QDATE) TOVAR(&YYMD) FROMFMT(*SYSVAL) +                  
           TOFMT(*YYMD) TOSEP(*NONE)                                     
                                                                         
    CALLPRC PRC(CEEDAYS) PARM((&YYMD) ('YYYYMMDD') (&LILIAN) (*OMIT))    
                                                                         
    CHGVAR VAR(&LILIAN) VALUE(&LILIAN - 31)                              
    CHGVAR     VAR(&YYMD2) VALUE(&LILIAN)                                
                                                                         
                 DSPOBJD    OBJ(JRNLIB/AUDRCV*) OBJTYPE(*JRNRCV) +       
                              DETAIL(*FULL) OUTPUT(*OUTFILE) +           
                                            OUTFILE(BONDELIB/RCVFILE)         
                                            
                  MONMSG CPF0000     
    ******************************************************************                                      
     READ:  RCVF RCDFMT(*FILE)                                             
                                                                           
            MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END))                   
                                                                           
     CALLPRC PRC(CEEDAYS) PARM((&ODCDAT) ('YYYYMMDD') (&LILIAN) (*OMIT))   
     CHGVAR     VAR(&YYMD4) VALUE(&LILIAN)                                 
                                                                           
     CVTDAT  DATE(&ODCDAT) TOVAR(&YYMD3) FROMFMT(*MDY) +                   
                                                                           
             TOFMT(*YYMD) TOSEP(*NONE)                                            
     END: ENDPGM                                     
    
    750 pointsBadges:
    report
  • Rrbond07
    Well guys, here is my working code.  The counters in the code were to if I was hitting the IF statements.  I change the value from -31 to various other values to see just how many hits I was getting on the IF statements.  I haven't replaced the code yet on the inner most IF yet. 
    PGM                                                             
                                                                    
    DCLF FILE(BONDELIB/RCVFILE)                                     
                                                                    
    DCL  VAR(&QDATE)   TYPE(*CHAR) LEN(6)                           
                                                                    
    DCL  VAR(&YYMD)   TYPE(*CHAR)  LEN(8)                           
     DCL  VAR(&YYMD2)  TYPE(*DEC)   LEN(6)                            
     DCL  VAR(&YYMD3)  TYPE(*CHAR)   LEN(8)                           
     DCL  VAR(&COUNT) TYPE(*DEC) LEN(4) VALUE(0)                      
     DCL  VAR(&COUNT1) TYPE(*DEC) LEN(4) VALUE(0)                     
     DCL  VAR(&COUNT2) TYPE(*DEC) LEN(4) VALUE(0)                     
                                                                      
     DCL  VAR(&LILIAN) TYPE(*INT)                                     
                                                                      
     DCL  VAR(&MDYY)  TYPE(*CHAR) LEN(6)                              
                                                                
    /*****************************************/                 
    /* Calculate date that is 31 days less   */                 
    /* than the system date.                 */                 
    /*****************************************/                 
                                                                
    RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&QDATE)                     
                                                                
    CVTDAT DATE(&QDATE) TOVAR(&YYMD) FROMFMT(*SYSVAL) +         
           TOFMT(*YYMD) TOSEP(*NONE)                            
                                                                
    CALLPRC PRC(CEEDAYS) PARM((&YYMD) ('YYYYMMDD') (&LILIAN) (*OMIT))   
                                                                        
    CHGVAR VAR(&LILIAN) VALUE(&LILIAN - 550)                            
    CHGVAR     VAR(&YYMD2) VALUE(&LILIAN)                               
                                                                        
    /*****************************************/                         
    /* Clear RCVFILE so it can be updated    */                         
    /* with new data, then DSPOBJD on the    */                         
    /* QAUDJRN receivers in library JRNLIB.  */                         
    /*****************************************/                         
                                                                             
          CLRPFM FILE(BONDELIB/RCVFILE)                                      
                                                                             
          DSPOBJD    OBJ(JRNLIB/AUDRCV*) OBJTYPE(*JRNRCV) +                  
                     DETAIL(*FULL) OUTPUT(*OUTFILE) +                        
                     OUTFILE(BONDELIB/RCVFILE)                               
                     MONMSG CPF0000                                          
     DMPCLPGM                                                                
      
    
                                                                           
     /*****************************************/                             
     /* Convert "Create Date" of the receiver,*/                        
     /* and if the date is 31 days less than  */                        
     /* calculated system date previously     */                        
     /* computed, then delete it.             */                        
     /*****************************************/                        
                                                                        
     READ:   RCVF RCDFMT(*FILE)                                         
                                                                        
             MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END))               
                                                                        
                                                                                 
     CVTDAT  DATE(&ODCDAT) TOVAR(&YYMD3) FROMFMT(*MDY) +                         
             TOFMT(*YYMD) TOSEP(*NONE)                                           
                                                                                 
     CALLPRC PRC(CEEDAYS) PARM((&YYMD3) ('YYYYMMDD') (&LILIAN) (*OMIT))          
                                                                                 
             IF COND(&LILIAN *LT &YYMD2) THEN(DO)                                
                  CHGVAR     VAR(&COUNT) VALUE(&COUNT + 1)                       
                                                                                 
                IF COND((&ODSCMD = 'SAVCHGOBJ') *OR (&ODSCMD = 'SAVLIB')) +      
                   THEN(DO)                                                      
                   CHGVAR     VAR(&COUNT1) VALUE(&COUNT1 + 1)                         
                                                                                      
                   IF COND((&ODSDAT *NE '000000') *AND (&ODOBTP = '*JRNRCV')) +       
                      THEN(DO)                                                        
                      CHGVAR  VAR(&COUNT2) VALUE(&COUNT2 + 1)                         
                   ENDDO                                                              
                ENDDO                                                                 
             ENDDO                                                                    
                                                                                      
     DMPCLPGM                                                                         
                                                                                     
     GOTO CMDLBL(READ)                                                               
                                                                                     
     END: ENDPGM                    
    
    750 pointsBadges:
    report
  • Rrbond07
    By the way, I used DMPCLPGM to dump the values of my variables to also help me see if my code was working. I will remove it once the code goes into production.
    750 pointsBadges:
    report
  • azohawk
    I was just thinking (bad news there--lol). There is an exit program "Delete Journal Receiver Exit Program" https://www.ibm.com/support/knowledgecenter/ssw_ibm_i_61/apis/XDLTRCV.htm I wonder if that might be a more straightforward approach to what you are trying to do.
    4,055 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

Thanks! We'll email you when relevant content is added and updated.

Following

Share this item with your network: