This program illustrates how to use APIs to create and manipulate a *DTAQ. The following program also works with OPM COBOL.
Refer to Example in ILE C: Data queue for the original example.
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program Name: DQUEUEX
*
* Programming Language: COBOL
*
* Description: This program illustrates how to use APIs to
* create and manipulate a *DTAQ.
*
* Header Files Included: QUSEC - Error Code Parameter
* QCAPCMD - Process Command API
*
***************************************************************
*
***************************************************************
PROGRAM-ID. DQUEUEX.
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
*
COPY QUSEC OF QSYSINC-QLBLSRC.
*
* Process Command API Include
*
COPY QCAPCMD OF QSYSINC-QLBLSRC.
*
* Command strings
*
01 CRTLIB PIC X(50) VALUE "CRTLIB QUEUELIB".
01 DLTLIB PIC X(50) VALUE "DLTLIB QUEUELIB".
01 CRTDQ PIC X(50)
VALUE "CRTDTAQ QUEUELIB/EXAMPLEQ MAXLEN(10)".
01 DLTDQ PIC X(50) VALUE "DLTDTAQ QUEUELIB/EXAMPLEQ".
*
* Error message text
*
01 BAD-NEWS.
05 TEXT1 PIC X(14) VALUE "Failed in API ".
05 API-NAME PIC X(10) VALUE "QCAPCMD".
05 TEXT2 PIC X(11) VALUE "with error ".
05 EXCEPTION-ID PIC X(07).
*
* Miscellaneous elements
*
01 COMMAND-LENGTH PIC S9(09) VALUE 50 BINARY.
01 RECEIVER PIC X(01).
01 RECEIVER-LENGTH PIC S9(09) VALUE 0 BINARY.
01 OPTIONS-SIZE PIC S9(09) VALUE 20 BINARY.
01 FORMAT-NAME PIC X(08) VALUE "CPOP0100".
01 FIRST-ERROR PIC X(01) VALUE "0".
01 NAME-OF-QUEUE PIC X(10) VALUE "EXAMPLEQ".
01 NAME-OF-LIBRARY PIC X(10) VALUE "QUEUELIB".
01 SIZE-OF-MSG PIC S9(05) VALUE 10 PACKED-DECIMAL.
01 WAIT-TIME PIC S9(05) VALUE 0 PACKED-DECIMAL.
01 MSG PIC X(10) VALUE "EXAMPLE".
01 MSG-BACK PIC X(10).
*
* Beginning of mainline
*
PROCEDURE DIVISION.
MAIN-LINE.
*
* Initialize the error code parameter. To signal exceptions to
* this program by the API, you need to set the bytes provided
* field of the error code to zero. Because this program has
* exceptions sent back through the error code parameter, it sets
* the bytes provided field to the number of bytes it gives the
* API for the parameter.
*
MOVE 16 TO BYTES-PROVIDED.
*
* Initialize QCAPCMD options control block for CL processing
*
MOVE 0 TO COMMAND-PROCESS-TYPE.
MOVE "0" TO DBCS-DATA-HANDLING.
MOVE "0" TO PROMPTER-ACTION.
MOVE "0" TO COMMAND-STRING-SYNTAX.
MOVE SPACES TO MESSAGE-KEY.
MOVE LOW-VALUES TO RESERVED OF QCA-PCMD-CPOP0100.
*
* Create library QUEUELIB
*
CALL QCAPCMD USING CRTLIB, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
*
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
*
* Create a data queue called EXAMPLEQ in library QUEUELIB. The
* queue will have a maximum entry length set at 10, and will be
* FIFO (first-in first-out).
*
CALL QCAPCMD USING CRTDQ, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
*
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
*
* Send information to the data queue.
*
CALL "QSNDDTAQ" USING NAME-OF-QUEUE, NAME-OF-LIBRARY,
SIZE-OF-MSG, MSG.
*
* Retrieve information from the data queue.
*
CALL "QRCVDTAQ" USING NAME-OF-QUEUE, NAME-OF-LIBRARY,
SIZE-OF-MSG, MSG-BACK, WAIT-TIME.
*
* Display the returned message
*
DISPLAY MSG-BACK.
*
* Delete the data queue
*
CALL QCAPCMD USING DLTDQ, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
*
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
*
* Delete the library
*
CALL QCAPCMD USING DLTLIB, COMMAND-LENGTH, QCA-PCMD-CPOP0100,
OPTIONS-SIZE, FORMAT-NAME, RECEIVER,
RECEIVER-LENGTH, RECEIVER-LENGTH, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
*
IF BYTES-AVAILABLE > 0 PERFORM ERROR-FOUND.
*
STOP RUN.
*
* End of MAINLINE
*
*****************************************************************
*
ERROR-FOUND.
*
* Process errors returned from the API.
*
* If first error found, then open QPRINT *PRTF
*
IF FIRST-ERROR = "0" OPEN OUTPUT LISTING,
MOVE "1" TO FIRST-ERROR.
*
* Print the error and the API that received the error
*
MOVE EXCEPTION-ID OF QUS-EC TO EXCEPTION-ID OF BAD-NEWS.
WRITE LIST-LINE FROM BAD-NEWS.