Midrange News for the IBM i Community


Posted by: John Tremper
Need some help
has no ratings.
Published: 30 Jun 2013
Revised: 14 Jul 2013 - 1535 days ago
Last viewed on: 25 Sep 2017 (3093 views) 

Using IBM i? Need to create Excel, CSV, HTML, JSON, PDF, SPOOL reports? Learn more about the fastest and least expensive tool for the job: SQL iQuery.

Need some help Published by: John Tremper on 30 Jun 2013 view comments(14)

Hi All,

I have to update an RPG III program that was written back in 1982, when I was still in high school.  I need to edit a 6 character text field that represents a date, MMDDYY.  The month and day characters must be valid (1-12 and 1-31).  When they pass the edits they need to be converted to a date field YYYY-MM-DD and then written to a more modern file that is an ISO date.  I am having trouble finding documentation, can anyone make some suggestions?  Thanks in advance or any help.

 

Thanks,

Return to midrangenews.com home page.
Sort Ascend | Descend

COMMENTS

(Sign in to Post a Comment)
Posted by: bobcozzi
Site Admin ****
Chicagoland
Comment on: Need some help
Posted: 4 years 2 months 28 days 19 hours 57 minutes ago

normally I "just" call an RPG IV program, passing the non-date field to it as a parameter, and then testing it using RPG IV:

 TEST(DE) *MDY0 MYDATE

Then if it passes, you send back the date in the format you want.

 

Posted by: TFisher
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 28 days 19 hours 52 minutes ago

Why would you not validate the date value?  If you only check the month and day portion then you could end up with an invalid date...like 2/31/2013.

If you cannot convert this source code to RPG IV then it might be easier to call an external routine to validate and convert the date format for you.  Back in my RPG-III days I used a common CL routine that used CVTDAT.  I passed   an 8-dec parameter in with a "convert-to format" parameter and I would get an 8-digit date value back. If the date came back 0 then I knew that the date I passed in was invalid. 

I think all you need to do when you populate the date field for your file is make sure the value is a character value that contains the delimiters:  '2013-06-30'.

Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 28 days 14 hours 49 minutes ago

I was thinking of using a different program for that as well, but was hoping to stay in the same program since this is an interactive program.  But this would work too.  Thanks for your help!

Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 28 days 7 hours 45 minutes ago

What is the correct syntax to call an RPG IV program from RPG III?

Posted by: TFisher
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 28 days 6 hours ago

It would be no different than calling an RPG-III program from another RPG-III program.  Use the CALL operation.  

Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 27 days 4 hours 1 minutes ago

Turns out this is RPG II.  The most current manual I have found is from 1977.  I have the rpg iv program that does the date edit and also converts character MMDDYY to YYYY-MM-DD.  This all works and if the date is valid the file is updated just fine.  My rpg iv program also does this:  *iso test(de) dateOut.  If this does not pass it turns a flag on that is passed back to the RPG II program.  My problem is simply getting the screen to redisplay the screen with the error.  I was hoping there would be the reliable EXFMT but that doesn't seem possible in RPG II.  Does anyone remember how the screen is re-written with the error message?  By the way the errors come from an array with 20 elements.  Thanks in advance.

Posted by: DaleB
Premium member *
Reading, PA
Comment on: Need some help
Posted: 4 years 2 months 27 days 1 hours 30 minutes ago

You should have a WORKSTN file. There will be Input specs and Output specs. Column 15 should be C for Combined, but column 16 can be either P for Pimary or D for Demand.

If Primary, cycle reads input from the WORKSTN as part of the logic cycle, and writes to H/D/T output record for the WORKSTN file.

If Demand, you do your own READ's. For output, you'll probably have (E)xception output records. There will be one or more EXCPT op-codes in the calcs.

In the O-specs, after the D or E record line (possibly with indicators), but before the output fields, there will be a line with K8 that lines up with the output end position, and a quoted string that lines up with the output constant or edit word area. The quoted string is the record format name from the format file (i.e., display file). The number after the K is actually the length of the format name, so it's not always an 8 (e.g., you might have K6 'FMT001'). Something like this:

     O        D        03N99NKC
     O K8 'AR23RD2'
     O CUSNO 8

 

Posted by: clbirk
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 27 days 1 hours 12 minutes ago
Edited: Wed, 03 Jul, 2013 at 20:00:39 (1546 days ago)

If on the workstation file (F spec) it is CD, you are all set. If it is the stupid CP, then it will take a bit more doing as you will fight the cycle.

