Quelle csq4cvb2.cob

Sprache: Cobol
CBL XOPTS(ANSI85)

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST

      * ------------------------------------------------------------- *

       IDENTIFICATION DIVISION.

      * ------------------------------------------------------------- *

       PROGRAM-ID. CSQ4CVB2.

      *REMARKS

      *****************************************************************

      *   @START_COPYRIGHT@                                           *

      *   Statement:     Licensed Materials - Property of IBM         *

      *                                                               *

      *                  5695-137                                     *

      *                  (C) Copyright IBM Corporation. 1993, 1997    *

      *                                                               *

      *   Status:        Version 1 Release 2                          *

      *   @END_COPYRIGHT@                                             *

      *                                                               *

      *  Module Name           : CSQ4CVB2                             *

      *                                                               *

      *  Environment           : CICS/ESA Version 3.3; COBOL II       *

      *                                                               *

      *  CICS Transaction Name : MVB2                                 *

      *                                                               *

      *  Description : Sample program to show the decomposition of an *

      *                inquiry message to a number of queries, the    *

      *                replies from the queries are received and      *

      *                when all are available a response is built and *

      *                sent to the reply to queue of the inquiry.     *

      *                Part completed inquiries are recovered after   *

      *                the application terminates or after system     *

      *                failure.                                       *

      *                                                               *

      *  Function    : This program provides the credit application   *

      *                manager function for the credit check sample   *

      *                See IBM MQSeries for MVS/ESA Application       *

      *                Programming Reference for details.             *

      *                                                               *

      * ************************************************************* *

         EJECT

      * ************************************************************* *

      *                                                               *

      *                    Program logic                              *

      *                    -------------                              *

      *                                                               *

      *START.                                                         *

      *    check the program is started with data.                    *

      *    if no go to invalid-start-routine                          *

      *    end-if                                                     *

      *    get storage for signal processing.                         *

      *    retrieve trigger data.                                     *

      *    if userdata (amount) passed to program                     *

      *        update threshold amount                                *

      *    end-if                                                     *

      *    open inquiry queue.                                        *

      *    if msg on inquiry queue                                    *

      *        open reply queue (loop through names until o.k.)       *

      *    else                                                       *

      *        open reply queue (name from mqtm-userdata)             *

      *    end-if                                                     *

      *    open waiting queue.                                        *

      *    open checking account queue.                               *

      *    open distribution queue. (change name!)                    *

      *    get browse first msg from waiting queue.                   *

      *    perform until compcode not = ok                            *

      *      evaluate msgtype                                         *

      *        when inquiry msg                                       *

      *          perform irt-add-entry                                *

      *        when response or propagation msg                       *

      *          perform irt-update-entry                             *

      *          if match not found                                   *

      *            perform irt-rebuild-no-match                       *

      *          end-if                                               *

      *        when other                                             *

      *          perform irt-rebuild-unknown-msg                      *

      *      end-evaluate                                             *

      *      get browse next msg from waiting queue                   *

      *    end-perform.                                               *

      *    if unexpected compcode                                     *

      *        exit program.                                          *

      *    perform  main-process until stop-process.                  *

      *    close all queues.                                          *

      *    return to cics.                                            *

      *                                                               *

      * ************************************************************* *

      *MAIN-PROCESS.                                                  *

      *    evaluate                                                   *

      *      when irt table full and inquiryq open                    *

      *        close inquiry queue                                    *

      *      when irt table not full and inquiryq close               *

      *        open inquiry queue                                     *

      *    end-evaluate.                                              *

      *    if irt full                                                *

      *      getwait on reply queue                                   *

      *      evaluate return-codes                                    *

      *        when msg got                                           *

      *          perform process-reply-queue                          *

      *        when no msg                                            *

      *          set flag to stop main-process                        *

      *        when other                                             *

      *          report error                                         *

      *          set flag to call-error                               *

      *      end-evaluate                                             *

      *    else                                                       *

      *      getwait with signal on inquiry queue                     *

      *      evaluate return-codes                                    *

      *        when msg got                                           *

      *          perform process-inquiry-queue                        *

      *        when signal accepted or outstanding                    *

      *          perform process-signal-accepted                      *

      *        when other                                             *

      *          report error                                         *

      *          set flag to call-error                               *

      *      end-evaluate                                             *

      *    end-if.                                                    *

      *    evaluate                                                   *

      *      when calls ok and msg complete                           *

      *        perform send-answer                                    *

      *        if error occured                                       *

      *          rollback uow                                         *

      *          set flag to stop main-process                        *

      *        end-if                                                 *

      *      when calls ok                                            *

      *        syncpoint                                              *

      *      when other                                               *

      *        rollback uow                                           *

      *        set flag to stop main-process                          *

      *    end-evaluate.                                              *

      * ************************************************************* *

      *IRT-ADD-ENTRY.                                                 *

      *    search irt-table                                           *

      *      at end                                                   *

      *         set reply queue trigger control to off                *

      *      when empty entry                                         *

      *         fill entry with data from inquiry msg                 *

      *    end-search.                                                *

      *    if current entries = limit                                 *

      *      set table status to full                                 *

      *    end-if .                                                   *

      *                                                               *

      * ************************************************************* *

      *IRT-UPDATE-ENTRY.                                              *

      *    set update status to ok                                    *

      *    search irt-table                                           *

      *      at end                                                   *

      *         set update status to match not found                  *

      *      when entry msgid = mqmd-correlid                         *

      *         evaluate                                              *

      *           when propagation msg                                *

      *             add/subtract entry counters                       *

      *           when response msg                                   *

      *             add/subtract entry counters                       *

      *         end-evaluate                                          *

      *         if msg complete                                       *

      *           set msg complete flag to true                       *

      *         end-if                                                *

      *                                                               *

      * ************************************************************* *

      *                                                               *

      *IRT-REBUILD-UNKNOWN-MSG.                                       *

      *    report error.                                              *

      *    get msg under cursor.                                      *

      *    if error occured                                           *

      *      report error                                             *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    perform forward-msg-to-dlq.                                *

      *    restore gmo options to browse next                         *

      *                                                               *

      * ************************************************************* *

      *IRT-DELETE-ENTRY.                                              *

      *    initialise irt table entry.                                *

      *    subtract 1 from current entries count.                     *

      *    set irt status to not full.                                *

      *                                                               *

      * ************************************************************* *

      *IRT-REBUILD-NO-MATCH.                                          *

      *    report error.                                              *

      *    get msg under cursor.                                      *

      *    if error occured                                           *

      *      report error                                             *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    perform forward-msg-to-dlq.                                *

      *    restore gmo options to browse next                         *

      *                                                               *

      * ************************************************************* *

      *IRT-NO-MATCH.                                                  *

      *    report error.                                              *

      *                                                               *

      * ************************************************************* *

      *FORWARD-MSG-TO-DLQ.                                            *

      *    mqput1 msg received to dlq.                                *

      *    evaluate return codes                                      *

      *      when ok                                                  *

      *        report that msg has been put to dlq                    *

      *      when other                                               *

      *        report error                                           *

      *    end-evaluate.                                              *

      *                                                               *

      * ************************************************************* *

      *PROCESS-SIGNAL-ACCEPTED.                                       *

      *    perform replyq-getsignal.                                  *

      *    evaluate return codes                                      *

      *      when ok                                                  *

      *        perform process-replyq-msg                             *

      *      when signal accepted or outstanding                      *

      *        perform external-wait                                  *

      *      when other                                               *

      *        report error                                           *

      *        set call-error flag                                    *

      *    end-evaluate.                                              *

      *                                                               *

      * ************************************************************* *

      *EXTERNAL-WAIT.                                                 *

      *    execute cics wait on the two ecbs                          *

      *    if inquiryq ecb posted                                     *

      *      perform test-inquiryq-ecb                                *

      *    else                                                       *

      *      perform test-replyq-ecb                                  *

      *    end-if.                                                    *

      *                                                               *

      * ************************************************************* *

      *TEST-INQUIRYQ-ECB.                                             *

      *    evaluate inquiryq ecb                                      *

      *      when msg arrived                                         *

      *        reset ecb                                              *

      *        perform inquiryq-get                                   *

      *        evaluate return codes                                  *

      *          when ok                                              *

      *            perform process-inquiryq-msg                       *

      *          when no msg                                          *

      *            continue                                           *

      *          when other                                           *

      *            report error                                       *

      *            set call-error flag                                *

      *        end-evaluate                                           *

      *      when wait interval expired                               *

      *        set flag to stop main-process                          *

      *      when wait cancelled                                      *

      *        set flag to stop main-process                          *

      *      when other                                               *

      *        report error                                           *

      *        set call-error flag                                    *

      *    end-evaluate                                               *

      *                                                               *

      * ************************************************************* *

      *TEST-REPLYQ-ECB.                                               *

      *    evaluate replyq ecb                                        *

      *      when msg arrived                                         *

      *        reset ecb                                              *

      *        perform replyq-get                                     *

      *        evaluate return codes                                  *

      *          when ok                                              *

      *            perform process-replyq-msg                         *

      *          when other                                           *

      *            report error                                       *

      *            set call-error flag                                *

      *        end-evaluate                                           *

      *      when wait interval expired                               *

      *        set flag to stop main-process                          *

      *      when wait cancelled                                      *

      *        set flag to stop main-process                          *

      *      when other                                               *

      *        report error                                           *

      *        set call-error flag                                    *

      *    end-evaluate                                               *

      *                                                               *

      * ************************************************************* *

      *INQUIRYQ-GET.                                                  *

      *    mqget msg                                                  *

      *                                                               *

      * ************************************************************* *

      *REPLYQ-GET.                                                    *

      *    mqget msg                                                  *

      *                                                               *

      * ************************************************************* *

      *REPLYQ-GETWAIT.                                                *

      *    mqget wait msg                                             *

      *                                                               *

      * ************************************************************* *

      *PROCESS-REPLYQ-MSG.                                            *

      *    evaluate                                                   *

      *      when response or propagation                             *

      *        perform irt-update-table                               *

      *        if no match                                            *

      *          perform irt-no-match                                 *

      *          perform replyq-unknown-msg                           *

      *        end-if                                                 *

      *      when other                                               *

      *        perform replyq-unknown-msg                             *

      *        exit this section                                      *

      *    end-evaluate.                                              *

      *    mqput msg to waiting queue                                 *

      *    if error occured                                           *

      *      report error                                             *

      *      set call-error flag                                      *

      *    end-if.                                                    *

      *                                                               *

      * ************************************************************* *

      *PROCESS-INQUIRYQ-MSG.                                          *

      *    if not inquiry msg                                         *

      *      perform iquiryq-unknown-msg                              *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    perform irt-add-entry                                      *

      *    mqput msg to waiting queue                                 *

      *    if error occured                                           *

      *      report error                                             *

      *      set call-error flag                                      *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    mqput msg to checking account queue                        *

      *    if error occured                                           *

      *      report error                                             *

      *      set call-error flag                                      *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    if loan figure > threshold amount                          *

      *      mqput to distribution queue                              *

      *      if error occured                                         *

      *        report error                                           *

      *        set call-error flag                                    *

      *        exit this section                                      *

      *      end-if                                                   *

      *                                                               *

      * ************************************************************* *

      *INQUIRYQ-GETSIGNAL.                                            *

      *    mqget with signal                                          *

      *                                                               *

      * ************************************************************* *

      *REPLYQ-GETSIGNAL.                                              *

      *    mqget with signal                                          *

      *                                                               *

      * ************************************************************* *

      *REPLYQ-UNKNOWN-MSG.                                            *

      *    report error                                               *

      *    perform forward-msg-to-dlq.                                *

      *                                                               *

      * ************************************************************* *

      *INQUIRYQ-UNKNOWN-MSG.                                          *

      *    report error                                               *

      *    perform forward-msg-to-dlq.                                *

      *                                                               *

      * ************************************************************* *

      *WAITQ-UNKNOWN-MSG.                                             *

      *    report error                                               *

      *    perform forward-msg-to-dlq.                                *

      *                                                               *

      * ************************************************************* *

      *SEND-ANSWER.                                                   *

      *    perform until all messages retreived or compcode not = ok  *

      *      get msg from waiting queue with correlid.                *

      *      evaluate msgtype                                         *

      *        when inquiry msg                                       *

      *          move data to output msg                              *

      *        when response msg                                      *

      *          move data to output msg                              *

      *        when propagation msg                                   *

      *          continue                                             *

      *        when other                                             *

      *          perform waitq-unknown-msg                            *

      *      end-evaluate                                             *

      *    end-perform.                                               *

      *    if error                                                   *

      *      report error                                             *

      *      set call-error flag                                      *

      *      exit this section                                        *

      *    end-if.                                                    *

      *    reset msg complete flag                                    *

      *    mqput1 answer msg to replytoq                              *

      *    if error occured                                           *

      *      report error                                             *

      *      set call-error flag                                      *

      *      exit this section                                        *

      *    end-if.                                                    *

      *                                                               *

      * ************************************************************* *

      *SET-REPLYQ-TC-OFF.                                             *

      *    mqset tc off                                               *

      *    if error occured                                           *

      *      report error                                             *

      *      set call-error flag                                      *

      *      exit this section                                        *

      *    end-if.                                                    *

      *                                                               *

      * ************************************************************* *

      *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-INPUT-MSG-PRIORITY      PIC S9(09) BINARY.

       01  W00-SUB                     PIC S9(09) BINARY.

       01  W00-INDEX                   PIC S9(09) BINARY.

      *

      *    W01 - Amount

      *

       01  W01-AMOUNT                  PIC X(6)   VALUE '010000'.

      *

      *    Queue names

      *

       01  W02-QUEUE-NAMES.

           05  W02-INQUIRY-QNAME       PIC X(48) VALUE

           'CSQ4SAMP.B2.INQUIRY                             '.

      *

      * The .N in the reply/waiting queue signifies a one digit

      * number 1 to 5.

      * This will be changed in the program.

      *

           05  W02-REPLY-QNAME         PIC X(48) VALUE

           'CSQ4SAMP.B2.REPLY.N                             '.

           05  REDEFINES W02-REPLY-QNAME.

               10                      PIC X(18).

               10 W02-REPLY-QNAME-NUM  PIC 9(01).

               10                      PIC X(29).

           05  W02-WAITING-QNAME       PIC X(48) VALUE

           'CSQ4SAMP.B2.WAITING.N                           '.

           05  REDEFINES W02-WAITING-QNAME.

               10                        PIC X(20).

               10 W02-WAITING-QNAME-NUM  PIC 9(01).

               10                        PIC X(27).

      *

           05  W02-DEAD-QNAME          PIC X(48) VALUE

           'CSQ4SAMP.DEAD.QUEUE                             '.

      *

           05  W02-CHECKACCNT-QNAME    PIC X(48) VALUE

           'CSQ4SAMP.B2.OUTPUT.ALIAS                        '.

      *

           05  W02-DIST-QNAME          PIC X(48) VALUE

           'CSQ4SAMP.B4.MESSAGES                            '.

      *

           05  W02-ANSWER-QNAME        PIC X(48).

           05  W02-ANSWER-QMGRNAME     PIC X(48).

           05  W02-USERIDENTIFIER      PIC X(12).

      *

      *    W03 - MQM API fields

      *

       01  W03-SELECTORCOUNT           PIC S9(9) BINARY VALUE 1.

       01  W03-INTATTRCOUNT            PIC S9(9) BINARY VALUE 1.

       01  W03-CHARATTRLENGTH          PIC S9(9) BINARY VALUE ZERO.

       01  W03-CHARATTRS               PIC X     VALUE LOW-VALUES.

       01  W03-HCONN                   PIC S9(9) BINARY VALUE ZERO.

       01  W03-OPTIONS                 PIC S9(9) BINARY.

       01  W03-HOBJ-REPLYQ             PIC S9(9) BINARY.

       01  W03-HOBJ-INQUIRYQ           PIC S9(9) BINARY.

       01  W03-HOBJ-WAITQ              PIC S9(9) BINARY.

       01  W03-HOBJ-CHECKQ             PIC S9(9) BINARY.

       01  W03-HOBJ-DISTQ              PIC S9(9) BINARY.

       01  W03-COMPCODE                PIC S9(9) BINARY.

       01  W03-REASON                  PIC S9(9) BINARY.

       01  W03-SELECTORS-TABLE.

           05  W03-SELECTORS           PIC S9(9) BINARY OCCURS 2 TIMES.

       01  W03-INTATTRS-TABLE.

           05  W03-INTATTRS            PIC S9(9) BINARY OCCURS 2 TIMES.

       01  W03-DATALEN                 PIC S9(9) BINARY.

       01  W03-BUFFLEN                 PIC S9(9) BINARY.

      *

       01  W03-GET-BUFFER.

           05 W03-CSQ4BQRM.

           COPY CSQ4VB4.

      *

           05 W03-CSQ4BIIM REDEFINES W03-CSQ4BQRM.

           COPY CSQ4VB1.

      *

           05 W03-CSQ4BPGM REDEFINES W03-CSQ4BIIM.

           COPY CSQ4VB5.

      *

       01  W03-PUT-BUFFER.

           05 W03-CSQ4BAM.

           COPY CSQ4VB2.

      *

           05 W03-CSQ4BCAQ REDEFINES W03-CSQ4BAM.

           COPY CSQ4VB3.

      *

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

      *

      *    Fields for ECB handling

      *

       01  W04-ECB-ADDR-LIST-PTR    POINTER.

       01  W04-ECB-PTR              POINTER.

       01  W04-INITIMG              PIC X VALUE LOW-VALUES.

      *

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

      *

      *    main process flags

      *

       01  W06-MAIN-PROCESS-FLAG    PIC 9 VALUE 0.

           88 END-PROCESS VALUE 1.

       01  W06-END-PROCESS          PIC 9 VALUE 1.

      *

       01  W06-INQUIRYQ-STATUS      PIC X(6) VALUE 'CLOSED'.

           88 INQUIRYQ-OPEN   VALUE 'OPEN'.

           88 INQUIRYQ-CLOSED VALUE 'CLOSED'.

      *

       01  W06-CALL-STATUS          PIC X(6) VALUE 'OK'.

           88 CALLS-OK       VALUE 'OK'.

       01  W06-CALL-ERROR           PIC X(6) VALUE 'FAILED'.

      *

       01  W06-MSG-STATUS           PIC 9 VALUE 0.

           88 MSG-COMPLETE     VALUE 1.

           88 MSG-NOT-COMPLETE VALUE 0.

      *

      *    CSQ4VB8 contains error messages used in this program

      *

       COPY CSQ4VB8.

      *

      *    Inquiry Record Table definition and associated fields

      *

       01  IRT-SUB                  PIC S9(9) BINARY.

       01  IRT-STATUS-OK            PIC S9(9) BINARY VALUE ZEROS.

       01  IRT-STATUS-NO-MATCH      PIC S9(9) BINARY VALUE 1.

       01  IRT-UPDATE-STATUS        PIC S9(9) BINARY VALUE ZEROS.

           88 IRT-UPDATE-NO-MATCH VALUE 1.

       01  IRT-MAX-ENTRIES          PIC S9(9) BINARY.

       01  IRT-CURRENT-ENTRIES      PIC S9(9) BINARY VALUE ZEROS.

       01  IRT-TABLE-SET-FULL       PIC S9(9) BINARY VALUE 1.

       01  IRT-TABLE-SET-NOT-FULL   PIC S9(9) BINARY VALUE ZEROS.

       01  IRT-TABLE-STATUS         PIC S9(9) BINARY VALUE ZEROS.

           88 IRT-TABLE-FULL VALUE 1.

      *

      *    Size of IRT-TABLE is set here - to 10 initially

      *

       01  IRT-TABLE.

           05 IRT-TABLE-ELEMENT OCCURS 10 INDEXED BY IRT-INDEX1.

              10 IRT-TABLE-ENTRY.

                 15 IRT-MSGID        PIC X(24).

                 15 IRT-PROPSOUT     PIC S9(9) BINARY.

                 15 IRT-REPLYEXP     PIC S9(9) BINARY.

                 15 IRT-REPLYREC     PIC S9(9) BINARY.

      *

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

      * ------------------------------------------------------------- *

       01  L01-ECB-ADDR-LIST.

           05  L01-ECB-ADDR1        POINTER.

           05  L01-ECB-ADDR2        POINTER.

      *

       01  L02-ECBS.

           05  L02-INQUIRY-ECB1     PIC S9(09) BINARY.

           05  L02-REPLY-ECB2       PIC S9(09) BINARY.

       01  REDEFINES L02-ECBS.

           05                       PIC  X(02).

           05  L02-INQUIRY-ECB1-CC  PIC S9(04) BINARY.

           05                       PIC  X(02).

           05  L02-REPLY-ECB2-CC    PIC S9(04) BINARY.

      *

       EJECT

      * ------------------------------------------------------------- *

       PROCEDURE DIVISION.

      * ------------------------------------------------------------- *

      * ------------------------------------------------------------- *

       A-MAIN SECTION.

      * ------------------------------------------------------------- *

      *                                                               *

      *                                                               *

      * ------------------------------------------------------------- *

      *

      *

      *    Initialize IRT and compute number of entries in table

      *

           MOVE LOW-VALUES TO IRT-TABLE.

           COMPUTE IRT-MAX-ENTRIES = LENGTH OF IRT-TABLE /

                                     LENGTH OF IRT-TABLE-ENTRY.

      *

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

      *

      *    Getmain storage for possible external wait on ecbs

      *

           EXEC CICS GETMAIN

               SET(W04-ECB-ADDR-LIST-PTR)

               FLENGTH(8)

           END-EXEC.

      *

      *    get addressability to storage

      *

           SET ADDRESS OF L01-ECB-ADDR-LIST TO W04-ECB-ADDR-LIST-PTR.

      *

           EXEC CICS GETMAIN

               SET(W04-ECB-PTR)

               FLENGTH(8)

               INITIMG(W04-INITIMG)

           END-EXEC.

      *

      *    get addressability to storage

      *

           SET ADDRESS OF L02-ECBS TO W04-ECB-PTR.

      *

      *    store address's of ebcs into list

      *

           SET L01-ECB-ADDR1 TO ADDRESS OF L02-INQUIRY-ECB1.

           SET L01-ECB-ADDR2 TO ADDRESS OF L02-REPLY-ECB2.

      *

      *    Retrieve the trigger data this transaction was started with

      *

           EXEC CICS RETRIEVE

                     INTO(MQTM)

           END-EXEC.

      *

      *    Get the amount, if one is passed

      *

           IF MQTM-USERDATA NOT = SPACE

               MOVE MQTM-USERDATA TO W01-AMOUNT

           END-IF.

      *

      *    Open the inquiry queue

      *

           PERFORM OPEN-INQUIRYQ.

      *

      *    Test the output from the open.

      *    If not ok write record the error an exit from the program

      *

           IF W03-COMPCODE NOT = MQCC-OK THEN

               GO TO A-MAIN-EXIT

           ELSE

               SET INQUIRYQ-OPEN TO TRUE

           END-IF.

      *

      *    At this point the data retrieved determines the open

      *    queue processing.

      *

      *    If the inquiry-queue has been triggered then

      *        loop trying to open a reply-queue

      *

      *    If a reply-queue has been triggered then open that

      *        particular reply-queue

      *

           IF MQTM-QNAME = W02-INQUIRY-QNAME

               PERFORM OPEN-UNNAMED-REPLY-QUEUE

               IF W03-COMPCODE NOT = MQCC-OK

                   GO TO A-MAIN-EXIT

               END-IF

           ELSE

               PERFORM OPEN-NAMED-REPLY-QUEUE

               IF W03-COMPCODE NOT = MQCC-OK

                   GO TO A-MAIN-EXIT

               ELSE

                   MOVE MQTM-QNAME TO W02-REPLY-QNAME

               END-IF

           END-IF.

      *

      *    Open the Waiting Queue

      *    Use the number from the reply queue - matching pairs

      *

           MOVE MQOT-Q              TO MQOD-OBJECTTYPE.

           MOVE W02-REPLY-QNAME-NUM TO W02-WAITING-QNAME-NUM.

           MOVE W02-WAITING-QNAME   TO MQOD-OBJECTNAME.

      *

      *    Initialize W03-OPTIONS to open the queue for input

      *    exclusive, browse and output

      *

           COMPUTE W03-OPTIONS = MQOO-INPUT-EXCLUSIVE +

                                 MQOO-BROWSE +

                                 MQOO-PASS-IDENTITY-CONTEXT +

                                 MQOO-SAVE-ALL-CONTEXT +

                                 MQOO-OUTPUT.

      *

      *    Open the queue

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-WAITQ

                               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.

      *

      *    Open the Checking Account Queue

      *

           MOVE MQOT-Q               TO MQOD-OBJECTTYPE.

           MOVE W02-CHECKACCNT-QNAME TO MQOD-OBJECTNAME.

      *

      *    Initialize W03-OPTIONS to open the queue for output

      *

           COMPUTE W03-OPTIONS = MQOO-OUTPUT +

                                 MQOO-PASS-IDENTITY-CONTEXT.

      *

      *    Open the queue

      *

           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.

      *

      *    Open the Distribution Queue

      *

      *

           MOVE MQOT-Q         TO MQOD-OBJECTTYPE.

           MOVE W02-DIST-QNAME TO MQOD-OBJECTNAME.

      *

      *    Initialize W03-OPTIONS to open the queue for output

      *

           COMPUTE W03-OPTIONS = MQOO-OUTPUT +

                                 MQOO-PASS-IDENTITY-CONTEXT.

      *

      *    Open the queue

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-DISTQ

                               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.

      *

      *****************************************************************

      *    Rebuild the IRT (Inquiry Record Table)

      *****************************************************************

      *

      *    Initialize the Get Message Options (MQGMO) control block.

      *    (The copy book initializes the remaining fields)

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-NO-WAIT +

                                   MQGMO-BROWSE-FIRST.

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    Make the first MQGET call outside the loop

      *    using the BROWSE-FIRST option

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-WAITQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

      *    Test the output of the MQGET call using the PERFORM loop

      *    that follows.

      *

      *    Change the MQGMO Options field to BROWSE-NEXT

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-NO-WAIT +

                                   MQGMO-BROWSE-NEXT.

      *

      *    Loop from here to END-PERFORM until the MQGET call fails

      *

           PERFORM WITH TEST BEFORE

                   UNTIL W03-COMPCODE NOT = MQCC-OK

      *

      *       Perform relevant add/update IRT entry dependent upon

      *       message. If message unknown then put it to deadq

      *

              EVALUATE TRUE

                  WHEN INITIAL-INQUIRY-MESSAGE

                      PERFORM T1-IRT-ADD-ENTRY

                  WHEN QUERY-RESPONSE-MESSAGE OR PROPAGATION-MESSAGE

                      PERFORM T2-IRT-UPDATE-ENTRY

                      IF IRT-UPDATE-NO-MATCH

                          PERFORM T5-IRT-REBUILD-NO-MATCH

                      END-IF

                  WHEN OTHER

                      PERFORM T3-IRT-REBUILD-UNKNOWN-MSG

              END-EVALUATE

      *

      *       Clear MQMD-MSGID and MQMD-CORRELID before the next

      *       MQGET call to ensure that all messages are retrieved

      *

              MOVE MQMI-NONE TO MQMD-MSGID

              MOVE MQCI-NONE TO MQMD-CORRELID

      *

      *       Get the next message

      *

              CALL 'MQGET' USING W03-HCONN

                                 W03-HOBJ-WAITQ

                                 MQMD

                                 MQGMO

                                 W03-BUFFLEN

                                 W03-GET-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,

      *    print an error message showing the completion code and

      *    reason code, unless the reason code is NO-MSG-AVAILABLE.

      *

      *    Note: When the loop reaches the end of the file, the

      *          completion code is MQCC-FAILED and the reason code

      *          is MQRC-NO-MSG-AVAILABLE

      *

           IF ( (W03-COMPCODE NOT = MQCC-FAILED) OR

                (W03-REASON NOT = MQRC-NO-MSG-AVAILABLE) )

               MOVE 'MQGET BROWSE'    TO M02-OPERATION

               MOVE W02-WAITING-QNAME TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               GO TO A-MAIN-EXIT.

      *

      *

      *    Loop until wait expired on either or both inquire and

      *    reply queue depending on IRT status. Achieved by setting

      *    flag

      *

           PERFORM MAIN-PROCESS WITH TEST AFTER

              UNTIL END-PROCESS.

      *

           PERFORM CLOSE-QUEUES.

      *

       A-MAIN-EXIT.

      *

      *

      * Return to CICS

      *

           EXEC CICS RETURN

           END-EXEC.

      *

           GOBACK.

           EJECT

      *

      * ------------------------------------------------------------- *

       CLOSE-QUEUES SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section closes the queues.                              *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           IF INQUIRYQ-OPEN

               PERFORM CLOSE-INQUIRYQ

      *

      *    Close waiting and reply queues, waiting before reply

      *    to avoid problems if multiple instances of the program

      *    are triggered

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-WAITQ

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQCLOSE'            TO M02-OPERATION

               MOVE W02-WAITING-QNAME    TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

           END-IF.

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-REPLYQ

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQCLOSE'            TO M02-OPERATION

               MOVE W02-REPLY-QNAME      TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

           END-IF.

      *

      *    Close the output queues

      *

           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 W02-CHECKACCNT-QNAME TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

           END-IF.

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-DISTQ

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQCLOSE'            TO M02-OPERATION

               MOVE W02-DIST-QNAME       TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

           END-IF.

      *

       CLOSE-QUEUES-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       CLOSE-INQUIRYQ SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      *  This section closes the inquiry queue                       *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-INQUIRYQ

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

            IF W03-COMPCODE NOT = MQCC-OK

                MOVE 'MQCLOSE'            TO M02-OPERATION

                MOVE W02-INQUIRY-QNAME    TO M02-OBJECTNAME

                PERFORM RECORD-CALL-ERROR

            END-IF.

      *

       CLOSE-INQUIRYQ-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       MAIN-PROCESS SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      *  This section performs the main message handling of the      *

      *  program. It is called from a loop in MAIN.                  *

      *                                                              *

      *  The program gets and handles messages, depending on the     *

      *  status of the IRT. When a message is complete, an answer    *

      *  is sent. If an error occurs, it is recorded and END-PROCESS *

      *  is set.                                                     *

      *                                                              *

      * ------------------------------------------------------------ *

      *

      *    Ensure the inquiry queue is open when there is space in

      *    the IRT for a new inquiry and closed when the IRT is full

      *

           EVALUATE TRUE

                WHEN (IRT-TABLE-FULL AND INQUIRYQ-OPEN)

                    PERFORM CLOSE-INQUIRYQ

                    IF W03-COMPCODE = MQCC-OK

                        SET INQUIRYQ-CLOSED TO TRUE

                    ELSE

                        MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

                        GO TO MAIN-PROCESS-EXIT

                    END-IF

      *

                WHEN (NOT IRT-TABLE-FULL AND INQUIRYQ-CLOSED)

                    PERFORM OPEN-INQUIRYQ

                    IF W03-COMPCODE = MQCC-OK

                        SET INQUIRYQ-OPEN TO TRUE

                    ELSE

                        MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

                        GO TO MAIN-PROCESS-EXIT

                    END-IF

           END-EVALUATE.

      *

      *    If the IRT is full, get messages from the reply queue

      *    only, using get wait

      *

           IF IRT-TABLE-FULL

               PERFORM REPLYQ-GETWAIT

               EVALUATE TRUE

                   WHEN (W03-COMPCODE = MQCC-OK AND

                           W03-REASON = MQRC-NONE)

                       PERFORM PROCESS-REPLYQ-MESSAGE

      *

                   WHEN (W03-COMPCODE = MQCC-FAILED AND

                           W03-REASON = MQRC-NO-MSG-AVAILABLE)

                       MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

      *

                   WHEN OTHER

                       MOVE 'MQGET WAIT '   TO M02-OPERATION

                       MOVE W02-REPLY-QNAME TO M02-OBJECTNAME

                       PERFORM RECORD-CALL-ERROR

                       MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

      *

               END-EVALUATE

      *

      *    Else the IRT isn't full,  get messages from both

      *    inquiry and reply queues, using get signal

      *

           ELSE

               PERFORM INQUIRYQ-GETSIGNAL

               EVALUATE TRUE

                   WHEN (W03-COMPCODE = MQCC-OK AND

                           W03-REASON = MQRC-NONE)

                       PERFORM PROCESS-INQUIRYQ-MESSAGE

      *

                   WHEN (W03-COMPCODE = MQCC-WARNING AND

                           W03-REASON = MQRC-SIGNAL-REQUEST-ACCEPTED)

                        OR

                        (W03-COMPCODE = MQCC-FAILED AND

                           W03-REASON = MQRC-SIGNAL-OUTSTANDING)

                       PERFORM PROCESS-SIGNAL-ACCEPTED

      *

                   WHEN OTHER

                       MOVE 'MQGET SIGNAL'  TO M02-OPERATION

                       MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME

                       PERFORM RECORD-CALL-ERROR

                       MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

      *

               END-EVALUATE

           END-IF.

      *

      *    Check whether an inquiry is complete, or whether

      *    problems have occurred

      *

           EVALUATE TRUE

               WHEN (CALLS-OK AND MSG-COMPLETE)

                   PERFORM SEND-ANSWER

                   IF W03-COMPCODE NOT = MQCC-OK

                       MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

                       EXEC CICS SYNCPOINT ROLLBACK END-EXEC

                       GO TO MAIN-PROCESS-EXIT

                   END-IF

                   EXEC CICS SYNCPOINT END-EXEC

                   SET MSG-NOT-COMPLETE TO TRUE

                   PERFORM T4-IRT-DELETE-ENTRY

      *

               WHEN CALLS-OK

                   EXEC CICS SYNCPOINT END-EXEC

      *

               WHEN OTHER

                   MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

                   EXEC CICS SYNCPOINT ROLLBACK END-EXEC

           END-EVALUATE.

      *

       MAIN-PROCESS-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

      *

      * ------------------------------------------------------------- *

       T1-IRT-ADD-ENTRY SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      *  This section adds a new entry into the in memory inquiry    *

      *  record table. If the new entry fills the table, table full  *

      *  is set. If the table is already full, there is an internal  *

      *  logic error - so triggering is set off for the replyq to    *

      *  avoid repeated errors.                                      *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           SET IRT-INDEX1 TO 1.

      *

           SEARCH IRT-TABLE-ELEMENT VARYING IRT-INDEX1

               AT END

      *             table is full - therefore a logic

      *             error has occurred. we need to set triggering off

      *             for the replyq so that the transaction does not

      *             get repeatedely started

                   PERFORM SET-REPLYQ-TC-OFF

                   EXEC CICS ABEND

                       ABCODE('TFUL')

                   END-EXEC

      *

               WHEN IRT-MSGID(IRT-INDEX1) = LOW-VALUES

                   ADD 1           TO IRT-CURRENT-ENTRIES

                   MOVE MQMD-MSGID TO IRT-MSGID(IRT-INDEX1)

                   MOVE 1          TO IRT-REPLYEXP(IRT-INDEX1)

                   MOVE ZEROES     TO IRT-REPLYREC(IRT-INDEX1)

                   IF CSQ4BIIM-LOANREQ > W01-AMOUNT

                       MOVE 1      TO IRT-PROPSOUT(IRT-INDEX1)

                   ELSE

                       MOVE ZEROES TO IRT-PROPSOUT(IRT-INDEX1)

                   END-IF

           END-SEARCH.

      *

           IF IRT-CURRENT-ENTRIES = IRT-MAX-ENTRIES

               MOVE IRT-TABLE-SET-FULL TO IRT-TABLE-STATUS.

      *

       T1-IRT-ADD-ENTRY-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T2-IRT-UPDATE-ENTRY SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This IRT update entry routine can be called from the initial *

      * rebuild of IRT at start of program OR during the main loop.  *

      *                                                              *

      * When a matched entry is found the counts are updated         *

      * dependent on type of message.                                *

      *                                                              *

      * If all the replies have been received then the message       *

      * complete flag is set to indicate this.                       *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           SET IRT-INDEX1 TO 1.

           MOVE IRT-STATUS-OK TO IRT-UPDATE-STATUS.

           SEARCH IRT-TABLE-ELEMENT VARYING IRT-INDEX1

      *

               AT END

                   MOVE IRT-STATUS-NO-MATCH TO IRT-UPDATE-STATUS

      *

               WHEN IRT-MSGID(IRT-INDEX1) = MQMD-CORRELID

                   EVALUATE TRUE

                       WHEN PROPAGATION-MESSAGE

                           ADD      1   TO IRT-REPLYREC(IRT-INDEX1)

                           ADD CSQ4BPGM-MSGS-SENT

                                        TO IRT-REPLYEXP(IRT-INDEX1)

                           SUBTRACT 1 FROM IRT-PROPSOUT(IRT-INDEX1)

                       WHEN QUERY-RESPONSE-MESSAGE

                           ADD      1   TO IRT-REPLYREC(IRT-INDEX1)

                   END-EVALUATE

      *

      *            Test whether all responses have been received,

      *            if they have - set message complete

      *

                   IF IRT-REPLYREC(IRT-INDEX1) =

                     IRT-REPLYEXP(IRT-INDEX1) AND

                     IRT-PROPSOUT(IRT-INDEX1) = ZERO

                       SET MSG-COMPLETE TO TRUE

                   ELSE

                       CONTINUE

                   END-IF

           END-SEARCH.

      *

       T2-IRT-UPDATE-ENTRY-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T3-IRT-REBUILD-UNKNOWN-MSG SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section is called during the initial phase of the       *

      * program when rebuilding the IRT because an 'unknown message  *

      * has been encountered on the 'waiting' queue.                 *

      * This code will remove the message using the message          *

      * under cursor option of MQGET and MQPUT it on the deadletter  *

      * queue.                                                       *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'UNKNOWN MSG DETECTED ON QUEUE' TO M02-OPERATION.

           MOVE W02-WAITING-QNAME               TO M02-OBJECTNAME.

           PERFORM RECORD-CALL-ERROR.

      *

           PERFORM T6-IRT-REBUILD-GET-MSG.

           IF W03-COMPCODE NOT = MQCC-OK

              GO TO T3-RESTORE

           END-IF.

      *

      *    put the message on the dead letter queue

      *

           MOVE W03-HOBJ-WAITQ TO MQPMO-CONTEXT.

           PERFORM FORWARD-MSG-TO-DLQ.

      *

       T3-RESTORE.

      *

      *    Change the MQGMO Options field back to BROWSE-NEXT

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-NO-WAIT +

                                   MQGMO-BROWSE-NEXT.

      *

       T3-IRT-REBUILD-UNKNOWN-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T4-IRT-DELETE-ENTRY SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section deletes and entry from the IRT                  *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE LOW-VALUES TO IRT-TABLE-ENTRY(IRT-INDEX1).

           SUBTRACT 1 FROM IRT-CURRENT-ENTRIES.

           MOVE IRT-TABLE-SET-NOT-FULL TO IRT-TABLE-STATUS.

      *

       T4-IRT-DELETE-ENTRY-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T5-IRT-REBUILD-NO-MATCH SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section gets an unknown message from the waiting queue, *

      * using T6-IRT-REBUILD-GET-MSG, records the error, and puts    *

      * the message to the dead queue.                               *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'MATCH NOT FOUND IN IRT' TO M02-OPERATION.

           MOVE W02-WAITING-QNAME TO M02-OBJECTNAME.

           PERFORM RECORD-CALL-ERROR.

      *

           PERFORM T6-IRT-REBUILD-GET-MSG.

           IF W03-COMPCODE NOT = MQCC-OK

              GO TO T5-RESTORE

           END-IF.

      *

      *    put the message on the dead letter queue

      *

           MOVE W03-HOBJ-WAITQ TO MQPMO-CONTEXT.

           PERFORM FORWARD-MSG-TO-DLQ.

      *

       T5-RESTORE.

      *

      *    Change the MQGMO Options field back to BROWSE-NEXT

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-NO-WAIT +

                                   MQGMO-BROWSE-NEXT.

      *

       T5-IRT-REBUILD-NO-MATCH-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T6-IRT-REBUILD-GET-MSG SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section gets the message under the browse cursor.       *

      *                                                              *

      * ------------------------------------------------------------ *

      *

      *    Change the MQGMO Options field to MSG-UNDER-CURSOR

      *    and in-syncpoint

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT +

                                   MQGMO-MSG-UNDER-CURSOR.

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    get the message destructively

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-WAITQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

      *    Test the output of the MQGET call.  If the call failed,

      *    record the error

      *

           IF W03-COMPCODE NOT = MQCC-OK

              MOVE 'MQGET IRT-REBUILD GET MESSAGE' TO M02-OPERATION

              MOVE W02-WAITING-QNAME TO M02-OBJECTNAME

              PERFORM RECORD-CALL-ERROR

           END-IF.

      *

       T6-IRT-REBUILD-GET-MSG-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       T7-IRT-NO-MATCH SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section record the error if no match is found on the    *

      * IRT for a message.                                           *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'MATCH NOT FOUND IN IRT' TO M02-OPERATION.

           MOVE SPACES TO M02-OBJECTNAME.

           PERFORM RECORD-CALL-ERROR.

      *

       T7-IRT-NO-MATCH-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       OPEN-INQUIRYQ SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section opens the inquiry queue for input shared        *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE MQOT-Q            TO MQOD-OBJECTTYPE.

           MOVE W02-INQUIRY-QNAME TO MQOD-OBJECTNAME.

      *

           COMPUTE W03-OPTIONS    =  MQOO-INPUT-SHARED +

                                     MQOO-SAVE-ALL-CONTEXT.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-INQUIRYQ

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQOPEN'             TO M02-OPERATION

               MOVE W02-INQUIRY-QNAME    TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

           END-IF.

      *

       OPEN-INQUIRYQ-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       OPEN-NAMED-REPLY-QUEUE SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section opens the reply to queue named in the trigger   *

      * information passed to the transaction on start up.           *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE MQTM-QNAME TO MQOD-OBJECTNAME.

      *

           PERFORM OPEN-REPLY-QUEUE.

      *

      *    Test the output from the open.

      *      If ok then continue.

      *      If already open by another task then continue.

      *      If another error then record the error.

      *    The performing section will handle the error conditions

      *

           EVALUATE TRUE

               WHEN (W03-COMPCODE = MQCC-OK AND

                     W03-REASON   = MQRC-NONE)

                   CONTINUE

               WHEN (W03-COMPCODE = MQCC-FAILED AND

                     W03-REASON   = MQRC-OBJECT-IN-USE)

                   CONTINUE

               WHEN OTHER

                   MOVE 'MQOPEN'        TO M02-OPERATION

                   MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

           END-EVALUATE.

      *

       OPEN-NAMED-REPLY-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       OPEN-UNNAMED-REPLY-QUEUE SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section opens a reply to queue when the transaction has *

      * been triggered to serve the inquiry queue.                   *

      * The section stops once a reply queue has been successfully   *

      * opened or if the reply queue being opened does not exist or  *

      * if the number of queue to try is exceeded (5 in this sample) *

      *                                                              *

      * ------------------------------------------------------------ *

      *

      *    Try to open a Reply Queue varying the name with the

      *    suffixed number from 1 to 5. Stop when successful

      *

           PERFORM WITH TEST AFTER VARYING W02-REPLY-QNAME-NUM

           FROM 1 BY 1 UNTIL ( W02-REPLY-QNAME-NUM = 5 OR

                               W03-COMPCODE = MQCC-OK  OR

                              (W03-COMPCODE = MQCC-FAILED AND

                               W03-REASON = MQRC-UNKNOWN-OBJECT-NAME))

      *

               MOVE W02-REPLY-QNAME TO MQOD-OBJECTNAME

               PERFORM OPEN-REPLY-QUEUE

      *

      *        Test the output from the open.

      *          If ok then continue.

      *          If already open by another task then continue.

      *          If any other error then report.

      *        The performing section will handle the error conditions

      *

               EVALUATE TRUE

                   WHEN (W03-COMPCODE = MQCC-OK AND

                         W03-REASON   = MQRC-NONE)

                       CONTINUE

                   WHEN (W03-COMPCODE = MQCC-FAILED AND

                         W03-REASON   = MQRC-OBJECT-IN-USE)

                       CONTINUE

                   WHEN OTHER

                       MOVE 'MQOPEN'        TO M02-OPERATION

                       MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME

                       PERFORM RECORD-CALL-ERROR

                       MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

               END-EVALUATE

      *

           END-PERFORM.

      *

       OPEN-UNNAMED-REPLY-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       OPEN-REPLY-QUEUE SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section opens a reply to queue for input exclusive and  *

      * set. The repsonse to the open is tested by the performing    *

      * section. This section is performed by either the named or

      * unnamed reply queue open sections.

      * The object name will be filled in by the peforming section.  *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE MQOT-Q              TO MQOD-OBJECTTYPE.

      *

           COMPUTE W03-OPTIONS = MQOO-INPUT-EXCLUSIVE +

                                 MQOO-SAVE-ALL-CONTEXT +

                                 MQOO-SET.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-REPLYQ

                               W03-COMPCODE

                               W03-REASON.

      *

       OPEN-REPLY-QUEUE-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 W02-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.

      *

      *    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-GET-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 W02-DEAD-QNAME   TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

               WHEN OTHER

                   MOVE 'MQPUT1'        TO M02-OPERATION

                   MOVE W02-DEAD-QNAME  TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

           END-EVALUATE.

      *

       FORWARD-MSG-TO-DLQ-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       PROCESS-SIGNAL-ACCEPTED SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      *  This section gets a messge with signal. If a message is     *

      *  received, it is processed. If the signal is set or is       *

      *  already set, the program goes into an operating system wait.*

      *  Otherwise an error is reported and call error set.          *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           PERFORM REPLYQ-GETSIGNAL.

      *

           EVALUATE TRUE

               WHEN (W03-COMPCODE = MQCC-OK AND

                       W03-REASON = MQRC-NONE)

                   PERFORM PROCESS-REPLYQ-MESSAGE

      *

               WHEN (W03-COMPCODE = MQCC-WARNING AND

                       W03-REASON = MQRC-SIGNAL-REQUEST-ACCEPTED)

                    OR

                    (W03-COMPCODE = MQCC-FAILED AND

                       W03-REASON = MQRC-SIGNAL-OUTSTANDING)

                   PERFORM EXTERNAL-WAIT

      *

               WHEN OTHER

                   MOVE 'MQGET SIGNAL'  TO M02-OPERATION

                   MOVE MQOD-OBJECTNAME TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

           END-EVALUATE.

      *

       PROCESS-SIGNAL-ACCEPTED-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       EXTERNAL-WAIT SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      *  This section perform an external CICS wait on two ecbs      *

      *  until at least one is posted.  It then calls the sections   *

      *  to handle the posted ecb.                                   *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           EXEC CICS WAIT EXTERNAL

               ECBLIST(W04-ECB-ADDR-LIST-PTR)

               NUMEVENTS(2)

           END-EXEC.

      *

      *    At least one ecb must have been posted to get to this

      *    posted.  Test which ecb has been posted and perform

      *    the apporpriate section

      *

           IF L02-INQUIRY-ECB1 NOT = 0

               PERFORM TEST-INQUIRYQ-ECB

           ELSE

               PERFORM TEST-REPLYQ-ECB

           END-IF.

      *

       EXTERNAL-WAIT-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       TEST-INQUIRYQ-ECB SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section called to check ecb return code when it has     *

      * been posted. There is a possibility that when we try to get  *

      * the message from the inquiry queue that another task may     *

      * already have got it as we do not have exclusive control      *

      * of the queue, therefore we could get a no-message condition  *

      * - in which case we do nothing                                *

      * The other reason (timeout and system shutdown) for posting   *

      * the ecb are also handled.                                    *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           EVALUATE L02-INQUIRY-ECB1-CC

               WHEN MQEC-MSG-ARRIVED

                   PERFORM INQUIRY-GET

                   EVALUATE TRUE

                       WHEN (W03-COMPCODE = MQCC-OK AND

                             W03-REASON = MQRC-NONE)

                           PERFORM PROCESS-INQUIRYQ-MESSAGE

                       WHEN (W03-COMPCODE = MQCC-FAILED AND

                             W03-REASON = MQRC-NO-MSG-AVAILABLE)

                           CONTINUE

                       WHEN OTHER

                           MOVE 'MQGET ECB POSTED' TO M02-OPERATION

                           MOVE W02-INQUIRY-QNAME  TO M02-OBJECTNAME

                           PERFORM RECORD-CALL-ERROR

                           MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

                   END-EVALUATE

      *

               WHEN MQEC-WAIT-INTERVAL-EXPIRED

                   MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

      *

               WHEN MQEC-WAIT-CANCELED

                   MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

      *

               WHEN OTHER

                   MOVE 'ECB WAIT CC ERROR'  TO M02-OPERATION

                   MOVE W02-INQUIRY-QNAME    TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W06-CALL-ERROR       TO W06-CALL-STATUS

           END-EVALUATE.

      *

       TEST-INQUIRYQ-ECB-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       TEST-REPLYQ-ECB SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section called to check ecb return code when it has     *

      * been posted.                                                 *

      * If a message has arrived, it must be available as we have    *

      * exclusive input control of the queue, therefore a            *

      * no-message condition is an error.                            *

      * The other reason (timeout and system shutdown) for posting   *

      * the ecb are also handled.                                    *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           EVALUATE L02-REPLY-ECB2-CC

               WHEN MQEC-MSG-ARRIVED

                   PERFORM REPLY-GET

                   EVALUATE TRUE

                       WHEN (W03-COMPCODE = MQCC-OK AND

                             W03-REASON = MQRC-NONE)

                           PERFORM PROCESS-REPLYQ-MESSAGE

                       WHEN OTHER

                           MOVE 'MQGET ECB POSTED' TO M02-OPERATION

                           MOVE W02-REPLY-QNAME    TO M02-OBJECTNAME

                           PERFORM RECORD-CALL-ERROR

                           MOVE W06-CALL-ERROR     TO W06-CALL-STATUS

                   END-EVALUATE

      *

               WHEN MQEC-WAIT-INTERVAL-EXPIRED

                   MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

      *

               WHEN MQEC-WAIT-CANCELED

                   MOVE W06-END-PROCESS TO W06-MAIN-PROCESS-FLAG

      *

               WHEN OTHER

                   MOVE 'ECB WAIT CC ERROR'  TO M02-OPERATION

                   MOVE W02-REPLY-QNAME      TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W06-CALL-ERROR       TO W06-CALL-STATUS

           END-EVALUATE.

      *

       TEST-REPLYQ-ECB-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       INQUIRY-GET SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section gets a message, in syncpoint, from the inquiry  *

      * queue. Error handling is done by the performing section.     *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT +

                                   MQGMO-NO-WAIT.

      *

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    Set msgid and correlid to nulls so that any message

      *    will qualify

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-INQUIRYQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

       INQUIRY-GET-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       REPLY-GET SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section gets a message, in syncpoint, from the reply    *

      * queue. Error handling is done by the performing section.     *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT +

                                   MQGMO-NO-WAIT.

      *

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    Set msgid and correlid to nulls so that any message

      *    will qualify

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-REPLYQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

       REPLY-GET-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       REPLYQ-GETWAIT SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section gets a message, in syncpoint with a wait, from  *

      * the reply queue.                                             *

      * Error handling is done by the performing section.            *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           COMPUTE MQGMO-OPTIONS  =  MQGMO-SYNCPOINT +

                                     MQGMO-WAIT.

           MOVE W00-WAIT-INTERVAL TO MQGMO-WAITINTERVAL.

      *

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    Set msgid and correlid to nulls so that any message

      *    will qualify

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-REPLYQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

       REPLYQ-GETWAIT-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       PROCESS-REPLYQ-MESSAGE SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section handles messages from the reply queue. When the *

      * received message is of an expected type (response or         *

      * propagation) the IRT is updated and the message put to the   *

      * waiting queue. Otherwise the message is forwarded to the     *

      * dead letter queue and the error reported.                    *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           EVALUATE TRUE

               WHEN QUERY-RESPONSE-MESSAGE OR PROPAGATION-MESSAGE

                   PERFORM T2-IRT-UPDATE-ENTRY

                   IF IRT-UPDATE-NO-MATCH

                       PERFORM T7-IRT-NO-MATCH

                       PERFORM REPLYQ-UNKNOWN-MSG

                       GO TO PROCESS-REPLYQ-MESSAGE-EXIT

                   END-IF

               WHEN OTHER

                   PERFORM REPLYQ-UNKNOWN-MSG

                   GO TO PROCESS-REPLYQ-MESSAGE-EXIT

           END-EVALUATE.

      *

      *    Put the message on the waiting queue, after setting

      *    priority and length as required

      *

           IF QUERY-RESPONSE-MESSAGE

               MOVE 1          TO MQMD-PRIORITY

               MOVE LENGTH OF CSQ4BQRM-MSG TO W03-BUFFLEN

           ELSE

               MOVE 2          TO MQMD-PRIORITY

               MOVE LENGTH OF CSQ4BPGM-MSG TO W03-BUFFLEN

           END-IF.

      *

           COMPUTE MQPMO-OPTIONS = MQPMO-SYNCPOINT +

                                   MQPMO-PASS-IDENTITY-CONTEXT.

           MOVE W03-HOBJ-REPLYQ TO MQPMO-CONTEXT.

      *

           CALL 'MQPUT' USING W03-HCONN

                              W03-HOBJ-WAITQ

                              MQMD

                              MQPMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-COMPCODE

                              W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQPUT'            TO M02-OPERATION

               MOVE W02-WAITING-QNAME TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

           END-IF.

      *

       PROCESS-REPLYQ-MESSAGE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       PROCESS-INQUIRYQ-MESSAGE SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section handles messages from the inquiry queue.        *

      * If an unexpected message is received this is forwarded to    *

      * the dead queue. Otherwise an entry is added in the IRT,      *

      * the message put to the waiting queue and query message       *

      * built and sent to the check queue and, if loan is greater    *

      * than the threshold amount, to the distribution queue.        *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           IF NOT INITIAL-INQUIRY-MESSAGE

               PERFORM INQUIRYQ-UNKNOWN-MSG

               GO TO PROCESS-INQUIRYQ-MESSAGE-EXIT

           END-IF.

      *

      *    Otherwise process the message

      *

           PERFORM T1-IRT-ADD-ENTRY.

      *

      *    Put the message on the waiting queue, after setting

      *    msgid, priority and length as required and saving the

      *    input message priority

      *

           MOVE MQMD-PRIORITY          TO W00-INPUT-MSG-PRIORITY.

      *

           MOVE MQMD-MSGID             TO MQMD-CORRELID.

           MOVE 3                      TO MQMD-PRIORITY.

           MOVE LENGTH OF CSQ4BIIM-MSG TO W03-BUFFLEN.

      *

           COMPUTE MQPMO-OPTIONS  =  MQPMO-SYNCPOINT +

                                     MQPMO-PASS-IDENTITY-CONTEXT.

           MOVE W03-HOBJ-INQUIRYQ TO MQPMO-CONTEXT.

      *

           CALL 'MQPUT' USING W03-HCONN

                              W03-HOBJ-WAITQ

                              MQMD

                              MQPMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-COMPCODE

                              W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQPUT'           TO M02-OPERATION

               MOVE W02-WAITING-QNAME TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               MOVE W06-CALL-ERROR    TO W06-CALL-STATUS

               GO TO PROCESS-INQUIRYQ-MESSAGE-EXIT

           END-IF.

      *

      *    Build the output message data

      *

           SET ACCOUNT-QUERY-MESSAGE TO TRUE.

           MOVE SPACES               TO CSQ4BCAQ-CHARGING.

           MOVE CSQ4BIIM-NAME        TO CSQ4BCAQ-NAME.

           MOVE CSQ4BIIM-SOCSECNO1   TO CSQ4BCAQ-SOCSECNO1.

           MOVE CSQ4BIIM-SOCSECNO2   TO CSQ4BCAQ-SOCSECNO2.

           MOVE CSQ4BIIM-SOCSECNO3   TO CSQ4BCAQ-SOCSECNO3.

           MOVE CSQ4BIIM-BANKNAME    TO CSQ4BCAQ-BANKNAME.

           MOVE CSQ4BIIM-BANKACNAME  TO CSQ4BCAQ-BANKACNAME.

           MOVE CSQ4BIIM-BANKACNUM   TO CSQ4BCAQ-BANKACNUM.

           MOVE CSQ4BIIM-LOANREQ     TO CSQ4BCAQ-LOANREQ.

      *

      *    Put the query message to the check queue

      *

           MOVE W00-INPUT-MSG-PRIORITY TO MQMD-PRIORITY.

           MOVE MQMT-REQUEST           TO MQMD-MSGTYPE.

           MOVE MQRO-PASS-CORREL-ID    TO MQMD-REPORT.

           MOVE MQMI-NONE              TO MQMD-MSGID.

           MOVE W02-REPLY-QNAME        TO MQMD-REPLYTOQ.

           MOVE SPACES                 TO MQMD-REPLYTOQMGR.

           MOVE LENGTH OF CSQ4BCAQ-MSG TO W03-BUFFLEN.

      *

           COMPUTE MQPMO-OPTIONS  =  MQPMO-SYNCPOINT +

                                     MQPMO-PASS-IDENTITY-CONTEXT.

           MOVE W03-HOBJ-INQUIRYQ TO MQPMO-CONTEXT.

      *

           CALL 'MQPUT' USING W03-HCONN

                              W03-HOBJ-CHECKQ

                              MQMD

                              MQPMO

                              W03-BUFFLEN

                              W03-PUT-BUFFER

                              W03-COMPCODE

                              W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQPUT'              TO M02-OPERATION

               MOVE W02-CHECKACCNT-QNAME TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               MOVE W06-CALL-ERROR       TO W06-CALL-STATUS

               GO TO PROCESS-INQUIRYQ-MESSAGE-EXIT

           END-IF.

      *

      *    If loan requested is greater than W01-AMOUNT put a

      *    query message on the distribution queue

      *

           IF CSQ4BIIM-LOANREQ > W01-AMOUNT

      *

               MOVE MQMI-NONE              TO MQMD-MSGID

               MOVE LENGTH OF CSQ4BCAQ-MSG TO W03-BUFFLEN

      *

               COMPUTE MQPMO-OPTIONS  =  MQPMO-SYNCPOINT +

                                         MQPMO-PASS-IDENTITY-CONTEXT

               MOVE W03-HOBJ-INQUIRYQ TO MQPMO-CONTEXT

      *

               CALL 'MQPUT' USING W03-HCONN

                                  W03-HOBJ-DISTQ

                                  MQMD

                                  MQPMO

                                  W03-BUFFLEN

                                  W03-PUT-BUFFER

                                  W03-COMPCODE

                                  W03-REASON

               END-CALL

      *

               IF W03-COMPCODE NOT = MQCC-OK

                   MOVE 'MQPUT       '  TO M02-OPERATION

                   MOVE W02-DIST-QNAME  TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

               END-IF.

      *

       PROCESS-INQUIRYQ-MESSAGE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       INQUIRYQ-GETSIGNAL SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section performs an MQGET, in syncpoint with signal,    *

      * on the inquiry queue. The signal field in the gmo is set     *

      * to the address of the ecb.                                   *

      * Response handling is done by the performing section.         *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           COMPUTE MQGMO-OPTIONS         =  MQGMO-SYNCPOINT +

                                            MQGMO-SET-SIGNAL.

           MOVE W00-WAIT-INTERVAL        TO MQGMO-WAITINTERVAL.

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

           MOVE ZEROS        TO L02-INQUIRY-ECB1.

           SET MQGMO-SIGNAL1 TO ADDRESS OF L02-INQUIRY-ECB1.

      *

      *    Set msgid and correlid to nulls so that any message

      *    will qualify

      *

           MOVE MQMI-NONE TO MQMD-MSGID

           MOVE MQCI-NONE TO MQMD-CORRELID

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-INQUIRYQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

       INQUIRYQ-GETSIGNAL-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       REPLYQ-GETSIGNAL SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section performs an MQGET, in syncpoint with signal,    *

      * on the reply queue. The signal field in the gmo is set       *

      * to the address of the ecb.                                   *

      * Response handling is done by the performing section.         *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           COMPUTE MQGMO-OPTIONS         =  MQGMO-SYNCPOINT +

                                            MQGMO-SET-SIGNAL.

           MOVE W00-WAIT-INTERVAL        TO MQGMO-WAITINTERVAL.

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

           MOVE ZEROS        TO L02-REPLY-ECB2.

           SET MQGMO-SIGNAL1 TO ADDRESS OF L02-REPLY-ECB2.

      *

      *    Set msgid and correlid to nulls so that any message

      *    will qualify

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-REPLYQ

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

      *

       REPLYQ-GETSIGNAL-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       REPLYQ-UNKNOWN-MSG SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section handles unexpected messages received on the     *

      * reply queue by recording the error and forwarding the        *

      * message to the dead queue.                                   *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'UNKNOWN MSG ON REPLYQ' TO M02-OPERATION

           MOVE W02-REPLY-QNAME         TO M02-OBJECTNAME

           PERFORM RECORD-CALL-ERROR

      *

           MOVE W03-HOBJ-REPLYQ TO MQPMO-CONTEXT.

           PERFORM FORWARD-MSG-TO-DLQ.

      *

       REPLYQ-UNKNOWN-MSG-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       INQUIRYQ-UNKNOWN-MSG SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section handles unexpected messages received on the     *

      * inquiry queue by recording the error and forwarding the      *

      * message to the dead queue.                                   *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'UNKNOWN MSG ON INQUIRYQ' TO M02-OPERATION

           MOVE W02-INQUIRY-QNAME         TO M02-OBJECTNAME

           PERFORM RECORD-CALL-ERROR

      *

           MOVE W03-HOBJ-INQUIRYQ TO MQPMO-CONTEXT.

           PERFORM FORWARD-MSG-TO-DLQ.

      *

       INQUIRYQ-UNKNOWN-MSG-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       WAITQ-UNKNOWN-MSG SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section handles unexpected messages received on the     *

      * waiting queue by recording the error and forwarding the      *

      * message to the dead queue.                                   *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE 'UNKNOWN MSG ON WAITQ' TO M02-OPERATION

           MOVE W02-WAITING-QNAME      TO M02-OBJECTNAME

           PERFORM RECORD-CALL-ERROR

      *

           MOVE W03-HOBJ-WAITQ TO MQPMO-CONTEXT.

           PERFORM FORWARD-MSG-TO-DLQ.

      *

       WAITQ-UNKNOWN-MSG-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       SEND-ANSWER SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section is performed when all messages have been        *

      * received for an inquiry. the irt index is set to the         *

      * entry, the msgid entry is used to get all messages relating  *

      * to that inquiry from the waiting queue by getting messages   *

      * with a specific correllid                                    *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE ZEROS            TO W00-SUB.

           MOVE SPACES           TO CSQ4BAM-MSG.

           SET ANSWER-MESSAGE    TO TRUE.

      *

           COMPUTE MQGMO-OPTIONS =  MQGMO-NO-WAIT +

                                    MQGMO-SYNCPOINT.

           MOVE MQMI-NONE                TO MQMD-MSGID.

           MOVE IRT-MSGID(IRT-INDEX1)    TO MQMD-CORRELID.

           MOVE LENGTH OF W03-GET-BUFFER TO W03-BUFFLEN.

      *

      *    Loop from here to END-PERFORM until all messages received

      *    and answer message built

      *

           PERFORM WITH TEST AFTER VARYING W00-INDEX FROM 1 BY 1

                   UNTIL (W03-COMPCODE NOT = MQCC-OK OR

                          W00-INDEX = (IRT-REPLYREC(IRT-INDEX1) + 1) )

      *

      *       Get the message

      *

              CALL 'MQGET' USING W03-HCONN

                                 W03-HOBJ-WAITQ

                                 MQMD

                                 MQGMO

                                 W03-BUFFLEN

                                 W03-GET-BUFFER

                                 W03-DATALEN

                                 W03-COMPCODE

                                 W03-REASON

      *

              IF W03-COMPCODE = MQCC-OK THEN

      *

      *           Use the received message to construct answer message.

      *           If message unknown then put it to the dead queue

      *

                  EVALUATE TRUE

                    WHEN INITIAL-INQUIRY-MESSAGE

      *

      *               Put the initial inquiry data in the answer

      *

                      MOVE MQMD-REPLYTOQ       TO W02-ANSWER-QNAME

                      MOVE MQMD-REPLYTOQMGR    TO W02-ANSWER-QMGRNAME

                      MOVE MQMD-USERIDENTIFIER TO W02-USERIDENTIFIER

                      MOVE CSQ4BIIM-NAME       TO CSQ4BAM-NAME

                      MOVE CSQ4BIIM-SOCSECNO1  TO CSQ4BAM-SOCSECNO1

                      MOVE CSQ4BIIM-SOCSECNO2  TO CSQ4BAM-SOCSECNO2

                      MOVE CSQ4BIIM-SOCSECNO3  TO CSQ4BAM-SOCSECNO3

                      MOVE CSQ4BIIM-BANKNAME   TO CSQ4BAM-BANKNAME

                      MOVE CSQ4BIIM-BANKACNAME TO CSQ4BAM-BANKACNAME

                      MOVE CSQ4BIIM-BANKACNUM  TO CSQ4BAM-BANKACNUM

                      MOVE CSQ4BIIM-LOANREQ    TO CSQ4BAM-LOANREQ

      *

                    WHEN QUERY-RESPONSE-MESSAGE

      *

      *               Put the reply data in the answer, ensuring that

      *               the total reply length will not overflow the

      *               data fields

      *

                      IF W00-SUB LESS THAN 12

                        ADD 1 TO W00-SUB

                        MOVE CSQ4BQRM-LINE(1) TO CSQ4BAM-LINE(W00-SUB)

                      END-IF

                      IF W00-SUB LESS THAN 12

                        ADD 1 TO W00-SUB

                        MOVE CSQ4BQRM-LINE(2) TO CSQ4BAM-LINE(W00-SUB)

                      END-IF

                      IF W00-SUB LESS THAN 12

                        ADD 1 TO W00-SUB

                        MOVE CSQ4BQRM-LINE(3) TO CSQ4BAM-LINE(W00-SUB)

                      END-IF

      *

                    WHEN PROPAGATION-MESSAGE

                      CONTINUE

      *

                    WHEN OTHER

                      PERFORM WAITQ-UNKNOWN-MSG

                  END-EVALUATE

      *

                  MOVE MQMI-NONE TO MQMD-MSGID

      *

              END-IF

      *

           END-PERFORM.

      *

           IF  W03-COMPCODE NOT = MQCC-OK THEN

               MOVE 'SEND-ANSWER PROBLEM' TO M02-OPERATION

               MOVE W02-WAITING-QNAME     TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               GO TO SEND-ANSWER-EXIT

           END-IF.

      *

      *    Send the answer message

      *

           MOVE MQMT-REPLY  TO MQMD-MSGTYPE.

           MOVE MQRO-NONE   TO MQMD-REPORT.

           MOVE SPACES      TO MQMD-REPLYTOQ.

           MOVE SPACES      TO MQMD-REPLYTOQMGR.

      *

           MOVE LENGTH OF CSQ4BAM-MSG      TO W03-BUFFLEN

           MOVE MQOT-Q                     TO MQOD-OBJECTTYPE.

           MOVE W02-ANSWER-QNAME           TO MQOD-OBJECTNAME.

           MOVE W02-ANSWER-QMGRNAME        TO MQOD-OBJECTQMGRNAME.

           MOVE W02-USERIDENTIFIER         TO MQOD-ALTERNATEUSERID.

           MOVE MQPER-PERSISTENCE-AS-Q-DEF TO MQMD-PERSISTENCE.

      *

           COMPUTE MQPMO-OPTIONS    =  MQPMO-SYNCPOINT +

                                       MQPMO-PASS-IDENTITY-CONTEXT +

                                       MQPMO-ALTERNATE-USER-AUTHORITY.

           MOVE W03-HOBJ-WAITQ      TO MQPMO-CONTEXT.

      *

           CALL 'MQPUT1' USING W03-HCONN

                               MQOD

                               MQMD

                               MQPMO

                               W03-BUFFLEN

                               W03-PUT-BUFFER

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               IF W03-REASON = MQRC-UNKNOWN-OBJECT-NAME

                   MOVE 'UNKNOWN OBJECT NAME' TO M02-OPERATION

                   MOVE MQOD-OBJECTNAME       TO M02-OBJECTNAME

                   PERFORM RECORD-CALL-ERROR

                   MOVE W03-HOBJ-WAITQ TO MQPMO-CONTEXT

                   PERFORM FORWARD-MSG-TO-DLQ

                   GO TO SEND-ANSWER-EXIT

               END-IF

      *

               MOVE 'MQPUT1 ERROR IN SEND-ANSWER' TO M02-OPERATION

               MOVE MQOD-OBJECTNAME               TO M02-OBJECTNAME

               PERFORM RECORD-CALL-ERROR

               MOVE W06-CALL-ERROR  TO W06-CALL-STATUS

           END-IF.

      *

       SEND-ANSWER-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

      * ------------------------------------------------------------- *

       SET-REPLYQ-TC-OFF SECTION.

      * ------------------------------------------------------------- *

      *                                                              *

      * This section sets triggering off on the reply queue.         *

      * The result of the set is recorded.                           *

      *                                                              *

      * ------------------------------------------------------------ *

      *

           MOVE MQIA-TRIGGER-CONTROL TO W03-SELECTORS(1).

           MOVE MQTC-OFF             TO W03-INTATTRS(1).

      *

           CALL 'MQSET' USING W03-HCONN

                              W03-HOBJ-REPLYQ

                              W03-SELECTORCOUNT

                              W03-SELECTORS-TABLE

                              W03-INTATTRCOUNT

                              W03-INTATTRS-TABLE

                              W03-CHARATTRLENGTH

                              W03-CHARATTRS

                              W03-COMPCODE

                              W03-REASON.

      *

           MOVE 'MQSET TRIGGER OFF'  TO M02-OPERATION.

           MOVE W02-REPLY-QNAME      TO M02-OBJECTNAME.

           PERFORM RECORD-CALL-ERROR.

      *

       SET-REPLYQ-TC-OFF-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                             *

      * ------------------------------------------------------------- *

      *
Messung V0.5 in Prozent
¤ Dauer der Verarbeitung: 0.74 Sekunden (vorverarbeitet am 2026-05-01) ¤

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 und die Messung sind noch experimentell.