Friday, April 1, 2022

COBOL program to interpret SMF record created by SYSVIEW for MQ Application Requests

SYSVIEW creates SMF record type 255 subtype 48 to output the MQ Application Request counts. The below COBOL program was developed for MQ 9.2.0 

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    MQSYSVW.
       AUTHOR.
       DATE-WRITTEN.
       DATE-COMPILED.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

      *   SMF255 CONTAINS THE DATA AND THIS IS A SPANNED RECORD.
      *   OPEN MODE IS INPUT.

             SELECT SMF255 ASSIGN TO INFILE
             ORGANIZATION IS SEQUENTIAL
             ACCESS MODE IS SEQUENTIAL
             FILE STATUS IS WS-STAT.

      *   SYSVWRPT1 CONTAINS THE REPORT CREATED FROM SMF255

             SELECT SYSVWRPT1 ASSIGN TO OUTFIL1
             ORGANIZATION IS SEQUENTIAL.

             SELECT SYSVWRPT2 ASSIGN TO OUTFIL2
             ORGANIZATION IS SEQUENTIAL.

       DATA DIVISION.
       FILE SECTION.

       FD SMF255
           RECORDING MODE IS S
           BLOCK CONTAINS 27998 CHARACTERS
           RECORD IS VARYING IN SIZE FROM
              18 TO 32756 CHARACTERS DEPENDING ON WS-LEN.

      *  S INDICATES THAT THIS IS A SPANNED RECORD. THIS CAN BE
      *  IDENTIFIED FROM THE BLOCK SIZE AND RECORD SIZE.

       01 SMFDATA-MIN-RECORD    PIC X(18).
       01 SMFDATA-MAX-RECORD    PIC X(32756).

       FD SYSVWRPT1.
       01 SYSVWRPT1-REC        PIC X(272).

       FD SYSVWRPT2.
       01 SYSVWRPT2-REC        PIC X(299).

       WORKING-STORAGE SECTION.
       01  DATE-TIME-COMPONENTS BINARY.
           05  YEAR                PIC 9(9).
           05  MONTH               PIC 9(9).
           05  DAYS                PIC 9(9).
           05  HOURS               PIC 9(9).
           05  MINUTES             PIC 9(9).
           05  SECONDS             PIC 9(9).
           05  MILLSEC             PIC 9(9).
      *  Double precision needed for the seconds results
       01  START-SECS              COMP-2.
       01  NEW-TIME                COMP-2.
       01  FC.
           02  Condition-Token-Value.
               88  CEE000       VALUE X'0000000000000000'.
               03  Case-1-Condition-ID.
                   04  Severity        PIC S9(4) BINARY.
                   04  Msg-No          PIC S9(4) BINARY.
               03  Case-2-Condition-ID
                         REDEFINES Case-1-Condition-ID.
                   04  Class-Code      PIC S9(4) BINARY.
                   04  Cause-Code      PIC S9(4) BINARY.
               03  Case-Sev-Ctl    PIC X.
               03  Facility-ID     PIC XXX.
           02  I-S-Info        PIC S9(9) BINARY.
       01  PICSTR.
           02  Vstring-length      PIC S9(4) BINARY.
           02  Vstring-text.
               03  Vstring-char        PIC X
                           OCCURS 0 TO 256 TIMES
                           DEPENDING ON Vstring-length
                              of PICSTR.
       01  WS-TIMESTAMP.
           02  Vstring-length      PIC S9(4) BINARY.
           02  Vstring-text.
               03  Vstring-char        PIC X
                           OCCURS 0 TO 256 TIMES
                           DEPENDING ON Vstring-length
                              of WS-TIMESTAMP.
       01  NEW-TIMESTAMP           PIC X(80).


       01 OUTFIL1-REC.
          05 O1-FMTD-DATE         PIC X(19).
          05 FILLER               PIC X(01) VALUE ','.
          05 O1-QUEUE-INFO        PIC X(112).
          05 O1-COMM-DATA         PIC X(140).

       01 OUTFIL2-REC.
          05 O2-FMTD-DATE         PIC X(19).
          05 FILLER               PIC X(01) VALUE ','.
          05 O2-JOB-INFO          PIC X(027).
          05 O2-QUEUE-INFO        PIC X(112).
          05 O2-COMM-DATA         PIC X(140).

       01 OUT-JOB-INFO.
          05 OUT-Jobname          PIC X(08).
          05 O2-FIL1              PIC X(01) VALUE ','.
          05 OUT-ConnType         PIC X(08).
          05 O2-FIL2              PIC X(01) VALUE ','.
          05 OUT-Qualifier        PIC X(08).
          05 O2-FIL3              PIC X(01) VALUE ','.

       01 OUT-QUEUE-INFO.
          05 OUT-QMGR             PIC X(04).
          05 O1-FIL1              PIC X(01) VALUE ','.
          05 OUT-qname            PIC X(48).
          05 O1-FIL2              PIC X(01) VALUE ','.
          05 OUT-Type             PIC X(08).
          05 O1-FIL3              PIC X(01) VALUE ','.
          05 OUT-ResName          PIC X(48).
          05 O1-FIL4              PIC X(01) VALUE ','.

       01 OUT-COMMON-DATA.
          05 OUT-OPENN            PIC Z(8)9.
          05 C-FIL1               PIC X(01) VALUE ','.
          05 OUT-CLOSEN           PIC Z(8)9.
          05 C-FIL2               PIC X(01) VALUE ','.
          05 OUT-GETN             PIC Z(8)9.
          05 C-FIL3               PIC X(01) VALUE ','.
          05 OUT-PUTN             PIC Z(8)9.
          05 C-FIL4               PIC X(01) VALUE ','.
          05 OUT-PUT1N            PIC Z(8)9.
          05 C-FIL5               PIC X(01) VALUE ','.
          05 OUT-INQN             PIC Z(8)9.
          05 C-FIL6               PIC X(01) VALUE ','.
          05 OUT-SETN             PIC Z(8)9.
          05 C-FIL7               PIC X(01) VALUE ','.
          05 OUT-F-OPENN          PIC Z(8)9.
          05 C-FIL8               PIC X(01) VALUE ','.
          05 OUT-F-CLOSEN         PIC Z(8)9.
          05 C-FIL9               PIC X(01) VALUE ','.
          05 OUT-F-GETN           PIC Z(8)9.
          05 C-FIL10              PIC X(01) VALUE ','.
          05 OUT-F-PUTN           PIC Z(8)9.
          05 C-FIL11              PIC X(01) VALUE ','.
          05 OUT-F-PUT1N          PIC Z(8)9.
          05 C-FIL12              PIC X(01) VALUE ','.
          05 OUT-F-INQN           PIC Z(8)9.
          05 C-FIL13              PIC X(01) VALUE ','.
          05 OUT-F-SETN           PIC Z(8)9.

       01 OUTFIL1-HDR.
          05              PIC X(19) VALUE 'TIME_STAMP'.
          05              PIC X(01) VALUE ','.
          05              PIC X(04) VALUE 'QMGR'.
          05              PIC X(01) VALUE ','.
          05              PIC X(48) VALUE 'QNAME'.
          05              PIC X(01) VALUE ','.
          05              PIC X(08) VALUE 'QType'.
          05              PIC X(01) VALUE ','.
          05              PIC X(48) VALUE 'QResName'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'OPENN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'CLOSEN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'GETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'PUTN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'PUT1N'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'INQN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'SETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_OPENN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_CLOSEN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_GETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_PUTN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_PUT1N'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_INQN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_SETN'.

       01 OUTFIL2-HDR.
          05              PIC X(19) VALUE 'TIME_STAMP'.
          05              PIC X(01) VALUE ','.
          05              PIC X(08) VALUE 'JOB NAME'.
          05              PIC X(01) VALUE ','.
          05              PIC X(08) VALUE 'CONN TYP'.
          05              PIC X(01) VALUE ','.
          05              PIC X(08) VALUE 'Qual    '.
          05              PIC X(01) VALUE ','.
          05              PIC X(04) VALUE 'QMGR'.
          05              PIC X(01) VALUE ','.
          05              PIC X(48) VALUE 'QNAME'.
          05              PIC X(01) VALUE ','.
          05              PIC X(08) VALUE 'QType'.
          05              PIC X(01) VALUE ','.
          05              PIC X(48) VALUE 'QResName'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'OPENN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'CLOSEN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'GETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'PUTN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'PUT1N'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'INQN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'SETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_OPENN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_CLOSEN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_GETN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_PUTN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_PUT1N'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_INQN'.
          05              PIC X(01) VALUE ','.
          05              PIC X(09) VALUE 'F_SETN'.

       01 WS-SYSVW-REC.
           05 MQRR-SMFHDR.
              10 FILLER                 PIC X(01).
              10 MQRR-RTY               PIC X(01).
              10 FILLER                 PIC X(16).
              10 MQRR-STY               PIC S9(04) COMP.
           05 MQRR-PRDHDR               PIC X(10).
      * Queue manager
           05 MQRR-OBJ-QMGR             PIC X(04).
      * Object name
           05 MQRR-OBJ-Name             PIC X(48).
      * Object type
           05 MQRR-OBJ-Type             PIC X(08).
      * Object subtype
           05 MQRR-OBJ-Subtype          PIC X(08).
      * Resolved name
           05 MQRR-OBJ-ResName          PIC X(48).
      * Resolved Qmgr name
           05 MQRR-OBJ-ResQMGR          PIC X(48).
      * Reserved
           05 FILLER                    PIC X(06).
      * Offset to first job entry
           05 MQRR-OBJ-JOB-Off          PIC S9(09) COMP-5.
      * Length of job entry
           05 MQRR-OBJ-JOB-Len          PIC S9(04) COMP.
      * Count  of job entries
           05 MQRR-OBJ-JOB-Cnt          PIC S9(04) COMP.
      * STCK start of interval
           05 MQRR-OBJ-Start            PIC X(08).
      * STCK end   of interval
           05 MQRR-OBJ-End              PIC X(08).
      * Interval time (End-Start)
           05 MQRR-OBJ-Interval         PIC X(08).
      * Section: OBJ - Request Count Information
      * ..Get count with browse
           05 MQRR-OBJ-GetBrowse        PIC S9(09) COMP.
      * ..Open count for object
           05 MQRR-OBJ-Open             PIC S9(09) COMP.
      * ..Close count for object
           05 MQRR-OBJ-Close            PIC S9(09) COMP.
      * ..Get count for queue
           05 MQRR-OBJ-Get              PIC S9(09) COMP.
      * ..Put count for queue
           05 MQRR-OBJ-Put              PIC S9(09) COMP.
      * ..Put1 count for queue
           05 MQRR-OBJ-Put1             PIC S9(09) COMP.
      * ..Inquire count for object
           05 MQRR-OBJ-Inq              PIC S9(09) COMP.
      * ..InquireL count for object
           05 MQRR-OBJ-InqL             PIC S9(09) COMP.
      * ..Set count for object
           05 MQRR-OBJ-Set              PIC S9(09) COMP.
      * Section: OBJ - Request Failure Count Information
           05 FILLER                    PIC X(04).
      * ..Open failed counts
           05 MQRR-OBJ-F-Open           PIC S9(09) COMP.
      * ..Close failed counts
           05 MQRR-OBJ-F-Close          PIC S9(09) COMP.
      * ..Get failed counts
           05 MQRR-OBJ-F-Get            PIC S9(09) COMP.
      * ..Put failed counts
           05 MQRR-OBJ-F-Put            PIC S9(09) COMP.
      * ..Put1 failed counts
           05 MQRR-OBJ-F-Put1           PIC S9(09) COMP.
      * ..Inquire failed counts
           05 MQRR-OBJ-F-Inq            PIC S9(09) COMP.
      * ..InquireL failed counts
           05 MQRR-OBJ-F-InqL           PIC S9(09) COMP.
      * ..Set failed counts
           05 MQRR-OBJ-F-Set            PIC S9(09) COMP.
      * Section: OBJ - Message Count Information
           05 FILLER                    PIC X(24).
      * Section: OBJ - Time Information
           05 FILLER                    PIC X(16).
      * ..All reqs cpu time total
           05 MQRR-OBJ-CPUTimeTotal               COMP-2.
           05 FILLER                    PIC X(40).
           05 FILLER                    PIC X(32364).

       01 WS-PTR-NUM                    PIC S9(09) COMP-5.
       01 FILLER REDEFINES WS-PTR-NUM.
          05 WS-PTR                     USAGE POINTER.
       01 WS-HEAD-NUM                   PIC S9(09) COMP-5.
       01 FILLER REDEFINES WS-HEAD-NUM.
          05 WS-HEAD-PTR                USAGE POINTER.

       01 WS-FILE-CNT.
           05 WS-CNT-READ               PIC S9(09) COMP VALUE ZEROES.
           05 WS-CNT-WRTN               PIC S9(09) COMP VALUE ZEROES.

       01 WS-EXT-EOF-FLG                PIC X(1) VALUE 'N'.
           88 WS-EXT-EOF                VALUE 'Y'.

       01 WS-TEMP.
          05 WS-I                       PIC S9(09) COMP.
          05 WS-BIN-DATA.
             10 FILLER                  PIC X(01) VALUE X'00'.
             10 WS-MQRR-RTY-2           PIC X(01).
          05 WS-MQRR-RTY REDEFINES WS-BIN-DATA PIC S9(04) COMP.
          05 WS-LEN                     PIC 9(9) COMP.
          05 WS-STAT                    PIC 9(2).
          05 WS-SECONDS                 PIC S9(9) COMP.

       01 WS-DATE-FIELDS.
           03  WS-FMTD-DATE        PIC  X(19).
           03  WS-CCYYMMDD         PIC  9(008).
           03  WS-CCYYMMDD-X       REDEFINES WS-CCYYMMDD
                                   PIC  X(008).
           03  FILLER              REDEFINES WS-CCYYMMDD.
               05  WS-DT-CCYY      PIC  9(004).
               05  WS-DT-MM        PIC  9(002).
               05  WS-DT-DD        PIC  9(002).
           03  WS-HHMMSS           PIC  9(006).
           03  FILLER              REDEFINES WS-HHMMSS.
               05  WS-TIME-HH      PIC  9(002).
               05  WS-TIME-MM      PIC  9(002).
               05  WS-TIME-SS      PIC  9(002).
           03  WS-MSECS-PACKED     PIC S9(015)     PACKED-DECIMAL.
           03  WS-MSECS-PACKED-X   REDEFINES WS-MSECS-PACKED
                                   PIC  X(008).
           03  WS-DWORD            PIC S9(015)     PACKED-DECIMAL.
           03  WS-DWORD-X          REDEFINES WS-DWORD
                                   PIC  X(008).
           03  WS-TOD-DWORD        PIC S9(018)     BINARY.
           03  WS-TOD-DWORD-X      REDEFINES WS-TOD-DWORD
                                   PIC  X(008).
           03  WS-BINARY-DWORD     PIC S9(018)     BINARY.
           03  WS-BINARY-DWORD-X   REDEFINES WS-BINARY-DWORD
                                   PIC  X(008).
           03  WS-INTEGER-OF-DATE  PIC S9(009)     PACKED-DECIMAL.
           03  WS-SAVE-MSECS       PIC S9(015)     PACKED-DECIMAL.
           03  WS-SAVE-MSECS-X     REDEFINES WS-SAVE-MSECS
                                   PIC  X(008).
           03  WS-DBLWORD          PIC S9(015)     PACKED-DECIMAL.
           03  WS-DBLWORD-X        REDEFINES WS-DBLWORD
                                   PIC  X(008).
           03  WS-CALC-SECS        PIC S9(015)     PACKED-DECIMAL.
           03  WS-CALC-SECS-V999   REDEFINES WS-CALC-SECS
                                   PIC S9(012)V999 PACKED-DECIMAL.
           03  WS-CALC-SECS-X      REDEFINES WS-CALC-SECS
                                   PIC X(008).
       01 WS-TS                    PIC X(26).
       01 WS-BLSUXTOD              PIC X(08) VALUE 'BLSUXTOD'.
       01 WS-CURR-DATE.
          05 WS-CURR-CCYY          PIC 9(04).
          05 WS-CURR-MM            PIC 9(02).
          05 WS-CURR-DD            PIC 9(02).
          05 WS-CURR-HH            PIC 9(02).
          05 WS-CURR-MM            PIC 9(02).
          05 WS-CURR-SS            PIC 9(02).
          05 WS-CURR-HS            PIC 9(02).
          05 WS-CURR-OFFS-SIGN     PIC X(01).
          05 WS-CURR-OFFS-HH       PIC 9(02).
          05 WS-CURR-OFFS-MM       PIC 9(02).

       LINKAGE SECTION.

      * Section: JOB - Job Information
       01 MQRR-JOB.
      * ..Jobname
           05 MQRR-JOB-Jobname          PIC X(08).
      * ..Connection type
           05 MQRR-JOB-ConnType         PIC X(08).
      * ..Qualifier
           05 MQRR-JOB-Qualifier        PIC X(08).
      * Section: JOB - Request Count Information
      * ..Get count with browse
           05 MQRR-JOB-GetBrowse        PIC S9(09) COMP.
      * ..Open count for object
           05 MQRR-JOB-Open             PIC S9(09) COMP.
      * ..Close count for object
           05 MQRR-JOB-Close            PIC S9(09) COMP.
      * ..Get count for queue
           05 MQRR-JOB-Get              PIC S9(09) COMP.
      * ..Put count for queue
           05 MQRR-JOB-Put              PIC S9(09) COMP.
      * ..Put1 count for queue
           05 MQRR-JOB-Put1             PIC S9(09) COMP.
      * ..Inquire count for object
           05 MQRR-JOB-Inq              PIC S9(09) COMP.
      * ..InquireL count for object
           05 MQRR-JOB-InqL             PIC S9(09) COMP.
      * ..Set count for object
           05 MQRR-JOB-Set              PIC S9(09) COMP.
      * Section: JOB - Request Failure Count Information
           05 FILLER                    PIC X(04).
      * ..Open failed counts
           05 MQRR-JOB-F-Open           PIC S9(09) COMP.
      * ..Close failed counts
           05 MQRR-JOB-F-Close          PIC S9(09) COMP.
      * ..Get failed counts
           05 MQRR-JOB-F-Get            PIC S9(09) COMP.
      * ..Put failed counts
           05 MQRR-JOB-F-Put            PIC S9(09) COMP.
      * ..Put1 failed counts
           05 MQRR-JOB-F-Put1           PIC S9(09) COMP.
      * ..Inquire failed counts
           05 MQRR-JOB-F-Inq            PIC S9(09) COMP.
      * ..InquireL failed counts
           05 MQRR-JOB-F-InqL           PIC S9(09) COMP.
      * ..Set failed counts
           05 MQRR-JOB-F-Set            PIC S9(09) COMP.
      * Section: JOB - Message Count Information
           05 FILLER                    PIC X(24).
      * Section: JOB - Time Information
           05 FILLER                    PIC X(16).
           05 MQRR-JOB-CPUTimeTotal               COMP-2.
           05 FILLER                    PIC X(40).

      ******************************************************************
       PROCEDURE DIVISION.
      ******************************************************************

       000-MAIN-PARA.

           PERFORM 100-INITIALIZE-PARA
              THRU 100-INITIALIZE-PARA-X.

           PERFORM 200-PROCESS-PARA
              THRU 200-PROCESS-PARA-X
             UNTIL WS-EXT-EOF.

           PERFORM 900-FINALIZE-PARA
              THRU 900-FINALIZE-PARA-X.

           STOP RUN.

       100-INITIALIZE-PARA.

           OPEN INPUT SMF255.
           OPEN OUTPUT SYSVWRPT1
                       SYSVWRPT2.
           WRITE SYSVWRPT1-REC FROM OUTFIL1-HDR.
           ADD 1                  TO WS-CNT-WRTN.
           WRITE SYSVWRPT2-REC FROM OUTFIL2-HDR.
           ADD 1                  TO WS-CNT-WRTN.
           MOVE FUNCTION CURRENT-DATE TO WS-CURR-DATE
           COMPUTE WS-SECONDS = (WS-CURR-OFFS-HH * 3600) +
                                (WS-CURR-OFFS-MM * 60)
           IF WS-CURR-OFFS-SIGN = '-'
              COMPUTE WS-SECONDS = WS-SECONDS * -1
           END-IF.

       100-INITIALIZE-PARA-X.
           EXIT.

       200-PROCESS-PARA.

           READ SMF255
              AT END SET WS-EXT-EOF     TO TRUE.

           IF NOT WS-EXT-EOF
              MOVE SMFDATA-MAX-RECORD (1:WS-LEN)
                TO WS-SYSVW-REC (1:WS-LEN)
              MOVE MQRR-RTY             TO WS-MQRR-RTY-2
              IF WS-MQRR-RTY = 255 AND
                 MQRR-STY = 48 AND
                 MQRR-OBJ-Name (1:4) NOT = 'AMQ.'
                 ADD 1                  TO WS-CNT-READ
                 PERFORM 240-CONVERT-STCK
                 PERFORM 210-MOVE-OBJ-DATA
                 SET WS-HEAD-PTR TO ADDRESS OF WS-SYSVW-REC
                 IF MQRR-OBJ-JOB-Cnt > 0
                    COMPUTE WS-PTR-NUM = WS-HEAD-NUM - 4 +
                                         MQRR-OBJ-JOB-Off
                    PERFORM VARYING WS-I
                       FROM 1 BY 1 UNTIL WS-I > MQRR-OBJ-JOB-Cnt
                       SET ADDRESS OF MQRR-JOB  TO WS-PTR
                       PERFORM 220-MOVE-JOB-DATA
                       COMPUTE WS-PTR-NUM = WS-PTR-NUM +
                                            MQRR-OBJ-JOB-Len
                    END-PERFORM
                 END-IF
              END-IF
           END-IF.

       200-PROCESS-PARA-X.
           EXIT.

       210-MOVE-OBJ-DATA.

           MOVE MQRR-OBJ-QMGR       TO OUT-QMGR
           MOVE MQRR-OBJ-Name       TO OUT-qname
           MOVE MQRR-OBJ-Type       TO OUT-Type
           MOVE MQRR-OBJ-ResName    TO OUT-ResName
           MOVE MQRR-OBJ-Open       TO OUT-OPENN
           MOVE MQRR-OBJ-Close      TO OUT-CLOSEN
           COMPUTE OUT-GETN = MQRR-OBJ-GetBrowse +
                              MQRR-OBJ-Get
           MOVE MQRR-OBJ-Put        TO OUT-PUTN
           MOVE MQRR-OBJ-Put1       TO OUT-PUT1N
           MOVE MQRR-OBJ-Inq        TO OUT-INQN
           MOVE MQRR-OBJ-Set        TO OUT-SETN
           MOVE MQRR-OBJ-F-Open     TO OUT-F-OPENN
           MOVE MQRR-OBJ-F-Close    TO OUT-F-CLOSEN
           MOVE MQRR-OBJ-F-Get      TO OUT-F-GETN
           MOVE MQRR-OBJ-F-Put      TO OUT-F-PUTN
           MOVE MQRR-OBJ-F-Put1     TO OUT-F-PUT1N
           MOVE MQRR-OBJ-F-Inq      TO OUT-F-INQN
           MOVE MQRR-OBJ-F-Set      TO OUT-F-SETN
           MOVE OUT-QUEUE-INFO      TO O1-QUEUE-INFO
           MOVE OUT-COMMON-DATA     TO O1-COMM-DATA
           MOVE WS-FMTD-DATE        TO O1-FMTD-DATE
           WRITE SYSVWRPT1-REC FROM OUTFIL1-REC
           ADD +1                   TO WS-CNT-WRTN.

       220-MOVE-JOB-DATA.

           MOVE MQRR-JOB-Jobname    TO OUT-Jobname
           MOVE MQRR-JOB-ConnType   TO OUT-ConnType
           MOVE MQRR-JOB-Qualifier  TO OUT-Qualifier
           MOVE MQRR-JOB-Open       TO OUT-OPENN
           MOVE MQRR-JOB-Close      TO OUT-CLOSEN
           COMPUTE OUT-GETN = MQRR-JOB-GetBrowse +
                              MQRR-JOB-Get
           MOVE MQRR-JOB-Put        TO OUT-PUTN
           MOVE MQRR-JOB-Put1       TO OUT-PUT1N
           MOVE MQRR-JOB-Inq        TO OUT-INQN
           MOVE MQRR-JOB-Set        TO OUT-SETN
           MOVE MQRR-JOB-F-Open     TO OUT-F-OPENN
           MOVE MQRR-JOB-F-Close    TO OUT-F-CLOSEN
           MOVE MQRR-JOB-F-Get      TO OUT-F-GETN
           MOVE MQRR-JOB-F-Put      TO OUT-F-PUTN
           MOVE MQRR-JOB-F-Put1     TO OUT-F-PUT1N
           MOVE MQRR-JOB-F-Inq      TO OUT-F-INQN
           MOVE MQRR-JOB-F-Set      TO OUT-F-SETN
           MOVE OUT-JOB-INFO        TO O2-JOB-INFO
           MOVE OUT-QUEUE-INFO      TO O2-QUEUE-INFO
           MOVE OUT-COMMON-DATA     TO O2-COMM-DATA
           MOVE WS-FMTD-DATE        TO O2-FMTD-DATE
           WRITE SYSVWRPT2-REC FROM OUTFIL2-REC
           ADD +1                   TO WS-CNT-WRTN.

       240-CONVERT-STCK.

           MOVE SPACES          TO WS-TS.
           CALL WS-BLSUXTOD USING MQRR-OBJ-Start WS-TS.
           MOVE 19              TO Vstring-length of WS-TIMESTAMP.
           MOVE WS-TS (1:19)    TO Vstring-text   of WS-TIMESTAMP.
           MOVE 19              TO Vstring-length of PICSTR.
           MOVE "MM/DD/YYYY HH:MI:SS" TO Vstring-text of PICSTR.
           CALL "CEESECS" USING WS-TIMESTAMP, PICSTR, START-SECS, FC.
           IF CEE000 of FC THEN
               COMPUTE START-SECS = START-SECS
                                  + WS-SECONDS
               CALL "CEESECI" USING START-SECS, YEAR, MONTH, DAYS,
                                   HOURS, MINUTES, SECONDS, MILLSEC, FC
               IF CEE000 of FC THEN
                  MOVE YEAR         TO WS-DT-CCYY
                  MOVE MONTH        TO WS-DT-MM
                  MOVE DAYS         TO WS-DT-DD
                  MOVE HOURS        TO WS-TIME-HH
                  MOVE MINUTES      TO WS-TIME-MM
                  MOVE SECONDS      TO WS-TIME-SS
                  STRING WS-CCYYMMDD-X (1:4) '/'
                         WS-CCYYMMDD-X (5:2) '/'
                         WS-CCYYMMDD-X (7:2) ' '
                         WS-HHMMSS     (1:2) ':'
                         WS-HHMMSS     (3:2) ':'
                         WS-HHMMSS     (5:2)
                         DELIMITED BY SIZE INTO WS-FMTD-DATE
                  END-STRING
               ELSE
                   DISPLAY "Error " Msg-No of FC
                       " converting seconds to components."
               END-IF
           ELSE
               DISPLAY "Error " Msg-No of FC
                   " converting timestamp to seconds."
           END-IF.

       900-FINALIZE-PARA.

           CLOSE SYSVWRPT1
                 SYSVWRPT2.
           CLOSE SMF255.
           DISPLAY '*-----------------------------------*'.
           DISPLAY 'TOTAL RECORDS READ    : ' WS-CNT-READ.
           DISPLAY 'TOTAL RECORDS WRITTEN : ' WS-CNT-WRTN.
           DISPLAY '*-----------------------------------*'.

       900-FINALIZE-PARA-X.
           EXIT.

 

