PGM (&PROGRAM &MSGID)                                                  
/* ================================================================= */
/* CHECKPGM: Check call stack for program                            */
/* If message ID passed back is blank, program is already active     */
/* ================================================================= */
             DCL        VAR(&PROGRAM) TYPE(*CHAR) LEN(10)              
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                 
             DCL        VAR(&KEYVAR) TYPE(*CHAR) LEN(4)                
/* ***************************************************************** */
/*  Start of mainline code                                           */
/* ***************************************************************** */
/* Set return parameter to blank before starting */                     
             CHGVAR     VAR(&MSGID) VALUE('       ')                   
/* Send a diagnostic message to program passed in as parameter */      
             SNDPGMMSG  MSGID(CPA6A21) MSGF(QCPFMSG) TOPGMQ(*SAME +    
                          (&PROGRAM)) MSGTYPE(*DIAG) KEYVAR(&KEYVAR)   
/* If command fails, program is not active in this job */              
             MONMSG     MSGID(CPF0000) EXEC(DO)                        
               RCVMSG     MSGTYPE(*LAST) MSGID(&MSGID)                 
               RCVMSG     MSGTYPE(*LAST) MSGID(&MSGID)                 
               GOTO       CMDLBL(ENDPGM)                               
             ENDDO                                                     
/* Remove diagnostic message from queue */                             
             RMVMSG     PGMQ(*SAME (&PROGRAM)) MSGKEY(&KEYVAR)         
ENDPGM:                                                                
RETURN                                                                 
ENDPGM