Tip

Print file descriptions revisited

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

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:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.