Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: sdl_pr.xml Sprache: Cobol

Original von: verschiedene^©

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

--> maximum size reached

--> --------------------

¤ Dauer der Verarbeitung: 0.96 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

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

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.