This example shows how to make use of an error returned in the error code structure.
Refer to Example in OPM RPG: Retrieving the HOLD parameter (error code structure) for the original example. The following program also works for OPM COBOL.
IDENTIFICATION DIVISION. ***************************************************************** ***************************************************************** * *Program Name: JOBDAPI * *Programming Language: COBOL * *Description: This example shows how to make use of an * error returned in the error code * structure. * *Header Files Included: QUSEC - Error Code Parameter * QWDRJOBD - Retrieve Job Description API * ***************************************************************** ***************************************************************** * PROGRAM-ID. JOBDAPI. * ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. * DATA DIVISION. WORKING-STORAGE SECTION. * * Error Code parameter include. As this sample program * uses COPY to include the error code structure, only the first * 16 bytes of the error code structure are available. If the * application program needs to access the variable length * exception data for the error, the developer should physically * copy the QSYSINC include and modify the copied include to * define additional storage for the exception data. * COPY QUSEC OF QSYSINC-QLBLSRC. (1) * * Retrieve Job Description API Include * COPY QWDRJOBD OF QSYSINC-QLBLSRC. * * Command String Data Structure * 01 COMMAND-STRING. 05 TEXT1 PIC X(26) VALUE 'SNDMSG MSG(''HOLD value is'. 05 HOLD PIC X(10). 05 TEXT2 PIC X(15) VALUE ''') TOUSR(QPGMR)'. * * Message Identifier Data Structure * 01 MESSAGE-TWO. 05 MSG2A PIC X(43) VALUE 'SNDMSG MSG(''Program failed with message ID'. 05 MSGIDD PIC X(7). 05 MSG2B PIC X(15) VALUE ''') TOUSR(QPGMR)'. * 01 COMMAND-LENGTH PIC S9(10)V99999 COMP-3. 01 RECEIVER-LENGTH PIC S9(9) COMP-4. 01 FORMAT-NAME PIC X(8) VALUE 'JOBD0100'. 01 QCMDEXC PIC X(10) VALUE 'QCMDEXC'. * * Job Description and Library Name Structure * 01 JOBD-AND-LIB-NAME. 05 JOB-DESC PIC X(10). 05 JOB-DESC-LIB PIC X(10). * LINKAGE SECTION. * * Two Parameters are being passed into this program. * 01 JOBD PIC X(10). 01 JOBDL PIC X(10). * PROCEDURE DIVISION USING JOBD, JOBDL. MAIN-LINE. * * Beginning of Mainline * * Move the two parameters passed into JOB-DESC and JOB-DESC-LIB. * MOVE JOBD TO JOB-DESC. MOVE JOBDL TO JOB-DESC-LIB. * * Error Code Parameter is set to 16. * MOVE 16 TO BYTES-PROVIDED. (3) * * Receiver Length Set to 390. * MOVE 390 TO RECEIVER-LENGTH. * * Call the QWDRJOBD API. * CALL QWDRJOBD USING QWD-JOBD0100, RECEIVER-LENGTH, FORMAT-NAME, JOBD-AND-LIB-NAME, QUS-EC. * * See if any errors were returned in the error code parameter. * PERFORM ERRCOD. * * Move HOLD-JOB-QUEUE to HOLD so that we can display the value using * the command string. * MOVE HOLD-JOB-QUEUE TO HOLD. * * Let's tell everyone what the hold value was for this job. * MOVE 51 TO COMMAND-LENGTH. CALL QCMDEXC USING COMMAND-STRING, COMMAND-LENGTH. * STOP RUN. * * End of Mainline * * * Subroutine to handle errors returned in the error code * parameter. * ERRCOD. * IF BYTES-AVAILABLE OF QUS-EC > 0 (2) * * Process errors returned from the API. * MOVE 65 TO COMMAND-LENGTH, MOVE EXCEPTION-ID TO MSGIDD, CALL QCMDEXC USING MESSAGE-TWO, COMMAND-LENGTH, STOP RUN.