Building an MQ Queue Depth Alert Program in COBOL

The following COBOL program is an IBM MQ queue monitoring utility that checks the depth of queues and reports queues that are approaching capacity.

The program:

-> Connects to an IBM MQ Queue Manager.

-> Reads a list of queue names from an input file.

-> For each queue:

     Opens the queue for inquiry.

     Retrieves:

        Current Queue Depth  

        Maximum Queue Depth  

-> Calculates 70% of the maximum queue depth.

-> Displays the queue name if the current depth is greater than or equal to 70% of its maximum capacity.

-> Closes the queue.

-> Disconnects from MQ after all queues are processed.

       IDENTIFICATION DIVISION.

       PROGRAM-ID. INQDEPTH.

       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.

       FILE-CONTROL.

           SELECT INPUT-FILE        ASSIGN TO INFILE.

       DATA DIVISION.

       FILE SECTION.

       FD  INPUT-FILE.

       01  INPUT-REC                   PIC X(48).

       WORKING-STORAGE SECTION.

       01  WS-EOF                      PIC X(01) VALUE 'N'.

       01  WS-CUR-DEPTH                PIC 9(9).

       01  WS-MAX-DEPTH                PIC 9(9).

       01  WS-CALC                     PIC 9(9).

       01  MQ-QM-NAME                  PIC X(48) VALUE SPACES.

       01  MQ-HCONN                    PIC S9(9) COMP-5 VALUE ZERO.

       01  MQ-RC                       PIC S9(9) BINARY.

       01  MQ-RSN                      PIC S9(9) BINARY.

       01  MQ-HOBJ                     PIC S9(9) BINARY.

       01  WS-OPTIONS                  PIC S9(9) BINARY.

       01  WS-SELECTORCOUNT            PIC S9(9) BINARY VALUE 2.

       01  WS-SELECTORS-TABLE.

           05  WS-SELECTORS            PIC S9(9) BINARY OCCURS 2 TIMES.

       01  WS-INTATTRCOUNT             PIC S9(9) BINARY VALUE 2.

       01  WS-INTATTRS-TABLE.

           05  WS-INTATTRS             PIC S9(09) BINARY OCCURS 2 TIMES.

       01  WS-CHARATTRLENGTH           PIC S9(9) BINARY VALUE ZERO.

       01  WS-CHARATTRS                PIC X(01) VALUE LOW-VALUES.

       01  MQM-OBJECT-DESCRIPTOR.

           COPY CMQODV.

       01  MQM-MESSAGE-DESCRIPTOR.

           COPY CMQMDV.

       01  MQM-PUT-MESSAGE-OPTIONS.

           COPY CMQPMOV.

       01  MQM-GET-MESSAGE-OPTIONS.

           COPY CMQGMOV.

       01  MQM-CONSTANTS.

           COPY CMQV SUPPRESS.

       PROCEDURE DIVISION.

       0000-MAIN.

           PERFORM 1000-INITIALIZATION

           PERFORM 2000-PROCESS

              THRU 2000-PROCESS-EXIT

             UNTIL WS-EOF = 'Y'

           PERFORM 3000-TERMINATION

           GOBACK.

       1000-INITIALIZATION.

           ACCEPT MQ-QM-NAME.

           CALL 'MQCONN' USING

                MQ-QM-NAME

                MQ-HCONN

                MQ-RC

                MQ-RSN

           IF MQ-RC = MQCC-FAILED

              DISPLAY 'MQCONN MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

           END-IF.

           OPEN INPUT INPUT-FILE.

       2000-PROCESS.

           READ INPUT-FILE

             AT END MOVE 'Y' TO WS-EOF

           END-READ

           IF WS-EOF = 'Y'

              GO TO 2000-PROCESS-EXIT

           END-IF

           PERFORM 2100-OPEN-FOR-INQ

           IF MQ-RC NOT = MQCC-OK

              GO TO 2000-PROCESS-EXIT

           END-IF

           MOVE MQIA-CURRENT-Q-DEPTH TO WS-SELECTORS(1)

           MOVE MQIA-MAX-Q-DEPTH     TO WS-SELECTORS(2)

           MOVE 2                    TO WS-INTATTRCOUNT

                                        WS-SELECTORCOUNT

           CALL 'MQINQ' USING MQ-HCONN

                              MQ-HOBJ

                              WS-SELECTORCOUNT

                              WS-SELECTORS-TABLE

                              WS-INTATTRCOUNT

                              WS-INTATTRS-TABLE

                              WS-CHARATTRLENGTH

                              WS-CHARATTRS

                              MQ-RC

                              MQ-RSN.

           IF MQ-RC NOT = MQCC-OK

              DISPLAY 'QUEUE: ' INPUT-REC

              DISPLAY 'MQINQ  MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

           ELSE

              MOVE WS-INTATTRS (1)     TO WS-CUR-DEPTH

              MOVE WS-INTATTRS (2)     TO WS-MAX-DEPTH

              IF WS-CUR-DEPTH > 0

                 COMPUTE WS-CALC = WS-MAX-DEPTH * 0.7

                 IF WS-CUR-DEPTH >= WS-CALC

                    DISPLAY INPUT-REC ' ' WS-CUR-DEPTH ' ' WS-MAX-DEPTH

                 END-IF

              END-IF

           END-IF

           PERFORM 2200-CLOSE-QUEUE.

       2000-PROCESS-EXIT.

           EXIT.

       2100-OPEN-FOR-INQ.

           MOVE MQOT-Q             TO MQOD-OBJECTTYPE

           MOVE INPUT-REC          TO MQOD-OBJECTNAME

           COMPUTE WS-OPTIONS = MQOO-INQUIRE +

                                 MQOO-FAIL-IF-QUIESCING.

           CALL 'MQOPEN' USING MQ-HCONN

                               MQOD

                               WS-OPTIONS

                               MQ-HOBJ

                               MQ-RC

                               MQ-RSN.

           IF MQ-RC NOT = MQCC-OK

              DISPLAY 'QUEUE: ' INPUT-REC

              DISPLAY 'MQOPEN MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

           END-IF.

       2100-OPEN-FOR-INQ-EXIT.

           EXIT.

       2200-CLOSE-QUEUE.

           CALL 'MQCLOSE' USING MQ-HCONN

                                MQ-HOBJ

                                MQCO-NONE

                                MQ-RC

                                MQ-RSN.

           IF MQ-RC NOT = MQCC-OK

              DISPLAY 'QUEUE: ' INPUT-REC

              DISPLAY 'MQCLOSE MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

           END-IF.

       2200-CLOSE-QUEUE-EXIT.

           EXIT.

       3000-TERMINATION.

           CALL 'MQDISC' USING

                MQ-HCONN

                MQ-RC

                MQ-RSN.

           IF MQ-RC = MQCC-FAILED

              DISPLAY 'MQDISC MQ-RC: ' MQ-RC ' MQ-RSN: ' MQ-RSN

           END-IF.

           CLOSE INPUT-FILE.

       3000-TERMINATION-EXIT.

           EXIT.