LAYOUT: An Improved DSPFFD

June 19, 2002 Timothy Prickett Morgan

Note: The code accompanying this article is available for download here.

The article was revised on 12/22/14.

Dear Readers:

Tim Swearingen recently sent me a copy of his LAYOUT utility. It shows records layouts, as does the Display File Field Description (DSPFFD) command, but in a nicer format, and it also includes access path information. I liked it and thought some of you might find it helpful too.

The utility consists of four objects:

a command object called LAYOUT

a printer file called LAYOUTP

a CL program called LAYOUTC

an RPG III (RPG/400) program called LAYOUTR

Place the source code in the source physical file members of your choice and create them using the instructions in the comments. I suggest you create them in the order I’ve listed them.

Command LAYOUT:

/*************************************************************/
 /* To compile:                                               */
 /*     CRTCMD     CMD(XXX/LAYOUT) PGM(XXX/LAYOUTC) +         */
 /*                  SRCFILE(QCMDSRC)                         */
 /*                                                           */
 /*************************************************************/

        CMD        PROMPT('Print File Field Descriptions')
        PARM       KWD(FILE) TYPE(ELEM1) MIN(1) +
                     PROMPT('Data File')
        PARM       KWD(OUTPUT) TYPE(*CHAR) LEN(10) DFT(*DFT) +
                     CHOICE('*DFT, *DSP, Printer name') +
                     PROMPT('Output type')


 ELEM1: ELEM       TYPE(NAME1) PROMPT('File')

 NAME1: QUAL       TYPE(*GENERIC) LEN(10)
        QUAL       TYPE(*CHAR) LEN(10) DFT(*LIBL) +
                          PROMPT('Library')

Printer file LAYOUTP:

     /*************************************************************/
     /* To compile:                                               */
     /*      CRTPRTF    FILE(XXX/LAYOUTP) SRCFILE(XXX/QDDSSRC)    */
     /*                                                           */
     /*************************************************************/

     A          R PAGHDR
     A                                     6
     A                                      'Date:'
     A                                      SKIPB(004)
     A                                    +1
     A                                      DATE(*SYS *YY)
     A                                      EDTCDE(Y)
     A                                    38
     A                                      'File Field Layout Report'
     A                                      SPACEB(003)
     A                                    12
     A                                      'File:'
     A                                      SPACEB(002)
     A            LIBFIL        21A  O    +3
     A                                      HIGHLIGHT
     A                                    10
     A                                      'Format:'
     A                                      SPACEB(001)
     A            WHNAME        10A  O    20
     A                                     5
     A                                      'Description:'
     A                                      SPACEB(001)
     A            MLMTXT        50A  O    +3
     A                                     5
     A                                      'Field'
     A                                      SPACEB(002)
     A                                    +9
     A                                      'From'
     A                                    +6
     A                                      'To'
     A                                    +2
     A                                      'Length'
     A                                    +1
     A                                      'Dec'
     A                                    +3
     A                                      'Type'
     A                                    +3
     A                                      'Description'
     A          R DTL1
     A                                      SPACEB(001)
     A            WHFLDE        10A  O     5
     A            WHIBO          5S 0O    +2
     A                                      EDTCDE(1)
     A            TOFLD          5S 0O    +2
     A                                      EDTCDE(1)
     A            WHFLDB         5S 0O    +2
     A                                      EDTCDE(1)
     A  51        WHFLDP         2S 0O    +2
     A                                      EDTCDE(1)
     A            WHFLDT         1A  O    +5
     A            WHFTXT        50A  O    +4
     A          R DTL2
     A                                      SPACEB(002)
     A            RLEN           5S 0O    33
     A                                      EDTCDE(1)
     A                                    +3
     A                                      'Format Length'
     A          R KEY1
     A                                      SPACEB(003)
     A            FLD002        92A  O     5
     A                                      UNDERLINE
     A                                    10
     A                                      'File Key Information'
     A                                      SPACEB(001)
     A  94                                +2
     A                                      '- This File is Non-Keyed.'
     A N94                                10
     A                                      'Physical File:'
     A                                      SPACEB(002)
     A N94        KEYFIL        21A  O    +2
     A N94                                54
     A                                      'Format:'
     A N94        KEYFMT        10A  O    63
     A N94                                13
     A                                      'Key Field Name'
     A                                      SPACEB(002)
     A N94                                +5
     A                                      'Asc/Dsc'
     A          R KEY2
     A                                      SPACEB(001)
     A            APKEYF        10A  O    13
     A            APKSEQ         1A  O   +12
     A          R PAGFTR
     A                                      SKIPB(059)
     A                                    44
     A                                      'Page:'
     A                                      SPACEB(001)
     A                                    +1
     A                                      PAGNBR
     A                                      EDTCDE(2)

