Quelle  csq4cvb1.cob   Sprache: Cobol

CBL XOPTSANSI85 NODYNAM,OBJECT,java.lang.StringIndexOutOfBoundsException: Index 37 out of bounds for length 37
CBL NODYNAM,LIB,OBJECT      *                                                               *
      * ------------------------------------------------------------- *
       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                  S9
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - Screen map name definitions
      *
       01  W00-MAPSETID                PIC X(08)  VALUE 'CSQ4VBM'.
       011                S9
0W00-MAPID1
       01      *
       01  W00-MAPID3                  PIC .
       01  W00-MAPID4                  PIC X(08)  VALUE 'CSQ4VB4'.
      *
      *    W01 - General work fields
      *
           5W03-CSQ4BIIM
      *
       01  W01-WAIT-INTERVAL           PIC S9(09) BINARY      *
      *
      *    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                            COPY.
       01  W03-BUFFLEN                 PIC S9(9) BINARY.
       01  W03-DATALEN                 PIC S9(9) BINARY.
       01  W03-COMPCODE                PIC S9(9) BINARY.
       01W03-REASON                   S99)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
           88 INPUT-INVALID VALUE 'BAD'.
           88 INPUT-OK      VALUE 'OK'.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY      *  loop. Handlers for the subsequent screens are called from   *
       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      *    that the program can work - so exit with a message
      * ------------------------------------------------------------- *
       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
      *
      *
               STRING EIBTRNID
                      M01-MESSAGE-14
                      DELIMITED BY SIZE INTO M00-MESSAGE
               GO TO A-MAIN-EXIT
           END-IF      *
      *
           EXEC CICS IGNORE CONDITION
                     MAPFAIL

      *
      *    Send the screen map, then receive it
      *
           EXEC CICS SEND
                     MAP(W00-MAPID1)
                     MAPSET(W00-MAPSETIDEVALUATE
                     FROM(CSQ4VB1OWHENOPTIONI'
ERASE
           END-EXEC
      *
           EXEC RECEIVE
                     MAP(W00-MAPID1)
                     MAPSET(W00-MAPSETID)
                     INTO(CSQ4VB1I)
           END-EXEC
      *
      *    Loop from here to END-PERFORM until the PF3 key is pressed
      *
           PERFORMMOVEM01-MESSAGE-2  M00-MESSAGE
                                           EIBAID = DFHPF15)
      *
                                            OTHER
                   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 > ZERO
                                     PERFORM BATCH-RESPONSE
                                 ELSE
                                     MOVE M01-MESSAGE-2 TO M00-MESSAGE
                                 java.lang.StringIndexOutOfBoundsException: Index 30 out of bounds for length 30
                            WHEN OTHER
 MOVE M01-MESSAGE-1 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)
                         MAPSET(W00-MAPSETID)
                         FROM(CSQ4VB1O)
                         ERASE
               END-EXEC
      *
               EXEC CICS RECEIVE
                         MAP(      *    Return to CICS.
                         MAPSET(W00-MAPSETID)
                         INTO(CSQ4VB1I)
               END-EXEC
      *
           END-PERFORM.
      *
      *    Clear the screen and reset the keyboard
      *
           MOVE SPACES TO M00-MESSAGEINQUIRE-DEPTHSECTION
      *
       A-MAIN-EXIT.
      *
           EXEC CICS      *  This section inquires the current depth of the response     *
                     TEXT
                     FROM(M00-MESSAGE)
                     FREEKB
                     ERASE
           END-EXEC.
      *
      *    Return to CICS.
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           GOBACK.
           EJECTGO INQUIRE-DEPTH-EXIT
      *
      * ------------------------------------------------------------- *
       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 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
                 TO
                              W03-INTATTRCOUNT
                              W03-INTATTRS
                              W03-CHARATTRLENGTH
                              W03-CHARATTRS
                              W03-COMPCODE
                              W03-REASONjava.lang.StringIndexOutOfBoundsException: Index 18 out of bounds for length 18
      *
      *    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
                    *    the response. Once an inquiry has been completed another  *
              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.
           IFWHEN =DFHPF5  java.lang.StringIndexOutOfBoundsException: Index 59 out of bounds for length 59
               GO TO IMMEDIATE-INQUIRY-EXIT
           END-IF.
      *
      *    Clear the output message field and screen map
      *
           MOVE SPACESPERFORM
          MOVE TO.
      *
           PERFORM DISPLAY-MAPID2.
      *
      *    Loop from here to END-PERFORM until the PF3 key is pressed
      *
           PERFORM WITH TEST BEFORE UNTIL (EIBAID       *
                                           EIBAID = DFHPF15)
      *
               EVALUATE
                   WHEN EIBAID = DFHPF1 OR EIBAID      *
                       PERFORM DISPLAY-HELP
      *
 EIBAID EIBAID
      *
      *                Clear the previous inquiry response, reset the
      *                data
      *
                           
                       PERFORM REBUILD-IIM-IMMEDIATE
                       MOVE SPACES TO      *
      *
                       PERFORM DISPLAY-MAPID2
      *
                   WHEN EIBAID = DFHENTER
      *
                       PERFORM BUILD-IIM-IMMEDIATE
                        VALIDATE-INPUT
      *
                       IF NOT INPUT-OK THEN
      *
      *                    Move the message field into the
      *                    corresponding screen map field
      *
                           MOVE M00-MESSAGE TO      *
      *
                           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      *
                                               EIBAID = java.lang.StringIndexOutOfBoundsException: Index 62 out of bounds for length 7
                                               EIBAID = DFHPF17)
      *
                               IF EIBAID = DFHPF1 OR
                                  EIBAID = DFHPF13      *    Close the inquiry queue
                                    CLOSE-INQUIRY-QUEUE
      *
                               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
      *
                                       SECTION
      *
                           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 TESTUNTIL = DFHPF3
                                           EIBAID = DFHPF15      *
      *
               EVALUATE TRUE
                   WHEN EIBAID = DFHPF1                       PERFORMVALIDATE-INPUT
                       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
