AS/400 Code Samples - AS/400 - FIELDS- GSS Print or Display File Layouts
Author: George Pearson
Company: Green Springs Software, Inc. www.green-springs.com
Purpose: Programmers Utility to Print or Display File Layouts
Uses ASC's Sequel Product
Components: FIELDS CMD
FIELDSC CL Program
FIELDSR RPG Program
Parameters: FILE Enter Qualified or Unqualified File Name or Generic name. Default Library is *ALL
LOGICALS Include Logical FIles, *Yes/*No
REFINFO Include Reference Info (The was for a COBOL installation that utilizes Long Names
OUTPUT "*" = Display on terminal, "*PRINT" will print a report
Written: 1995 ?
/*˜*************************************************************************/
/* */
/* ‚ Green Springs Software, Inc. Ashland, OR */
/* */
/*˜*************************************************************************/
/* */
/* COMMAND ID - FIELDS */
/* DISPLAY FILE - None */
/* DESCRIPTION - GSS File Layout (Print or Display) */
/* WRITTEN BY - George Pearson, Green Springs Software, Inc. */
/* DATE CREATED - 9/28/1997 */
/* PURPOSE - Display or Print File Layouts */
/* */
/* NOTES - Executes FIELDSC CPP. */
/* Uses IBM Command Outfiles from DSPFD and DSPFFD */
/* Requires a LF to be built over a copy of IBM's */
/* outfile created by DSPFFD Command. */
/* */
/*˜*************************************************************************/
/* */
/* (c) MMIII Green Springs Software, Inc. */
/* POB 3336, Ashland, OR 97520 */
/* (541) 488-2560 george@green-springs.com */
/* www.green-springs.com */
/* */
/*˜*************************************************************************/
CMD PROMPT('GSS Print File Layouts')
PARM KWD(FILE) TYPE(QUAL1) MIN(1) MAX(1) +
PROMPT('Files to print:' 1)
PARM KWD(LOGICALS) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) MAX(1) +
PROMPT('Include Logicals?' 2)
PARM KWD(REFINFO) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) MAX(1) +
PROMPT('Include ALIAS Info?' 3)
PARM KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) +
DFT(*) VALUES(* *PRINT) MAX(1) +
PROMPT('Output: * or *Print' 4)
QUAL1: QUAL TYPE(*GENERIC) LEN(10) SPCVAL((*ALL)) MIN(1) +
EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('In Library:')
/*˜******* End of FIELDS Command *****************************************/
/*˜*************************************************************************/
/* */
/* ‚ Green Springs Software, Inc. Ashland, OR */
/* */
/*˜*************************************************************************/
/* */
/* PROGRAM ID - FIELDSC AS/400 VERSION */
/* DISPLAY FILE NAME - *None */
/* CREATED BY - George Pearson */
/* DATE CREATED - 6/19/89 */
/* */
/* PURPOSE - Display File Format Layouts from Object */
/* Descriptions. */
/* */
/* NOTES - Executed by FIELDS Command. */
/* */
/* (c) MMIII Green Springs Software, Inc. */
/* POB 3336, Ashland, OR 97520 */
/* (541) 488-2560 george@green-springs.com */
/* */
/*˜*************************************************************************/
PGM PARM(&FILLIB &INCLF &YESNO &OUTPUT)
DCL &FILLIB *CHAR LEN(20)
DCL &FILE *CHAR LEN(10)
DCL &GENERIC *CHAR LEN(01)
DCL &INCLF *CHAR LEN(04)
DCL &LIB *CHAR LEN(10)
DCL &MSG *CHAR LEN(80)
DCL &N *DEC LEN(3 0)
DCL &OUTPUT *CHAR LEN(06)
DCL &TYPE *CHAR LEN(01)
DCL &YESNO *CHAR LEN(04)
RTVJOBA TYPE(&TYPE)
IF COND(&TYPE = '0') THEN(DO)
CHGVAR VAR(&OUTPUT) VALUE(*PRINT)
ENDDO
DLTF FILE(QTEMP/QAFDACCP)
MONMSG MSGID(CPF0000)
OVRPRTF FILE(QPRINT) TOFILE(QPRINT) OUTQ(*JOB)
OVRPRTF FILE(QPRINT2) TOFILE(QPRINT) OUTQ(*JOB)
CHGVAR VAR(&FILE) VALUE(%SST(&FILLIB 1 10))
CHGVAR VAR(&LIB) VALUE(%SST(&FILLIB 11 10))
IF COND(&INCLF = *YES) THEN(GOTO SCAN_DONE)
SCAN: CHGVAR VAR(&N) VALUE(&N + 1)
IF COND(&N = 11) THEN(DO)
CHGVAR VAR(&INCLF) VALUE(*YES)
GOTO CMDLBL(SCAN_DONE)
ENDDO
IF COND(%SST(&FILE &N 1) = '*') THEN(DO)
GOTO CMDLBL(SCAN_DONE)
ENDDO
GOTO CMDLBL(SCAN)
SCAN_DONE: DSPFD FILE(&LIB/&FILE) TYPE(*ACCPTH) +
OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDACCP) +
FILEATR(*PF *LF)
MONMSG MSGID(CPF3064) EXEC(DO)
RCVMSG RMV(*NO) MSG(&MSG)
SNDPGMMSG MSGID(CPF3064) MSGF(QCPFMSG) +
MSGDTA(&LIB)
GOTO CMDLBL(ENDPGM)
ENDDO
MONMSG MSGID(CPF3012) EXEC(DO)
RCVMSG RMV(*NO) MSG(&MSG)
SNDPGMMSG MSGID(CPF3012) MSGF(QCPFMSG) +
MSGDTA(&FILE *CAT &LIB)
GOTO CMDLBL(ENDPGM)
ENDDO
MONMSG MSGID(CPF2105) EXEC(DO)
RCVMSG RMV(*NO) MSG(&MSG)
SNDPGMMSG MSGID(CPF2105) MSGF(QCPFMSG) +
MSGDTA(&FILE *CAT &LIB *CAT 'FILE')
GOTO CMDLBL(ENDPGM)
ENDDO
DSPFFD FILE(&LIB/&FILE) OUTPUT(*OUTFILE) +
OUTFILE(DSPFFDP)
/****** DSPDBR FILE(&LIB/&FILE) OUTPUT(*OUTFILE) OUTFILE(DSPDBRP) **/
IF COND(&INCLF = '*YES') THEN(OVRDBF +
FILE(DSPFFDL) TOFILE(DSPFFDP))
IF COND(&OUTPUT = '*PRINT') THEN(DO)
OVRPRTF FILE(QPRINT) PAGRTT(0)
ENDDO
OVRDBF FILE(QAFDACCP) TOFILE(QTEMP/QAFDACCP)
/* šRun the RPG Print Program */
/* ‚------------------------- */
CALL_PGM: CALL PGM(FIELDSR) PARM(&YESNO &LIB)
IF COND(&OUTPUT = '* ') THEN(DO)
DSPSPLF FILE(QPRINT) SPLNBR(*LAST)
MONMSG MSGID(CPF3309) EXEC(SNDPGMMSG MSG('No file +
layout to display.'))
DLTSPLF FILE(QPRINT) SPLNBR(*LAST)
MONMSG MSGID(CPF0000)
DLTSPLF FILE(QPRINT2) SPLNBR(*LAST)
MONMSG MSGID(CPF0000)
ENDDO
IF COND(&OUTPUT = '*PRINT') THEN(DO)
DLTOVR FILE(QPRINT)
ENDDO
IF COND(&INCLF = '*YES') THEN(DLTOVR +
FILE(DSPFFDL))
CLRPFM FILE(DSPFFDP)
DLTOVR FILE(QAFDACCP)
ENDPGM: ENDPGM
/*˜***** End Of FIELDSC Program ******************************************/
*˜*********************************************************************
*
* GREEN SPRINGS SOFTWARE, INC. ASHLAND, OR
*
*˜*********************************************************************
* PROGRAM ID - FIELDSR AS/400 VERSION
* DISPLAY FILE - *None
* DESCRIPTION - PRINTS FILE LAYOUTS
* WRITTEN BY - George Pearson, Green Springs Software, Inc.
* DATE CREATED - 1/14/87
* PURPOSE - Prints File Record Layouts On Demand
*
* (C) 1989 Green Springs Software, Inc,
* PO Box 3336, Ashland OR 97520
* (541) 488-2560 WWW.GREEN-SPRINGS.COM
*
*˜*********************************************************************
FDSPFFDL IPE E K DISK
FQAFDACCP IF E DISK
FQPRINT O F 132 PRINTER OFLIND(*INOF)
*
* šArrays
* ‚------
D #AP S 10 DIM(100)
D #AST S 1 DIM(75) ASTERISKS (***)
D #AST2 S 1 DIM(60) MORE ASTERISKS (**)
D #MSG S 20 DIM(4) CTDATA PERRCD(1) UNIQUE/NON LABELS
* šData Structures
* ‚---------------
D WHCRTD DS
D WHCRTC 1 1
D @CRTDT 2 7 0
*
* šWorking Variables
* ‚-----------------
D @ENDPOS S 5 0
D @F S 2 0
D @FILLIB S 21
D @I S 2 0
D @KEYTYP S 15
D @TYPE S 10
D @X S 1 0
D @YESNO S 4
*
* šTHIS FILE WAS CREATED AS AN OUTFILE FROM DSPFFD COMMAND
* ‚-------------------------------------------------------
*
IQWHDRFFD 01
I WHFILE L2
I WHLIB L3
I WHNAME L1
*
C IF *InL1 = *On
C EVAL @ENDPOS = *Zero
C @CRTDT MULT 100.0001 @DATECR 6 0
*
* šIF FORMAT TEXT IS BLANK: GET OBJECT TEXT
* ‚-----------------------------------------
C*** WHTEXT CASEQ*BLANK SR_GET_TEXT FIN
C*** ENDCS
*
C N22 EXSR SR_GETKEY LIS
C EXCEPT @HEAD
C EVAL *In67 = *On
C EndIF
*
C**** End
*
C EVAL @I = *Zero
C*
C EVAL @ENDPOS = WHFLDB + @ENDPOS COMPUTE
*
C EVAL @F = 1
C @F DOWLT 100 FIND KEY
C IF WHFLDE = #AP(@F) FIELDS
C EVAL @I = @F
C EndIF
C #AP(@F) CABEQ *BLANKS TAG#01
C EVAL @F = @F + 1
C EndDO
C TAG#01 TAG
C*
C EVAL *IN10 = *Off
C IF WHFLDT = 'S' Or WHFLDT = 'P' CHECK
C EVAL *IN10 = *On
C EndIF
*
* šBUILD FILE/LIBRARY FIELD (COMPRESS OUT BLANKS)
* ‚----------------------------------------------
C EVAL @FILLIB = %trimr(WHRLIB) + '/' + WHRFIL
*
C IF *InOF = *On
C EXCEPT @HEAD
C EndIF
*
*˜********************************************************************************************
* ‚ ~SR_GET_TEXT - GET OBJECT TEXT
*˜********************************************************************************************
CSR SR_GET_TEXT BEGSR
C CALL 'FIELDSC2'
C PARM WHFILE
C PARM WHLIB
C PARM @TYPE
C PARM WHTEXT
CSR ENDSR
*
*˜********************************************************************************************
* ‚ ~SR_GETKEY - GET KEY INFO
*˜********************************************************************************************
CSR SR_GETKEY BEGSR
C MOVEA *BLANKS #AP
C EVAL @F = *Zero
C *IN22 DOUEQ *ON READ F
C READ QAFDACCP 22 DESC,
*
* DETERMINE IF KEYED, AND IF SO, UNIQUE KEYS?
* ‚-------------------------------------------
C IF APACCP = 'A' ARRIVAL SEQ
*
C EVAL @KEYTYP = #MSG(3)
C ELSE
C IF APUNIQ = 'Y' KEYED UNIQUE
C EVAL @KEYTYP = #MSG(1)
C ELSE
C EVAL @KEYTYP = #MSG(2)
C EndIF
C EndIF
*
CSR *IN22 CABEQ *ON END SAVE K
CSR APFILE CABGT WHFILE END
CSR APFILE IFEQ WHFILE LOAD
CSR EVAL @F = @F + 1 FIELDS
CSR MOVE APKEYF #AP(@F) AN ARR
CSR @F CABGE 99 END
CSR EndIF
CSR End
*
CSR END TAG
CSR READP QAFDACCP 22
CSR MOVE *OFF *IN22
CSR ENDSR
*˜********************************************************************************************
* ‚ *INZSR - INITIALIZATION
*˜********************************************************************************************
CSR *INZSR BEGSR
*
* šENTRY PARM: WHETHER OR NOT TO PRINT REF INFO
* ‚--------------------------------------------
CSR *ENTRY PLIST
CSR PARM @YESNO
CSR PARM @PLIB 10
*
CSR IF @YESNO = '*YES'
CSR EVAL *In12 = *On
CSR MOVE *ON *IN12
CSR MOVE '*' #AST2
CSR EndIF
*
CSR MOVE '*' #AST
CSR EVAL @TYPE = '*FILE'
CSR TIME UTIME 6 0
CSR ENDSR
*
*˜********************************************************************************************
OQPRINT E @HEAD 0 02
O *DATE Y 10
O UTIME + 1 ' : : '
O 48 'GREEN SPRINGS SOFTWARE, '
O 'INC.'
O PAGE Z 75
O E @HEAD 1
O 48 'GREEN SPRINGS SOFTWARE, '
O 'INC.'
O E @HEAD 2
O 46 'FILE RECORD LAYOUT'
O E L1 @HEAD 1
O L1 #AST 75
O L1 12 #AST2 132
O E L1 @HEAD 1
O 75 '*'
O 53 '*'
O 1 '*'
O 12 132 '*'
O E L1 @HEAD 0 0
O 12 'CREATED -'
O @DATECR Y 21
O 40 'LIBRARY -'
O WHLIB 51
O 63 'FILE -'
O WHFILE 74
O 75 '*'
O 53 '*'
O 1 '*'
O 12 132 '*'
O E L1 @HEAD 1
O @DATECR Y 21
O WHLIB 51
O WHFILE 74
O E L1 @HEAD 1
O 53 '*'
O 75 '*'
O 1 '*'
O 12 132 '*'
O E L1 @HEAD 2
O #AST 75
O 12 #AST2 132
O E L1 @HEAD 2
O 18 'NBR OF FIELDS -'
O WHFLDN 3 24
O 44 'RECORD LENGTH -'
O WHRLEN 3 50
O @KEYTYP 75
O E L1 @HEAD 2
O 16 'FORMAT NAME -'
O WHNAME 27
O 35 'TEXT -'
O WHTEXT 87
O E L1 @HEAD 2
O #AST 75
O 12 #AST2 132
O E @HEAD 1
O 26 'START END FIELD'
O 50 'FIELD DEC '
O E @HEAD 2
O 14 'POS POS'
O 40 'KEY NAME USED TYPE'
O 50 ' LEN POS '
O N12 57 'TEXT'
O 12 60 'ALIAS NAME'
O 12 90 'TEXT'
O***** 57 'TEXT'
O***** 12 110 'REFERENCE '
O D 01 67 1
O WHIBO 3 7
O @ENDPOS 3 14
O @I Z 18
O WHFLDB 3 33
O WHFLDE 31
O WHFLDT 38
O WHFLDD 3 43
O N10 WHFLDB 3 43
O 10 WHFLDP 3 48
O 12 WHALIS 80
O 12 WHFTXT 132
O N12 WHFTXT 101
O*
O***** 12 WHRFLD 110
O***** 12 @FILLIB 132
** KEY TYPE MESSAGE
- UNIQUE KEYS -
NON-UNIQUE KEYS
ARRIVAL SEQ.
DATA BASE RELATIONS:
/*˜***** End Of FIELDSC Program ****** (Delete This Line) **********/
* *****************************************************************
*
* GREEN SPRINGS SOFTWARE, INC. ASHLAND, OR
*
* *****************************************************************
* LAST PRODUCTION UPDATE: G PEARSON 9/30/02
* *****************************************************************
* LOGICAL FILE - DSPFFDL AS/400 VERSION
* DESCRIPTION - LOGICAL OF OUTFILE FOR DSPFFD COMMAND
* OVER PF - DSPFFDP (A COPY OF, NOT THE ONE IN QSYS)
* WRITTEN BY - GEORGE PEARSON GEORGE@GREEN-SPRINGS.COM
* DATE CREATED - 1/14/87
* PURPOSE - USED IN PRINTING FILE RECORD LAYOUTS ON DEMAND
*
* USED BY - FIELDS (CMD), FIELDSR, FIELDSC
*
* (C) MMII GREEN SPRINGS SOFTWARE, INC,
* PO BOX 3336, ASHLAND OR 97520
* (541) 488-2560 WWW.GREEN-SPRINGS.COM
*******************************************************************
* **
A R QWHDRFFD PFILE(DSPFFDP)
* **
A K WHLIB
A K WHFILE
A K WHNAME
* **
A S WHFTYP COMP(EQ 'P')
*
******************** END OF SOURCE (DSPFFDL) LOGICAL FILE *************