Calc Date in RPG with parm from a CL program

Question

I would like to build a function that calculate a date.

I have a CL program that calls a RPG program with a parameter The calculation i want to do is if i send in the parm 00000000 (yearmonthdays) nothing happends. the function returns todays date in ISO. If i send in 00050000 the function returns 2017-02-15 (todays date - 5 years) If i send in 00020100 the function returns 2020-01-15 (today date - 2 years - 1 month)

The results i need to be set in the variable VALUE in the CL program.

PGM        PARM(&RTNDATE)                                               
DCL        VAR(&VALUE) TYPE(*CHAR) LEN(50)                              
DCL        VAR(&RTNDATE) TYPE(*CHAR) LEN(8)                             
CALL       PGM(B91RKI/RCVRPG) PARM(&RTNDATE)                            
SNDPGMMSG  MSG(&RTNDATE)                                                
CHGVAR     VAR(&VALUE) VALUE(&RTNDATE)                                  
ENDPGM

RPGLE :

hoption(*srcstmt:*nodebugio)                                                     
dRCVRPG           PR                  extpgm('RCVCALL')                          
C     *ENTRY        PLIST                                                        
C                   PARM                    RTNDATE                              
dRTNDATE                         8a                                              
dyear1                           4a                                              
dmonth1                          2a                                              
dday1                            2a                                              
   /free                                                                         
       year1 = %subst(RTNDATE:1:4) ;                                             
       month1 = %subst(RTNDATE:5:2) ;                                            
       day1 = %subst(RTNDATE:7:2) ;                                              
       RTNDATE = %date() ;                                                       
       RTNDATE = RTNDATE - %years(year1) ;                                       
       RTNDATE = RTNDATE - %months(month1) ;                                     
       return ;                                                                  
   /end-free                                                                     
c                   SETON                                            LR

Please ask a question if you want an answer. – nfgl Feb 16 '22 at 13:04 — nfgl, Feb 16 '22 at 13:04

score 1 · Answer 1 · answered Feb 16 '22 at 13:13

You have a few things going on here.

1 - Watch your D specs and C specs. All D specs have to come before C specs or you get a specifications out of order error.

2 - You're trying to convert several different data types here. You're using a character field for input, and then trying to substring it into year1, month1, and date1 and use it in the %Years, %Months, and %Days BIFs. These BIFs require numeric data.

3 - If you intend for the SETON LR op code to ever execute, it needs to come BEFORE your RETURN opcode.

See the fixed code below.

 hoption(*srcstmt:*nodebugio)
 dRCVRPG           PR                  extpgm('RCVCALL')
 dRTNDATE          S              8a
 dyear1            S              4S 0
 dmonth1           S              2S 0
 dday1             S              2S 0
 C     *ENTRY        PLIST
 C                   PARM                    RTNDATE
  /free
   year1 = %Dec(%Subst(RTNDATE:1:4):4:0);
   month1 = %Dec(%Subst(RTNDATE:5:2):2:0);
   day1 = %Dec(%Subst(RTNDATE:7:2):2:0);
   RTNDATE = %Char((%Date() - %Years(year1) -
               %Months(month1) - %Days(day1)):*ISO0);
  /end-free
 c                   SETON                                        LR
 c                   RETURN

use of `/free` and `/end-free` shouldn't be needed now-a-days. Nor any fixed format C-Specs. For that matter, the whole thing could have been free-format. — Charles, Feb 16 '22 at 14:29
What is `dRCVRPG PR extpgm('RCVCALL')` for? You aren't using it. — jmarkmurphy, Feb 16 '22 at 17:15
@Charles -- /free and /end-free are required up to 7.1 TR7. I'm hoping his company is beyond that OS version, but they may not be. With that being said, I definitely agree, I just wasn't going to do his entire job for him. — Rob Schember, Feb 17 '22 at 15:38

Calc Date in RPG with parm from a CL program

1 Answers1