ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/exdqilecobol.htm

232 lines
9.8 KiB
HTML
Raw Normal View History

2024-04-02 14:02:31 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en-us" xml:lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="security" content="public" />
<meta name="Robots" content="index,follow" />
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
<meta name="DC.Type" content="reference" />
<meta name="DC.Title" content="Example in ILE COBOL: Data queue" />
<meta name="abstract" content="This program illustrates how to use APIs to create and manipulate a *DTAQ. The following program also works with OPM COBOL." />
<meta name="description" content="This program illustrates how to use APIs to create and manipulate a *DTAQ. The following program also works with OPM COBOL." />
<meta name="DC.Relation" scheme="URI" content="ExTaskDataque.htm" />
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Format" content="XHTML" />
<meta name="DC.Identifier" content="exdqilecobol" />
<meta name="DC.Language" content="en-us" />
<!-- All rights reserved. Licensed Materials Property of IBM -->
<!-- US Government Users Restricted Rights -->
<!-- Use, duplication or disclosure restricted by -->
<!-- GSA ADP Schedule Contract with IBM Corp. -->
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
<link rel="stylesheet" type="text/css" href="./ic.css" />
<title>Example in ILE COBOL: Data queue</title>
</head>
<body id="exdqilecobol"><a name="exdqilecobol"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Example in ILE COBOL: Data queue</h1>
<div><p>This program illustrates how to use APIs to create and manipulate
a *DTAQ. The following program also works with OPM COBOL.</p>
<div class="section" id="exdqilecobol__HDRDQ1"><a name="exdqilecobol__HDRDQ1"><!-- --></a><p>Refer to <a href="exdqilec.htm">Example in ILE C: Data queue</a> for
the original example.</p>
<div class="note"><span class="notetitle">Note:</span> Read the <a href="codedisclaimer.htm">Code license and disclaimer information</a> for
important legal information.</div>
<pre> 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 &gt; 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 &gt; 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 &gt; 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 &gt; 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.</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="ExTaskDataque.htm" title="Data queues and user queues both provide a means for one or more processes to communicate asynchronously. The queues can be processed FIFO (first-in first-out), LIFO (last-in first-out), or by key.">Examples: Using data queues or user queues</a></div>
</div>
</div>
</body>
</html>