A good program will typically have something like:

 

                    POPD2          tag
                                       excptscrd2
                    readd2         tag
                                      setof                       60
                                       read workstn                           LR
Kx comparisions maybe
                        then some sort of validation whether it be a called subroutine or inline assume in this example that flag 60 is seton with the error (and the beeper)

either you would go and do this:

60                                 excpt updd2
60                                 goto readd2

     oworkstn      E            scrd2
                                                             k8 'myprogd2'

                        E           updd2

                                                              k8 'myprogrd2'

                                    flda                    10 (etc.)
                             all the fields maybe even an error message.

 

This would be the "modern" rpg2 way of doing it. However you may have a situation with CP and then you will have to fight the cycle, etc.  It can be done. I have programmed in rpg2 since 1973, and I have seen good programming and bad spaghetti code that you would think you are still running a 1442 card reader/punch or the MFCU on a sys/3.  Of course if the program is a MRT, etc. best thing to do is to re do it. I would not run a MRT at all.

I have somewhere around 20,000 programs running on an i, under S36E and the majority are rpg2, and every day, I call rpgiv programs to write stuff to the web, call bob cozzi's tools, etc. It works and it works fine. You can read/update db files (even sql defined ones, etc.).

Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 25 days 21 hours 59 minutes ago

Thanks CL, hope to get this working this afternoon.  I am hoping to put this one behind me soon.

Posted by: bobcozzi
Site Admin ****
Chicagoland
Comment on: Need some help
Posted: 4 years 2 months 25 days 17 hours 14 minutes ago

I wrote a little RPGIII routine (which can be used in RPGII) to call the IBM i API.

     IQUSEC       DS                                        
     I                                    B   1   40ECSIZE  
     I                                    B   5   80ECRTG   
     I                                        9  15 CPFMSG  
     I                                       16  16 RESV1   
     I                                       17  65 MSGDTA  
     IINDTE       DS                                        
     I                                        1   1 ICENT   
     I                                        2   7 IDATE   
     I                                        8  13 ITIME   
     I                                       14  16 IMILS   
     IOUTDTE      DS                                        
     I                                        1   8 ODATE   
     I                                        9  14 OTIME   
     I                                       15  17 OMILS   
     C                     MOVE *ON       *INLR             
      *** SET UP DATA VARIABLES                            
     C                     Z-ADD0         ECSIZE     
     C                     Z-ADD0         ECRTG      
     C                     BITOF'01234567'RESV1      
     C                     MOVE *ZEROS    INDTE      
     C                     MOVE '1'       ICENT      
     C                     MOVE *ZEROS    OUTDTE     
      *                                              
      ** MOVE YOUR DATE INTO THE PARM                
     C                     MOVEL'070413'  IDATE      
      ** MOVE THE INPUT FORMAT INTO PARMS            
     C                     MOVEL'*MDY'    INFMT      
      ** MOVE THE OUTPUT FORMAT INTO THE PARM        
     C                     MOVEL'*YYMD'   OUTFMT     
      *                                              
     C                     CALL 'QWCCVTDT'           
     C                     PARM           INFMT  10  
     C                     PARM           INDTE      
     C                     PARM           OUTFMT 10  
     C                     PARM           OUTDTE     
     C                     PARM           QUSEC     
      ** ODATE CONTAINS THE DATE IN YYYYMMDD FORMAT  
     C           ODATE     DSPLY                     
     C                     RETRN                    
Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 24 days 3 hours 12 minutes ago
Edited: Fri, 05 Jul, 2013 at 11:45:09 (1544 days ago)

Ok, this program has the CP, which means I have to 'fight the cycle'?  I am pasting the chunk of code below where I believe exfmt (or the rpg ii version of it) should go.  You will see where I am calling the program I wrote that does my date edit just fine.  Sure do hope I don't have to work on this one anymore.  Thanks again for the help everyone!!!!

 

