Article

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
 

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

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: