• 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
    DRV Tech

    Get More Out of Your IBM i

    With soaring costs, operational data is more critical than ever. IBM shops need faster, easier ways to distribute IBM applications-based data to users more efficiently, no matter where they are.

    The Problem:

    For Users, IBM Data Can Be Difficult to Get To

    IBM Applications generate reports as spooled files, originally designed to be printed. Often those reports are packed together with so much data it makes them difficult to read. Add to that hardcopy is a pain to distribute. User-friendly formats like Excel and PDF are better, offering sorting, searching, and easy portability but getting IBM reports into these formats can be tricky without the right tools.

    The Solution:

    IBM i Reports can easily be converted to easy to read and share formats like Excel and PDF and Delivered by Email

    Converting IBM i, iSeries, and AS400 reports into Excel and PDF is now a lot easier with SpoolFlex software by DRV Tech.  If you or your users are still doing this manually, think how much time is wasted dragging and reformatting to make a report readable. How much time would be saved if they were automatically formatted correctly and delivered to one or multiple recipients.

    SpoolFlex converts spooled files to Excel and PDF, automatically emailing them, and saving copies to network shared folders. SpoolFlex converts complex reports to Excel, removing unwanted headers, splitting large reports out for individual recipients, and delivering to users whether they are at the office or working from home.

    Watch our 2-minute video and see DRV’s powerful SpoolFlex software can solve your file conversion challenges.

    Watch Video

    DRV Tech

    www.drvtech.com

    866.378.3366

    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

    • Meet The Next Gen Of IBMers Helping To Build IBM i
    • Looks Like IBM Is Building A Linux-Like PASE For IBM i After All
    • Will Independent IBM i Clouds Survive PowerVS?
    • Now, IBM Is Jacking Up Hardware Maintenance Prices
    • IBM i PTF Guide, Volume 27, Number 24
    • Big Blue Raises IBM i License Transfer Fees, Other Prices
    • Keep The IBM i Youth Movement Going With More Training, Better Tools
    • Remain Begins Migrating DevOps Tools To VS Code
    • IBM Readies LTO-10 Tape Drives And Libraries
    • IBM i PTF Guide, Volume 27, Number 23

    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 © 2025 IT Jungle