Home page  Up a level  Display Fields command source  Display Fields CL source  Display Fields display file source  Display Fields help PanelGroup source  Display Fields RPG Source  Display Fields printer file source  Display Fields CL Subprogram 1  Display Fields CL subprogram 2  Display Fields Logicals  Display Fields create command source

Display Fields CL Source

/**************************************************************************/
/***        NAME: DSPFLD                                                ***/
/*** DESCRIPTION: Display the fields, and the attributes of, in a file; ***/
/*** also, mark the key fields in the list with their order number. The ***/
/*** program will also show a window listing just the key fields in     ***/
/*** order, a window showing the related files, and a window showing    ***/
/*** the select/omit fields.  You can query a file name that is listed  ***/
/*** in the relations window.  The program will display up to four      ***/
/*** files.  You can request from one to four files through the command ***/
/*** or you can open additional files by pressing F11 and filling in    ***/
/*** the file and library fields.  You can cycle through the files by   ***/
/*** pressing F5 or you can press F20 and select a file to show.        ***/
/***                                                                    ***/
/*** ACCPTH contains the key fields of the requested file               ***/
/*** ACCPTH1 contains the key fields of all the related logicals        ***/
/*** ATR contains a list of all the logical files + the physical        ***/
/*** ATR1 contains information about the physical                       ***/
/*** DBR contains a list of all the logicals                            ***/
/*** FLDLST contains a list of the fields in the file                   ***/
/*** SELECT contains a list of the select/omit values                   ***/
/***                                                                    ***/
/*** Copyright 1995 by John H. Daily III                                ***/
/**************************************************************************/

PGM                     PARM(&FILELIB &PRINTONLY)

/**************************************************************************/
/*** DECLARE VARIABLES                                                  ***/
/**************************************************************************/

             DCL        VAR(&FILELIB) TYPE(*CHAR) LEN(82)
             DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FILE2) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB2) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FILE3) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB3) TYPE(*CHAR) LEN(10)
             DCL        VAR(&FILE4) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB4) TYPE(*CHAR) LEN(10)
             DCL        VAR(&NBR) TYPE(*DEC) LEN(3 0)

             DCL        VAR(&PRINTONLY) TYPE(*CHAR) LEN(1)

             DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)
             DCL        VAR(&CRTDATE) TYPE(*CHAR) LEN(13)
             DCL        VAR(&CHGDATE) TYPE(*CHAR) LEN(13)
             DCL        VAR(&SAVDATE) TYPE(*CHAR) LEN(13)
             DCL        VAR(&SIZE) TYPE(*DEC) LEN(15 0)
             DCL        VAR(&SRCF) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&SRCDATE) TYPE(*CHAR) LEN(13)
             DCL        VAR(&RECORDS) TYPE(*DEC) LEN(10 0)

             DCL        VAR(&SRCCHGDATE) TYPE(*CHAR) LEN(13)
             DCL        VAR(&STSMSG) TYPE(*CHAR) LEN(7)

             DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PHYL) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PHYF) TYPE(*CHAR) LEN(10)

             DCLF       FILE(DSPFLDL1) ALWNULL(*YES) /* Logical over +
ยน                         DBR */


/**************************************************************************/
/*** STANDARD ERROR VARIABLES                                           ***/
/**************************************************************************/

             DCL        &ERRORSW *LGL                     /* Std err */
             DCL        &MSGID *CHAR LEN(7)               /* Std err */
             DCL        &MSGDTA *CHAR LEN(100)            /* Std err */
             DCL        &MSGF *CHAR LEN(10)               /* Std err */
             DCL        &MSGFLIB *CHAR LEN(10)            /* Std err */
             DCL        &KEYVAR *CHAR LEN(4)              /* Std err */
             MONMSG     MSGID(CPF0000) EXEC(GOTO STDERR1) /* Std err */

/**************************************************************************/
/*** HOUSEKEEPING                                                       ***/
/***************************************************************** ********/

/***                                                                    ***/
/*** Don't display status messages.                                     ***/
/***                                                                    ***/
             RTVJOBA    STSMSG(&STSMSG)
             CHGJOB     STSMSG(*NONE)

             CHGVAR     VAR(&NBR) VALUE(%BINARY(&FILELIB 1 2))