at No comments:
Labels:

Wednesday, February 16, 2022

COBOL program to process SMF 101 Accounting data

Below COBOL program processes SMF 101 Accounting data. The program was written for DB2 12 version.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. SMF101.
       AUTHOR.   
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
            SELECT SMFDATA ASSIGN TO SMFDATA
            ORGANIZATION SEQUENTIAL.
            SELECT RPT-FILE ASSIGN TO RPTFILE
            ORGANIZATION SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD SMFDATA
            LABEL RECORDS ARE STANDARD
            RECORDING MODE IS S
            BLOCK CONTAINS 32760 CHARACTERS
            RECORD IS VARYING FROM 18 TO 32756
            DEPENDING ON WS-LEN.
       01 SMFDATA-MIN-RECORD    PIC X(18).
       01 SMFDATA-MAX-RECORD    PIC X(32756).
       FD RPT-FILE
           LABEL RECORDS ARE STANDARD.
       01 RPT-FILE-REC         PIC X(80).
       WORKING-STORAGE SECTION.
       01 WS-REC.
          05 F-STRDATE          PIC 9(5).
          05 FILLER             PIC X VALUE SPACE.
          05 F-STRTIME.
             10 F-STRTIME-HH    PIC 99.
             10 FILLER          PIC X VALUE ':'.
             10 F-STRTIME-MM    PIC 99.
             10 FILLER          PIC X VALUE ':'.
             10 F-STRTIME-SS    PIC 99.
          05 FILLER             PIC X VALUE SPACE.
          05 F-JOBNAME          PIC X(8).
          05 FILLER             PIC X VALUE SPACE.
          05 F-CONNECT          PIC X(8).
          05 FILLER             PIC X VALUE SPACE.
          05 CONN-TYPE          PIC X(10).
          05 FILLER             PIC X VALUE SPACE.
          05 F-QWHCAID          PIC X(8).
          05 FILLER             PIC X VALUE SPACE.
          05 F-PLAN             PIC X(8).
          05 FILLER             PIC X VALUE SPACE.
          05 F-TCB              PIC ZZZZZ9.9(5).
          05 FILLER             PIC X VALUE SPACE.
          05 DB2CPU             PIC ZZZZZ9.9(5).
       01 WS-SMF-RECNO          PIC 9(6) COMP VALUE 0.
       01 BIN4-32768            PIC 9(8) COMP VALUE 32768 SYNC.
       01 SMF00-PNTR USAGE IS POINTER SYNC.
       01 SMF00-ADDRVAL REDEFINES SMF00-PNTR
                                PIC S9(9) COMP.
       01 SMF101RPS-PNTR USAGE IS POINTER SYNC.
       01 SMF101RPS-ADDRVAL REDEFINES SMF101RPS-PNTR
                                PIC S9(9) COMP.
       01 DSNDQWHS-PNTR USAGE IS POINTER SYNC.
       01 DSNDQWHS-ADDRVAL REDEFINES DSNDQWHS-PNTR
                                PIC S9(9) COMP.
       01 DSNDQWAC-PNTR USAGE IS POINTER SYNC.
       01 DSNDQWAC-ADDRVAL REDEFINES DSNDQWAC-PNTR
                                PIC S9(9) COMP.
       01 DSNDQWHC-PNTR USAGE IS POINTER SYNC.
       01 DSNDQWHC-ADDRVAL REDEFINES DSNDQWHC-PNTR
                                PIC S9(9) COMP.
       01 END-OF-FILE-FLAG      PIC X VALUE 'N'.
          88 END-OF-FILE        VALUE 'Y'.
       01 WS-VARS.
          02 PROGRAM-NAME       PIC X(8).
          02 CUTOFF-CPU-TIME    PIC 9V99 VALUE 1.00.
          02 TOT-INDB2-ELAP     PIC 9(15)V99.
          02 TOT-DB2-CPU        PIC 9(9)V9(5) COMP.
          02 TCB-TIME           PIC 9(9)V9(5) COMP.
          02 TEMP-HOURS         PIC 9(9) COMP.
          02 TEMP-MIN           PIC 9(9) COMP.
          02 TEMP-SECS          PIC 9(9) COMP.
          02 WS-CNT             PIC 9(4) COMP.
          02 WS-LEN             PIC 9(9) COMP.
       01 WS-SMF-REC.
          05 WS-CHAR OCCURS 1 TO 32756 DEPENDING ON WS-LEN
                                PIC X(01).
       LINKAGE SECTION.
       01 SMF101RPS.
      ** HEADER FOR TYPE 101 RECORD
           02 SMF101RHD.
             03 SMF101FLG       PIC X(1).
             03 SMF101RTY       PIC X(1).
             03 SMF101TME       PIC 9(9) COMP.
             03 SMF101DTE       PIC 9(7) COMP-3.
             03 SMF101SID       PIC X(4).
             03 SMF101SSI       PIC X(4).
             03 SM101STF        PIC 9(04) COMP.
             03 FILLER          PIC X(4).
      ** SELF-DEFINING SECTION OF TYPE 101 RECORD
           02 DSNDQWA0.
             03 QWA01PSO        PIC 9(9) COMP.
             03 QWA01PSL        PIC 9(4) COMP.
             03 QWA01PSN        PIC 9(4) COMP.
             03 QWA01R1O        PIC 9(9) COMP.
             03 QWA01R1L        PIC 9(4) COMP.
             03 QWA01R1N        PIC 9(4) COMP.
             03 QWA01R2O        PIC 9(9) COMP.
             03 QWA01R2L        PIC 9(4) COMP.
             03 QWA01R2N        PIC 9(4) COMP.
             03 QWA01R3O        PIC 9(9) COMP.
             03 QWA01R3L        PIC 9(4) COMP.
             03 QWA01R3N        PIC 9(4) COMP.
             03 QWA01R4O        PIC 9(9) COMP.
             03 QWA01R4L        PIC 9(4) COMP.
             03 QWA01R4N        PIC 9(4) COMP.
             03 QWA01R5O        PIC 9(9) COMP.
             03 QWA01R5L        PIC 9(4) COMP.
             03 QWA01R5N        PIC 9(4) COMP.
             03 QWA01R6O        PIC 9(9) COMP.
             03 QWA01R6L        PIC 9(4) COMP.
             03 QWA01R6N        PIC 9(4) COMP.
             03 QWA01R7O        PIC 9(9) COMP.
             03 QWA01R7L        PIC 9(4) COMP.
             03 QWA01R7N        PIC 9(4) COMP.
             03 QWA01R8O        PIC 9(9) COMP.
             03 QWA01R8L        PIC 9(4) COMP.
             03 QWA01R8N        PIC 9(4) COMP.
             03 QWA01R9O        PIC 9(9) COMP.
             03 QWA01R9L        PIC 9(4) COMP.
             03 QWA01R9N        PIC 9(4) COMP.
      *
      *****************************************************************
      * PRODUCT DATA SECTION
      * INSTRUMENTATION STANDARD HEADER
      ****************************************************************
      *
       01 DSNDQWHS.
         02 QWHSLEN             PIC 9(4) COMP.
         02 QWHSTYP             PIC X(1).
            88 STANDARD-HEADER         VALUE X'01'.