C******************************************************* SCRN2 
C SCRN2 BEGSR
C KK 62 disallowed keys
COR KL 62 GOTO $SCRN2
C KK SETOF 22
C KL EXSR CANCL
C KL GOTO $SCRN2
C NKK GOTO $SCRN2
C 41
COR 42 EXSR IQCHG
C 41
COR 42 GOTO $SCRN2
C* 43= ADD NEW EXMR ACCT
C XMRDTA CHAINEXMR 98
C EXSR FMTPCI format percent in
C N98 U3 MOVELOFCCOD KEYNAT get natl file fields
C N98 U3 MOVE XMRDTA KEYNAT
C N98 U3 KEYNAT CHAINNTXRFL 90
C N98 U3 90 MOVE *BLANKS XVOIDF
C N98NU3 MOVE *BLANKS XVOIDF
C N98 U3 90 MOVE *BLANKS XEMAIL
C N98 U3 90 MOVE *BLANKS XTYPEX
C N98 U3 90 MOVE *BLANKS XNJSUI
C N98 U3 90 MOVE *BLANKS XTXIDT
C N98 U3 90 MOVE *BLANKS XEMPTP
C N98 U3 90 MOVE *BLANKS XEMPID
C N98NU3 MOVE *BLANKS XEMAIL
C N98NU3 MOVE *BLANKS XTYPEX
C N98NU3 MOVE *BLANKS XNJSUI
C N98NU3 MOVE *BLANKS XTXIDT
C N98NU3 MOVE *BLANKS XEMPTP
C N98NU3 MOVE *BLANKS XEMPID
C N98 MOVE ERR,9 IERR
C N98 SETON 2269
C N98 GOTO $SCRN2
C NU1 GOTO NONOCK check no if U1
C ICODE COMP ' ' 35 exmr num code
C N35 ICODE COMP '0000' 35
C 35 MOVE ERR,18 IERR
C 35 SETON 6922
C N69 SETOF 35
C N69 ICODE CHAINEXMR# 35
C N69N35 DCD# COMP 'D' 35
C N69N35 MOVE ERR,16 IERR
C N69N35 SETON 6922
C 69 GOTO $SCRN2
C NONOCK TAG
C MOVELINMLST KLSTNM
C MOVELINMFST KFSTNM
C Z-ADD0 KIDNUM
C 'A' DOWEQ'A' FIND UNU ALT K
C SETOF 35
C KEYA CHAINEXMRA 35 35=OK TO USE
C N35 YRECNO COMP 'D' 35
C N35 KIDNUM COMP 9 35 35
C N35 KIDNUM ADD 1 KIDNUM
C N35 END TRY NEXT
C EXSR MOVOT
C MOVE ' ' ORECNO RCD CD BLANK
C EXSR FMTPCO format percent out
C***---> PUT IT HERE
C MOVE ' 'ERBCK
C CALL 'EXMRDTDT'                                                                                  I added this to edit the date
C PARM OSTART                                                                                       I added this to edit the date
C PARM DTRTN 10                                                                                     I added this to edit the date
C PARM ERBCK 11                                                                                    I added this to edit the date
C MOVE DTRTN OSTRDT                                                                           I added this to edit the date
C ERBCK IFNE ' '                                                                                      I added this to edit the date
C***---> WHERE THE HELL SHOULD I GO FROM HERE???                             I added this to edit the date
C END                                                                                                     I added this to edit the date
C***---> PUT IT HERE
C EXSR DONTFL Update natl exmr fl
C SETON 31
C EXCPT EXMR ADD
C SETOF 312223
C U1 EXSR SPCPRC UPDATE SPECAL
C SETON 21
C EXCPT
C ADD 1 ADDNUM 40
C EXSR CLRFST
C EXSR MOVOT
C $SCRN2 TAG
C SETON 40
C ENDSR
Posted by: bobcozzi
Site Admin ****
Chicagoland
Comment on: Need some help
Posted: 4 years 2 months 24 days 1 hours 26 minutes ago

John,

You need to paste in the code into a PRE tag. To do that, move your cursor to a blank line, then select the FORMATS, BLOCKS, PRE from the drop down. When you select it, the paragraph will be a PRE.

Keep the cursor in that empty paragraph, and click your Ctrl+V (paste) button to insert the program code.

This will retain the spaces so we can actually read what you pasted in.