/***                                                                    ***/
/*** Separate out the file and library, then make sure they exist.      ***/
/***                                                                    ***/
             CHGVAR     VAR(&FILE) VALUE(%SST(&FILELIB 3 10))
             CHGVAR     VAR(&LIB) VALUE(%SST(&FILELIB 13 10))

             IF         COND(&NBR *GE 2) THEN(DO)
                  CHGVAR     VAR(&FILE2) VALUE(%SST(&FILELIB 23 10))
                  CHGVAR     VAR(&LIB2) VALUE(%SST(&FILELIB 33 10))
             ENDDO

             IF         COND(&NBR *GE 3) THEN(DO)
                  CHGVAR     VAR(&FILE3) VALUE(%SST(&FILELIB 43 10))
                  CHGVAR     VAR(&LIB3) VALUE(%SST(&FILELIB 53 10))
             ENDDO

             IF         COND(&NBR *GE 4) THEN(DO)
                  CHGVAR     VAR(&FILE4) VALUE(%SST(&FILELIB 63 10))
                  CHGVAR     VAR(&LIB4) VALUE(%SST(&FILELIB 73 10))
             ENDDO

             CHKOBJ     OBJ(&LIB/&FILE) OBJTYPE(*FILE)
             IF         COND(&FILE2 *NE ' ') THEN(CHKOBJ +
                          OBJ(&LIB2/&FILE2) OBJTYPE(*FILE))
             IF         COND(&FILE3 *NE ' ') THEN(CHKOBJ +
                          OBJ(&LIB3/&FILE3) OBJTYPE(*FILE))
             IF         COND(&FILE4 *NE ' ') THEN(CHKOBJ +
                          OBJ(&LIB4/&FILE4) OBJTYPE(*FILE))


/**************************************************************************/
/*** ON-LINE PROCESSING                                                 ***/
/**************************************************************************/

/***                                                                    ***/
/*** Get the physical file name if the requested file is a logical.     ***/
/***                                                                    ***/
             RTVOBJD    OBJ(&LIB/&FILE) OBJTYPE(*FILE) OBJATR(&OBJATR)
             IF         COND(&OBJATR *EQ 'LF') THEN(DO)
                  DSPFD      FILE(&LIB/&FILE) TYPE(*ACCPTH) +
                               OUTPUT(*OUTFILE) OUTFILE(QTEMP/DBR2)
                  CALL       PGM(DSPFLD1) PARM(&PHYF &PHYL)
                  CLRPFM     FILE(QTEMP/DBR2)
             ENDDO

             ELSE       CMD(DO)
                  CHGVAR     VAR(&PHYF) VALUE(&FILE)
                  CHGVAR     VAR(&PHYL) VALUE(&LIB)
             ENDDO

/***                                                                    ***/
/*** Display the key fields to an outfile.                              ***/
/***                                                                    ***/
             DSPFD      FILE(&LIB/&FILE) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/ACCPTH)

Rec:         RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         COND(&KEYVAR *EQ '    ') THEN(GOTO +
                          CMDLBL(DSPFFD))
             RMVMSG     MSGKEY(&KEYVAR)
             GOTO       CMDLBL(REC)

/***                                                                    ***/
/*** Display the fields to an outfile.                                  ***/
/***                                                                    ***/
DspFFD:
             DSPFFD     FILE(&LIB/&FILE) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/FLDLST)

Rec1:        RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         COND(&KEYVAR *EQ '    ') THEN(GOTO +
                          CMDLBL(CRTLF))
             RMVMSG     MSGKEY(&KEYVAR)
             GOTO       CMDLBL(REC1)

/***                                                                    ***/
/*** Create the logical over FLDLST by field if it does not exist.      ***/
/***                                                                    ***/
CrtLf:       CHKOBJ     OBJ(QTEMP/DSPFLDL) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF0000) EXEC(CRTLF +
                          FILE(QTEMP/DSPFLDL) DTAMBRS((QTEMP/FLDLST +
                          (FLDLST))) OPTION(*NOSRC *NOLIST))

Rec2:        RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         COND(&KEYVAR *EQ '    ') THEN(GOTO +
                          CMDLBL(SELECT))
             RMVMSG     MSGKEY(&KEYVAR)
             GOTO       CMDLBL(REC2)

/***                                                                    ***/
/*** Display the select/omit fields to an out file.                     ***/
/***                                                                    ***/
Select:
             DSPFD      FILE(&LIB/&FILE) TYPE(*SELECT) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/SELECT)