*******     88 TRACE-HEADER            VALUE X'04'.
*******     88 CPU-HEADER              VALUE X'08'.
*******     88 DISTRIBUTED-HEADER      VALUE X'10'.
*******     88 DATA-SHARING-HEADER     VALUE X'20'.
         02 QWHSRMID            PIC X(1).
         02 QWHSIID             PIC 9(4) COMP.
         02 QWHSNSDA            PIC X(1).
         02 QWHSSRN             PIC X(1).
         02 QWHSACE             PIC 9(9) COMP.
      * SUBSYSTEM NAME
         02 QWHSSSID            PIC X(4).
         02 QWHSSTCK.
            03 QWHSSC1          PIC 9(9) COMP.
            03 QWHSSC2          PIC 9(9) COMP.
         02 QWHSISEQ            PIC 9(9) COMP.
         02 QWHSWSEQ            PIC 9(9) COMP.
         02 QWHSMTN             PIC X(4).
         02 QWHSLOCN            PIC X(16).
         02 QWHSNID             PIC X(8).
         02 QWHSLUNM            PIC X(8).
         02 QWHSLUUV            PIC X(6).
         02 QWHSLUCC            PIC 9(4) COMP.
         02 QWHSFLAG            PIC X.
       01 DSNDQWHC.
      * CORELATION HEADER
         02 QWHCLEN             PIC 9(4) COMP.
         02 QWHCTYP             PIC X.
            88 CORRELATION-HEADER      VALUE X'02'.
         02 FILLER              PIC X.
      * %U AUTHORIZATION ID
      *   Truncated if QWHCAID_Off¬=0
         02 QWHCAID             PIC X(8).
      *CORRELATION VALUE
         02 QWHCCV              PIC X(12).
      *CONNECTION NAME (NOT VALID ON EOM REFLECTS THE MVS HOME ASID
      *CONNECTION NAME
         02 QWHCCN              PIC X(8).
      * PLAN NAME     (BIND NAME)
         02 QWHCPLAN            PIC X(8).
      * %U ORIGINAL OPERATOR ID
      *   Truncated if QWHCOPID_Off¬=0
         02 QWHCOPID            PIC X(8).
      *CONNECTING SYSTEM TYPE CODE
         02 QWHCATYP            PIC 9(9) COMP.
            88 TSO-OR-BATCH                VALUE   1.
            88 DB2-CALL-ATTACH             VALUE   2.
            88 DLI-BATCH                   VALUE   3.
            88 CICS-ATTACH                 VALUE   4.
            88 IMS-ATTACH-BMP              VALUE   5.
            88 IMS-ATTACH-MPP              VALUE   6.
            88 DB2-PRIVATE-PROTOCOL        VALUE   7.
            88 DRDA                        VALUE   8.
            88 IMS-CONTROL-REGION          VALUE   9.
            88 IMS-TRANSACTION-BMP         VALUE  10.
            88 DB2-UTILITIES               VALUE  11.
            88 RRSAF-ATTACH                VALUE  12.
      *********************************************************
      **** ACCOUNTING DATA
      *********************************************************
       01 DSNDQWAC.
          02 QWACBSC            pic x(8).
          02 QWACESC            pic x(8).
          02 QWACBJST           PIC 9(18) COMP-5.
          02 QWACEJST           PIC 9(18) COMP-5.
          02 QWACBSRB           PIC 9(18) COMP-5.
          02 QWACESRB           PIC 9(18) COMP-5.
          02 QWACRINV           PIC 9(9) COMP.
          02 QWACNID            PIC X(16).
          02 QWACCOMM           PIC 9(9) COMP.
          02 QWACABRT           PIC 9(9) COMP.
          02 QWCA1.
             03 QWACASC         PIC 9(18) COMP-5.
             03 QWACAJST        PIC 9(18) COMP-5.
             03 QWACASRB        PIC 9(18) COMP-5.
             03 QWACAWTI        PIC 9(18) COMP-5.
             03 QWACAWTL        PIC 9(18) COMP-5.
             03 QWACARNA        PIC 9(9) COMP.
             03 QWACARNE        PIC 9(9) COMP.
       PROCEDURE DIVISION.
       0000-MAINLINE.
           PERFORM 1000-INITIALIZE
           PERFORM UNTIL END-OF-FILE
              READ SMFDATA
              AT END MOVE 'Y' TO END-OF-FILE-FLAG
              END-READ
              IF NOT END-OF-FILE
                 MOVE SMFDATA-MAX-RECORD (1:WS-LEN)
                   TO WS-SMF-REC(1:WS-LEN)
                 SET ADDRESS OF SMF101RPS
                   TO ADDRESS OF WS-SMF-REC
                 SET SMF101RPS-PNTR
                   TO ADDRESS OF WS-SMF-REC
                 IF SMF101RTY = X'65' AND
                    SM101STF  = ZEROS
                    ADD 1 TO WS-SMF-RECNO
      *** 4 IS SUBTRACTED AS RDW IS NOT INCLUDED IN OUR RECORD
                    COMPUTE DSNDQWHS-ADDRVAL = SMF101RPS-ADDRVAL
                                               + QWA01PSO - 4
                    SET ADDRESS OF DSNDQWHS TO DSNDQWHS-PNTR
                    IF QWHSIID = 03
******** IFCID = 03 - Gen. Accounting data - processed
                       COMPUTE DSNDQWHC-ADDRVAL = DSNDQWHS-ADDRVAL
                                                  + QWHSLEN
                       SET ADDRESS OF DSNDQWHC TO DSNDQWHC-PNTR
                       IF CORRELATION-HEADER
                          PERFORM 2000-TYPE101-PROCESS
                       END-IF
                    END-IF
                 END-IF
              END-IF
           END-PERFORM.
           CLOSE SMFDATA.
           CLOSE RPT-FILE.
           GOBACK.
       1000-INITIALIZE.
           OPEN INPUT SMFDATA.
           OPEN OUTPUT RPT-FILE.
       2000-TYPE101-PROCESS.
           MOVE SMF101DTE     TO F-STRDATE
           PERFORM 2100-CONVERT-TIME
           MOVE TEMP-HOURS    TO F-STRTIME-HH
           MOVE TEMP-MIN      TO F-STRTIME-MM
           MOVE TEMP-SECS     TO F-STRTIME-SS
           MOVE QWHCCN        TO F-CONNECT
           MOVE QWHCCV        TO F-JOBNAME
           MOVE QWHCPLAN      TO F-PLAN
           MOVE QWHCAID       TO F-QWHCAID
           MOVE 0             TO TOT-INDB2-ELAP ,
                                 TOT-DB2-CPU
           COMPUTE DSNDQWAC-ADDRVAL = SMF101RPS-ADDRVAL + QWA01R1O - 4
           SET ADDRESS OF DSNDQWAC TO DSNDQWAC-PNTR
           PERFORM 3000-COMPUTE-TIMES QWA01R1N TIMES
********   COMPUTE TOT-INDB2-ELAP =
********   (TOT-INDB2-ELAP / 4096000000.0) + 0.005
           COMPUTE TOT-DB2-CPU =  TOT-DB2-CPU / 4096000000
********   MOVE TOT-INDB2-ELAP TO DB2ELAP
           MOVE TOT-DB2-CPU    TO DB2CPU
           COMPUTE TCB-TIME = (QWACEJST - QWACBJST)/ 4096000000
           MOVE TCB-TIME       TO F-TCB
           EVALUATE TRUE
              WHEN TSO-OR-BATCH
                   MOVE 'BATCH'            TO CONN-TYPE
              WHEN DB2-CALL-ATTACH
                   MOVE 'DB2CALL'          TO CONN-TYPE
              WHEN DLI-BATCH
                   MOVE 'DLI'              TO CONN-TYPE
              WHEN CICS-ATTACH
                   MOVE 'CICS'             TO CONN-TYPE
              WHEN IMS-ATTACH-BMP
                   MOVE 'IMSBMP'           TO CONN-TYPE
              WHEN IMS-ATTACH-MPP
                   MOVE 'IMSMPP'           TO CONN-TYPE
              WHEN DB2-PRIVATE-PROTOCOL
                   MOVE 'DB2PRIVA'         TO CONN-TYPE
              WHEN DRDA
                   MOVE 'DRDA'             TO CONN-TYPE
              WHEN IMS-CONTROL-REGION
                   MOVE 'IMSCTL'           TO CONN-TYPE
              WHEN IMS-TRANSACTION-BMP
                   MOVE 'IMSTRANBMP'       TO CONN-TYPE
              WHEN DB2-UTILITIES
                   MOVE 'DB2UTIL'          TO CONN-TYPE
              WHEN RRSAF-ATTACH
                   MOVE 'RRSAF'            TO CONN-TYPE
           END-EVALUATE.
           WRITE RPT-FILE-REC FROM WS-REC.
       2100-CONVERT-TIME.
           COMPUTE TEMP-HOURS = SMF101TME / 360000
           COMPUTE TEMP-MIN =
           (SMF101TME - (TEMP-HOURS * 360000)) / 6000
           COMPUTE TEMP-SECS = (SMF101TME - (TEMP-HOURS * 360000) -
           (TEMP-MIN * 6000)) / 100 .
       3000-COMPUTE-TIMES.
*******    COMPUTE TOT-INDB2-ELAP = TOT-INDB2-ELAP + QWACASC
           COMPUTE TOT-DB2-CPU = TOT-DB2-CPU + QWACAJST + QWACASRB
           COMPUTE DSNDQWAC-ADDRVAL = DSNDQWAC-ADDRVAL + QWA01R1L
           SET ADDRESS OF DSNDQWAC TO DSNDQWAC-PNTR.
       3000-EXIT.
           EXIT.

at No comments:
Labels: ,

Tuesday, October 26, 2021

Validate a date whether it is a valid Gregorian date using COBOL function

TEST-DATE-YYYYMMDD function tests whether a date in form (YYYYMMDD) is a valid date in the Gregorian calendar. 

Argument to this function must be an integer and it should be of the form YYYYMMDD.

Function returns following values
  • If the value of argument is less than 16010000 or greater than 99999999, the returned value is 1,which means the year is not within the range of 1601 to 9999.
  • Returned value is 2, when the month is not within the range of 1 to 12.
  • Returned value is 3, when the day is not valid for the given year and month.
  • Otherwise, the returned value is 0 (zero) , which means the date is valid.
Sample COBOL code is below

        IDENTIFICATION DIVISION.                                   
        PROGRAM-ID. DTCONV.                                        
        ENVIRONMENT DIVISION.                                      
        CONFIGURATION SECTION.                                     
        SPECIAL-NAMES.                                             
        INPUT-OUTPUT SECTION.                                      
        FILE-CONTROL.                                              
        DATA DIVISION.                                             
        FILE SECTION.                                              
        WORKING-STORAGE SECTION.                                   
        01 WS-WORK-AREA.                                           
           05 WS-GREG-DATE                  PIC  9(10).            
        01 RC PIC 9(5).                                            
        PROCEDURE DIVISION.                                        
******** Example 1                                                 
******** returns 0 because the date is valid                       
            MOVE 19950215 TO WS-GREG-DATE                          
            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE) 
            DISPLAY RC                                                  
