IDENTIFICATION DIVISION. **************************************************************** * * * Program name: AMQ0GET0 * * * * Description: Sample COBOL program that gets messages from * * a message queue (example using MQGET) * * * * Statement: Licensed Materials - Property of IBM * * * * 04L1773, 5765-B73 * * 04L1802, 5639-B42 * * 04L1788, 5765-B74 * * 04L1816, 5765-B75 * * 04L1830, 5639-B43 * * (C) Copyright IBM Corp. 1994, 1998 * * * * * **************************************************************** * * * Function: * * * * * * AMQ0GET0 is a sample COBOL program to get messages from * * a message queue, and is an example of MQGET * * * * -- sample gets messages from the queue which is * * obtained via the console * * * * -- displays the contents of the message queue, * * assuming each message data to represent a line * * of text to be written * * * * messages are removed from the queue * * * * -- writes a message for each MQI reason other than * * MQRC-NONE; stops if there is a MQI completion code * * of MQCC-FAILED * * * * Program logic: * * display prompt for queue name * * ACCEPT the input queue name from the console * * MQCONNect to default queue manager * * MQOPEN queue for INPUT * * while no MQI failures, * * . MQGET next message, remove from queue * * . display the result * * MQCLOSE the source queue * * MQDISConnect from queue manager * * * * * **************************************************************** * * * * * * * Exceptions signaled: none * * Exceptions monitored: none * * * * AMQ0GET0 has no parameters * * * **************************************************************** PROGRAM-ID. MQGETTST. **************************************************************** DATA DIVISION. WORKING-STORAGE SECTION. * ** Declare MQI structures needed * MQI named constants 01 MY-MQ-CONSTANTS. COPY CMQV. * Object Descriptor 01 OBJECT-DESCRIPTOR. COPY CMQODV. * Message Descriptor 01 MESSAGE-DESCRIPTOR. COPY CMQMDV. * Get message options 01 GMOPTIONS. COPY CMQGMOV. ** note, sample uses defaults where it can 01 QM-NAME PIC X(48) VALUE SPACES. 01 HCONN PIC S9(9) BINARY. 01 Q-HANDLE PIC S9(9) BINARY. 01 MY-OPTIONS PIC S9(9) BINARY. 01 COMPLETION-CODE PIC S9(9) BINARY. 01 OPEN-CODE PIC S9(9) BINARY. 01 CON-REASON PIC S9(9) BINARY. 01 REASON PIC S9(9) BINARY. 01 BUFFER PIC X(64). 01 BUFFER-LENGTH PIC S9(9) BINARY. 01 DATA-LENGTH PIC S9(9) BINARY. 01 SOURCE-QUEUE PIC X(48). 01 WS-RESPONSE. 05 WS-MESSAGE OCCURS 200 TIMES PIC X(80). 01 WS-SUB PIC 999. **************************************************************** PROCEDURE DIVISION. P0. ** indicate that sample program has started DISPLAY 'AMQ0GET0 start' UPON SYSOUT. **************************************************************** * * * Display prompt for the name of the source queue * * * **************************************************************** DISPLAY 'Please enter the name of the source queue ' UPON SYSOUT ** get the source queue from StdIn. * ACCEPT SOURCE-QUEUE FROM SYSIN. MOVE 'HEIRLOOM.Q.ETP1' TO SOURCE-QUEUE **************************************************************** * * * Connect to default queue manager * * * **************************************************************** CALL 'MQCONN' USING QM-NAME, HCONN, COMPLETION-CODE, CON-REASON. * report reason and stop if it failed IF COMPLETION-CODE IS EQUAL TO MQCC-FAILED DISPLAY 'MQCONN ended with reason code ' CON-REASON UPON SYSOUT MOVE CON-REASON TO RETURN-CODE GOBACK END-IF. * **************************************************************** * * * Open the message queue (and fail if MQM is quiescing) * * * **************************************************************** OPENS. MOVE SOURCE-QUEUE TO MQOD-OBJECTNAME. ADD MQOO-INPUT-AS-Q-DEF MQOO-FAIL-IF-QUIESCING GIVING MY-OPTIONS. CALL 'MQOPEN' USING HCONN, OBJECT-DESCRIPTOR, MY-OPTIONS, Q-HANDLE, OPEN-CODE, REASON. * report reason, if any; stop if failed IF REASON IS NOT EQUAL TO MQRC-NONE DISPLAY 'MQOPEN ended with reason code ' REASON UPON SYSOUT END-IF. IF OPEN-CODE IS EQUAL TO MQCC-FAILED DISPLAY 'unable to open queue for input' UPON SYSOUT MOVE REASON TO RETURN-CODE GOBACK END-IF. **************************************************************** * * * Get messages from the message queue * * * **************************************************************** GETS. MOVE OPEN-CODE TO COMPLETION-CODE. PERFORM GETR THRU DISPR WITH TEST BEFORE UNTIL COMPLETION-CODE IS EQUAL TO MQCC-FAILED. **************************************************************** * * * Close the source queue * * * **************************************************************** CLOSES. MOVE MQCO-NONE TO MY-OPTIONS. CALL 'MQCLOSE' USING HCONN, Q-HANDLE, MY-OPTIONS, COMPLETION-CODE, REASON. * report reason, if any IF REASON IS NOT EQUAL TO MQRC-NONE DISPLAY 'MQCLOSE ended with reason code ' REASON UPON SYSOUT END-IF. **************************************************************** * * * Disconnect from queue manager (if not previously connected) * * * **************************************************************** DISCS. IF CON-REASON IS NOT EQUAL TO MQRC-ALREADY-CONNECTED CALL 'MQDISC' USING HCONN, COMPLETION-CODE, REASON * report reason, if any IF REASON IS NOT EQUAL TO MQRC-NONE DISPLAY 'MQDISC ended with reason code ' REASON UPON SYSOUT END-IF END-IF. OVER. ** indicate that sample program has finished EXEC CICS SEND TEXT FROM (WS-RESPONSE) LENGTH(LENGTH OF WS-RESPONSE) END-EXEC. DISPLAY 'AMQ0GET0 end' UPON SYSOUT. MOVE ZERO TO RETURN-CODE. GOBACK. **************************************************************** * * * Get one message * * * * In order to read the messages in sequence, MSGID and * * CORRELID must have the default value. MQGET sets them * * to the values for the message it returns, so re-initialise * * them each time * * * **************************************************************** GETR. ADD 1 TO WS-SUB MOVE MQMI-NONE TO MQMD-MSGID. MOVE MQCI-NONE TO MQMD-CORRELID. MOVE SPACES TO BUFFER. COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT + MQGMO-WAIT MOVE 15000 TO MQGMO-WAITINTERVAL. MOVE 64 to BUFFER-LENGTH. CALL 'MQGET' USING HCONN, Q-HANDLE, MESSAGE-DESCRIPTOR, GMOPTIONS, BUFFER-LENGTH, BUFFER, DATA-LENGTH, COMPLETION-CODE, REASON. DISPLAY 'MQGET COMPLETION-CODE: ' COMPLETION-CODE UPON SYSOUT DISPLAY 'MQGET REASON : ' REASON UPON SYSOUT IF COMPLETION-CODE = MQCC-OK THEN MOVE BUFFER TO WS-MESSAGE(WS-SUB) ELSE IF REASON = MQRC-NO-MSG-AVAILABLE AND WS-SUB = 1 THEN MOVE 'No messages available.' TO WS-MESSAGE(WS-SUB) END-IF END-IF **************************************************************** * * * Display message received * * * **************************************************************** DISPM. IF COMPLETION-CODE IS NOT EQUAL TO MQCC-FAILED DISPLAY 'message is <' BUFFER '>' UPON SYSOUT END-IF. **************************************************************** * * * Report reason, if any * * * **************************************************************** DISPR. IF REASON IS NOT EQUAL TO MQRC-NONE IF REASON IS EQUAL TO MQRC-NO-MSG-AVAILABLE DISPLAY 'no more messages' UPON SYSOUT ELSE DISPLAY 'MQGET ended with reason code ' REASON UPON SYSOUT END-IF END-IF. **************************************************************** * * * END OF AMQ0GET0 * * * ****************************************************************