000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.         QUE_SEARCH.
000300 ENVIRONMENT DIVISION.
001000 DATA DIVISION.
001100 WORKING-STORAGE SECTION.
       01  MSD-STATUS                  PIC X(02).
       01  DISPLAY_QUEUE               PIC S9(09) COMP VALUE 6.
       01  IOSB.
           02  FILLER                            OCCURS 2 TIMES.
               03  IOSB-LONGWORD       PIC 9(09) COMP.
       01  JBC$_NOMOREQUE              PIC S9(09) COMP VALUE 295338.
000120 01  QUE_ITMLST.
000130     02  FILLER                  PIC S9(04) COMP VALUE 31.
000140     02  FILLER                  PIC S9(04) COMP VALUE 77.
000160     02  FILLER                  POINTER VALUE REFERENCE
000170                                                      SEARCH_NAME.
000180     02  FILLER                  POINTER VALUE REFERENCE
000190                                               SEARCH_NAME_LENGTH.

000130     02  FILLER                  PIC S9(04) COMP VALUE 4.
000140     02  FILLER                  PIC S9(04) COMP VALUE 76.
000160     02  FILLER                  POINTER VALUE REFERENCE
000170                                                     SEARCH_FLAGS.
000180     02  FILLER                  POINTER VALUE REFERENCE
000190                                              SEARCH_FLAGS_LENGTH.

000130     02  FILLER                  PIC S9(04) COMP VALUE 31.
000140     02  FILLER                  PIC S9(04) COMP VALUE 31.
000160     02  FILLER                  POINTER VALUE REFERENCE
000170                                                        FORM_NAME.
000180     02  FILLER                  POINTER VALUE REFERENCE
000190                                                 FORM_NAME_LENGTH.

000130     02  FILLER                  PIC S9(04) COMP VALUE 31.
000140     02  FILLER                  PIC S9(04) COMP VALUE 70.
000160     02  FILLER                  POINTER VALUE REFERENCE
000170                                                       QUEUE_NAME.
000180     02  FILLER                  POINTER VALUE REFERENCE
000190                                                QUEUE_NAME_LENGTH.

000130     02  FILLER                  PIC S9(04) COMP VALUE 4.
000140     02  FILLER                  PIC S9(04) COMP VALUE 71.
000160     02  FILLER                  POINTER VALUE REFERENCE
000170                                                     QUEUE_STATUS.
000180     02  FILLER                  POINTER VALUE REFERENCE
000190                                              QUEUE_STATUS_LENGTH.

000200     02  FILLER                  PIC S9(09) COMP VALUE 0.

       01  SEARCH_NAME                 PIC X(31).
       01  SEARCH_NAME_LENGTH          PIC S9(09)    COMP VALUE 0.
       01  SEARCH_FLAGS                PIC 9(09)     COMP VALUE 0.
       01  SEARCH_FLAGS_LENGTH         PIC S9(09)    COMP VALUE 0.
       01  FORM_NAME                   PIC X(31).
       01  FORM_NAME_LENGTH            PIC S9(09)    COMP.
       01  QUEUE_NAME                  PIC X(31).
       01  QUEUE_NAME_LENGTH           PIC S9(09)    COMP.
       01  QUEUE_STATUS                PIC 9(09)     COMP.
       01  QUEUE_STATUS_LENGTH         PIC S9(09)    COMP.
       01  POS                         PIC 9(09)     COMP.
       01  STATUS_FLAG_VALUE           PIC 9(09)     COMP.
       01  NUMBER-OF-BITS              PIC 9(04) COMP VALUE 1.
       01  TBL-IND                     PIC S9(09)          COMP
                                   VALUE EXTERNAL LIB$K_CLI_GLOBAL_SYM.
       01  STAT                        PIC S9(09)          COMP.
       01  QTYPE                       PIC X(05)     VALUE " ".
       01  WHAT_QUE                    PIC X(31)     VALUE " ".
       01  QUEUE_OK                    PIC X(03)     VALUE " ".

       PROCEDURE DIVISION.
       MAIN-PARA.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "QTYPE"
                                       BY DESCRIPTOR QTYPE
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           CALL "LIB$GET_SYMBOL" USING BY DESCRIPTOR "WHAT_QUE"
                                       BY DESCRIPTOR WHAT_QUE
                                       BY VALUE 0
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           IF QTYPE = "BATCH"
               MOVE 4 TO SEARCH_FLAGS.
           IF QTYPE = "PRINT"
               MOVE 8 TO SEARCH_FLAGS.
           MOVE "NO" TO QUEUE_OK.
           MOVE "*" TO SEARCH_NAME.
       START-SEARCHING.
           CALL "SYS$GETQUIW" USING BY VALUE 0
                                   BY VALUE DISPLAY_QUEUE
                                   BY VALUE 0
                                   BY REFERENCE QUE_ITMLST
                                   BY REFERENCE IOSB
                                   BY VALUE 0 0
                             GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
           IF IOSB-LONGWORD (1) = JBC$_NOMOREQUE
               GO TO E-O-J.
      *     PERFORM VARYING POS FROM 0 BY 1 UNTIL POS > 15
      *         CALL "LIB$EXTZV" USING BY REFERENCE POS
      *                                             NUMBER-OF-BITS
      *                                             QUEUE_STATUS
      *                           GIVING STATUS_FLAG_VALUE
      *         IF POS = 0
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE ALIGNING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 1
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE IDLE ****"
      *             END-IF
      *         END-IF
      *         IF POS = 2
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE LOWERCASE ****"
      *             END-IF
      *         END-IF
      *         IF POS = 3
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** UNDEFINED QUEUE STATUS ****"
      *             END-IF
      *         END-IF
      *         IF POS = 4
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE PAUSED ****"
      *             END-IF
      *         END-IF
      *         IF POS = 5
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE PAUSING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 6
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE REMOTE ****"
      *             END-IF
      *         END-IF
      *         IF POS = 7
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE RESETTING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 8
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE RESUMING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 9
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE SERVER ****"
      *             END-IF
      *         END-IF
      *         IF POS = 10
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE STALLED ****"
      *             END-IF
      *         END-IF
      *         IF POS = 11
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE STARTING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 12
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE STOPPED ****"
      *             END-IF
      *         END-IF
      *         IF POS = 13
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE STOPPING ****"
      *             END-IF
      *         END-IF
      *         IF POS = 14
      *             IF STATUS_FLAG_VALUE = 1
      *                 DISPLAY "**** QUEUE UNAVAILABLE ****"
      *             END-IF
      *         END-IF
      *     END-PERFORM.
      *     DISPLAY " ".
      *     DISPLAY "FORM NAME = " FORM_NAME.
      *     DISPLAY "QUEUE NAME = " QUEUE_NAME "*".
           IF QUEUE_NAME (1:QUEUE_NAME_LENGTH) NOT = WHAT_QUE
               GO TO START-SEARCHING.
           MOVE "YES" TO QUEUE_OK.
           GO TO START-SEARCHING.
       E-O-J.
           CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR "QUEUE_OK"
                                       BY DESCRIPTOR QUEUE_OK
                                       BY REFERENCE TBL-IND
                          GIVING STAT.
           IF STAT IS FAILURE
               CALL "LIB$STOP" USING BY VALUE STAT.
            STOP RUN.