******** Example 2                                                      
******** returns 1 because the year is invalid and the value of argument
******** is less than 16010000.                                         
            MOVE 12950215 TO WS-GREG-DATE                               
            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      
            DISPLAY RC                                                  
******** Example 3                                                      
******** returns 1 because the year is invalid and the value of argument
******** is greater than 99999999.                                      
            MOVE 912950215 TO WS-GREG-DATE                              
            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      
            DISPLAY RC                                                  
******** Example 4                                                      
******** returns 2 because the month is not within the range            
******** of 1 to 12                                                     
            MOVE 19921415  TO WS-GREG-DATE                              
            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      
            DISPLAY RC                                                  
******** Example 5                                                      
******** returns 3 because the day is invalid                         
            MOVE 19950240  TO WS-GREG-DATE                              
            COMPUTE RC = FUNCTION TEST-DATE-YYYYMMDD(WS-GREG-DATE)      
            DISPLAY RC                                                  

at No comments:
Labels: ,

How to pass data to a program present many levels down the calling chain

Let us say we have below calling chain

Program A --> Program B ---> Program C ---> Program D --> Program E

And we want to pass data from "Program B" to "Program E"

Common approaches for passing data between programs include:
  • Passing data through the LINKAGE section from Program B → Program C → Program D → Program E
  • Storing the data in a VSAM file
  • Storing the data in a DB2 table
  • Using CICS TSQ/TDQ in online environments
  • Channels/Containers in CICS