/***                                                                    ***/
/*** If there are no select/omit fields, create the file anyway.        ***/
/***                                                                    ***/
             MONMSG     MSGID(CPF3083 CPF3011) EXEC(DO)
                  DSPFD      FILE(QTEMP/DSPFLDL) TYPE(*SELECT) +
                               OUTPUT(*OUTFILE) OUTFILE(QTEMP/SELECT)
                  CLRPFM     FILE(QTEMP/SELECT)
             ENDDO

Recs:        RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         COND(&KEYVAR *EQ '    ') THEN(GOTO +
                          CMDLBL(RELATIONS))
             RMVMSG     MSGKEY(&KEYVAR)
             GOTO       CMDLBL(RECS)

/***                                                                    ***/
/*** Display the database relations to an outfile.  This uses file      ***/
/*** QADSPDBR in QSYS. Create the logical over it if it does not exist. ***/
/***                                                                    ***/
Relations:
             DSPDBR     FILE(&PHYL/&PHYF) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/DBR)
             CHKOBJ     OBJ(QTEMP/DSPFLDL1) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF0000) EXEC(CRTLF +
                          FILE(QTEMP/DSPFLDL1) OPTION(*NOSRC *NOLIST))

Rels:        RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         COND(&KEYVAR *EQ '    ') THEN(GOTO +
                          CMDLBL(RECEIVE))
             RMVMSG     MSGKEY(&KEYVAR)
             GOTO       CMDLBL(RELS)