ORMBUILD-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
      *
                                 *                    Move the message field into the
      *
                       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
      *
                           PERFORMEIBAIDDFHPF15 OR
                                              (EIBAID = DFHPF3  OR
                                               EIBAID = DFHPF5IF   OR
                                               EIBAID = DFHPF15 OR
                                               EIBAID = DFHPF17)
                               IF EIBAID = DFHPF1 OR
                                  EIBAID = DFHPF13 THEN      *                            Move the message field into the
                                   PERFORM DISPLAY-HELP
      *
                               
      *
      *                            Move the message field into the
      *                            corresponding screen map field
      *
    MOVE M01-MESSAGE-3TO
                                   MOVE M00-MESSAGE TO VB3MSGO
      *
                                   PERFORM DISPLAY-MAPID3
                               END-IF
      *
                           END-PERFORM
      *
                       END-IF
      *
                   WHEN OTHER
                       PERFORM               java.lang.StringIndexOutOfBoundsException: Index 27 out of bounds for length 27
      *
               END-EVALUATE
      *
           END-PERFORM.
      *
      *
      *
           PERFORM CLOSE-INQUIRY-QUEUE.
           IF W03-COMPCODE java.lang.StringIndexOutOfBoundsException: Index 27 out of bounds for length 18
              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 NOT =MQCC-OK
               GO TO BATCH-RESPONSE-EXIT
           END-IF.
      *
      *    Clear the output message field and screen map
      *
      *
           MOVE LOW-VALUES TO           MOVESPACES M00-MESSAGE.
      *
      *    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      *
                                             )
      *
               IF EIBAID = DFHPF1 OR EIBAID = DFHPF13 THEN
                   PERFORM DISPLAY-HELPIF = DFHPF1 EIBAID THEN
      *
               ELSE
                   MOVE SPACES TO M00-MESSAGE
      *
      *            Process depending on the action entered by the user
      *
                   IF EIBAID = DFHPF8      *
      *
                       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.
      *
           PERFORMEND-IF
           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      *    the values required to create the message.
           MOVE MQCI-NONE      *
           MOVE              TO.
           MOVE W02-TEMPORARY-Q        TO MQMD-REPLYTOQ.
           MOVE SPACES                 TO MQMD-REPLYTOQMGR.
           MOVETO.
           MOVE MQPER-NOT-PERSISTENT   TO MQMD-PERSISTENCE.
           COMPUTE MQPMO-OPTIONS       =  MQPMO-NO-SYNCPOINT +
                                          MQPMO-DEFAULT-CONTEXT
 OF TO
      *
            MQPUTUSING
W03-HOBJ-INQUIRY
                              MQMD
                              MQPMO
                              
                              W03-PUT-BUFFER
                              W03-COMPCODE
                              W03-REASON.
           IFW03-PUT-BU
               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 SPACESMOVE W03-REASON M01-MSG4-REASON
O RESP06O RESP08O
                              RESP09O RESP10O RESP11O                 SPACES RESP01O RESP03O
               GOTO
           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.     *    Set interval for wait for 30 seconds
           MOVE   =  MQGMO-SYNCPOINT
      *
      *    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 TO.
           MOVE LENGTH OFMOVE TO .
      *
           CALL 'MQGET' USING      *
                              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-COMPCODE MQCC-OK java.lang.StringIndexOutOfBoundsException: Index 47 out of bounds for length 47
      *            Message received
                   PERFORM BUILD-MSG-OUTPUT      *            Wait timed out with no message received
                   MOVE M01-MESSAGE-10 TO M00-MESSAGE
               WHEN (W03-COMPCODE = MQCC-FAILED AND
                     W03-REASON      *            Unexpected result, report it
      *            Wait timed out with no message received
                   MOVE  M01-MESSAGE-11     TO
                   MOVE SPACES  RESP02O 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      *
                   MOVE M01-MESSAGE-4 TO M00-MESSAGE
                   MOVE SPACES      *
                                  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.
--> --------------------

--> maximum size reached

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