CL program LAYOUTC:

/*************************************************************/
 /* To compile:                                               */
 /*          CRTCLPGM   PGM(XXX/LAYOUTC) SRCFILE(QCLSRC)      */
 /*                                                           */
 /*************************************************************/

PGM        PARM(&FILNAM &OUTPUT)

   DCL        VAR(&FILNAM) TYPE(*CHAR) LEN(22)
   DCL        VAR(&FILE)     TYPE(*CHAR) LEN(10)
   DCL        VAR(&LIBR)     TYPE(*CHAR) LEN(10)
   DCL        VAR(&OUTPUT)   TYPE(*CHAR) LEN(10)
   DCL        VAR(&TEXT)     TYPE(*CHAR) LEN(200)
   DCL        VAR(&MSGID)    TYPE(*CHAR) LEN(07)

   MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

   CHGVAR     VAR(&FILE)    VALUE(%SST(&FILNAM  3 10))
   CHGVAR     VAR(&LIBR)    VALUE(%SST(&FILNAM 13 10))

   DSPFFD     FILE(&LIBR/&FILE) OUTPUT(*OUTFILE) +
                OUTFILE(QTEMP/QADSPFFD)
   MONMSG     MSGID(CPF3012) EXEC(DO)
   SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('File ' +
                *CAT &FILE *TCAT ' in library ' *CAT +
                &LIBR *TCAT ' not found.') MSGTYPE(*ESCAPE)
     GOTO       CMDLBL(EXIT)
   ENDDO
   MONMSG     MSGID(CPF3064) EXEC(DO)
   SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Library +
                ' *CAT &LIBR *TCAT ' not found.') +
                MSGTYPE(*ESCAPE)
     GOTO       CMDLBL(EXIT)
   ENDDO
   DSPFD      FILE(&LIBR/&FILE) TYPE(*ACCPTH) +
                OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDACCP)

   DSPFD      FILE(&LIBR/&FILE) TYPE(*MBRLIST) +
                OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDMBRL)

   OVRDBF     FILE(QADSPFFD) TOFILE(QTEMP/QADSPFFD)
   OVRDBF     FILE(QAFDACCP) TOFILE(QTEMP/QAFDACCP)
   OVRDBF     FILE(QAFDMBRL) TOFILE(QTEMP/QAFDMBRL)

   IF         COND(&OUTPUT *NE '*DFT' *AND &OUTPUT *NE +
                '*DSP') THEN(DO)
   OVRPRTF    FILE(LAYOUTP) PAGESIZE(66 102) LPI(6) +
                CPI(12) OVRFLW(55) PAGRTT(0) +
                OUTQ(&OUTPUT) USRDTA(&FILE) 
                
   WRKWTR     WTR(&OUTPUT) OUTPUT(*PRINT)
   MONMSG     MSGID(CPF0000) EXEC(   +
   SNDPGMMSG  MSG('Printer: ' *CAT &OUTPUT *TCAT ' is not +
                on the system. Output was sent to Que: +
                QPRINT'))
   DLTSPLF    FILE(QPRTRDWT) SPLNBR(*LAST)
   MONMSG     MSGID(CPF0000)
   ENDDO
   ELSE DO
   OVRPRTF    FILE(LAYOUTP) PAGESIZE(66 102) LPI(6) +
                CPI(12) OVRFLW(55) PAGRTT(0) USRDTA(&FILE)
   ENDDO

   CALL       PGM(LAYOUTR)

   IF         COND(&OUTPUT *EQ '*DSP') THEN(DO)
     DSPSPLF    FILE(LAYOUTP) SPLNBR(*LAST)
   ENDDO
EXIT:
   DLTOVR     FILE(*ALL)
   RETURN
ERROR:
   SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) +
                MSGDTA('Unexpected error in LAYOUT.') +
                MSGTYPE(*ESCAPE)
   MONMSG     MSGID(CPF0000)
   RETURN
ENDPGM

RPG program LAYOUTR:

*************************************************************
* To compile:                                               *
*      CRTRPGPGM  PGM(XXX/LAYOUTR)                          *
*                 SRCFILE(XXX/QRPGSRC)                      *
*                 SRCMBR(LAYOUTR)                           *
*                                                           *
*************************************************************
     FQADSPFFDIF  E                    DISK
     FQAFDACCPIF  E                    DISK
     FQAFDMBRLIF  E                    DISK
     FLAYOUTP O   E                    PRINTER
     F**
      *************************************************************
      *                  MAIN                                            *
      *************************************************************
      *
     C           *IN90     DOWEQ*OFF
      *  Calcs "TO" field
     C                     Z-ADDWHFLDB    TOFLD
     C                     ADD  WHIBO     TOFLD
     C                     SUB  1         TOFLD
     C           WHFLDD    IFGT 0
     C                     Z-ADDWHFLDD    WHFLDB
     C                     ENDIF
     C           WHFLDT    IFEQ 'A'
     C                     MOVE *OFF      *IN51
     C                     ELSE
     C                     MOVE *ON       *IN51
     C                     ENDIF
      *
     C                     WRITEDTL1                   91
      *
     C           *IN91     IFEQ *ON
     C                     EXSR NEWPAG
     C                     ENDIF
      *
     C                     READ QADSPFFD                 90
      *  With multi formatted files outputs to a new page
     C           WHNAME    IFNE FMTNAM
     C                     WRITEDTL2                   91
     C                     EXSR KEYHDR
     C                     EXSR KEYDTL
     C                     EXSR NEWPAG
     C                     CLEARFMTNAM
     C                     MOVELWHNAME    FMTNAM
     C                     Z-ADDWHRLEN    RLEN
     C                     ENDIF
      *
     C                     ENDDO
      *  Outputs "KEY" information
     C                     SETOF                     50
     C                     WRITEDTL2                   91
     C           *IN91     IFEQ *ON
     C                     EXSR NEWPAG
     C                     ENDIF
      *
     C                     EXSR KEYHDR
     C                     EXSR KEYDTL
      *
     C                     WRITEPAGFTR                 93
      *
     C                     SETON                     LR
      *************************************************************
      *                  NEW PAGE                                        *
      *************************************************************
     C           NEWPAG    BEGSR
     C                     WRITEPAGFTR                 93
     C           *IN95     IFEQ *OFF
     C                     WRITEPAGHDR
     C                     ENDIF
     C                     SETOF                       95
     C                     ENDSR
      *************************************************************
      *                  KEY HEADER SUBROUTINE                           *
      *************************************************************
     C           KEYHDR    BEGSR
     C                     READ QAFDACCP                 94
     C           APNKYF    IFEQ 0
     C                     SETON                     94
     C                     ENDIF
      *
     C                     CLEARKEYFIL
     C                     MOVELAPBOLF    KEYFMT
     C                     MOVELAPBOL     KEYFIL
     C           KEYFIL    CAT  '/':0     KEYFIL
     C           KEYFIL    CAT  APBOF:0   KEYFIL
     C                     WRITEKEY1                   91
     C           *IN91     IFEQ *ON
     C                     EXSR NEWPAG
     C                     ENDIF
      *
     C                     ENDSR
      *************************************************************
      *                  KEY DETAIL SUBROUTINE                           *
      *************************************************************
     C           KEYDTL    BEGSR
      *
     C                     Z-ADD1         COUNT
      *
     C           *IN94     DOWEQ*OFF
      *
     C                     WRITEKEY2                   91
     C           *IN91     IFEQ *ON
     C                     EXSR NEWPAG
     C                     ENDIF
      *
     C           COUNT     IFGE APNKYF
     C                     SETON                     94
     C                     ELSE
     C                     READ QAFDACCP                 94
     C                     ADD  1         COUNT
     C                     ENDIF
      *
     C                     ENDDO
      *
     C                     ENDSR
      *************************************************************
      *                  INITIAL SUBROUTINE                              *
      *************************************************************
     C           *INZSR    BEGSR
      *
     C                     READ QAFDMBRL                 90
      *
     C                     READ QADSPFFD                 90
     C                     CLEARLIBFIL
     C                     MOVELWHLIB     LIBFIL
     C           LIBFIL    CAT  '/':0     LIBFIL
     C           LIBFIL    CAT  WHFILE:0  LIBFIL
     C                     SETON                     50
     C                     WRITEPAGHDR
     C                     Z-ADD0         COUNT   50
     C                     MOVELWHNAME    FMTNAM 10
     C                     Z-ADDWHRLEN    RLEN
     C                     ENDSR

— Ted

Sponsored By TRAMENCO

Introducing a New Source for Training and Mentoring. Follow this link to a vital new source for how-to technical information: www.tramenco.com. Unlike companies that offer training as an afterthought, The Training and Mentoring Company (Tramenco) is dedicated to just one thing: Advancing your career by giving you the skills you need to solve real-world business problems. You get the best information from the world’s leading experts–Howard Arner, Kelly Conklin, Don Denoncourt, Susan Gantner, Skip Marchesani, Glen Marchesani, Shannon O’Donnell, Craig Pelke, and Richard Shaler. Choose from a menu of training options to fit your needs: onsite seminars, public seminars, mentoring, consulting, books, CBTs, and Web-based training. And make plans to attend the 2002 iSeries Connection Conference, the multi-day, multi-track conference that was the only sold-out iSeries training event this year, co-sponsored by the Education Connection and Tramenco. For more information about Tramenco’s career enhancing opportunities, call (800) 421-8031 or go to www.tramenco.com.