Program A can call program B and at the same time pass data as parameters. While program B is running, it can call program C. At this point, there are three programs in your program stack: A, B and C. This process can continue indefinitely, calling program after program and never returning to the caller.
There is a problem, however. In some HLLs such as RPG, program C cannot call program B or A (which is already in the program stack) because doing so would create a recursion and an infinite loop of programs calling one another. Adding insult to injury, OS/400 has no built-in function that will let you determine, before calling program X, whether program X is already in the stack. You must call the program and hope for the best.
Enter the Check Program Stack command (CHKPGMSTK). This command (Figures 2a and 2b) accepts a program name as a parameter and returns a character value 'Y' if the program is in your program stack, or 'N' if it isn't.
This is accomplished with the SNDPGMMSG command. Because the SNDPGMMSG command attempts to send a message to the program that you named, SNDPGMMSG will fail if the program is not in your program stack. If SNDPGMMSG is successful, the message just sent is removed, "just in case."
To solve your problem, therefore, you could call the processing program for CHKPGMSTK (program PGM001CL) from your RPG program, as follows:
CALL 'PGM001CL' PARM 'PGMX' PGMNAM 10 PARM RTNCDE 1
If RTNCDE has 'Y,' you can't call program PGMX from your RPG program.
TechTalk: Checking the Program Stack
Figure 2A Command CHKPGMSTK
CHKPGMSTK: CMD PROMPT('Check Program Stack') PARM KWD(PGM) TYPE(*SNAME) LEN(10) MIN(1) + PROMPT('Program name') PARM KWD(RTNCDE) TYPE(*CHAR) LEN(1) RTNVAL(*YES) + CHOICE('''Y'' or ''N''') PROMPT('Return + code (CHAR(1))')
TechTalk: Checking the Program Stack
Figure 2B CL program PGM001CL
PGM001CL: + PGM PARM(&PGM &RTNCDE) DCL VAR(&PGM) TYPE(*CHAR) LEN(10) DCL VAR(&RTNCDE) TYPE(*CHAR) LEN(1) DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) CHGVAR VAR(&RTNCDE) VALUE('Y') SNDPGMMSG MSG(TEST) TOPGMQ(*SAME &PGM) MSGTYPE(*INFO) + KEYVAR(&MSGKEY) MONMSG MSGID(CPF2479 CPF2469) EXEC(DO) CHGVAR VAR(&RTNCDE) VALUE('N') ENDDO IF COND(&RTNCDE) THEN(DO) RMVMSG PGMQ(*SAME &PGM) MSGKEY(&MSGKEY) CLEAR(*BYKEY) ENDDO ENDPGM
LATEST COMMENTS
MC Press Online