LAYOUT: An Improved DSPFFD

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:                                               *
      *      CRTPRTF    FILE(XXX/LAYOUTP) SRCFILE(XXX/QDDSSRC)    *
      *                                                           *
      *************************************************************
     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.