Determine field usage in file -- code

Determine field usage in file -- code

 
      F**********************************************************************
      F*    PROGRAM ID   - CPUR670                                         **
      F*    PROGRAM NAME - FILE FIELD USAGE TEST                           **
      F*    WRITTEN BY   - JAMES H. GREENE                                 **
      F*                 - 920-751-7169                                    **
      F*                 - jgreene@banta.com                               **
      F*    DATE WRITTEN - 10/08/90                                        **
      F*    slightly modified on 07/17/2003                                **
      F*    PURPOSE      - READ A USER SELECTED FILE AND DETERMINE         **
      F*                 - WHICH FIELDS ARE BEING USED BY CHECKING
      F*                   FOR EITHER A BLANK OR ZERO CONDITION
      F*                   AT LR TIME A LIST IS PRODUCED BY FIELD.
      F*                   FIELDS THAT ARE EITHER BLANK OR ZERO
      F*                   THROUGHOUT THE FILE ARE NOTED.
      f*                   note: binary and date or time type fields are
      f*                   indicated as not used.
      FDATA      IF   F 2400        DISK    usropn
      F                                     INFDS(FINFO)
      FCPUFREFP  IF   E             DISK    usropn
      FQSYSPRT   O    F  132        PRINTER OFLIND(*INOF)
      d sysstamp        s               z   inz(*sys)
      d cmdlength       s             15  5 inz(80)
      d command         s             80
      d library         s             10
      d file            s             10
      D USE             S              7  0 DIM(250)
      D SP              S              5  0 DIM(250)
      D FL              S              5  0 DIM(250)
      D FT              S              1    DIM(250)
      D RCD             S              1    DIM(2400)
      D E               S              1    DIM(16) CTDATA PERRCD(16)
      D FINFO           DS
      D  FNAME                 83     92
      D  LNAME                 93    102
      D  MNAME                129    138
      D  RECLEN               125    126B 0
      D  NORIFL               156    159B 0
      D PGMSTS         SDS
      D  USER                 254    263
      IDATA      NS
      I                                  1 2400  RCD
      c                   dou       %eof(data)
      c                   read      data
      c                   if        not %eof(data)
      C                   ADD       1             RC                7 0
      C                   DO        F3            X                 3 0
      C     SP(X)         ADD       FL(X)         EP                5 0
      C                   SUB       1             EP
      C                   Z-ADD     SP(X)         BP                5 0
      C     BP            DO        EP            Y                 5 0
      C                   SELECT
 0055 C     FT(X)         WHENEQ    'A'
      C     RCD(Y)        ANDNE     ' '
      C                   ADD       1             USE(X)
      C                   Z-ADD     EP            Y
 0055 C     FT(X)         WHENEQ    'S'
      C     RCD(Y)        ANDNE     '0'
      C                   ADD       1             USE(X)
      C                   Z-ADD     EP            Y
 0055 C     FT(X)         WHENEQ    'P'
 0109 C                   EXSR      UNPACK
      C     Y             IFNE      EP
      C     E(TOP)        IFNE      '0'
      C     E(BTM)        ORNE      '0'
      C                   ADD       1             USE(X)
      C                   Z-ADD     EP            Y

 0067 C                   ENDIF
 0066 C                   ELSE
      C     E(TOP)        IFNE      '0'
      C                   ADD       1             USE(X)
      C                   Z-ADD     EP            Y
 0073 C                   endif
 0066 C                   endif
 0055 C                   ENDSL
 0054 C                   ENDDO
 0049 C                   ENDDO
      c                   endif
 0049 C                   ENDDO
 0085 C                   EXSR      LRTIME
      C     TLOUF         MULT      RC            BYTES             9 0
      C                   EXCEPT    TOTAL
      c                   eval      *inlr = *on
      c**  LR  *******************************************************
      C     LRTIME        BEGSR
      C                   Z-ADD     0             F3
      C     1             SETLL     CPUFREFP                           25
      C     *IN23         DOUEQ     *on
      C     F3            OREQ      250
      C                   READ      CPUFREFP                               23
      C     *IN23         IFEQ      *off
      C                   ADD       1             F3                3 0
      C     F3            IFEQ      1
      C                   EXCEPT    HEADNG
 0093 C                   END
      C     USE(F3)       IFEQ      0
      C                   eval      *in24 = *on
      C                   ADD       1             UUF               5 0
      C                   ADD       WHFLDB        TLOUF             7 0
 0096 C                   ELSE
      C                   eval      *in24 = *off
 0096 C                   END
      C                   EXCEPT    DETAIL
      C   OF              EXCEPT    HEADNG
 0091 C                   END
 0088 C                   END
 0085 C                   ENDSR
      C* UNPACK SUBROUTINE**********************************************
      C     UNPACK        BEGSR
      C*   CHARCHTER TO HEX CONVERSION ROUTINE
      C                   MOVE      RCD(Y)        CHAR              1
      C                   TESTB     '0'           CHAR                     20
      C                   TESTB     '1'           CHAR                     21
      C                   TESTB     '2'           CHAR                     22
      C                   TESTB     '3'           CHAR                     23
      C                   TESTB     '4'           CHAR                     24
      C                   TESTB     '5'           CHAR                     25
      C                   TESTB     '6'           CHAR                     26
      C                   TESTB     '7'           CHAR                     27
      C                   Z-ADD     0             HEX               3 0
      C   20              ADD       128           HEX
      C   21              ADD       64            HEX
      C   22              ADD       32            HEX
      C   23              ADD       16            HEX
      C   24              ADD       8             HEX
      C   25              ADD       4             HEX
      C   26              ADD       2             HEX
      C   27              ADD       1             HEX
      C     HEX           DIV       16            TOP               2 0
      C                   MVR                     BTM               2 0
      C                   ADD       1             TOP
      C                   ADD       1             BTM
 0109 C                   ENDSR

      C* Initialization **********************************************
      c* DSPFFD     FILE(&LIB/&FILE) OUTPUT(*OUTFILE)
      c*              OUTFILE(QTEMP/CPUFREFP)
      c* OVRDBF     FILE(DATA) TOFILE(&LIB/&FILE)
      C     *inzsr        BEGSR
      c     *entry        plist
      c                   parm                    library
      c                   parm                    file
      c                   eval      command = 'DSPFFD FILE(' +
      c                             %trim(library) + '/' + %trim(file) +
      c                             ') OUTPUT(*OUTFILE) OUTFILE(' +
      c                             'QTEMP/CPUFREFP)'
      c                   call      'QCMDEXC'
      c                   parm                    command
      c                   parm                    cmdlength
      c                   open      cpufrefp
      C                   TIME                    TOD               6 0
      C                   DOU       %eof(cpufrefp) or
      C                             f3 = 250
      C                   READ      CPUFREFP
      C                   IF        not %eof(cpufrefp)
      C                   ADD       1             F3                3 0
      C                   MOVE      WHFLDT        FT(F3)
      C                   Z-ADD     WHFOBO        SP(F3)
      C                   MOVE      WHFLDB        FL(F3)
 0040 C                   END
 0037 C                   ENDDO
      c                   eval      command = 'OVRDBF FILE(DATA) ' +
      c                             'TOFILE(' + %trim(library) +
      c                             '/' + %trim(file) + ')'
      c                   call      'QCMDEXC'
      c                   parm                    command
      c                   parm                    cmdlength
      c                   open      data
 0109 C                   ENDSR
      OQSYSPRT   E            HEADNG         1 01
      O                                            7 'CPUR670'
      O                                           58 'FIELD USAGE BY FILE     '
      O                       UDATE         Y    110
      O                                          120 'PAGE'
      O                       PAGE          Z    125
      O          E            HEADNG         2
      O                       USER                10
      O                       TOD                110 '  :  :  '
      O                       WHFILE              31
      O                       WHNAME              42
      O                       WHLIB               53
      O                       WHRLEN        Z     63
      O          E            DETAIL         1
      O                       WHFLDI              11
      O               24                          20 'NOT USED'
      O              N24      USE(F3)       Z     20
      O                       WHFOBO        Z     30
      O                       WHFLDB        Z     36
      O                       WHFLDT              40
      O                       WHCHD1              62
      O                       WHFTXT             115
      O          E            TOTAL       1  1
      O                                           11 'TOTAL RCDS'
      O                                           30 'FIELDS AVAIL'
      O                                           45 'FIELDS NOT USED'
      O                                           70 'RECORD LENGTH IN BYTES'
      O                                           95 'BYTES NOT USED/RECORD'
      O                                          120 'TOTAL FILE BYTES UNUSED'
      O          E            TOTAL          1
      O                       RC            Z     11

      O                       WHFLDN        Z     27
      O                       UUF           Z     40
      O                       WHRLEN        Z     63
      O                       TLOUF         Z     90
      O                       BYTES         Z    115
 **    -E- ARRAY   USED TO TEST PACKED FIELDS
 0123456789ABCDEF
 

Dig deeper on iSeries system performance and monitoring

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close