• The Four Hundred
  • Subscribe
  • Media Kit
  • Contributors
  • About Us
  • Contact
Menu
  • The Four Hundred
  • Subscribe
  • Media Kit
  • Contributors
  • About Us
  • Contact
  • 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.

    Share this:

    • Reddit
    • Facebook
    • LinkedIn
    • Twitter
    • Email

    Tags: Tags: mgo_rc, Volume 2, Number 47 -- June 19, 2002

    Sponsored by
    Raz-Lee Security

    iSecurity Multi Factor Authentication (MFA) helps organizations meet compliance standards and improve the existing security environment on IBM i. It requires a user to verify his identity with two or more credentials.

    Key Features:

    • iSecurity provides Multi Factor Authentication as part of the user’s initial program
    • Works with every Authenticator App available in the Market.

    Contact us at https://www.razlee.com/isecurity-multi-factor-authentication/

    Share this:

    • Reddit
    • Facebook
    • LinkedIn
    • Twitter
    • Email

    Searching Message Text RPG II

    Leave a Reply Cancel reply

MGO Volume: 2 Issue: 47

This Issue Sponsored By

    Table of Contents

    • String Parameters of Various Lengths
    • Tracing a Qshell Variable
    • LAYOUT: An Improved DSPFFD

    Content archive

    • The Four Hundred
    • Four Hundred Stuff
    • Four Hundred Guru

    Recent Posts

    • IBM i Has a Future ‘If Kept Up To Date,’ IDC Says
    • When You Need Us, We Are Ready To Do Grunt Work
    • Generative AI: Coming to an ERP Near You
    • Four Hundred Monitor, March 22
    • IBM i PTF Guide, Volume 25, Number 12
    • Unattended IBM i Operations Continue Upward Climb
    • VS Code Is The Full Stack IDE For IBM i
    • Domino Runs on IBM i 7.5, But HCL Still Working on Power10
    • Four Hundred Monitor, March 6
    • IBM i PTF Guide, Volume 25, Number 11

    Subscribe

    To get news from IT Jungle sent to your inbox every week, subscribe to our newsletter.

    Pages

    • About Us
    • Contact
    • Contributors
    • Four Hundred Monitor
    • IBM i PTF Guide
    • Media Kit
    • Subscribe

    Search

    Copyright © 2023 IT Jungle