astradyne
370 pts. | Mar 5 2007 8:39PM GMT
I have done this in the past, but have never been able to code a variable in the GOTO statement as the previous reply suggests - SEU always generates an error (at least at v5r1 it does).
The following is a sample piece of code I’ve used in the past:
PGM PARM(&P1 &P2 &P3)
DCL VAR(&P1) TYPE(*CHAR) LEN(3)
DCL VAR(&P2) TYPE(*CHAR) LEN(7)
DCL VAR(&P3) TYPE(*CHAR) LEN(10)
DCL VAR(&MYPGM) TYPE(*CHAR) LEN(10) VALUE(’PGMNAME’)
DCL VAR(&RSTPNT) TYPE(*CHAR) LEN(4)
DCL VAR(&TAG) TYPE(*CHAR) LEN(10)
/* Generic MONMSG to save restore point in case of an error… */
MONMSG MSGID(CPF0000) EXEC(DO)
CHGDTAARA DTAARA(&MYPGM) VALUE(&RSTPNT)
ENDDO
/* Retrieve the restore point and see if we need to restart from any point… */
TAG0000: RTVDTAARA DTAARA(&MYPGM) RTNVAR(&RSTPNT)
IF COND(&RSTPNT *NE ‘0000′) THEN(DO)
IF COND(&RSTPNT *EQ ‘0100′) THEN(GOTO CMDLBL(TAG0100))
IF COND(&RSTPNT *EQ ‘0200′) THEN(GOTO CMDLBL(TAG0200))
IF COND(&RSTPNT *EQ ‘0300′) THEN(GOTO CMDLBL(TAG0300))
IF COND(&RSTPNT *EQ ‘0400′) THEN(GOTO CMDLBL(TAG0400))
IF COND(&RSTPNT *EQ ‘0500′) THEN(GOTO CMDLBL(TAG0500))
ENDDO
/* Set the restore point for the TAG we are just about to execute. That way */
/* if the program does crash then we know where to restart from… */
CHGVAR VAR(&RSTPNT) VALUE(’0100′)
TAG0100: CALL PGM(PROG1) PARM(&P1)
CHGVAR VAR(&RSTPNT) VALUE(’0200′)
TAG0200: CALL PGM(PROG2) PARM(&P1)
CHGVAR VAR(&RSTPNT) VALUE(’0300′)
TAG0300: CALL PGM(PROG3) PARM(&P1)
CHGVAR VAR(&RSTPNT) VALUE(’0400′)
TAG0400: CALL PGM(PROG4) PARM(&P1)
CHGVAR VAR(&RSTPNT) VALUE(’0500′)
TAG0500: CALL PGM(PROG5) PARM(&P1)
/* Close the program and reset the return point data area… */
TAG9900: CHGVAR VAR(&RSTPNT) VALUE(’0000′)
CHGDTAARA DTAARA(&MYPGM) VALUE(&RSTPNT)
RETURN
ENDPGM
Jonathan






