Quelle  csq4cvb3.cob   Sprache: unbekannt

CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4CVB3.
      *REMARKS
      *****************************************************************
      *   @START_COPYRIGHT@                                           *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1993, 1997    *
      *                                                               *
      *   Status:        Version 1 Release 2                          *
      *   @END_COPYRIGHT@                                             *
      *                                                               *
      *  Product Number        : 5695-137                             *
      *                                                               *
      *  Module Name           : CSQ4CVB3                             *
      *                                                               *
      *  Environment           : CICS/ESA Version 3.3; COBOL II       *
      *                                                               *
      *  CICS Transaction Name : MVB3                                 *
      *                                                               *
      *  Description : Sample program to show a reply being developed *
      *                and sent in response to an input message.      *
      *                The account file is read; if the account is    *
      *                known, data from the file is used in the reply,*
      *                if the account is not known, an appropriate    *
      *                response is sent.                              *
      *                                                               *
      *                The queue on which the input message is to be  *
      *                found is identified in the trigger information *
      *                available to the program.                      *
      *                                                               *
      *  Function    : This program provides the checking account     *
      *                query function for the credit check sample     *
      *                See IBM MQSeries for MVS/ESA Application       *
      *                Programming Reference for details.             *
      *                                                               *
      *  Dependency  : Uses VSAM file known to CICS as 'CSQ4FIL'      *
      *                                                               *
      * ************************************************************* *
          EJECT
      * ************************************************************* *
      *                                                               *
      *                     Program logic                             *
      *                     -------------                             *
      *                                                               *
      *  Start  (A-MAIN SECTION)                                      *
      *  -----                                                        *
      *       Check the program is started with data.                 *
      *       If no go to invalid-start-routine                       *
      *       End-if                                                  *
      *       Retrieve input queue name from trigger data             *
      *                                                               *
      *       Open the input queue                                    *
      *       If open unsuccessful                                    *
      *          Record error and exit from program                   *
      *       End-if                                                  *
      *                                                               *
      *       Set the call parameters                                 *
      *       Get a message from the input queue with wait            *
      *                                                               *
      *       Do while messages are retrieved                         *
      *          If expected message type                             *
      *             Perform PROCESS-QUERY                             *
      *          Else                                                 *
      *             Perform CHECKQ-UNKNOWN-MSG                        *
      *          End-if                                               *
      *          Reset the call parameters                            *
      *          Get the next message from the input queue with wait  *
      *       End-do                                                  *
      *                                                               *
      *       If loop has not ended because no message is available   *
      *          Record the reason                                    *
      *       End-If                                                  *
      *                                                               *
      *       Close the queues                                        *
      *       Return to CICS                                          *
      *                                                               *
      *                                                               *
      *  PROCESS-QUERY SECTION                                        *
      *  ---------------------                                        *
      *       Initialize the reply message with query information     *
      *                                                               *
      *       Look for the account number in the file                 *
      *       Evaluate the response to the file read                  *
      *          When record found                                    *
      *             Build reply message data, using data from file    *
      *          When record not found                                *
      *             Build reply message data, indicating 'not known'  *
      *          When other                                           *
      *             Record the error                                  *
      *             Build reply message data, indicating file read    *
      *             error                                             *
      *       End-evaluate                                            *
      *                                                               *
      *       Set the parameters for the reply message                *
      *                                                               *
      *       Put message to queue                                    *
      *       If put unsuccessful                                     *
      *          Record the error                                     *
      *          Forward the message to the samples dead queue        *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *  CLOSE-QUEUES                                                 *
      *  ------------                                                 *
      *       Close the input queue                                   *
      *       If close unsuccessful                                   *
      *          Record the error                                     *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *  CHECKQ-UNKNOWN-MSG                                           *
      *  ------------------                                           *
      *       Record the error                                        *
      *       Forward the message to the samples dead queue           *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *  RECORD-CALL-ERROR                                            *
      *  -----------------                                            *
      *       Get the time from CICS                                  *
      *       Get the time formatted by CICS                          *
      *       Build the output message data                           *
      *                                                               *
      *       Write the call error message to CICS TS queue CSQ4SAMP  *
      *       Write the log error message to CICS TD queue CSML       *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *  FORWARD-MSG-TO-DLQ                                           *
      *  ------------------                                           *
      *       Set the object descriptor, open options, and message    *
      *       descriptor to enable the message to be put to the       *
      *       samples dead letter queue                               *
      *                                                               *
      *       If message to be sent is longer than buffer             *
      *          Set message length to send the full buffer           *
      *       End-if                                                  *
      *                                                               *
      *       Put the message (using MQPUT1) to the queue             *
      *       If put successful                                       *
      *          Record the fact                                      *
      *       Else                                                    *
      *          Record the error                                     *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *  INVALID-START-ROUTINE                                        *
      *  ---------------------                                        *
      *       Build error message                                     *
      *       Send message                                            *
      *       Return to cics.                                         *
      *                                                               *
      * ************************************************************* *
           EJECT
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-MESSAGE                 PIC X(70).
       01  W00-STARTCODE               PIC X(02).
       01  W00-WAIT-INTERVAL           PIC S9(09) BINARY VALUE 30000.
       01  W00-RESPONSE                PIC S9(09) BINARY.
      *
      *    W01 - Queue names
      *
       01  W01-QUEUE-NAMES.
           05  W01-DEAD-QNAME          PIC X(48) VALUE
           'CSQ4SAMP.DEAD.QUEUE                             '.
      *
      *    CSQ4VB7 contains W02 messages sent in reply messages
      *
       COPY CSQ4VB7.
      *
      *    W03 - API fields
      *
       01  W03-HCONN                   PIC S9(9) BINARY VALUE ZERO.
       01  W03-OPTIONS                 PIC S9(9) BINARY.
       01  W03-HOBJ-CHECKQ             PIC S9(9) BINARY.
       01  W03-COMPCODE                PIC S9(9) BINARY.
       01  W03-REASON                  PIC S9(9) BINARY.
       01  W03-DATALEN                 PIC S9(9) BINARY.
       01  W03-BUFFLEN                 PIC S9(9) BINARY.
      *
       01  W03-MSG-BUFFER.
           05 W04-CSQ4BCAQ.
           COPY CSQ4VB3.
      *
       01  W03-PUT-BUFFER.
           05 W04-CSQ4BQRM.
           COPY CSQ4VB4.
      *
      *    W04 - File handling fields
      *
       01  W04-FILE-BUFFER.
           05 W04-CSQ4CAQ.
           COPY CSQ4VB6.
      *
       01  W04-READ-MESSAGE-LENGTH     PIC S9(4) BINARY.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
       01  MQM-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV.
       01  MQM-GET-MESSAGE-OPTIONS.
           COPY CMQGMOV.
       01  MQM-TRIGGER-MESSAGE.
           COPY CMQTML.
      *
      *    CICS ts queue fields
      *
       01  W05-TD-MESSAGE-LENGTH    PIC S9(4) BINARY.
       01  W05-TS-MESSAGE-LENGTH    PIC S9(4) BINARY.
       01  W05-ABSTIME              PIC S9(15) COMP-3.
      *
      *    CSQ4VB8 contains error messages used in this program
      *
       COPY CSQ4VB8.
      *
      *    CMQV contains constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  W99-MQV.
       COPY CMQV SUPPRESS.
      *
      *    DFHAID contains the constants used for checking for
      *    attention identifiers
      *
       COPY DFHAID SUPPRESS.
      *
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
      * ------------------------------------------------------------- *
      *
       EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section initializes and controls the program flow      *
      *                                                              *
      *  After opening the input queue, the program enters a loop    *
      *  getting and processing messages.  Once no more messages     *
      *  are available, shown by the program timing out, control is  *
      *  returned to CICS                                            *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Check that the program has been started with data
      *
           EXEC CICS ASSIGN
               STARTCODE(W00-STARTCODE)
           END-EXEC.
      *
           IF W00-STARTCODE NOT = 'SD'
               PERFORM INVALID-START-ROUTINE
      *        No return from INVALID-START-ROUTINE
           END-IF.
      *
      *    Retrieve the trigger data for this transaction
      *
           EXEC CICS RETRIEVE
                     INTO(MQTM)
           END-EXEC.
      *
      *    At this point the data retrieved has name of the queue
      *    which has caused this program to be triggered
      *
      *    Open the queue
      *
           MOVE MQOT-Q      TO MQOD-OBJECTTYPE.
           MOVE MQTM-QNAME  TO MQOD-OBJECTNAME.
      *
      *    Initialize options and open the queue for input
      *
           COMPUTE W03-OPTIONS = MQOO-INPUT-SHARED +
                                 MQOO-SAVE-ALL-CONTEXT.
      *
           CALL 'MQOPEN' USING W03-HCONN
                               MQOD
                               W03-OPTIONS
                               W03-HOBJ-CHECKQ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output from the open, if
      *    not ok then exit program
      *
           IF W03-COMPCODE NOT = MQCC-OK THEN
               MOVE 'MQOPEN'        TO M02-OPERATION
               MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME
               PERFORM RECORD-CALL-ERROR
               GO TO A-MAIN-EXIT.
      *
      *    Now get and process messages
      *
           COMPUTE MQGMO-OPTIONS = MQGMO-WAIT +
                                   MQGMO-ACCEPT-TRUNCATED-MSG +
                                   MQGMO-SYNCPOINT.
           MOVE LENGTH OF W03-MSG-BUFFER TO W03-BUFFLEN.
           MOVE W00-WAIT-INTERVAL TO MQGMO-WAITINTERVAL.
           MOVE MQMI-NONE TO MQMD-MSGID.
           MOVE MQCI-NONE TO MQMD-CORRELID.
      *
      *    Make the first MQGET call outside the loop
      *
           CALL 'MQGET' USING W03-HCONN
                              W03-HOBJ-CHECKQ
                              MQMD
                              MQGMO
                              W03-BUFFLEN
                              W03-MSG-BUFFER
                              W03-DATALEN
                              W03-COMPCODE
                              W03-REASON.
      *
      *    Test the output of the MQGET call using the PERFORM loop
      *    that follows
      *
      *
      *    Loop from here to END-PERFORM until the MQGET call fails
      *
           PERFORM WITH TEST BEFORE
                   UNTIL W03-COMPCODE = MQCC-FAILED
      *
      *       Perform the message received
      *
              EVALUATE TRUE
                  WHEN ACCOUNT-QUERY-MESSAGE
                      PERFORM PROCESS-QUERY
                  WHEN OTHER
                      PERFORM CHECKQ-UNKNOWN-MSG
              END-EVALUATE
      *
              EXEC CICS SYNCPOINT END-EXEC
      *
      *       Reset parameters for the next call
      *
              MOVE MQMI-NONE TO MQMD-MSGID
              MOVE MQCI-NONE TO MQMD-CORRELID
      *
      *       Get the next message
      *
              CALL 'MQGET' USING W03-HCONN
                                 W03-HOBJ-CHECKQ
                                 MQMD
                                 MQGMO
                                 W03-BUFFLEN
                                 W03-MSG-BUFFER
                                 W03-DATALEN
                                 W03-COMPCODE
                                 W03-REASON
      *
      *       Test the output of the MQGET call at the top of the loop.
      *       Exit the loop if an error occurs
      *
           END-PERFORM.
      *
      *    Test the output of the MQGET call.  If the call failed,
      *    send an error message showing the completion code and
      *    reason code, unless the completion code is NO-MSG-AVAILABLE
      *
           IF (W03-COMPCODE NOT = MQCC-FAILED) OR
              (W03-REASON NOT = MQRC-NO-MSG-AVAILABLE)
               MOVE 'MQGET '          TO M02-OPERATION
               MOVE MQOD-OBJECTNAME   TO M02-OBJECTNAME
               PERFORM RECORD-CALL-ERROR
           END-IF.
      *
           PERFORM CLOSE-QUEUES.
      *
       A-MAIN-EXIT.
      *
      * Return to CICS
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           GOBACK.
           EJECT
      *
      * ------------------------------------------------------------- *
       PROCESS-QUERY SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section develops a reply message and puts it onto      *
      *  the reply queue of the input message.  If the put to the    *
      *  reply queue fails, this is recorded and the message         *
      *  forwarded to the dead queue                                 *
      *                                                              *
      *  To develop the reply message the section uses the data in   *
      *  the input message to obtain information from a file. If no  *
      *  relevant record is found in the file an 'unknown' message   *
      *  is returned.                                                *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Initialize the reply message with details from the
      *    query message
      *
           MOVE SPACES                 TO CSQ4BQRM-MSG.
           SET  QUERY-RESPONSE-MESSAGE TO TRUE.
           MOVE CSQ4BCAQ-CHARGING      TO CSQ4BQRM-CHARGING.
           MOVE CSQ4BCAQ-GROUP         TO CSQ4BQRM-GROUP.
      *
      *    Look for the account number in the file
      *
           MOVE LENGTH OF W04-CSQ4CAQ  TO W04-READ-MESSAGE-LENGTH.
      *
           EXEC CICS READ
                 FILE('CSQ4FIL')
                 INTO(W04-CSQ4CAQ)
                 LENGTH(W04-READ-MESSAGE-LENGTH)
                 RIDFLD(CSQ4BCAQ-BANKACNUM)
                 KEYLENGTH(10)
                 RESP(W00-RESPONSE)
           END-EXEC.
      *
      *    Examine the response to the file read
      *
           EVALUATE TRUE
               WHEN (W00-RESPONSE = DFHRESP(NORMAL))
      *            Account number found
                   MOVE CSQ4CAQ-NAME         TO W02-MSG1-NAME
                   MOVE W02-MESSAGE-1        TO CSQ4BQRM-LINE(1)
                   MOVE CSQ4CAQ-DATE-OPENED  TO W02-MSG2-OPENED
                   MOVE CSQ4CAQ-AVERAGE-BAL  TO W02-MSG2-BALANCE
                   MOVE W02-MESSAGE-2        TO CSQ4BQRM-LINE(2)
                   MOVE CSQ4CAQ-CREDIT-INDEX TO W02-MSG6-INDEX
                   MOVE W02-MESSAGE-6        TO CSQ4BQRM-LINE(3)
      *
               WHEN (W00-RESPONSE = DFHRESP(NOTFND))
      *            No record of account number found
                   MOVE CSQ4BCAQ-NAME        TO W02-MSG1-NAME
                   MOVE W02-MESSAGE-1        TO CSQ4BQRM-LINE(1)
                   MOVE W02-MESSAGE-3        TO CSQ4BQRM-LINE(2)
                   MOVE 'NOT KNOWN'          TO W02-MSG6-INDEX
                   MOVE W02-MESSAGE-6        TO CSQ4BQRM-LINE(3)
      *
               WHEN OTHER
      *            Error reading file - record and feedback error
                   MOVE 'FILE READ ERROR'    TO M02-OPERATION
                   MOVE W00-RESPONSE         TO M02-OBJECTNAME
                   PERFORM RECORD-CALL-ERROR
                   MOVE CSQ4BCAQ-NAME        TO W02-MSG1-NAME
                   MOVE W02-MESSAGE-1        TO CSQ4BQRM-LINE(1)
                   MOVE W02-MESSAGE-3        TO CSQ4BQRM-LINE(2)
                   MOVE W00-RESPONSE         TO W02-MSG7-RESP
                   MOVE W02-MESSAGE-7        TO CSQ4BQRM-LINE(3)
           END-EVALUATE.
      *
      *    Set the object descriptor, message descriptor and put
      *    message options to the values required to create the
      *    message.
      *    Set the length of the message
      *
           MOVE MQMD-REPLYTOQ    TO MQOD-OBJECTNAME.
           MOVE MQMD-REPLYTOQMGR TO MQOD-OBJECTQMGRNAME.
           MOVE MQMT-REPLY       TO MQMD-MSGTYPE.
           MOVE MQRO-NONE        TO MQMD-REPORT.
           MOVE SPACES           TO MQMD-REPLYTOQ.
           MOVE SPACES           TO MQMD-REPLYTOQMGR.
           MOVE LOW-VALUES       TO MQMD-MSGID.
           COMPUTE MQPMO-OPTIONS =  MQPMO-SYNCPOINT +
                                    MQPMO-PASS-IDENTITY-CONTEXT.
           MOVE W03-HOBJ-CHECKQ  TO MQPMO-CONTEXT.
           MOVE LENGTH OF CSQ4BQRM-MSG TO W03-BUFFLEN.
      *
           CALL 'MQPUT1' USING W03-HCONN
                               MQOD
                               MQMD
                               MQPMO
                               W03-BUFFLEN
                               W03-PUT-BUFFER
                               W03-COMPCODE
                               W03-REASON.
           IF W03-COMPCODE NOT = MQCC-OK
               MOVE 'MQPUT1'          TO M02-OPERATION
               MOVE MQOD-OBJECTNAME   TO M02-OBJECTNAME
               PERFORM RECORD-CALL-ERROR
               PERFORM FORWARD-MSG-TO-DLQ
           END-IF.
      *
       PROCESS-QUERY-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CLOSE-QUEUES SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section closes the input queue. All output from this    *
      * program uses MQPUT1, so no output queues are open            *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           CALL 'MQCLOSE' USING W03-HCONN
                                W03-HOBJ-CHECKQ
                                MQCO-NONE
                                W03-COMPCODE
                                W03-REASON.
           IF W03-COMPCODE NOT = MQCC-OK
               MOVE 'MQCLOSE'  TO M02-OPERATION
               MOVE MQTM-QNAME TO M02-OBJECTNAME
               PERFORM RECORD-CALL-ERROR
           END-IF.
      *
       CLOSE-QUEUES-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CHECKQ-UNKNOWN-MSG SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section handles unexpected messages by recording the   *
      *  error and forwarding the message to the dead queue          *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE 'UNKNOWN MSG DETECTED' TO M02-OPERATION.
           MOVE MQOD-OBJECTNAME        TO M02-OBJECTNAME.
      *
           PERFORM RECORD-CALL-ERROR.
      *
           PERFORM FORWARD-MSG-TO-DLQ.
      *
       CHECKQ-UNKNOWN-MSG-EXIT.
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       RECORD-CALL-ERROR SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section writes an error message to the CICS td queue    *
      * 'CSML' and the CICS ts queue 'CSQ4SAMP'.                     *
      * The failing operation and object name fields are completed   *
      * by the calling application. The remaining fields of the      *
      * message are completed by this routine                        *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           EXEC CICS ASKTIME
               ABSTIME(W05-ABSTIME)
           END-EXEC.
           EXEC CICS FORMATTIME
               ABSTIME(W05-ABSTIME)
               DATE(M02-DATE) DATESEP
               TIME(M02-TIME) TIMESEP
           END-EXEC.
      *
           MOVE EIBTRNID        TO M02-TRANSACTION
                                   M03-TRANSACTION.
           MOVE EIBTASKN        TO M02-TASK-NUMBER
                                   M03-TASK-NUMBER.
           MOVE W03-COMPCODE    TO M02-COMPCODE
           MOVE W03-REASON      TO M02-REASON
           MOVE M02-DATE        TO M03-DATE.
           MOVE M02-TIME        TO M03-TIME.
           MOVE LENGTH OF M02-CALL-ERROR-MSG
                                TO W05-TS-MESSAGE-LENGTH
           MOVE LENGTH OF M03-CSML-ERROR-MSG
                                TO W05-TD-MESSAGE-LENGTH.
      *
           EXEC CICS WRITEQ TS
               QUEUE('CSQ4SAMP')
               FROM (M02-CALL-ERROR-MSG)
               LENGTH(W05-TS-MESSAGE-LENGTH)
           END-EXEC.
      *
           EXEC CICS WRITEQ TD
               QUEUE('CSML')
               FROM (M03-CSML-ERROR-MSG)
               LENGTH(W05-TD-MESSAGE-LENGTH)
           END-EXEC.
      *
       RECORD-CALL-ERROR-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       FORWARD-MSG-TO-DLQ SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section forwards a message to the samples dead queue.  *
      *  A message is written using RECORD-CALL-ERROR, the content   *
      *  of the message shows whether the message was put to the     *
      *  dead queue successfully                                     *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE MQOT-Q          TO MQOD-OBJECTTYPE.
           MOVE W01-DEAD-QNAME  TO MQOD-OBJECTNAME.
      *
           MOVE MQPER-PERSISTENCE-AS-Q-DEF TO MQMD-PERSISTENCE.
      *
      *    Use syncpoint option to avoid possible duplicate messages
      *    on dead queue
      *
           COMPUTE MQPMO-OPTIONS =  MQPMO-SYNCPOINT +
                                    MQPMO-PASS-IDENTITY-CONTEXT.
           MOVE W03-HOBJ-CHECKQ  TO MQPMO-CONTEXT.
      *
      *    Send as many bytes of the message as possible
      *
           IF W03-DATALEN IS LESS THAN W03-BUFFLEN
              MOVE W03-DATALEN TO W03-BUFFLEN
           END-IF.
      *
           CALL 'MQPUT1' USING W03-HCONN
                               MQOD
                               MQMD
                               MQPMO
                               W03-BUFFLEN
                               W03-MSG-BUFFER
                               W03-COMPCODE
                               W03-REASON.
      *
           EVALUATE TRUE
               WHEN (W03-COMPCODE = MQCC-OK AND
                       W03-REASON = MQRC-NONE)
                   MOVE 'MSG PUT TO DLQ' TO M02-OPERATION
                   MOVE W01-DEAD-QNAME   TO M02-OBJECTNAME
                   PERFORM RECORD-CALL-ERROR
               WHEN OTHER
                   MOVE 'MQPUT1'        TO M02-OPERATION
                   MOVE W01-DEAD-QNAME  TO M02-OBJECTNAME
                   PERFORM RECORD-CALL-ERROR
           END-EVALUATE.
      *
       FORWARD-MSG-TO-DLQ-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       INVALID-START-ROUTINE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section sets sends an error message to a terminal if    *
      * the program is started without data.                         *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE SPACES TO W00-MESSAGE.
           STRING EIBTRNID
                  M04-STARTUP-ERROR
                  DELIMITED BY SIZE INTO W00-MESSAGE.
 
           EXEC CICS SEND
                     TEXT
                     FROM(W00-MESSAGE)
                     FREEKB
                     ERASE
           END-EXEC.
      *
       INVALID-START-ROUTINE-EXIT.
      *
      *    Return to CICS
      *
           EXEC CICS RETURN
           END-EXEC.
      *
      * ------------------------------------------------------------- *
      *                    End of program                             *
      * ------------------------------------------------------------- *