While these methods are widely used and appropriate in many scenarios, they may require changes to multiple programs, additional I/O operations. For example, passing data through the LINKAGE section requires every intermediate program in the call chain to receive and forward the data, even when those programs have no need for it. Similarly, storing data in VSAM, DB2, or CICS queues introduces persistence and access overhead that may be unnecessary for small amounts of transient data.

Channels and Containers work only in CICS programs. They cannot be used in batch jobs, so they are not suitable if the solution must support both online and batch processing.

In situations where a small piece of data needs to be shared between non-adjacent COBOL programs during the same execution path, a lightweight cache program can provide a simple alternative. This approach avoids modifications to intermediate programs while keeping the data readily accessible to programs located several levels down the calling chain.

This technique works well in both online and batch environments.

Here I am using a sub program called "CACHEPGM" as a cache. 

       IDENTIFICATION DIVISION.  
       PROGRAM-ID.    CACHEPGM.
       ENVIRONMENT DIVISION. 
       DATA DIVISION.       
       WORKING-STORAGE SECTION.  
       01 WS-SAVE-DATA PIC X(80) VALUE SPACES. 
       LINKAGE SECTION.                        
       01 LS-PARAMETERS.  
          05 LS-FUNC          PIC X(4) VALUE SPACES. 
               88 LS-SET-DATA           VALUE 'SET'.  
               88 LS-GET-DATA           VALUE 'GET'.      
           05 LS-DATA         PIC X(80). 
       PROCEDURE DIVISION USING LS-PARAMETERS. 
           EVALUATE TRUE  
             WHEN LS-SET-DATA  
               MOVE LS-DATA      TO WS-SAVE-DATA   
             WHEN LS-GET-DATA 
               MOVE WS-SAVE-DATA TO LS-DATA  
           END-EVALUATE   
           GOBACK.    

