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