IDENTIFICATION DIVISION. **************************************************************** * * * Program name: AMQ0PUT0 * * * * Description: Sample COBOL program that puts messages * * to a message queue (example using MQPUT) * * * * 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: * * * * * * AMQ0PUT0 is a sample COBOL program to put messages on * * a message queue, and is an example of the use of MQPUT * * * * -- sample message input is read using the ACCEPT * * verb, with a blank entry indicating the end of * * input; the target queue is obtained from the * * console * * * * -- puts each text line in the input to the message * * queue, taking each line of text as the content * * of a message * * * * -- 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 target queue name from the console * * MQCONNect to default queue manager * * display name of target queue * * MQOPEN target queue for OUTPUT * * display prompt for message(s) * * while no MQI failures, * * . ACCEPT line of text * * . MQPUT message with text to target queue * * MQCLOSE target queue * * MQDISConnect from queue manager * * * * * **************************************************************** * * * * * * * Exceptions signaled: none * * Exceptions monitored: none * * * * AMQ0PUT0 has no parameters * * * **************************************************************** PROGRAM-ID. MQPUTTST. **************************************************************** 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. * Put message options 01 PMOPTIONS. COPY CMQPMOV. ** note, sample uses defaults where it can 01 WS-COMP-TEST PIC X(48) COMP-1. 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(60). 01 BUFFER-LENGTH PIC S9(9) BINARY. 01 TARGET-QUEUE PIC X(48). 01 WS-RESPONSE PIC X(300). 01 WS-REASON PIC 9(9). LINKAGE SECTION. *01 dfhcommarea pic x(32700). 01 dfhcommarea. 03 pic x occurs 0 to 32700 times depending on eibcalen. **************************************************************** PROCEDURE DIVISION. P0. ** indicate that sample program has started display 'dfhcommarea:' dfhcommarea upon sysout DISPLAY 'AMQ0PUT0 start' UPON SYSOUT. **************************************************************** * * * Display prompt for the name of the target queue * * * **************************************************************** ** DISPLAY 'Please enter the name of the target queue ' ** UPON SYSOUT ** get the target queue from StdIn. MOVE 'HEIRLOOM.Q.ETP1' TO TARGET-QUEUE ** ACCEPT TARGET-QUEUE FROM SYSIN. **************************************************************** * * * 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 MOVE CON-REASON TO WS-REASON PERFORM OVER END-IF. **************************************************************** * * * Display name of target queue read from StdIn * * * **************************************************************** DISPLAY 'target queue is ' TARGET-QUEUE UPON SYSOUT. **************************************************************** * * * Open the target message queue for output (and fail if * * MQM is quiescing) * * * **************************************************************** OPENS. MOVE TARGET-QUEUE TO MQOD-OBJECTNAME. ADD MQOO-OUTPUT 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 MOVE REASON TO WS-REASON DISPLAY 'MQOPEN ended with reason code ' REASON UPON SYSOUT END-IF. IF OPEN-CODE IS EQUAL TO MQCC-FAILED DISPLAY 'unable to open target queue for output' UPON SYSOUT MOVE REASON TO RETURN-CODE MOVE REASON TO WS-REASON PERFORM OVER END-IF. **************************************************************** * * * Put request messages to the target queue * * * **************************************************************** PUTS. ** Display prompt for the message(s) * ** DISPLAY 'Please enter the message(s) ' UPON SYSOUT MOVE OPEN-CODE TO COMPLETION-CODE. * MOVE "MQ IS THE GREATEST" TO BUFFER MOVE dfhcommarea TO BUFFER PERFORM PUTR WITH TEST BEFORE UNTIL COMPLETION-CODE IS EQUAL TO MQCC-FAILED. **************************************************************** * * * Close the target 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 MOVE REASON TO WS-REASON 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 MOVE REASON TO WS-REASON DISPLAY 'MQDISC ended with reason code ' REASON UPON SYSOUT END-IF END-IF. OVER. STRING 'MqPut to ' TARGET-QUEUE ' Finished. ' WS-REASON INTO WS-RESPONSE END-STRING. EXEC CICS SEND TEXT FROM (WS-RESPONSE) LENGTH(LENGTH OF WS-RESPONSE) END-EXEC. . ** indicate that sample program has finished DISPLAY 'AMQ0PUT0 end' UPON SYSOUT. MOVE ZERO TO RETURN-CODE. GOBACK. **************************************************************** * * * Put one request to the target queue * * * **************************************************************** PUTR. ** ACCEPT BUFFER FROM SYSIN. IF BUFFER IS NOT EQUAL TO SPACES PERFORM PUTIT ELSE MOVE MQCC-FAILED TO COMPLETION-CODE. MOVE SPACES TO BUFFER. PUTIT. MOVE 60 to BUFFER-LENGTH. COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT + MQPMO-DEFAULT-CONTEXT. MOVE MQFMT-STRING TO MQMD-FORMAT CALL 'MQPUT' USING HCONN, Q-HANDLE, MESSAGE-DESCRIPTOR, PMOPTIONS, BUFFER-LENGTH, BUFFER, COMPLETION-CODE, REASON. * report reason, if any MOVE REASON TO WS-REASON IF REASON IS NOT EQUAL TO MQRC-NONE MOVE REASON TO WS-REASON DISPLAY 'MQPUT ended with reason code ' REASON UPON SYSOUT END-IF. **************************************************************** * * * END OF AMQ0PUT0 * * * ****************************************************************