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.

No comments:

Post a Comment

Note: Only a member of this blog may post a comment.