Quellcode-Bibliothek

^© Kompilation durch diese Firma

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

Datei: Bat.dll Sprache: Cobol

Original von: verschiedene^©

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

--> maximum size reached

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

¤ Dauer der Verarbeitung: 0.102 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

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

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.