Quelle csq4cvb1.cob Sprache: Cobol

CBL XOPTS(ANSI85)

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

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

       IDENTIFICATION DIVISION.

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

       PROGRAM-ID. CSQ4CVB1.

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

      *                                                               *

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

      *                                                               *

      *  CICS Transaction Name : MVB1                                 *

      *                                                               *

      *  Description : Sample program to handle screen interface and  *

      *                message generation and recovery for the        *

      *                credit check sample                            *

      *                                                               *

      *  Function    : This program provides the user interface       *

      *                function for the credit check sample           *

      *                See IBM MQSeries for MVS/ESA Application       *

      *                Programming Reference for details.             *

      *                                                               *

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

      *                                                               *

      *                     Program logic                             *

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

      *                                                               *

      *  Start  (A-MAIN SECTION)                                      *

      *  -----                                                        *

      *                                                               *

      *      Clear the output message field and screen map            *

      *      Inquire depth of response queue                          *

      *      If depth cannot be obtained                              *

      *         Exit program with error message                       *

      *      End-if                                                   *

      *      Display the screen map and wait for input data           *

      *                                                               *

      *      Do while PF3 key is not pressed                          *

      *                                                               *

      *         If Help (PF1) key pressed                             *

      *            Display the help screen while PF12 not pressed     *

      *         Else if Enter key pressed                             *

      *            Evaluate request                                   *

      *               When '1'  Perform IMMEDIATE-INQUIRY             *

      *               When '2'  Perform BATCH-INQUIRY                 *

      *               When '3'  If messages available                 *

      *                            Perform BATCH-RESPONSE             *

      *                         Else                                  *

      *                            Build message                      *

      *                         End-if                                *

      *               Otherwise build error message                   *

      *            End-evaluate                                       *

      *         Else                                                  *

      *            Do nothing                                         *

      *         End-if                                                *

      *                                                               *

      *         Move message to screen map                            *

      *         Inquire depth of response queue                       *

      *         Display the screen map and wait for input data        *

      *      End-do                                                   *

      *                                                               *

      *      Clear screen                                             *

      *      Return to CICS                                           *

      *                                                               *

      *                                                               *

      *  INQUIRE-DEPTH SECTION                                        *

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

      *      Open response queue for inquiry                          *

      *      If open is successful                                    *

      *         Inquire depth of response queue                       *

      *         If inquire unsuccessful                               *

      *            Build error message                                *

      *         Else                                                  *

      *            Update queue depth on screen map                   *

      *         End-if                                                *

      *      End-if                                                   *

      *                                                               *

      *                                                               *

      *  IMMEDIATE-INQUIRY SECTION                                    *

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

      *      Open the inquiry queue (Perform OPEN-INQUIRY-QUEUE)      *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *         Goto Immediate-Inquiry-Exit                           *

      *      End-if                                                   *

      *                                                               *

      *      Clear the output message field and screen map            *

      *      Display the screen map and wait for input data, here     *

      *      and throughout this section by performing DISPLAY-MAPID2 *

      *                                                               *

      *      Do while PF3 key is not pressed                          *

      *                                                               *

      *         If Help (PF1) key pressed                             *

      *            Display the help screen while PF12 not pressed     *

      *         Else if PF5 key pressed                               *

      *            Clear the screen map                               *

      *            Put the previous inquiry data back into the        *

      *            screen map (Perform REBUILD-IIM-IMMEDIATE)         *

      *            Display the screen map                             *

      *         Else if Enter key pressed                             *

      *            Build the inquiry message                          *

      *               (Perform BUILD-IIM-IMMEDIATE)                   *

      *            Validate the user input (Perform VALIDATE-INPUT)   *

      *            If input not ok                                    *

      *               Display error message                           *

      *            Else                                               *

      *               Make the inquiry and obtain the result          *

      *                  (Perform PROCESS-SCREEN-IMMEDIATE)           *

      *               Syncpoint                                       *

      *               Move message to screen map                      *

      *               Do while PF3 or PF5 key is not pressed          *

      *                 If Help (PF1) key pressed                     *

      *                    Display the help screen while PF12 not     *

      *                    pressed                                    *

      *                 Else                                          *

      *                    Display the screen map                     *

      *                    Move new messsage to screen map            *

      *                 End-if                                        *

      *               End-do                                          *

      *            Move the response message to the screen map        *

      *            (Perform BUILD-MSG-OUTPUT)                         *

      *            End-if                                             *

      *         Else                                                  *

      *            Display screen map                                 *

      *         End-if                                                *

      *                                                               *

      *      End-do                                                   *

      *                                                               *

      *      Close the inquiry queue, without updating the message    *

      *      if there has been a problem earlier                      *

      *                                                               *

      *   Immediate-Inquiry-Exit                                      *

      *                                                               *

      *      Set EIBAID to prevent calling program terminating        *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  BATCH-INQUIRY SECTION                                        *

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

      *      Open the inquiry queue (Perform OPEN-INQUIRY-QUEUE)      *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *         Goto Batch-Inquiry-Exit                               *

      *      End-if                                                   *

      *                                                               *

      *      Clear the output message field and screen map            *

      *      Display the screen map and wait for input data, here     *

      *      and throughout this section by performing DISPLAY-MAPID3 *

      *                                                               *

      *      Do while PF3 key is not pressed                          *

      *                                                               *

      *         If Help (PF1) key pressed                             *

      *            Display the help screen while PF12 not pressed     *

      *         Else if PF5 key pressed                               *

      *            Clear the screen map                               *

      *            Put the previous inquiry data back into the        *

      *            screen map (Perform REBUILD-IIM-BATCH)             *

      *            Display the screen map                             *

      *         Else if Enter key pressed                             *

      *            Build the inquiry message                          *

      *               (Perform BUILD-IIM-BATCH)                       *

      *            Validate the user input (Perform VALIDATE-INPUT)   *

      *            If input not ok                                    *

      *               Display error message                           *

      *            Else                                               *

      *               Make the inquiry (Perform PROCESS-SCREEN-BATCH) *

      *               Syncpoint                                       *

      *               Move message to screen map                      *

      *               Display the screen map                          *

      *               Do while PF3 or PF5 key is not pressed          *

      *                 If Help (PF1) key pressed                     *

      *                    Display the help screen while PF12 not     *

      *                    pressed                                    *

      *                 Else                                          *

      *                    Move new messsage to screen map            *

      *                    Display the screen map                     *

      *                 End-if                                        *

      *               End-do                                          *

      *            End-if                                             *

      *         Else                                                  *

      *            Display screen map                                 *

      *         End-if                                                *

      *                                                               *

      *      End-do                                                   *

      *                                                               *

      *      Close the inquiry queue                                  *

      *      If close unsuccessful, build an error message            *

      *                                                               *

      *   Batch-Inquiry-Exit                                          *

      *                                                               *

      *      Set EIBAID to prevent calling program terminating        *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  BATCH-RESPONSE SECTION                                       *

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

      *      Open the response queue (Perform OPEN-RESPONSE-QUEUE)    *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *         Goto Batch-Response-Exit                              *

      *      End-if                                                   *

      *                                                               *

      *      Clear the output message field and screen map            *

      *                                                               *

      *      Get a response message (Perform PROCESS-SCREEN-RESPONSE) *

      *      Move the message to the screen map field                 *

      *                                                               *

      *      Display the screen map, here and throughout this         *

      *      section by performing DISPLAY-MAPID4                     *

      *                                                               *

      *      Do while PF3 key is not pressed                          *

      *                                                               *

      *         If Help (PF1) key pressed                             *

      *            Display the help screen while PF12 not pressed     *

      *         Else if PF5 key pressed                               *

      *            Clear the message field                            *

      *            If PF8 key is pressed                              *

      *               Syncpoint                                       *

      *               Get a response message                          *

      *               Move the message to the screen map field        *

      *            End-if                                             *

      *            Display the screen map                             *

      *         End-if                                                *

      *                                                               *

      *      End-do                                                   *

      *                                                               *

      *      Close the response queue                                 *

      *      If close unsuccessful, build an error message            *

      *                                                               *

      *   Batch-Response-Exit                                         *

      *                                                               *

      *      Set EIBAID to prevent calling program terminating        *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  PROCESS-IMMEDIATE-SCREEN SECTION                             *

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

      *      Create the temporary response queue                      *

      *         (Perform OPEN-TEMP-RESPONSE-QUEUE)                    *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *         Goto Process-Immediate-Screen-Exit                    *

      *      End-if                                                   *

      *                                                               *

      *      Set the message descriptor and put message options       *

      *      for the immediate inquiry put                            *

      *                                                               *

      *      Put the inquiry message on the queue                     *

      *      If put not successful                                    *

      *         Build an error message                                *

      *         Clear the response area of the screen                 *

      *         Goto Process-Immediate-Screen-Exit-2                  *

      *      End-if                                                   *

      *                                                               *

      *      Set the message descriptor and get message options       *

      *      to get the message from the temporary response queue     *

      *                                                               *

      *      Get the response message                                 *

      *      If message received                                      *

      *         Move response data from message to screen map by      *

      *         performing BUILD-MSG-OUTPUT                           *

      *         Build 'inquiry complete' message                      *

      *      Else if no message received                              *

      *         Build 'no response' message                           *

      *         Clear the response area of the screen                 *

      *      Else                                                     *

      *         Build 'no response' message                           *

      *         Clear the response area of the screen                 *

      *      End-if                                                   *

      *                                                               *

      *   Process-Immediate-Screen-Exit-2                             *

      *                                                               *

      *      Close the temporary dynamic queue                        *

      *                                                               *

      *   Process-Immediate-Screen-Exit                               *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  PROCESS-INQUIRY-SCREEN SECTION                               *

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

      *      Set the message descriptor and put message options       *

      *      for the batch inquiry put                                *

      *                                                               *

      *      Put the inquiry message on the queue                     *

      *      If put not successful                                    *

      *         Build an error message                                *

      *         Clear the response area of the screen                 *

      *      Else                                                     *

      *         Build 'inquiry sumitted' message                      *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  PROCESS-RESPONSE SCREEN SECTION                              *

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

      *      Set the message descriptor and get message options to    *

      *      get a message from the response queue                    *

      *                                                               *

      *      Get the response message                                 *

      *      If message received                                      *

      *         Move response data from message to screen map         *

      *      Else if no message received                              *

      *         Build 'no more responses' message                     *

      *         Clear the response area of the screen                 *

      *      Else                                                     *

      *         Build error message                                   *

      *         Clear the response area of the screen                 *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  DISPLAY-MAPID2 SECTION                                       *

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

      *      Exec CICS send immediate inquiry screen map              *

      *      Exec CICS receive immediate inquiry screen map           *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  DISPLAY-MAPID3 SECTION                                       *

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

      *      Exec CICS send batch inquiry screen map                  *

      *      Exec CICS receive batch inquiry screen map               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  DISPLAY-MAPID4 SECTION                                       *

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

      *      Exec CICS send batch response screen map                 *

      *      Exec CICS receive batch response screen map              *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  DISPLAY-HELP SECTION                                         *

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

      *      Do until PF12 key is pressed                             *

      *         Exec CICS send help screen map                        *

      *         Exec CICS receive help screen map                     *

      *      End-do                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  VALDATE-INPUT SECTION                                        *

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

      *      If amount requested is numeric                           *

      *         Set input-ok                                          *

      *      Else                                                     *

      *         Set input-invalid                                     *

      *         Build 'input-invalid' message                         *

      *      End-do                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  BUILD-IIM-IMMEDIATE SECTION                                  *

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

      *      Move data from screen map to initial inquiry message     *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  BUILD-IIM-BATCH SECTION                                      *

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

      *      Move data from screen map to initial inquiry message     *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  REBUILD-IIM-IMMEDIATE SECTION                                *

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

      *      Move data from inquiry message to screen map (MAPID2)    *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  REBUILD-IIM-BATCH SECTION                                    *

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

      *      Move data from inquiry message to screen map (MAPID3)    *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  BUILD-MESSAGE-OUTPUT                                         *

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

      *      Move data from response message to screen map (MAPID2)   *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  CLEAR-RESPONSE-SCREEN SECTION                                *

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

      *      Clear all data from the response screen map (MAPID4)     *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  OPEN-RESPONSEQ-FOR-INQ SECTION                               *

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

      *      Set the object descriptor and open options to open the   *

      *      response queue for inquiry                               *

      *                                                               *

      *      Open the queue                                           *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  OPEN-TEMP-RESPONSE-QUEUE SECTION                             *

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

      *      Set the object descriptor and open options to create     *

      *      and open the temporary response queue                    *

      *                                                               *

      *      Open the queue                                           *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *      Else                                                     *

      *         Save the temporary queue name                         *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  OPEN-INQUIRY-QUEUE SECTION                                   *

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

      *      Set the object descriptor and open options to open the   *

      *      inquiry queue for output                                 *

      *                                                               *

      *      Open the queue                                           *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  OPEN-RESPONSE-QUEUE SECTION                                  *

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

      *      Set the object descriptor and open options to open the   *

      *      inquiry queue for input shared                           *

      *                                                               *

      *      Open the queue                                           *

      *      If open unsuccessful                                     *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  CLOSE-RESPONSE-QUEUE SECTION                                 *

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

      *      Close the queue                                          *

      *      If close unsuccessful                                    *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  CLOSE-INQUIRY-QUEUE SECTION                                  *

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

      *      Close the queue                                          *

      *      If close unsuccessful                                    *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

      *  CLOSE-TEMP-RESPONSE-QUEUE SECTION                            *

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

      *      Close the queue                                          *

      *      If close unsuccessful                                    *

      *         Build error message                                   *

      *      End-if                                                   *

      *                                                               *

      *      Return to performing section                             *

      *                                                               *

      *                                                               *

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

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

       ENVIRONMENT DIVISION.

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

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

       DATA DIVISION.

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

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

       WORKING-STORAGE SECTION.

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

      *

      *    W00 - Screen map name definitions

      *

       01  W00-MAPSETID                PIC X(08)  VALUE 'CSQ4VBM'.

       01  W00-MAPIDHLP                PIC X(08)  VALUE 'CSQ4VB5'.

       01  W00-MAPID1                  PIC X(08)  VALUE 'CSQ4VB1'.

       01  W00-MAPID2                  PIC X(08)  VALUE 'CSQ4VB2'.

       01  W00-MAPID3                  PIC X(08)  VALUE 'CSQ4VB3'.

       01  W00-MAPID4                  PIC X(08)  VALUE 'CSQ4VB4'.

      *

      *    W01 - General work fields

      *

       01  W01-CURDEPTH-EDITED         PIC 9(9).

      *

       01  W01-WAIT-INTERVAL           PIC S9(09) BINARY VALUE 30000.

      *

      *    W02 - Queues processed in this program

      *

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

           'CSQ4SAMP.B2.INQUIRY                             '.

       01  W02-RESPONSE-QNAME          PIC X(48) VALUE

           'CSQ4SAMP.B2.RESPONSE                            '.

       01  W02-MODEL-QNAME             PIC X(48) VALUE

           'CSQ4SAMP.B1.MODEL                               '.

       01  W02-NAME-PREFIX             PIC X(48) VALUE

           'CSQ4SAMP.B1.*                                   '.

       01  W02-TEMPORARY-Q             PIC X(48).

      *

      *    W03 - MQM API fields

      *

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

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

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

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

       01  W03-OPTIONS                 PIC S9(9) BINARY.

       01  W03-BUFFLEN                 PIC S9(9) BINARY.

       01  W03-DATALEN                 PIC S9(9) BINARY.

       01  W03-COMPCODE                PIC S9(9) BINARY.

       01  W03-REASON                  PIC S9(9) BINARY.

      *

       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-SELECTORS               PIC S9(9) BINARY.

       01  W03-INTATTRS                PIC S9(9) BINARY.

      *

       01  W03-GET-BUFFER.

           05 W03-CSQ4BAM.

           COPY CSQ4VB2.

      *

       01  W03-PUT-BUFFER.

      *

           05 W03-CSQ4BIIM.

           COPY CSQ4VB1.

      *

      *    W04 - Process flag

      *

       01  W04-INPUT-STATUS         PIC X(3) VALUE 'OK'.

           88 INPUT-INVALID VALUE 'BAD'.

           88 INPUT-OK      VALUE 'OK'.

      *

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

      *

      *    MQV contains constants (for filling in the control blocks)

      *    and return codes (for testing the result of a call)

      *

       01  MQM-CONSTANTS.

           COPY CMQV SUPPRESS.

      *

      *    The following copy book contains messages that will be

      *    displayed to the user

      *

       COPY CSQ4VB0.

      *

      *    Screen map definitions used by this sample program

      *

       COPY CSQ4VBM.

      *

      *    DFHAID contains the constants used for checking for

      *    attention identifiers

      *

       COPY DFHAID SUPPRESS.

      *

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

       LINKAGE SECTION.

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

      *

       EJECT

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

       PROCEDURE DIVISION.

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

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

       A-MAIN SECTION.

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

      *                                                              *

      *  This section handles the selection screen, CSQ4VB1, in a    *

      *  loop. Handlers for the subsequent screens are called from   *

      *  within the loop.                                            *

      *                                                              *

      *  The section updates the number of responses available       *

      *  using the INQUIRE-DEPTH function.                           *

      *                                                              *

      *  After exit from the loop, the section returns control to    *

      *  CICS.                                                       *

      *                                                              *

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

      *

      *    Clear the output message field and screen map

      *

           MOVE SPACES TO M00-MESSAGE.

           MOVE LOW-VALUES TO CSQ4VB1O.

      *

           PERFORM INQUIRE-DEPTH

      *

      *    If the depth cannot be obtained, there is no possibility

      *    that the program can work - so exit with a message

      *

           IF M00-MESSAGE NOT = SPACES THEN

               STRING EIBTRNID

                      M01-MESSAGE-14

                      DELIMITED BY SIZE INTO M00-MESSAGE

               GO TO A-MAIN-EXIT

           END-IF.

      *

           EXEC CICS IGNORE CONDITION

                     MAPFAIL

           END-EXEC.

      *

      *    Send the screen map, then receive it

      *

           EXEC CICS SEND

                     MAP(W00-MAPID1)

                     MAPSET(W00-MAPSETID)

                     FROM(CSQ4VB1O)

                     ERASE

           END-EXEC

      *

           EXEC CICS RECEIVE

                     MAP(W00-MAPID1)

                     MAPSET(W00-MAPSETID)

                     INTO(CSQ4VB1I)

           END-EXEC

      *

      *    Loop from here to END-PERFORM until the PF3 key is pressed

      *

           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3   OR

                                           EIBAID = DFHPF15)

      *

               EVALUATE TRUE

                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13

                       PERFORM DISPLAY-HELP

      *

                   WHEN EIBAID = DFHENTER

      *

      *                Process depending on the action entered by the

      *                user

      *

                       EVALUATE TRUE

                            WHEN OPTIONI = '1'

                                 PERFORM IMMEDIATE-INQUIRY

                            WHEN OPTIONI = '2'

                                 PERFORM BATCH-INQUIRY

                            WHEN OPTIONI = '3'

                                 IF W01-CURDEPTH-EDITED > ZERO

                                     PERFORM BATCH-RESPONSE

                                 ELSE

                                     MOVE M01-MESSAGE-2 TO M00-MESSAGE

                                 END-IF

                            WHEN OTHER

                                 MOVE M01-MESSAGE-1 TO M00-MESSAGE

                                 MOVE -1 TO OPTIONL

                       END-EVALUATE

      *

               END-EVALUATE

      *

      *        Move the message field into the corresponding

      *        screen map field and update the response messages

      *        available field

      *

               MOVE M00-MESSAGE TO VB1MSGO

               PERFORM INQUIRE-DEPTH

      *

      *        Send the screen map, then receive it

      *

               EXEC CICS SEND

                         MAP(W00-MAPID1)

                         MAPSET(W00-MAPSETID)

                         FROM(CSQ4VB1O)

                         ERASE

               END-EXEC

      *

               EXEC CICS RECEIVE

                         MAP(W00-MAPID1)

                         MAPSET(W00-MAPSETID)

                         INTO(CSQ4VB1I)

               END-EXEC

      *

           END-PERFORM.

      *

      *    Clear the screen and reset the keyboard

      *

           MOVE SPACES TO M00-MESSAGE.

      *

       A-MAIN-EXIT.

      *

           EXEC CICS SEND

                     TEXT

                     FROM(M00-MESSAGE)

                     FREEKB

                     ERASE

           END-EXEC.

      *

      *    Return to CICS.

      *

           EXEC CICS RETURN

           END-EXEC.

      *

           GOBACK.

           EJECT

      *

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

       INQUIRE-DEPTH SECTION.

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

      *                                                              *

      *  This section inquires the current depth of the response     *

      *  queue and updates the appropriate field (CURDPTHO) on the   *

      *  map                                                         *

      *                                                              *

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

      *

           PERFORM OPEN-RESPONSEQ-FOR-INQ.

      *

      *    Test for an error.  If an error occurred, exit

      *

           IF W03-COMPCODE NOT = MQCC-OK

              GO TO INQUIRE-DEPTH-EXIT

           END-IF.

      *

      *    Set selectors to inquire on current depth

      *

           MOVE MQIA-CURRENT-Q-DEPTH TO W03-SELECTORS.

      *

      *    Inquire on the attributes

      *

           CALL 'MQINQ' USING W03-HCONN

                              W03-HOBJ-RESPONSE

                              W03-SELECTORCOUNT

                              W03-SELECTORS

                              W03-INTATTRCOUNT

                              W03-INTATTRS

                              W03-CHARATTRLENGTH

                              W03-CHARATTRS

                              W03-COMPCODE

                              W03-REASON.

      *

      *    Test the output from the inquiry:

      *

      *     - If the completion code is not OK, display an error

      *       message showing the completion and reason codes

      *

      *     - Otherwise, move the correct attribute status into

      *       the relevant screen map fields

      *

           IF W03-COMPCODE NOT = MQCC-OK

              MOVE 'MQINQ'       TO M01-MSG4-OPERATION

              MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

              MOVE W03-REASON    TO M01-MSG4-REASON

              MOVE M01-MESSAGE-4 TO M00-MESSAGE

      *

           ELSE

              MOVE W03-INTATTRS        TO W01-CURDEPTH-EDITED

              MOVE W01-CURDEPTH-EDITED TO CURDPTHO

           END-IF.

      *

           PERFORM CLOSE-RESPONSE-QUEUE.

      *

       INQUIRE-DEPTH-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

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

       IMMEDIATE-INQUIRY SECTION.

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

      *                                                              *

      *  This section contains a loop which does the following:      *

      *    displays the immediate inquiry map, gets and validates    *

      *    user input, sends an inquiry message, waits to receive    *

      *    the response. Once an inquiry has been completed another  *

      *    inquiry can be initiated by the user                      *

      *    The loop is terminated by the user and a help panel is    *

      *    available.                                                *

      *                                                              *

      *  Any errors occurring are reported to the user               *

      *                                                              *

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

      *

      *    Open inquiry queue

      *

           PERFORM OPEN-INQUIRY-QUEUE.

           IF W03-COMPCODE NOT = MQCC-OK

               GO TO IMMEDIATE-INQUIRY-EXIT

           END-IF.

      *

      *    Clear the output message field and screen map

      *

           MOVE SPACES TO M00-MESSAGE.

           MOVE LOW-VALUES TO CSQ4VB2O.

      *

           PERFORM DISPLAY-MAPID2.

      *

      *    Loop from here to END-PERFORM until the PF3 key is pressed

      *

           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3   OR

                                           EIBAID = DFHPF15)

      *

               EVALUATE TRUE

                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13

                       PERFORM DISPLAY-HELP

      *

                   WHEN EIBAID = DFHPF5 OR EIBAID = DFHPF17

      *

      *                Clear the previous inquiry response, reset the

      *                data

      *

                       MOVE LOW-VALUES TO CSQ4VB2O

                       PERFORM REBUILD-IIM-IMMEDIATE

                       MOVE SPACES TO CSQ4BAM-MSG

      *

                       PERFORM DISPLAY-MAPID2

      *

                   WHEN EIBAID = DFHENTER

      *

                       PERFORM BUILD-IIM-IMMEDIATE

                       PERFORM VALIDATE-INPUT

      *

                       IF NOT INPUT-OK THEN

      *

      *                    Move the message field into the

      *                    corresponding screen map field

      *

                           MOVE M00-MESSAGE TO VB2MSGO

      *

                           PERFORM DISPLAY-MAPID2

      *

                       ELSE

      *

                           PERFORM PROCESS-IMMEDIATE-SCREEN

      *

                           EXEC CICS SYNCPOINT END-EXEC

      *

      *                    Move the message field into the

      *                    corresponding screen map field

      *

                           MOVE M00-MESSAGE TO VB2MSGO

      *

      *                    Loop from here to END-PERFORM until

      *                    the PF5 or PF3 is pressed

      *

                           PERFORM WITH TEST BEFORE UNTIL

                                              (EIBAID = DFHPF3  OR

                                               EIBAID = DFHPF5  OR

                                               EIBAID = DFHPF15 OR

                                               EIBAID = DFHPF17)

      *

                               IF EIBAID = DFHPF1 OR

                                  EIBAID = DFHPF13 THEN

                                   PERFORM DISPLAY-HELP

      *

                               ELSE

                                   PERFORM DISPLAY-MAPID2

      *

      *                            Move the message field into the

      *                            corresponding screen map field

      *

                                   MOVE M01-MESSAGE-3 TO M00-MESSAGE

                                   MOVE M00-MESSAGE TO VB2MSGO

      *

                               END-IF

      *

                               PERFORM BUILD-MSG-OUTPUT

      *

                           END-PERFORM

      *

                       END-IF

      *

                   WHEN OTHER

      *

                       PERFORM DISPLAY-MAPID2

      *

               END-EVALUATE

      *

           END-PERFORM.

      *

      *    Close the inquiry queue

      *

           PERFORM CLOSE-INQUIRY-QUEUE

           IF W03-COMPCODE = MQCC-OK

               MOVE M01-MESSAGE-5 TO M00-MESSAGE

           END-IF.

      *

       IMMEDIATE-INQUIRY-EXIT.

      *

      *    Reset EIBAID to enable the previous screen to be displayed

      *

           MOVE DFHENTER TO EIBAID.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

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

       BATCH-INQUIRY SECTION.

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

      *                                                              *

      *  This section contains a loop which does the following:      *

      *    displays the batch inquiry map, gets and validates        *

      *    user input, sends an inquiry message. Once an inquiry     *

      *    has been made, another inquiry can be initiated by the    *.

      *    user.                                                     *

      *    The loop is terminated by the user and a help panel is    *

      *    available.                                                *

      *                                                              *

      *  Prior to displaying the map for the first time the inquiry  *

      *  queue is opened for output.                                 *

      *                                                              *

      *  Any errors occurring are reported to the user               *

      *                                                              *

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

      *

      *    open inquiry queue

      *

           PERFORM OPEN-INQUIRY-QUEUE.

           IF W03-COMPCODE NOT = MQCC-OK

               GO TO BATCH-INQUIRY-EXIT

           END-IF.

      *

      *    Clear the output message field and screen map

      *

           MOVE SPACES TO M00-MESSAGE.

           MOVE LOW-VALUES TO CSQ4VB3O.

      *

           PERFORM DISPLAY-MAPID3.

      *

      *    Loop from here to END-PERFORM until the PF3 key is pressed

      *

           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3   OR

                                           EIBAID = DFHPF15)

      *

               EVALUATE TRUE

                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13

                       PERFORM DISPLAY-HELP

      *

                   WHEN EIBAID = DFHPF5 OR EIBAID = DFHPF17

      *

      *                Clear the previous inquiry response, reset the

      *                data

      *

                       MOVE LOW-VALUES to CSQ4VB3O

                       PERFORM REBUILD-IIM-BATCH

      *

                       PERFORM DISPLAY-MAPID3

      *

                   WHEN EIBAID = DFHENTER

                       PERFORM BUILD-IIM-BATCH

                       PERFORM VALIDATE-INPUT

      *

                       IF NOT INPUT-OK THEN

      *

      *                    Move the message field into the

      *                    corresponding screen map field.

      *

                           MOVE M00-MESSAGE TO VB3MSGO

      *

                           PERFORM DISPLAY-MAPID3

      *

                       ELSE

                           PERFORM PROCESS-INQUIRY-SCREEN

      *

                           EXEC CICS SYNCPOINT END-EXEC

      *

      *                    Move the message field into the

      *                    corresponding screen map field

      *

                           MOVE M00-MESSAGE TO VB3MSGO

      *

                           PERFORM DISPLAY-MAPID3

      *

      *                    Loop from here to END-PERFORM until

      *                    the PF3 or PF5 key is pressed

      *

                           PERFORM WITH TEST BEFORE UNTIL

                                              (EIBAID = DFHPF3  OR

                                               EIBAID = DFHPF5  OR

                                               EIBAID = DFHPF15 OR

                                               EIBAID = DFHPF17)

                               IF EIBAID = DFHPF1 OR

                                  EIBAID = DFHPF13 THEN

                                   PERFORM DISPLAY-HELP

      *

                               ELSE

      *

      *                            Move the message field into the

      *                            corresponding screen map field

      *

                                   MOVE M01-MESSAGE-3 TO M00-MESSAGE

                                   MOVE M00-MESSAGE TO VB3MSGO

      *

                                   PERFORM DISPLAY-MAPID3

                               END-IF

      *

                           END-PERFORM

      *

                       END-IF

      *

                   WHEN OTHER

                       PERFORM DISPLAY-MAPID3

      *

               END-EVALUATE

      *

           END-PERFORM.

      *

      *

      *

           PERFORM CLOSE-INQUIRY-QUEUE.

           IF W03-COMPCODE = MQCC-OK

              MOVE M01-MESSAGE-6 TO M00-MESSAGE

           END-IF.

      *

      *

       BATCH-INQUIRY-EXIT.

      *

      *    Reset EIBAID to enable the previous screen to be displayed

      *

           MOVE DFHENTER TO EIBAID.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

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

       BATCH-RESPONSE SECTION.

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

      *                                                              *

      *  This section contains a loop which does the following:      *

      *    displays the batch response map, receives a message from  *

      *    the response queue and displays its content.  Display     *

      *    of another response can be initiated by the user.         *

      *    The loop is terminated by the user and a help panel is    *

      *    available.                                                *

      *                                                              *

      *  Prior to displaying the map for the first time the response *

      *  queue is opened for input.                                  *

      *                                                              *

      *  Any errors occurring are reported to the user               *

      *                                                              *

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

      *

      *    open response queue

      *

           PERFORM OPEN-RESPONSE-QUEUE.

           IF W03-COMPCODE NOT = MQCC-OK

               GO TO BATCH-RESPONSE-EXIT

           END-IF.

      *

      *    Clear the output message field and screen map

      *

           MOVE SPACES TO M00-MESSAGE.

           MOVE LOW-VALUES TO CSQ4VB4O.

      *

      *    Get first message

      *

           PERFORM PROCESS-RESPONSE-SCREEN.

      *

      *    Move the message field into the corresponding

      *    screen map field

      *

           MOVE M00-MESSAGE TO VB4MSGO.

      *

           PERFORM DISPLAY-MAPID4.

      *

      *    Loop from here to END-PERFORM until the PF3 key is pressed

      *

           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3   OR

                                           EIBAID = DFHPF15)

      *

               IF EIBAID = DFHPF1 OR EIBAID = DFHPF13 THEN

                   PERFORM DISPLAY-HELP

      *

               ELSE

                   MOVE SPACES TO M00-MESSAGE

      *

      *            Process depending on the action entered by the user

      *

                   IF EIBAID = DFHPF8 OR EIBAID = DFHPF20

      *

                       EXEC CICS SYNCPOINT END-EXEC

      *

      *                Get the next message

      *

                       PERFORM PROCESS-RESPONSE-SCREEN

      *

      *                Move the message field into the corresponding

      *                screen map field

      *

                       MOVE M00-MESSAGE TO VB4MSGO

                   END-IF

      *

                   PERFORM DISPLAY-MAPID4

               END-IF

      *

           END-PERFORM.

      *

           PERFORM CLOSE-RESPONSE-QUEUE.

           IF W03-COMPCODE = MQCC-OK

              MOVE M01-MESSAGE-7 TO M00-MESSAGE

           END-IF.

      *

      *    Reset EIBAID to enable the previous screen to be displayed

      *

           MOVE DFHENTER TO EIBAID.

      *

       BATCH-RESPONSE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

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

       PROCESS-IMMEDIATE-SCREEN SECTION.

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

      *                                                              *

      *  This section creates the temporary dynamic queue to receive *

      *  the response, sends a message to the inquiry queue and      *

      *  waits for a response on the temporary dynamic queue.        *

      *                                                              *

      *  When a response is received it is transferred to the        *

      *  map for display, otherwise an error message is built.       *

      *                                                              *

      *  Finally the temporary dynamic queue is deleted              *

      *                                                              *

      *    Note: Inquiry message is built prior to this section      *

      *          being called                                        *

      *                                                              *

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

      *

      *    Open model queue, to create the temporary response queue

      *

           PERFORM OPEN-TEMP-RESPONSE-QUEUE.

           IF W03-COMPCODE NOT = MQCC-OK

               GO TO PROCESS-IMMEDIATE-SCREEN-EXIT

           END-IF.

      *

      *    Set the message descriptor and put message options to

      *    the values required to create the message.

      *    Set the length of the message

      *

           MOVE MQMT-REQUEST           TO MQMD-MSGTYPE.

           MOVE MQCI-NONE              TO MQMD-CORRELID.

           MOVE MQMI-NONE              TO MQMD-MSGID.

           MOVE W02-TEMPORARY-Q        TO MQMD-REPLYTOQ.

           MOVE SPACES                 TO MQMD-REPLYTOQMGR.

           MOVE 5                      TO MQMD-PRIORITY.

           MOVE MQPER-NOT-PERSISTENT   TO MQMD-PERSISTENCE.

           COMPUTE MQPMO-OPTIONS       =  MQPMO-NO-SYNCPOINT +

                                          MQPMO-DEFAULT-CONTEXT.

           MOVE LENGTH OF CSQ4BIIM-MSG TO W03-BUFFLEN.

      *

           CALL 'MQPUT' USING W03-HCONN

                              W03-HOBJ-INQUIRY

                              MQMD

                              MQPMO

                              W03-BUFFLEN

                              W03-PUT-BUFFER

                              W03-COMPCODE

                              W03-REASON.

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQPUT  '    TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE TO M01-MSG4-COMPCODE

               MOVE W03-REASON   TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

               MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O

                              RESP05O RESP06O RESP07O RESP08O

                              RESP09O RESP10O RESP11O RESP12O

               GO TO PROCESS-IMMEDIATE-EXIT-2

           END-IF.

      *

      *

      *

      *    Set get message options field to wait within syncpoint

      *    Set interval for wait for 30 seconds

      *

           COMPUTE MQGMO-OPTIONS  =  MQGMO-SYNCPOINT +

                                     MQGMO-WAIT.

           MOVE W01-WAIT-INTERVAL TO MQGMO-WAITINTERVAL.

      *

      *    Set msgid and correlid in md to nulls so that any message

      *    will qualify. Set the length to the available buffer

      *    length

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

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

      *

           CALL 'MQGET' USING W03-HCONN,

                              W03-HOBJ-MODEL,

                              MQMD,

                              MQGMO,

                              W03-BUFFLEN,

                              W03-GET-BUFFER,

                              W03-DATALEN,

                              W03-COMPCODE,

                              W03-REASON.

           EVALUATE TRUE

               WHEN (W03-COMPCODE = MQCC-OK AND

                     W03-REASON = MQRC-NONE)

      *            Message received

                   PERFORM BUILD-MSG-OUTPUT

                   MOVE M01-MESSAGE-10 TO M00-MESSAGE

               WHEN (W03-COMPCODE = MQCC-FAILED AND

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

      *            Wait timed out with no message received

                   MOVE  M01-MESSAGE-11 TO M00-MESSAGE

                   MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O

                                  RESP05O RESP06O RESP07O RESP08O

                                  RESP09O RESP10O RESP11O RESP12O

               WHEN OTHER

      *            Unexpected result, report it

                   MOVE 'MQGETW '     TO M01-MSG4-OPERATION

                   MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

                   MOVE W03-REASON    TO M01-MSG4-REASON

                   MOVE M01-MESSAGE-4 TO M00-MESSAGE

                   MOVE SPACES TO RESP01O RESP02O RESP03O RESP04O

                                  RESP05O RESP06O RESP07O RESP08O

                                  RESP09O RESP10O RESP11O RESP12O

           END-EVALUATE.

      *

       PROCESS-IMMEDIATE-EXIT-2.

      *

           PERFORM CLOSE-TEMP-RESPONSE-QUEUE.

      *

       PROCESS-IMMEDIATE-SCREEN-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       PROCESS-INQUIRY-SCREEN SECTION.

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

      *                                                              *

      *  This section sends a message to the inquiry queue. It does  *

      *  not wait for a response.                                    *

      *                                                              *

      *    Note: Inquiry message is built prior to this section      *

      *          being called                                        *

      *                                                              *

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

      *

      *    Set the message descriptor and put message options to

      *    the values required to create the message.

      *    Set the length of the message

      *

           MOVE MQMT-REQUEST           TO MQMD-MSGTYPE.

           MOVE MQCI-NONE              TO MQMD-CORRELID.

           MOVE MQMI-NONE              TO MQMD-MSGID.

           MOVE W02-RESPONSE-QNAME     TO MQMD-REPLYTOQ.

           MOVE SPACES                 TO MQMD-REPLYTOQMGR.

           MOVE 3                      TO MQMD-PRIORITY.

           MOVE MQPER-PERSISTENT       TO MQMD-PERSISTENCE.

           COMPUTE MQPMO-OPTIONS       =  MQPMO-NO-SYNCPOINT +

                                          MQPMO-DEFAULT-CONTEXT.

           MOVE LENGTH OF CSQ4BIIM-MSG TO W03-BUFFLEN.

      *

           CALL 'MQPUT' USING W03-HCONN

                              W03-HOBJ-INQUIRY

                              MQMD

                              MQPMO

                              W03-BUFFLEN

                              W03-PUT-BUFFER

                              W03-COMPCODE

                              W03-REASON.

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'MQPUT  '     TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

               MOVE W03-REASON    TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

           ELSE

      *        Inquiry successfully submitted

               MOVE M01-MESSAGE-12 TO M00-MESSAGE

           END-IF.

      *

       PROCESS-INQUIRY-SCREEN-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       PROCESS-RESPONSE-SCREEN SECTION.

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

      *                                                              *

      *  This section gets a message from the response queue.        *

      *                                                              *

      *  When a correct response is received it is transferred to    *

      *  the map for display, otherwise an error message is built    *

      *                                                              *

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

      *

      *    Set get message options

      *

           COMPUTE MQGMO-OPTIONS = MQGMO-SYNCPOINT +

                                   MQGMO-ACCEPT-TRUNCATED-MSG +

                                   MQGMO-NO-WAIT.

      *

      *    Set msgid and correlid in md to nulls so that any message

      *    will qualify. Set length to available buffer length

      *

           MOVE MQMI-NONE TO MQMD-MSGID.

           MOVE MQCI-NONE TO MQMD-CORRELID.

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

      *

           CALL 'MQGET' USING W03-HCONN

                              W03-HOBJ-RESPONSE

                              MQMD

                              MQGMO

                              W03-BUFFLEN

                              W03-GET-BUFFER

                              W03-DATALEN

                              W03-COMPCODE

                              W03-REASON.

           EVALUATE TRUE

               WHEN W03-COMPCODE NOT = MQCC-FAILED

                   IF ANSWER-MESSAGE

                       MOVE SPACES             TO M00-MESSAGE

                       MOVE CSQ4BAM-NAME       TO NAMERO

                       MOVE CSQ4BAM-SOCSECNO1  TO SSNO1RO

                       MOVE CSQ4BAM-SOCSECNO2  TO SSNO2RO

                       MOVE CSQ4BAM-SOCSECNO3  TO SSNO3RO

                       MOVE CSQ4BAM-BANKACNAME TO ACNAMERO

                       MOVE CSQ4BAM-BANKACNUM  TO ACNORO

                       MOVE CSQ4BAM-LOANREQ    TO AMOUNTRO

                       MOVE CSQ4BAM-LINE(1)  TO RESP01RO

                       MOVE CSQ4BAM-LINE(2)  TO RESP02RO

                       MOVE CSQ4BAM-LINE(3)  TO RESP03RO

                       MOVE CSQ4BAM-LINE(4)  TO RESP04RO

                       MOVE CSQ4BAM-LINE(5)  TO RESP05RO

                       MOVE CSQ4BAM-LINE(6)  TO RESP06RO

                       MOVE CSQ4BAM-LINE(7)  TO RESP07RO

                       MOVE CSQ4BAM-LINE(8)  TO RESP08RO

                       MOVE CSQ4BAM-LINE(9)  TO RESP09RO

                       MOVE CSQ4BAM-LINE(10) TO RESP10RO

                       MOVE CSQ4BAM-LINE(11) TO RESP11RO

                       MOVE CSQ4BAM-LINE(12) TO RESP12RO

                   ELSE

      *                This message was not expected

                       MOVE M01-MESSAGE-8 TO M00-MESSAGE

                       PERFORM CLEAR-RESPONSE-SCREEN

                   END-IF

      *

               WHEN (W03-COMPCODE = MQCC-FAILED AND

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

                       MOVE M01-MESSAGE-9 TO M00-MESSAGE

                       PERFORM CLEAR-RESPONSE-SCREEN

      *

               WHEN OTHER

                   MOVE 'MQGET  '     TO M01-MSG4-OPERATION

                   MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

                   MOVE W03-REASON    TO M01-MSG4-REASON

                   MOVE M01-MESSAGE-4 TO M00-MESSAGE

                   PERFORM CLEAR-RESPONSE-SCREEN

           END-EVALUATE.

      *

       PROCESS-RESPONSE-SCREEN-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       DISPLAY-MAPID2 SECTION.

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

      *                                                              *

      *  This section sends the immediate inquiry screen (MAPID2)    *

      *  to the terminal and returns once the receive is complete    *

      *                                                              *

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

      *

              EXEC CICS SEND

                        MAP(W00-MAPID2)

                        MAPSET(W00-MAPSETID)

                        FROM(CSQ4VB2O)

                        ERASE

              END-EXEC.

      *

              EXEC CICS RECEIVE

                        MAP(W00-MAPID2)

                        MAPSET(W00-MAPSETID)

                        INTO(CSQ4VB2I)

              END-EXEC.

      *

       DISPLAY-MAPID2-EXIT.

      *

           EXIT.

           EJECT

      *

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

       DISPLAY-MAPID3 SECTION.

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

      *                                                              *

      *  This section sends the batch inquiry screen (MAPID3)        *

      *  to the terminal and returns once the receive is complete    *

      *                                                              *

      *                                                              *

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

      *

              EXEC CICS SEND

                        MAP(W00-MAPID3)

                        MAPSET(W00-MAPSETID)

                        FROM(CSQ4VB3O)

                        ERASE

              END-EXEC.

      *

              EXEC CICS RECEIVE

                        MAP(W00-MAPID3)

                        MAPSET(W00-MAPSETID)

                        INTO(CSQ4VB3I)

              END-EXEC.

      *

       DISPLAY-MAPID3-EXIT.

      *

           EXIT.

           EJECT

      *

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

       DISPLAY-MAPID4 SECTION.

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

      *                                                              *

      *  This section sends the batch response screen (MAPID4)       *

      *  to the terminal and returns once the receive is complete    *

      *                                                              *

      *                                                              *

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

      *

              EXEC CICS SEND

                        MAP(W00-MAPID4)

                        MAPSET(W00-MAPSETID)

                        FROM(CSQ4VB4O)

                        ERASE

              END-EXEC.

      *

              EXEC CICS RECEIVE

                        MAP(W00-MAPID4)

                        MAPSET(W00-MAPSETID)

                        INTO(CSQ4VB4I)

              END-EXEC.

      *

       DISPLAY-MAPID4-EXIT.

      *

           EXIT.

           EJECT

      *

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

       DISPLAY-HELP SECTION.

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

      *                                                              *

      *  This section displays the help panel until PF12 is pressed  *

      *                                                              *

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

      *

             PERFORM WITH TEST BEFORE UNTIL EIBAID = DFHPF12

                                         OR EIBAID = DFHPF24

      *

                 EXEC CICS SEND

                           MAP(W00-MAPIDHLP)

                           MAPSET(W00-MAPSETID)

                           FROM(CSQ4VB5O)

                           ERASE

                 END-EXEC

      *

                 EXEC CICS RECEIVE

                           MAP(W00-MAPIDHLP)

                           MAPSET(W00-MAPSETID)

                           INTO(CSQ4VB5I)

                 END-EXEC

      *

             END-PERFORM.

      *

       DISPLAY-HELP-EXIT.

      *

           EXIT.

      *

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

       VALIDATE-INPUT SECTION.

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

      *                                                              *

      *  In this section the user input is validated.                *

      *                                                              *

      *  The only validation performed is that the amount requested  *

      *  is numeric                                                  *

      *                                                              *

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

      *

           EVALUATE TRUE

               WHEN CSQ4BIIM-LOANREQ NOT NUMERIC

                   MOVE M01-MESSAGE-13 TO M00-MESSAGE

                   SET INPUT-INVALID TO TRUE

               WHEN OTHER

                   SET INPUT-OK TO TRUE

           END-EVALUATE.

      *

      *

       VALIDATE-INPUT-EXIT.

      *

           EXIT.

           EJECT

      *

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

       BUILD-IIM-IMMEDIATE SECTION.

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

      *                                                              *

      *  This section moves the user input data from the screen map  *

      *  to the inquiry message, prior to validation                 *

      *                                                              *

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

      *

           SET INITIAL-INQUIRY-MESSAGE TO TRUE.

      *

           MOVE NAMEI   TO CSQ4BIIM-NAME.

           MOVE SSNO1I  TO CSQ4BIIM-SOCSECNO1.

           MOVE SSNO2I  TO CSQ4BIIM-SOCSECNO2.

           MOVE SSNO3I  TO CSQ4BIIM-SOCSECNO3.

           MOVE 'FIRST GALACTIC BANK' TO CSQ4BIIM-BANKNAME.

           MOVE ACNAMEI TO CSQ4BIIM-BANKACNAME.

           MOVE ACNOI   TO CSQ4BIIM-BANKACNUM.

           MOVE AMOUNTI TO CSQ4BIIM-LOANREQ.

      *

       BUILD-IIM-IMMEDIATE-EXIT.

      *

           EXIT.

           EJECT

      *

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

       BUILD-IIM-BATCH SECTION.

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

      *                                                              *

      *  This section moves the user input data from the screen map  *

      *  to the inquiry message, prior to validation                 *

      *                                                              *

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

      *

           SET INITIAL-INQUIRY-MESSAGE TO TRUE.

      *

           MOVE NAMEII   TO CSQ4BIIM-NAME.

           MOVE SSNO1II  TO CSQ4BIIM-SOCSECNO1.

           MOVE SSNO2II  TO CSQ4BIIM-SOCSECNO2.

           MOVE SSNO3II  TO CSQ4BIIM-SOCSECNO3.

           MOVE 'FIRST GALACTIC BANK' TO CSQ4BIIM-BANKNAME.

           MOVE ACNAMEII TO CSQ4BIIM-BANKACNAME.

           MOVE ACNOII   TO CSQ4BIIM-BANKACNUM.

           MOVE AMOUNTII TO CSQ4BIIM-LOANREQ.

      *

       BUILD-IIM-BATCH-EXIT.

      *

           EXIT.

           EJECT

      *

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

       REBUILD-IIM-IMMEDIATE SECTION.

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

      *                                                              *

      *  This section moves data from the inquiry message to the     *

      *  screen map.                                                 *

      *                                                              *

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

      *

           MOVE CSQ4BIIM-NAME       TO NAMEO.

           MOVE CSQ4BIIM-SOCSECNO1  TO SSNO1O.

           MOVE CSQ4BIIM-SOCSECNO2  TO SSNO2O.

           MOVE CSQ4BIIM-SOCSECNO3  TO SSNO3O.

           MOVE CSQ4BIIM-BANKACNAME TO ACNAMEO.

           MOVE CSQ4BIIM-BANKACNUM  TO ACNOO.

      *

       REBUILD-IIM-IMMEDIATE-EXIT.

      *

           EXIT.

           EJECT

      *

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

       REBUILD-IIM-BATCH SECTION.

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

      *                                                              *

      *  This section moves data from the inquiry message to the     *

      *  screen map.                                                 *

      *                                                              *

      *                                                              *

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

      *

      *

           MOVE CSQ4BIIM-NAME       TO NAMEIO.

           MOVE CSQ4BIIM-SOCSECNO1  TO SSNO1IO.

           MOVE CSQ4BIIM-SOCSECNO2  TO SSNO2IO.

           MOVE CSQ4BIIM-SOCSECNO3  TO SSNO3IO.

           MOVE CSQ4BIIM-BANKACNAME TO ACNAMEIO.

           MOVE CSQ4BIIM-BANKACNUM  TO ACNOIO.

      *

       REBUILD-IIM-BATCH-EXIT.

      *

           EXIT.

           EJECT

      *

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

       BUILD-MSG-OUTPUT SECTION.

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

      *                                                              *

      *  This section moves data from the response message to the    *

      *  immediate inquiry display screen                            *

      *                                                              *

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

      *

           MOVE CSQ4BAM-LINE(1) TO RESP01O.

           MOVE CSQ4BAM-LINE(2) TO RESP02O.

           MOVE CSQ4BAM-LINE(3) TO RESP03O.

           MOVE CSQ4BAM-LINE(4) TO RESP04O.

           MOVE CSQ4BAM-LINE(5) TO RESP05O.

           MOVE CSQ4BAM-LINE(6) TO RESP06O.

           MOVE CSQ4BAM-LINE(7) TO RESP07O.

           MOVE CSQ4BAM-LINE(8) TO RESP08O.

           MOVE CSQ4BAM-LINE(9) TO RESP09O.

           MOVE CSQ4BAM-LINE(10) TO RESP10O.

           MOVE CSQ4BAM-LINE(11) TO RESP11O.

           MOVE CSQ4BAM-LINE(12) TO RESP12O.

      *

       BUILD-MSG-OUTPUT-EXIT.

      *

           EXIT.

           EJECT

      *

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

       CLEAR-RESPONSE-SCREEN SECTION.

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

      *                                                              *

      *  This section clears the previous inquiry from the           *

      *  response screen map                                         *

      *                                                              *

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

      *

           MOVE SPACES TO NAMERO.

           MOVE SPACES TO SSNO1RO.

           MOVE SPACES TO SSNO2RO.

           MOVE SPACES TO SSNO3RO.

           MOVE SPACES TO ACNAMERO.

           MOVE SPACES TO ACNORO.

           MOVE SPACES TO AMOUNTRO.

           MOVE SPACES TO RESP01RO RESP02RO RESP03RO RESP04RO

                          RESP05RO RESP06RO RESP07RO RESP08RO

                          RESP09RO RESP10RO RESP11RO RESP12RO.

      *

       CLEAR-RESPONSE-SCREEN-EXIT.

      *

           EXIT.

           EJECT

      *

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

       OPEN-RESPONSEQ-FOR-INQ SECTION.

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

      *                                                              *

      *  This section opens the response queue to allow an MQINQ     *

      *  call to be made                                             *

      *                                                              *

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

      *

           MOVE MQOT-Q             TO MQOD-OBJECTTYPE.

           MOVE W02-RESPONSE-QNAME TO MQOD-OBJECTNAME.

      *

      *    Initialize W03-OPTIONS to open the queue for inquiry

      *

           COMPUTE W03-OPTIONS = MQOO-INQUIRE.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-RESPONSE

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

                    MOVE 'OPEN INQ'    TO M01-MSG4-OPERATION

                    MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

                    MOVE W03-REASON    TO M01-MSG4-REASON

                    MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       OPEN-RESPONSEQ-FOR-INQ-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       OPEN-TEMP-RESPONSE-QUEUE SECTION.

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

      *                                                              *

      *  This section creates a temporary dynamic queue using a      *

      *  model queue                                                 *

      *                                                              *

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

      *

      *    Change three fields in the Object Descriptor (MQOD)

      *    control block.  (MQODV initializes the other fields)

      *

           MOVE MQOT-Q           TO MQOD-OBJECTTYPE.

           MOVE W02-MODEL-QNAME  TO MQOD-OBJECTNAME.

           MOVE W02-NAME-PREFIX  TO MQOD-DYNAMICQNAME.

      *

           COMPUTE W03-OPTIONS = MQOO-INPUT-EXCLUSIVE.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-MODEL

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

                MOVE 'OPEN TEMPQ'  TO M01-MSG4-OPERATION

                MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

                MOVE W03-REASON    TO M01-MSG4-REASON

                MOVE M01-MESSAGE-4 TO M00-MESSAGE

           ELSE

                MOVE MQOD-OBJECTNAME TO W02-TEMPORARY-Q

           END-IF.

      *

       OPEN-TEMP-RESPONSE-QUEUE-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       OPEN-INQUIRY-QUEUE SECTION.

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

      *                                                              *

      * This section opens the inquiry queue                         *

      *                                                              *

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

      *

      *    Change three fields in the Object Descriptor (MQOD)

      *    control block.  (MQODV initializes the other fields)

      *

           MOVE MQOT-Q                 TO MQOD-OBJECTTYPE.

           MOVE W02-INQUIRY-QNAME      TO MQOD-OBJECTNAME.

           MOVE SPACES                 TO MQOD-DYNAMICQNAME.

      *

      *    Initialize W03-OPTIONS to open the queue for output only.

      *

           COMPUTE W03-OPTIONS = MQOO-OUTPUT.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-INQUIRY

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'OPEN INQQ'   TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

               MOVE W03-REASON    TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       OPEN-INQUIRY-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

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

       OPEN-RESPONSE-QUEUE SECTION.

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

      *                                                              *

      *  This section opens the response queue for input shared      *

      *                                                              *

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

      *

           MOVE MQOT-Q             TO MQOD-OBJECTTYPE.

           MOVE W02-RESPONSE-QNAME TO MQOD-OBJECTNAME.

      *

           COMPUTE W03-OPTIONS = MQOO-INPUT-SHARED.

      *

           CALL 'MQOPEN' USING W03-HCONN

                               MQOD

                               W03-OPTIONS

                               W03-HOBJ-RESPONSE

                               W03-COMPCODE

                               W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

                    MOVE 'OPEN RESP'   TO M01-MSG4-OPERATION

                    MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

                    MOVE W03-REASON    TO M01-MSG4-REASON

                    MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       OPEN-RESPONSE-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

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

       CLOSE-RESPONSE-QUEUE SECTION.

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

      *                                                              *

      *  This section closes the response queue                      *

      *                                                              *

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

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-RESPONSE

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'CLOSE RESP'  TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

               MOVE W03-REASON    TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       CLOSE-RESPONSE-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

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

       CLOSE-INQUIRY-QUEUE SECTION.

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

      *                                                              *

      *  This section closes the inquiry queue                       *

      *                                                              *

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

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-INQUIRY

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'CLOSE INQ'   TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

               MOVE W03-REASON    TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       CLOSE-INQUIRY-QUEUE-EXIT.

      *

      *    Return to performing section.

      *

           EXIT.

           EJECT

      *

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

       CLOSE-TEMP-RESPONSE-QUEUE SECTION.

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

      *                                                              *

      *  This section closes, and thus deletes, the temporary        *

      *  dynamic queue                                               *

      *                                                              *

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

      *

           CALL 'MQCLOSE' USING W03-HCONN

                                W03-HOBJ-MODEL

                                MQCO-NONE

                                W03-COMPCODE

                                W03-REASON.

      *

           IF W03-COMPCODE NOT = MQCC-OK

               MOVE 'CLOSE TEMP'  TO M01-MSG4-OPERATION

               MOVE W03-COMPCODE  TO M01-MSG4-COMPCODE

               MOVE W03-REASON    TO M01-MSG4-REASON

               MOVE M01-MESSAGE-4 TO M00-MESSAGE

           END-IF.

      *

       CLOSE-TEMP-RESPONSE-QUEUE-EXIT.

      *

      *    Return to performing section

      *

           EXIT.

           EJECT

      *

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

      *                    End of program                             *

      * ------------------------------------------------------------- *
Messung
C	H	Z	G
95	97	100	97
¤ Dauer der Verarbeitung: 0.53 Sekunden ¤

Wurzel
Suchen
PVS Prover
Isabelle Prover
Cephes Mathematical Library
Vienna Development Method
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.