Figure 2. Command exit point program example
======================================================================== /* Program Name: WRKJOBEXIT */ /* Purpose: This is the exit program for the Command WRKJOB. */ /* Exit Point IS QIBM_QCA_CHG_COMMAND */ /* Parameter format for parm1 is CHGC0100. */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Copyright© 2002-2007 Dan Riehl – All rights reserved */ PGM PARM(&ExitInfo &NewString &Newlength) DCL &Class *CHAR 10 DCL &OffsetDec *DEC (7 0) DCL &CmdLenDec *DEC (7 0) DCL &ExitInfo *CHAR 2000 /* CHGC0100 interface data */ /* Exit point interface CHGC0100 for QIBM_CA_CHG_COMMAND exit point */ /* Input parameters */ DCL &ExitPoint *CHAR 20 /* Exit Point name */ DCL &ExitFormat *CHAR 8 /* Exit Point Format */ DCL &CmdName *CHAR 10 /* Command name being executed */ DCL &CmdLib *CHAR 10 /* Command Library */ DCL &Change *CHAR 1 /* Change allowed? 1=yes 0=no */ DCL &Prompt *CHAR 1 /* Prompt requested? 1=yes 0=no */ DCL &Filler *CHAR 2 /* Reserved by IBM */ DCL &Offset *CHAR 4 /* Offset to command string */ DCL &CmdLength *CHAR 4 /* Command string length */ DCL &CmdString *CHAR 2000 /* Command String */ /* Output Parameters */ DCL &NewString *CHAR 2000 /* Replace with this command */ DCL &NewLength *CHAR 4 /* Length of new command */ /* 0 = no new command */ /* Error handling variables */ DCL &MsgID *CHAR 7 DCL &MsgFile *CHAR 10 DCL &MsgFLib *CHAR 10 DCL &MsgData *CHAR 512 MONMSG CPF0000 EXEC(GOTO ERROR) /* Parse out the exit info data */ CHGVAR &ExitPoint %SST(&ExitInfo 1 20) CHGVAR &ExitFormat %SST(&ExitInfo 21 8) CHGVAR &CmdName %SST(&ExitInfo 29 10) CHGVAR &CmdLib %SST(&ExitInfo 39 10) CHGVAR &Change %SST(&ExitInfo 49 1) CHGVAR &Prompt %SST(&ExitInfo 50 1) CHGVAR &Filler %SST(&ExitInfo 51 2) CHGVAR &Offset %SST(&ExitInfo 53 4) CHGVAR &CmdLength %SST(&ExitInfo 57 4) CHGVAR &CmdLenDec %BIN(&Cmdlength) CHGVAR &OffsetDec (%BIN(&Offset) + 1) /* Set offset */ CHGVAR &CmdString %SST(&ExitInfo &OffsetDec &CmdLenDec) IF (&Change = '0') GOTO ENDIT /* If Change is not allowed */ RTVUSRPRF USRCLS(&Class) IF (&Class = '*USER') DO /* If a user class of *USER */ CHGVAR &NewString 'QSYS/DSPJOB' CHGVAR %BIN(&Newlength) 11 ENDDO ENDIT: RETURN /* Normal end of Program */ /* Error handling */ ERROR: RCVMSG MSGTYPE(*LAST) MSGDTA(&MsgData) + MSGID(&MsgID) MSGF(&MsgFile) + SNDMSGFLIB(&MsgFLib) MONMSG CPF0000 EXEC(RETURN) SNDPGMMSG MSGID(&MsgID) MSGF(&MSGFLIB/&MsgFile) + MSGDTA(&MsgData) MSGTYPE(*ESCAPE) MONMSG CPF0000 EXEC(RETURN) ENDPGM