Posted by: jtremper
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 23 days 22 hours 48 minutes ago
C           SCRN2     BEGSR                                                        
C   KK 62                                             disallowed keys             
COR KL 62             GOTO $SCRN2                                                 
C   KK                SETOF                     22                                
C   KL                EXSR CANCL                                                  
C   KL                GOTO $SCRN2                                                 
C  NKK                GOTO $SCRN2                                                 
C   41                                                                            
COR 42                EXSR IQCHG                                                  
C   41                                                                            
COR 42                GOTO $SCRN2                                                 
C*  43= ADD NEW EXMR ACCT                                                         
C           XMRDTA    CHAINEXMR                 98                                
C                     EXSR FMTPCI                     format percent in           
C  N98 U3             MOVELOFCCOD    KEYNAT           get natl file fields        
C  N98 U3             MOVE XMRDTA    KEYNAT                                       
C  N98 U3   KEYNAT    CHAINNTXRFL               90                                
C  N98 U3 90          MOVE *BLANKS   XVOIDF 
C  N98NU3             MOVE *BLANKS   XVOIDF                                                
C  N98 U3 90          MOVE *BLANKS   XEMAIL                                                
C  N98 U3 90          MOVE *BLANKS   XTYPEX                                                
C  N98 U3 90          MOVE *BLANKS   XNJSUI                                                
C  N98 U3 90          MOVE *BLANKS   XTXIDT                                                
C  N98 U3 90          MOVE *BLANKS   XEMPTP                                                
C  N98 U3 90          MOVE *BLANKS   XEMPID                                                
C  N98NU3             MOVE *BLANKS   XEMAIL                                                
C  N98NU3             MOVE *BLANKS   XTYPEX                                                
C  N98NU3             MOVE *BLANKS   XNJSUI                                                
C  N98NU3             MOVE *BLANKS   XTXIDT                                                
C  N98NU3             MOVE *BLANKS   XEMPTP                                                
C  N98NU3             MOVE *BLANKS   XEMPID                                                
C  N98                MOVE ERR,9     IERR                                                  
C  N98                SETON                     2269                                       
C  N98                GOTO $SCRN2                                                          
C  NU1                GOTO NONOCK                                          check no if U1  
C           ICODE     COMP ' '                      35                     exmr num code   
C  N35      ICODE     COMP '0000'                   35                                     
C   35                MOVE ERR,18    IERR                                                  
C   35                SETON                     6922                      
C  N69                SETOF                     35                        
C  N69      ICODE     CHAINEXMR#                35                        
C  N69N35   DCD#      COMP 'D'                      35                    
C  N69N35             MOVE ERR,16    IERR                                 
C  N69N35             SETON                     6922                      
C   69                GOTO $SCRN2                                         
C           NONOCK    TAG                                                 
C                     MOVELINMLST    KLSTNM                               
C                     MOVELINMFST    KFSTNM                               
C                     Z-ADD0         KIDNUM                               
C           'A'       DOWEQ'A'                         FIND UNU ALT K     
C                     SETOF                     35                        
C           KEYA      CHAINEXMRA                35     35=OK TO USE       
C  N35      YRECNO    COMP 'D'                      35                    
C  N35      KIDNUM    COMP 9                    35  35                    
C  N35      KIDNUM    ADD  1         KIDNUM                               
C  N35                END                              TRY NEXT           
C                     EXSR MOVOT                                          
C                     MOVE ' '       ORECNO            RCD CD BLANK       
C***---> PUT IT HERE                                                                        
C                     MOVE '        'ERBCK                                                  
C                     CALL 'EXMRDTDT'                                                       
C                     PARM           OSTART                                                 
C                     PARM           DTRTN  10                                              
C                     PARM           ERBCK  11                                              
C                     MOVE DTRTN     OSTRDT                                                 
C           ERBCK     IFNE ' '                                                              
C***--->  WHERE THE HELL SHOULD I GO FROM HERE???                                           
C                     END                                                                   
C***---> PUT IT HERE                                                                        
C                     EXSR DONTFL                     Update natl exmr fl                   
C                     SETON                     31                                          
C                     EXCPT                            EXMR ADD                             
C                     SETOF                     312223                                      
C   U1                EXSR SPCPRC                      UPDATE SPECAL                        
C                     SETON                     21                                          
C                     EXCPT                                                                 
C                     ADD  1         ADDNUM  40                                      
C                     EXSR CLRAL                                                     
C                     EXSR CLRFST                                                    
C                     EXSR MOVOT                                                     
C           $SCRN2    TAG                                        &nb
Posted by: tdaly
Premium member *
Comment on: Need some help
Posted: 4 years 2 months 22 days 16 hours 21 minutes ago
Edited: Sat, 06 Jul, 2013 at 20:53:32 (1543 days ago)

At the "where  should I go from here" comment set an indicator that will enable PUTOVR on the DSPF record then GOTO $SCRN2. When you return from $SCRN2 be sure that the same screen record will be written again when the cycle gets down to the O specs. With PUTOVER only fields that have OVRDTA or OVRATR will be effected (trust but verify, it's been a while). As for displaying an error message one way would be to populate a display field that is otherwise blank, might need to enable an indicator on this field to make it display with the PUTOVR.