/*-------------------------------------------------------------------*/ /* Vengoal Chang Development Resource Copyright 1999.10 */ /* */ /* \\\\\\\ */ /* ( o o ) */ /*------------------------oOO----(_)----OOo--------------------------*/ /* */ /* System name . . . : Technical Support */ /* Command name . . . : PRTRCDINF */ /* Text . . . . . . . : Print record information */ /* */ /* Author . . . . . . : Vengoal Chang */ /* Description. . . . : Print record information */ /* */ /* ooooO Ooooo */ /* ( ) ( ) */ /*----------------------( )-------------( )----------------------*/ /* (_) (_) */ /* */ /* */ /* PRTRCDINF -> QCMDSRC CPP-> RCDINFC1P */ /* RCDINFC1P -> QCLSRC */ /* RCDINFR1P -> QRPGSRC */ /* RCDINFP1 PRTF -> QDDSSRC */ /**********************************************************************/ /* PRTRCDINF -> QCMDSRC */ /**********************************************************************/ CMD PROMPT('Print Record Information') PARM KWD(FILE) TYPE(NAME1) MIN(1) PROMPT('File') NAME1: QUAL TYPE(*NAME) LEN(10) EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) EXPR(*YES) PROMPT('Library') /**********************************************************************/ /* RCDINFC1P -> QCLSRC */ /**********************************************************************/ PGM PARM(&FILELIB) DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) DCL VAR(&FILE) TYPE(*CHAR) LEN(10) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10) DCL VAR(&TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(OOPS)) CHGVAR &FILE %sst(&FileLib 1 10) CHGVAR &LIB %sst(&FileLib 11 10) CHKOBJ &LIB/&FILE *FILE RTVOBJD OBJ(&LIB/&FILE) OBJTYPE(*FILE) + OBJATR(&OBJATR) TEXT(&TEXT) DLTF FILE(QTEMP/QADSPFFD) MONMSG MSGID(CPF0000) EXEC(RCVMSG MSGTYPE(*LAST)) DSPFFD FILE(&LIB/&FILE) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/QADSPFFD) MONMSG MSGID(CPF0000) DLTF FILE(QTEMP/QAFDACCP) MONMSG MSGID(CPF0000) EXEC(RCVMSG MSGTYPE(*LAST)) DSPFD FILE(&LIB/&FILE) TYPE(*ACCPTH) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDACCP) IF (&OBJATR = 'LF') DO DLTF FILE(QTEMP/QAFDSELO) MONMSG MSGID(CPF0000) EXEC(RCVMSG MSGTYPE(*LAST)) DSPFD FILE(&LIB/&FILE) TYPE(*SELECT) + OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDSELO) ENDDO OVRDBF FILE(QADSPFFD) TOFILE(QTEMP/QADSPFFD) SHARE(*YES) OVRDBF FILE(QAFDACCP) TOFILE(QTEMP/QAFDACCP) SHARE(*YES) OVRDBF FILE(QAFDSELO) TOFILE(QTEMP/QAFDSELO) SHARE(*YES) CALL PGM(RCDINFR1P) PARM(&TEXT) CHGSPLFA FILE(RCDINFP1) SPLNBR(*LAST) USRDTA(&FILE) DLTF FILE(QTEMP/QADSPFFD) MONMSG MSGID(CPF0000) RCVMSG MSGTYPE(*LAST) DLTF FILE(QTEMP/QAFDACCP) MONMSG MSGID(CPF0000) RCVMSG MSGTYPE(*LAST) DLTF FILE(QTEMP/QAFDSELO) MONMSG MSGID(CPF0000) RCVMSG MSGTYPE(*LAST) DLTOVR FILE(*ALL) RETURN OOPS: RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) MONMSG MSGID(CPF0000) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000) ENDPGM /**********************************************************************/ /* RCDINFR1P -> QRPGSRC */ /**********************************************************************/ ****************************************************** * THIS APPLICATION WILL DISPLAY ALL FIELDS IN A * DATABASE RECORD FORMAT AND THE ACCESS PATH, IF * ONE EXISTS. * ****************************************************** * FQAFDACCPIF E DISK FQAFDSELOIF E DISK UC FQADSPFFDIF E DISK UC F*RCDINFD1CF E WORKSTN F* @RRN KSFILE SUBF01 F* KINFDS LOCATE FRCDINFP1O E 80 PRINTER UC * ILOCATE DS I B 370 3710CURSOR I B 378 3790FIRST * I DS I 1 120DATTME I 1 60@TIME I 7 120@DATE * * I 'File UNIQUE by Key' C UNIQUE ************************************************************* * MAINLINE C *ENTRY PLIST C PARM FILTXT 50 * C EXSR $FILL * C MOVE *ON *INLR ************************************************************* C $FILL BEGSR * C OPEN QADSPFFD C OPEN RCDINFP1 * C MOVE *ON *IN80 * C MOVE *OFF *IN75 C *IN75 DOUEQ*ON C READ QADSPFFD 75 C *IN75 IFEQ *OFF * C WHFOBO ADD WHFLDB WHENDP C WHENDP SUB 1 WHENDP C WHMAP IFEQ 'Y' SST C MOVE WHMAPS STR 5 C MOVE WHMAPL LEN 5 C 'SST(' CAT WHFLDI SST1 15 C SST1 CAT STR SST2 21 C SST2 CAT LEN SST3 26 C SST3 CAT ') ' SST4 28 C SST4 CAT WHFLDE WHFTXT C ENDIF C MOVELWHFTXT @TEXT C MOVE WHFLDP @DEC C WHFLDT IFNE 'S' C WHFLDT ANDNE'P' C MOVE *BLANKS @DEC C ENDIF C MOVE WHFLDB @FLEN C WHFLDT IFEQ 'P' C WHFLDT OREQ 'B' C MOVE WHFLDD @FLEN C ENDIF * C ADD 1 FIELDN 30 C *IN80 IFEQ *ON C EXSR $OVER C ENDIF C WRITEDET01 C CLEARWHENDP C CLEAR@TEXT C CLEAR@DEC C CLEAR@FLEN * C ENDIF C ENDDO * C FIELDN IFGT *ZEROS * C CLEARWHFLDI C CLEARWHFLDT C CLEARWHFOBO C CLEARWHENDP C CLEAR@TEXT C CLEAR@DEC C CLEAR@FLEN * C MOVE *OFF *IN75 C MOVE ' ' SELECT 1 QADFDSELO C *IN75 DOUEQ*ON C READ QAFDACCP 75 C *IN75 IFEQ *OFF * C APFTYP IFEQ 'L' C SELECT ANDEQ' ' C MOVE '1' SELECT C ENDIF * C APKEYF IFEQ *BLANKS C MOVE *ON *IN75 C LEAVE C ENDIF * C MOVE 'K' WHFLDT C MOVELAPKEYF @TEXT C *IN80 IFEQ *ON C EXSR $OVER C ENDIF C WRITEDET01 C CLEARWHFLDI C CLEARWHFLDT C CLEARWHFOBO C CLEARWHENDP C CLEAR@TEXT C CLEAR@DEC C CLEAR@FLEN * C ELSE C APUNIQ IFEQ 'Y' C MOVELUNIQUE @TEXT C *IN80 IFEQ *ON C EXSR $OVER C ENDIF C WRITEDET01 C ENDIF * C ENDIF C ENDDO * C SELECT IFEQ '1' C OPEN QAFDSELO C MOVE *OFF *IN75 C *IN75 DOUEQ*ON C READ QAFDSELO 75 C *IN75 IFEQ *OFF * C SORULE IFEQ *BLANKS C MOVE *ON *IN75 C LEAVE C ENDIF * C MOVE SORULE WHFLDT C SOFLD CAT SOCOMP TTEXT 13 C TTEXT CAT SOVALU @TEXT C *IN80 IFEQ *ON C EXSR $OVER C ENDIF C WRITEDET01 C CLEARWHFLDI C CLEARWHFLDT C CLEARWHFOBO C CLEARWHENDP C CLEAR@TEXT C CLEAR@DEC C CLEAR@FLEN * C ENDIF C ENDDO C CLOSEQAFDSELO C ENDIF * C ENDIF * C CLOSEQADSPFFD C CLOSERCDINFP1 * C ENDSR ************************************************************* C $OVER BEGSR * C ADD 1 #PAGE C WRITEHDR01 C MOVE *OFF *IN80 * C ENDSR * ****************************************************** C *INZSR BEGSR * C MOVE *OFF @DONE 1 * C OPEN QADSPFFD C MOVE *OFF *IN99 C READ QADSPFFD 99 C *IN99 IFEQ *OFF C MOVE WHLIB @LIB C MOVE WHFILE @FILE C MOVE WHNAME @FORMT C* MOVE WHTEXT @NAME C MOVE FILTXT @NAME C MOVE WHRLEN @LEN C WHFTYP CAT 'F' @FTYPE C ENDIF * C CLOSEQADSPFFD * C MOVEL@LIB @LBFL 21 P C @LBFL CAT '/':0 @LBFL C @LBFL CAT @FILE:0 @LBFL * C ENDSR ****************************************************** /**********************************************************************/ /* RCDINFP1 PRTF -> QDDSSRC */ /**********************************************************************/ A R HDR01 A SKIPB(001) A 1 A 'File Layouts' A HIGHLIGHT A UNDERLINE A 69 A 'Page:' A #PAGE 4S 0O +1 A EDTCDE(Z) A 2 A 'File:' A SPACEB(001) A @FILE 10A O 9 A HIGHLIGHT A 20'Type:' A @FTYPE 2A O 26 A HIGHLIGHT A @NAME 50A O 31 A 4 A 'Library:' A SPACEB(001) A @LIB 10A O 14 A HIGHLIGHT A 35 A 'Format:' A @FORMT 10A O 43 A HIGHLIGHT A 61 A 'Record Length:' A @LEN 5S 0O 75 A EDTCDE(Z) A 1 A '----------------------------------- A ------------------------------------ A -----------' A SPACEB(001) A 54 A 'Description' A SPACEB(001) A 4 A 'Name' A +4 A 'Type' A +2 A 'Length' A +4 A 'From' A +3 A 'To' A 1 A '----------' A SPACEB(001) A +1 A '----' A +1 A '--------' A +2 A '-----' A +2 A '-----' A +2 A '----------------------------------- A ------' A R DET01 A SPACEB(001) A WHFLDI 10A O 1 A WHFLDT 1A O +2 A @FLEN 5S 0O +3 A EDTCDE(Z) A @DEC 1A O +1 A WHFOBO 5S 0O +2 A EDTCDE(Z) A WHENDP 5S 0O +2 A EDTCDE(Z) A @TEXT 39A O +3