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 *************