Friday, April 8, 2022

COBOL code to test BIT setting in a BINARY field

The below COBOL code tests whether 31st bit in "0100 0000 0000 0000 0000 0000 0000 0000" is ON.
 
        WORKING-STORAGE SECTION.                                         
       ***************************************************************** 
       * DETERMINE THE VALUE IN A SPECIFIC BIT IN A FULLWORD.          * 
       *                                                               * 
       * - 'BIT-POINTER'. MOVE A VALUE TO THIS FIELD TO INDICATE       * 
       *       WHICH BIT YOU WANT TO TEST. BIT '0' IS THE LOW-ORDER    * 
       *       BIT AND '31' IS THE HIGH-ORDER.                         * 
       * - 'RESULT-FIELD'. CONTAINS A VALUE OF '0' OR '1', INDICATING  * 
       *       THE VALUE OF THE BIT TO WHICH BIT-POINTER IS POINTING.  * 
       *                                                               * 
       ***************************************************************** 
        01  FEEDBACK-CODE.                                               
            05 FC-SEVERITY                 PIC S9(4) BINARY VALUE +0.    
            05 FC-MESSAGE                  PIC S9(4) BINARY VALUE +0.    
            05 FILLER                      PIC X(08).                    
        01  WS-WORK-FIELDS.                                              
           05 INPUT-BINARY-FIELD             PIC S9(9) COMP-5.           
           05 BIT-POINTER                    PIC S9(9) BINARY VALUE +0.  
           05 RESULT-FIELD                   PIC S9(9) BINARY VALUE +0.  
        PROCEDURE DIVISION.                                              
            MOVE 1073741824 TO INPUT-BINARY-FIELD                        
            MOVE +30 TO BIT-POINTER.                                     
            MOVE +0  TO RESULT-FIELD.                                    
            CALL 'CEESITST' USING INPUT-BINARY-FIELD,                    
                                  BIT-POINTER,                           
                                 FEEDBACK-CODE,                         
                                 RESULT-FIELD.                          
           IF FC-SEVERITY = +0                                          
              DISPLAY 'VALUE OF BIT ' BIT-POINTER ' IS ' RESULT-FIELD   
           ELSE                                                         
             DISPLAY 'BAD RETURN FROM CEESITST '                        
             DISPLAY 'FEEDBACK SEVERITY = ' FC-SEVERITY                 
             DISPLAY 'FEEDBACK MESSAGE  = ' FC-MESSAGE                  
           END-IF.                                                      
           GOBACK.                                                      


at No comments:
Labels:

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: ,
Subscribe to: Posts (Atom)