A command, CL program and RPGLE program combined to print a more readable layout for file descriptions, including key information when present. My tip is similar to a previous tip to print file descriptions. But I like the output from this one a little better. My program gets the key description(s) for keyed files, computes the end positions and prints a text description of the file.
Command Prtfd: Print File Description.
/* ************************************************************* */
/* PRTFD PRINT AN EXTERNAL FILE DESCRIPITON LIST */
/* ************************************************************* */
CMD PROMPT('Print File Field Description')
PARM KWD(FIL) TYPE(Q1) MIN(1) PROMPT('File Name')
Q1: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB *CURLIB)) +
PROMPT('Library')
Cl Program Prtfdclp
PGM PARM(&FNAME)
DCL VAR(&FNAME) TYPE(*CHAR) LEN(20)
DCL VAR(&FNAMENM) TYPE(*CHAR) LEN(10)
DCL VAR(&FNAMELB) TYPE(*CHAR) LEN(10)
DCL VAR(&SWS) TYPE(*CHAR) LEN(8)
CHGVAR VAR(&FNAMENM) VALUE(%SST(&FNAME 1 10))
CHGVAR VAR(&FNAMELB) VALUE(%SST(&FNAME 11 10))
/* GET FILE FIELD INFORMATION */
DSPFFD FILE(&FNAMELB/&FNAMENM) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/FILEDESC)
/* GET ACCESS PATH INFO, KEY INFORMATION */
DSPFD FILE(&FNAMELB/&FNAMENM) TYPE(*ACCPTH) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/FILEDES1)
/* GET ACCESS PATH INFO, KEY INFORMATION */
DSPFD FILE(&FNAMELB/&FNAMENM) TYPE(*BASATR) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/FILEDES2)
CALL PGM(PRTFDRPG)
RETURN
ENDPGM
RPG400 program:
H
F*****************************************************************
FFILEDESC IF E DISK
FFILEDES1 IF E DISK USROPN
FFILEDES2 IF E DISK USROPN
FLIST O F 132 PRINTER OFLIND(*INOF)
D DS
D first 1 1N
D*
*
*
* get text description for fil
C OPEN FILEDES2
C READ FILEDES2 46 *EOF?
*
C *IN47 DOWEQ '0'
C READ FILEDESC 47 *EOF?
c *IN47 IFEQ *OFF
* check for first heading output
c IF not First
C MOVE '1' *IN04
C EXCEPT HEAD
C MOVE '0' *IN04
c move *on First
C ENDIF
*
* Compute end position
C WHIBO ADD WHFLDB WKEND 5 0
C SUB 1 WKEND
*
C EXCEPT DETAIL
C ENDIF
*
C ENDDO DOW 47 EQ 0
* give total for fields
C EXCEPT FLDEND
*
* now get key information if keyed file
C OPEN FILEDES1
C *IN48 DOWEQ '0'
C READ FILEDES1 48 *EOF?
c *IN48 IFEQ *OFF
*
C *IN49 IFEQ '0'
C EXCEPT KEYHED
C MOVE '1' *IN49
C ENDIF
*
C EXCEPT KEYINF
C READ FILEDES1 48 *EOF?
C ENDIF
*
C ENDDO DOW 48 EQ 0
*
c CLOSE FILEDES2
C CLOSE FILEDES1
*
C END TAG
C MOVE '1' *INLR
C RETURN
CSR *inzsr begsr
C TIME TIME 6 0
c endsr
C*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
C*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
OLIST E 04 HEAD 1 01
O OR OF
O 08 'SYR010'
O 69 'FILE FIELD DESCRIPTIONS'
O UDATE Y 94
O TIME 103 ' : : '
O 124 'PAGE'
O PAGE 129
O E 04 HEAD 2
O OR OF
O 13 'SYSTEM NAME:'
O APSYSN 23
O E 04 HEAD 1
O OR OF
O 10 'LIBRARY:'
O WHLIB 22
O 28 'FILE:'
O WHFILE 40
O 46 'TYPE:'
O WHFTYP 48
O 55 'DESC:'
O ATTXT 106
*
O E 04 HEAD 2 1
O OR OF
O 05 'FIELD'
O 17 'FROM'
O 25 'TO'
O 35 'LENGTH'
O 40 'DEC'
O 47 'TYPE'
O 69 'DESCRIPTION'
O E 04 HEAD 2
O OR OF
O 24 '------------------------'
O 48 '------------------------'
O 72 '------------------------'
O 96 '------------------------'
O EF DETAIL 1
O WHFLDE 10
O WHIBO 4 17
O WKEND 4 25
O WHFLDB 4 35
O WHFLDP 4 40
O WHFLDT 45
O WHFTXT + 10
O EF FLDEND 2
O 30 'TOTAL RECORD LENGTH:'
O WHRLEN 4 35
O EF KEYHED 2
O 21 'KEY FIELD INFORMATION'
O EF KEYHED 1 1
O 5 'FIELD'
O 24 'A/D SIGN ZD'
O E KEYHED 2
O 24 '------------------------'
O 48 '------------------------'
O 72 '------------------------'
O 96 '------------------------'
O EF KEYINF 1
O APKEYF 10
O APKSEQ + 2
O APKSIN + 5
O APKZD + 4
_
Note: You will have to run the dspfd and dspffd commands in order for the compile of the RPGLE program to work. These commands will put the files in Qtemp to use as external file descriptions.
This was first published in July 2002