From Program B, call CACHEPGM with the SET function and the data that needs to be shared. CACHEPGM stores the data in its Working-Storage area for later use.

From Program E, call CACHEPGM with the GET function to retrieve the previously stored data. CACHEPGM returns the value from its Working-Storage area to the calling program.

at No comments:
Labels: , ,

Wednesday, October 20, 2021

Useful ESP commands

Below are some of the useful CA ESP scheduler commands

AJ ALL APPL(TESTFASD.1155) HOLD                     
- HOLD operand stops submission of jobs in the application and places the application in APPLHOLD status.

AJ ALL APPL(TESTFASD.1155) RELEASE                  
- Releases an application (removes it from APPLHOLD status)

AJ ALL APPL(TESTFASD.1155) UNWAIT                   
- Removes an application from APPLWAIT status

AJ ALL APPL(TESTFASD.1155) WITHDRAW                 
- WITHDRAW ENTIRE APPL                                     

AJ ALL APPL(TESTFASD.1155) COMPLETE                 
- Completes All the jobs in the application once there are no APPLHOLD and APPLWAIT conditions on it

AJ ALL APPL(TESTFASD.1155) TERMINATE                
- Completes an application immediately. CA WA ESP Edition removes any APPLHOLD and APPLWAIT conditions 

DELETE CYBER.PAYROLL                                
- Delete an Event

