This example shows how to print messages to spool files.
Refer to Example in OPM RPG: Accessing the HOLD attribute for the original example. The following example also works for OPM COBOL.
IDENTIFICATION DIVISION.
*****************************************************************
*****************************************************************
*
*Program Name: JOBDAPI
*
*Programming Language: ILE COBOL
*
*Description: This example shows how to print messages
* to spool files.
*
*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.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
SELECT LISTING ASSIGN TO PRINTER-QPRINT
ORGANIZATION IS SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
FD LISTING RECORD CONTAINS 132 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS LIST-LINE.
01 LIST-LINE PIC X(132).
*
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.
*
* Retrieve Job Description API Include
*
COPY QWDRJOBD OF QSYSINC-QLBLSRC.
*
* Command String Data Structure
*
01 HOLD-VALUE.
05 TEXT1 PIC X(13) VALUE 'HOLD value - '.
05 HOLD PIC X(10).
*
* Error Message Text
*
01 MESSAGE-TEXT.
05 MSG1 PIC X(19) VALUE 'Failed. Error ID - '.
05 MSGID PIC X(7).
*
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.
*
* 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.
*
* If no bytes available, API was successful; print HOLD value
*
IF BYTES-AVAILABLE OF QUS-EC = 0 PERFORM GOOD.
*
* If some bytes available, API failed; print Error message ID
*
IF BYTES-AVAILABLE OF QUS-EC > 0 PERFORM BAD.
*
STOP RUN.
*
* End of Mainline
*
*
* Subroutine to perform if no errors were encountered.
*
GOOD.
OPEN OUTPUT LISTING.
MOVE HOLD-JOB-QUEUE TO HOLD.
WRITE LIST-LINE FROM HOLD-VALUE.
*
* Subroutine to perform if an error was returned in error code.
*
BAD.
OPEN OUTPUT LISTING.
MOVE EXCEPTION-ID TO MSGID.
WRITE LIST-LINE FROM MESSAGE-TEXT.
STOP RUN.