Quelle csq4cvb3.cob Sprache: Cobol

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                             *
      * ------------------------------------------------------------- *

quality99%

¤ Dauer der Verarbeitung: 0.20 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.