/***                                                                    ***/
/*** Create a file of all key fields.                                   ***/
/***                                                                    ***/
Receive:
             DSPFD      FILE(&PHYL/&PHYF) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/ACCPTH1) +
                          OUTMBR(*FIRST *ADD)

             DSPFD      FILE(&PHYL/&PHYF) TYPE(*ATR) +
                          OUTPUT(*OUTFILE) FILEATR(*PF) +
                          OUTFILE(QTEMP/ATR1)
             CHKOBJ     OBJ(QTEMP/DSPFLDL3) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF0000) EXEC(CRTLF +
                          FILE(QTEMP/DSPFLDL3) TEXT('Logical over +
                          ATR1') OPTION(*NOSRC *NOLIST))


Rcv:         RCVF
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(OBJD))
             IF         COND(&WHREFI *EQ ' ') THEN(GOTO +
                          CMDLBL(RCV))
             DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/ACCPTH1) +
                          OUTMBR(*FIRST *ADD)
             IF         COND(&WHTYPE *NE 'C') THEN(Do)
                  DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ATR) +
                               OUTPUT(*OUTFILE) FILEATR(*LF) +
                               OUTFILE(QTEMP/ATR) OUTMBR(*FIRST *ADD)
                  CHKOBJ     OBJ(QTEMP/DSPFLDL2) OBJTYPE(*FILE)
                  MONMSG     MSGID(CPF0000) EXEC(CRTLF +
                               FILE(QTEMP/DSPFLDL2) TEXT('Logical +
                               over ATR') OPTION(*NOSRC *NOLIST))
             ENDDO

             ELSE       CMD(DO)
                  DSPFD      FILE(&WHRELI/&WHREFI) TYPE(*ATR) +
                               OUTPUT(*OUTFILE) FILEATR(*PF) +
                               OUTFILE(QTEMP/ATR1) OUTMBR(*FIRST *ADD)
             ENDDO

             GOTO       CMDLBL(RCV)

/***                                                                    ***/
/*** Get important information from the file and from it's source       ***/
/*** file/member.                                                       ***/
/***                                                                    ***/
ObjD:
             IF         COND(%SST(&LIB 1 1) *EQ '*') THEN(RTVOBJD +
                          OBJ(&LIB/&FILE) OBJTYPE(*FILE) +
                          RTNLIB(&LIB) TEXT(&TEXT) +
                          CRTDATE(&CRTDATE) CHGDATE(&CHGDATE) +
                          SAVDATE(&SAVDATE) SIZE(&SIZE) SRCF(&SRCF) +
                          SRCFLIB(&SRCFLIB) SRCMBR(&SRCMBR) +
                          SRCDATE(&SRCDATE))

             ELSE       CMD(RTVOBJD OBJ(&LIB/&FILE) OBJTYPE(*FILE) +
                          TEXT(&TEXT) CRTDATE(&CRTDATE) +
                          CHGDATE(&CHGDATE) SAVDATE(&SAVDATE) +
                          SIZE(&SIZE) SRCF(&SRCF) SRCFLIB(&SRCFLIB) +
                          SRCMBR(&SRCMBR) SRCDATE(&SRCDATE))

             RTVMBRD    FILE(&LIB/&FILE) NBRCURRCD(&RECORDS)
             MONMSG     MSGID(CPF3019) EXEC(CHGVAR VAR(&RECORDS) +
                          VALUE(0))

             IF         COND(&SRCF *NE ' ' *AND &SRCFLIB *NE ' ') +
                          THEN(DO)
                  RTVMBRD    FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) +
                               SRCCHGDATE(&SRCCHGDATE)
                  MONMSG     MSGID(CPF9810 CPF9812 CPF9815) EXEC(DO)
                       RTVMBRD    FILE(*LIBL/&SRCF) MBR(&SRCMBR) +
                                    SRCCHGDATE(&SRCCHGDATE)
                       MONMSG     MSGID(CPF0000)
                  ENDDO
             ENDDO

/***                                                                    ***/
/*** If any of the dates are blank then change them to zeros.           ***/
/***                                                                    ***/
             IF         COND(&CRTDATE *EQ '             ') +
                          THEN(CHGVAR VAR(&CRTDATE) +
                          VALUE('0000000000000'))
             IF         COND(&CHGDATE *EQ '             ') +
                          THEN(CHGVAR VAR(&CHGDATE) +
                          VALUE('0000000000000'))
             IF         COND(&SAVDATE *EQ '             ') +
                          THEN(CHGVAR VAR(&SAVDATE) +
                          VALUE('0000000000000'))
             IF         COND(&SRCDATE *EQ '             ') +
                          THEN(CHGVAR VAR(&SRCDATE) +
                          VALUE('0000000000000'))
             IF         COND(&SRCCHGDATE *EQ '             ') +
                          THEN(CHGVAR VAR(&SRCCHGDATE) +
                          VALUE('0000000000000'))

/***                                                                    ***/
/*** Make sure all of the files exist in QTEMP.                         ***/
/***                                                                    ***/
/*** The ATR file and DSPFLDL2 logical over it.                         ***/
/***                                                                    ***/

             CHKOBJ     OBJ(QTEMP/ATR) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF0000) EXEC(DO)
                  DSPFD      FILE(QTEMP/DSPFLDL1) TYPE(*ATR) +
                               OUTPUT(*OUTFILE) FILEATR(*LF) +
                               OUTFILE(QTEMP/ATR) OUTMBR(*FIRST *ADD)
                  CLRPFM     FILE(QTEMP/ATR)
                  CHKOBJ     OBJ(QTEMP/DSPFLDL2) OBJTYPE(*FILE)
                  MONMSG     MSGID(CPF0000) EXEC(CRTLF +
                               FILE(QTEMP/DSPFLDL2) TEXT('Logical +
                               over ATR') OPTION(*NOSRC *NOLIST))
             ENDDO

/***                                                                    ***/
/*** Call the program to display the file and pass in the parms.        ***/
/***                                                                    ***/
             CHGVAR     VAR(&FILELIB) VALUE(' ')
             CHGJOB     STSMSG(&STSMSG)

             CALL       PGM(DSPFLDR) PARM(&FILE &LIB &FILE2 &LIB2 +
                          &FILE3 &LIB3 &FILE4 &LIB4 &TEXT &CRTDATE +
                          &CHGDATE &SAVDATE &SIZE &SRCF &SRCFLIB +
                          &SRCMBR &SRCDATE &SRCCHGDATE &RECORDS +
                          &FILELIB &PRINTONLY)

             GOTO       CMDLBL(ENDPGM) /* Normal end of program */

/**************************************************************************/
/*** STANDARD ERROR SUBROUTINE                                          ***/
/**************************************************************************/

Stderr1:                /* Standard error handling routine */

Chgjob:      CHGJOB     STSMSG(&STSMSG)

             IF         &ERRORSW SNDPGMMSG MSGID(CPF9999) +
                          MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
             CHGVAR     &ERRORSW '1' /* Set to fail if error occurs */
Stderr2:     RCVMSG     MSGTYPE(*DIAG) RMV(*NO) KEYVAR(&KEYVAR) +
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
                          SNDMSGFLIB(&MSGFLIB)
             IF         (&KEYVAR *EQ '    ') GOTO STDERR3
             RMVMSG     MSGKEY(&KEYVAR)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
             GOTO       STDERR2 /* Loop back for addl diagnostics */
Stderr3:     RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB)
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)


/**************************************************************************/
/*** END OF PROGRAM                                                     ***/
/**************************************************************************/

Endpgm:
 ENDPGM