AJ TESTCGP HOLD APPL(TESTPCPM.624)                  
- MANHOLD A JOB called TESTCGP                                 

AJ TESTCGP DROPRES APPL(TESTPCPM.624)               
- Removes all resource requirements for TESTCGP  job

AJ TESTCGP READY APPL(TESTPCPM.624)                 
- Removes all job dependencies (except resources) from TESTCGP job (including time, predecessors, manual hold)

AJ TESTBIP  RELEASE APPL(TEST1MCW.534)              
- RELEASE MANFOLD for TESTBIP JOB    

AJ TESTMZ26 COMPLETE APPL(TESTCCBP.007)             
- FORCE COMPLETE TESTMZ26 JOB     

AJ TESTMZ26 WITHDRAW APPL(TESTCCBP.007)             
- WITHDRAW TESTMZ26 JOB     

AJ TESTMZ26 DROPDEP  APPL(TESTCCBP.007)             
- Drops all predecessor relationships for TESTMZ26 job

AJ TESTMZ26 BYPASS APPL(TESTCCBP.007)               
- Indicates that TESTMZ26 job is no longer required. As soon as the dependencies are met, the job is bypassed. Successor jobs are posted as in a normal job completion. If a job is bypassed, it can be unbypassed at any time up to submission.

AJ TESTMZ26 UNBYPASS APPL(TESTCCBP.007)            
 - Indicates that a job must no longer be bypassed.

AJ TESTR71P REQUEST APPL(TESTORG1.028)              
- TO REQUEST A JOB          

AJ TESTR71P UNREQUEST APPL(TESTORG1.028)            
- Specifies that an on-request job is no longer required

AJ TESTAGET RESET DELAYSUB(RESET) APPL(TESTAGET.12) 
- DROP TIME WAIT                                

AJ PAYJOB7 RESET DELAYSUB('9PM') APPL(PAYROLL.0)    
-  resets PAYJOB7's delayed submission time to 9 pm

AJ PAYJOB8 RESET LATEEND(RESET) APPL(PAYROLL.1)       
 -  removes a job's dueout time. CA WA ESP Edition no longer considers the job overdue if the job has not ended by the late end time specified in the job definition

AJ PAYJOB7 RESET EXPECTEDSTART('2PM') APPL(PAYROLL.3)  
-  sets the expected start time to 2PM for job PAYJOB7 in generation 3 of the PAYROLL application:

AJ PAYJOB8 HOLD REASON('WAITING FOR TAPE 09999') APPL(PAYROLL.0)
-     holds a job with a reason

AJ PAYJOB8 RELEASE REASON(.) APPL(PAYROLL.0)       
 -  releases a job and resets the reason field to null

AJ PAYJOBS BYPASS APPL(PAYROLL.0)                  
 - bypasses a subapplication called PAYJOBS. The BYPASS command indicates that all remaining jobs in this subapplication are no longer required.

APPLJOB GLDLYAPPL APPLICATION(GLAPPL.100) WITHDRAW   
- withdraws all incomplete jobs in subapplication GLDLYAPPL of application GLAPPL

AJ PAYJOB4 INSERT APPL(PAYROLL.293) PREDECESSORS(PAYJOB3) SUCCESSORS(PAYJOB5)
 -  inserts PAYJOB4 into generation 293 of the PAYROLL application. PAYJOB4 runs after PAYJOB3 completes successfully, but before PAYJOB5

AJ PAYJOB9 INSERT ATTRIBUTES(HOLD) APPL(PAYROLL.0)  
- inserts PAYJOB9 on hold into the PAYROLL application's current generation

