This example is a program that sends the last diagnostic message as an escape message.
The following program is an example default program that could be used when a diagnostic message is sent followed by an escape message. This program could be an original program model (OPM) CL program or an Integrated Language Environment® (ILE) program that has this single CL procedure.
PGM PARM(&MSGQ &MRK)
DCL VAR(&MRK) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGQ) TYPE(*CHAR) LEN(6381)
DCL VAR(&QNAME) TYPE(*CHAR) LEN(4096)
DCL VAR(&MODNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&BPGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&BLANKMRK) TYPE(*CHAR) LEN(4) VALUE(' ')
DCL VAR(&DIAGMRK) TYPE(*CHAR) LEN(4) VALUE(' ')
DCL VAR(&SAVEMRK) TYPE(*CHAR) LEN(4)
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100)
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&OFFSET) TYPE(*DEC)
DCL VAR(&LENGTH) TYPE(*DEC)
/* Check for OPM program type */
IF (%SST(&MSGQ 277 1) *EQ '0') THEN(DO)
CHGVAR VAR(&QNAME) VALUE(%SST(&MSGQ 1 10))
CHGVAR VAR(&MODNAME) VALUE('*NONE')
CHGVAR VAR(&BPGMNAME) VALUE('*NONE')
ENDDO
ELSE DO
/* Not an OPM program; always use the long procedure name */
CHGVAR VAR(&OFFSET) VALUE(%BIN(&MSGQ 281 4))
CHGVAR VAR(&LENGTH) VALUE(%BIN(&MSGQ 285 4))
CHGVAR VAR(&QNAME) VALUE(%SST(&MSGQ &OFFSET &LENGTH))
CHGVAR VAR(&MODNAME) VALUE(%SST(&MSGQ 11 10))
CHGVAR VAR(&BPGMNAME) VALUE(%SST(&MSGQ 1 10))
ENDDO
GETNEXTMSG: CHGVAR VAR(&SAVEMRK) VALUE(&DIAGMRK)
RCVMSG PGMQ(*SAME (&QNAME &MODNAME &BPGMNAME)) +
MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&DIAGMRK)
IF (&DIAGMRK *NE &BLANKMRK) THEN(GOTO GETNEXTMSG)
ELSE IF (&SAVEMRK *NE ' ') THEN(DO)
/* If no diag message is sent, no message is sent to the previous program */
RCVMSG PGMQ(*SAME (&QNAME &MODNAME &BPGMNAME)) +
MSGKEY(&SAVEMRK) RMV(*NO) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV (&QNAME +
&MODNAME &BPGMNAME))
MSGTYPE(*ESCAPE)
ENDDO
ENDPGM
The program receives all the diagnostic messages in FIFO order. Then it sends the last diagnostic message as an escape message to allow the previous program to monitor for it.