Posted: 10 years 9 months 26 days 1 hours 24 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: 10 years 9 months 26 days 1 hours 19 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: 10 years 9 months 25 days 20 hours 15 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: 10 years 9 months 25 days 13 hours 12 minutes ago
What is the correct syntax to call an RPG IV program from RPG III?
Posted: 10 years 9 months 25 days 11 hours 27 minutes ago
It would be no different than calling an RPG-III program from another RPG-III program. Use the CALL operation.
Posted: 10 years 9 months 24 days 9 hours 27 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: 10 years 9 months 24 days 6 hours 56 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: 10 years 9 months 24 days 6 hours 39 minutes ago
Edited: Wed, 03 Jul, 2013 at 20:00:39 (3948 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: 10 years 9 months 23 days 3 hours 25 minutes ago
Thanks CL, hope to get this working this afternoon. I am hoping to put this one behind me soon.
Posted: 10 years 9 months 22 days 22 hours 41 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: 10 years 9 months 21 days 8 hours 38 minutes ago
Edited: Fri, 05 Jul, 2013 at 11:45:09 (3946 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: 10 years 9 months 21 days 6 hours 52 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: 10 years 9 months 21 days 4 hours 15 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: 10 years 9 months 19 days 21 hours 47 minutes ago
Edited: Sat, 06 Jul, 2013 at 20:53:32 (3945 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.