The following AJ commands insert PAYJOB19 on hold into the PAYROLL application's current generation. PAYJOB19 has a time dependency, it's submission time is set to 9 pm and it is then released from hold.
AJ PAYJOB19 INSERT ATTRIBUTE(HOLD) APPL(PAYROLL.0)
AJ PAYJOB19 RESET DELAYSUB('9PM') APPL(PAYROLL.0)
AJ PAYJOB19 RELEASE APPL(PAYROLL.0)

The following AJ command inserts PAYJOB13 into the PAYROLL application's current generation with one predecessor. PAYJOB13 runs after PAYJOB11 completes, whether or not it is successful.
AJ PAYJOB13 INSERT APPL(PAYROLL.0) PREDECESSORS(PAYJOB11(U))

The following AJ command inserts PAYJOB12 with two predecessors into the PAYROLL application's current generation. PAYJOB12 runs after PAYJOB10 and PAYJOB11 complete successfully.
AJ PAYJOB12 INSERT PREDECESSORS(PAYJOB10,PAYJOB11)  APPL(PAYROLL.0)

The following AJ command inserts a task called REPORT.BALANCE into the PAYROLL application's current generation. REPORT.BALANCE runs after PAYJOB6 completes successfully.
AJ REPORT.BALANCE INSERT APPL(PAYROLL) PREDECESSORS(PAYJOB6) ATTRIBUTES(TASK)

The following AJ command resubmits PAYJOB18 using CA WA Restart Option ESP Edition
AJ PAYJOB18 RESUB RESTART APPL(PAYROLL.0)

The following AJ command resubmits PAYJOB2 and selects which steps are rerun.
AJ PAYJOB2 APPL(PAYROLL.0) RESTART RESUB -
FROMSTEP(STEP020) TOSTEP(STEP060) -
EXCLSTEP(STEP0030 STEP0050)

The following AJ command resubmits PAYJOB2 from the CYBER.COPY.JCL library
AJ PAYJOB2 RESUB APPL(PAYROLL.0) -
DATASET('CYBER.COPY.JCL')

SUSPEND ESPM.TESTFMRD - SUSPEND AN EVENT   


The following command TRIGGER AN EVENT STARTING FROM PARTICULAR JOBS   
TR ESPM2D.TEST1DLY ROOT(TEST1DLY,TEST1CDB+)

In the following example, the TRIGGER command suppresses the execution of CYBER.PAYROLL
TRIGGER CYBER.PAYROLL NOXEQ  

LIST EVENT(PROD.TEST)    
- List event PROD.TEST
                
LJS JOB(TESTJOB) INDEX
- Displays last 10 runs of TESTJOB job 

NEXT 10 PROD.TEST
- Display next ten sceduled timings of event PROD.TEST

LAP TESTAPPL.0 ALL 
- Display the status of all the jobs from current generation of TESTAPPL

SIMULATE EVENT(PROD.TESTAPP) SCHED(00:01JUL062025)
- Siumulates PROD.TESTAPP event with time of 01-Jul-2025 00:01 AM 

AJ MYJOB RESUBMIT APPL(TESTAPP.0) 
- Resubmits MYJOB from current generation of TESTAPP appl 

L LEVEL(TEST) ALL 
- List all the events starting with "TEST"

at No comments:
Labels:

Execute CA ESP scheduler commands thru batch jobs


Below job LISTs ESP EVENTS that starts with "PROD"

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                          
//SYSPRINT DD SYSOUT=*                                              
//SYSIN    DD *                                                     
  L LEVEL(PROD) ALL PRINT(OUPUT.LIST.EVENTS)                       
//*                                                                 

Below job PURGE CSF COMPLETED APPLICATIONS AND JOBS 
                        
//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'     
//SYSPRINT DD SYSOUT=*  
//SYSIN    DD *                                                      
  OPER PURGSCHF NOW                                                
//*   
                                                                  
Below job GENERATES CURRENT LISTING/SETTING OF ESP RESOURCES    
      
//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'         
//SYSPRINT DD SYSOUT=*
//SYSIN    DD *                                                      
   RESDEF - LIST                                                
//*                                                                  

Below job GENERATES CURRENT LISTING/SETTING OF ESP VARIABLES
                  
//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                          
//SYSPRINT DD SYSOUT=*                                              
//SYSIN    DD *                                                     
   VTLIST                                                           
//*                                                                 

Below job SIMULATEs ESP events

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                       
//SYSPRINT DD DSN=output dataset,
//            DISP=(NEW,CATLG,DELETE),  
//            UNIT=SYSDA,                                          
//            DCB=(RECFM=FBA,BLKSIZE=0,LRECL=133),                
//            SPACE=(133,(60,10),RLSE),AVGREC=K                      
//SYSIN    DD *                                                      
   SIMULATE EVENT(PROD.DAILY)                                       
//*                                                                   
//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'             
//SYSPRINT DD SYSOUT=*                                      
//SYSUDUMP DD SYSOUT=*                                      
//SYSIN DD *                                                
 SIMULATE EVENT(PROD.DAILY) SCHED('10/15/2021 00.01.00')  
/*                                                          

Below job UPDATES VARIABLE called "VK"

//STEP01   EXEC PGM=ESP,PARM='SUBSYS(ESP)'                           
//SYSPRINT DD SYSOUT=*                                               
//SYSIN    DD *                                                      
   VSET WK 2 TABLE(TABLE1)                                           
//*

Below job Trigger an event

//STEP02   EXEC PGM=ESP,PARM='SUBSYS(ESP)'         
//SYSPRINT DD SYSOUT=*                             
//SYSIN    DD *                                    
  TRIGGER PROD.DEMAND
/*                                                 
//                                                 

Below job lists the history run times of D01D001A job

//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'     
//SYSPRINT DD SYSOUT=*                              
//SYSUDUMP DD SYSOUT=*                              
//SYSIN DD *                                        
 LJS JOB(D01D001A) I                              
/*                                                  

Below two jobs generates reports of job runs

//XCFDG1 EXEC PGM=ESP,PARM='SUBSYS(ESP) MASTER'                    
//SYSPRINT DD SYSOUT=*                                             
//SYSUDUMP DD SYSOUT=*                                             
//SYSIN DD *                                                       
REPORT                                                             
  SETWIDTH 130                                                     
  FROM OCT 15TH 2021 TO OCT 16TH 2021                              
  DISPLAY JOBNAME EXECSDATE EXECST ENDDATE ENDT CPUTIME CMPC     
ENDR                                                               
/*                                                                 

//STEP010 EXEC PGM=ESP,REGION=4M,PARM='SUBSYS(ESP)'  
//SYSPRINT DD  DSN=output dataset
//             DISP=(NEW,CATLG,DELETE),                  
//             UNIT=SYSDA,SPACE=(CYL,(20,20),RLSE),      
//             DCB=(RECFM=FB,LRECL=240,BLKSIZE=13300)    
//SYSIN    DD *
REPORT                 
DATEFORM YMD DAY(NO)    
DISPLAY EXECSDATE 10,EXECST 8,ENDDATE 10,ENDT 8,APPLSYS 8,
SUBAPPL 8,  
JOBNAME 8,JOBNO 6,RC 5,CMPC 8,FORCED 3,STATUS 8,CPUTIME 8, 
TCBTIME 8,SRBTIME 8,EXECQT 5,MINRUNT 5,MAXRUNT 5,AVGRUNT 5,  
ALLOCQT 5,CRITPATH 3,STEPS 2,EXCP 8,DEXCP 8,TEXCP 8,ESPSUB 3,
SUB# 1,SYSPLEX 8,SRVCLASS 8,OVDSUBAT 15
FROM 12AM TODAY   
  SORT EXECSDATE,EXECST     
 ENDR                                                             
/*

at No comments:
Labels:
Subscribe to: Posts (Atom)