Home page  Up a level  Display Fields command source  Display Fields control language 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 Sub-program 2  Display Fields Logicals  Display Fields create command source

Display Fields CL sub-program 2

/*************************************************************************/
/***        NAME: DSPFLD2                                              ***/
/*** DESCRIPTION: Reload the files in QTEMP with the info for a new    ***/
/*** library/file.  This is called from DSPFLDR in order to load an    ***/
/*** additional file.                                                  ***/
/***                                                                   ***/
/*** Copyright 1995 by John H. Daily III                               ***/
/*************************************************************************/

PGM                     PARM(&FILE &LIB &TEXT &CRTDATE &CHGDATE +
                          &SAVDATE &SIZE &SRCF &SRCFLIB &SRCMBR +
                          &SRCDATE &SRCCHGDATE &RECORDS)

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

             DCL        VAR(&FILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&LIB) TYPE(*CHAR) LEN(10)

             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)


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

/***                                                                   ***/
/*** If the file doesn't exist, clear the values and exit the program. ***/
/***                                                                   ***/
             CHKOBJ     OBJ(&LIB/&FILE) OBJTYPE(*FILE)
             MONMSG     MSGID(CPF0000) EXEC(DO)
                  CHGVAR     VAR(&LIB) VALUE(' ')
                  CHGVAR     VAR(&FILE) VALUE(' ')
                  GOTO       CMDLBL(ENDPGM)
             ENDDO


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

/***                                                                   ***/
/*** Get the physical file name if the 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) +
                               OUTMBR(*FIRST *ADD)
                  CALL       PGM(DSPFLD1) PARM(&PHYF &PHYL)
             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) +
                          OUTMBR(*FIRST *ADD)
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 and create a logical over it by  ***/
/*** field name.                                                ยท      ***/
/***                                                                   ***/
DspFFD:
             DSPFFD     FILE(&LIB/&FILE) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/FLDLST) OUTMBR(*FIRST *ADD)
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)

CrtLf:
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) +
                          OUTMBR(*FIRST *ADD)
             MONMSG     MSGID(CPF3083 CPF3011) EXEC(DO)
                  DSPFD      FILE(QTEMP/DSPFLDL) TYPE(*SELECT) +
                               OUTPUT(*OUTFILE) OUTFILE(QTEMP/SELECT) +
                               OUTMBR(*FIRST *ADD)
                  CLRPFM     FILE(QTEMP/SELECT)
                  MONMSG     MSGID(CPF0000)
             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.                     ***/
/***                                                                   ***/
Relations:
             DSPDBR     FILE(&PHYL/&PHYF) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/DBR) OUTMBR(*FIRST *ADD)

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) OUTMBR(*FIRST *ADD)

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(DSPFD +
                          FILE(&WHRELI/&WHREFI) TYPE(*ATR) +
                          OUTPUT(*OUTFILE) FILEATR(*LF) +
                          OUTFILE(QTEMP/ATR) OUTMBR(*FIRST *ADD))
             ELSE       CMD(DSPFD FILE(&WHRELI/&WHREFI) TYPE(*ATR) +
                          OUTPUT(*OUTFILE) FILEATR(*PF) +
                          OUTFILE(QTEMP/ATR1) OUTMBR(*FIRST *ADD))

             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'))

/***                                                                   ***/
/*** Get more information from files.                                  ***/
/***                                                                   ***/

             DSPFFD     FILE(&LIB/&FILE) OUTPUT(*OUTFILE) +
                          OUTFILE(QTEMP/PRTFILPF) OUTMBR(*FIRST *ADD)
             OVRDBF     FILE(PRTFILPF) TOFILE(QTEMP/PRTFILPF)
             DSPFD      FILE(&LIB/&FILE) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/PRTFILP1) +
                          OUTMBR(*FIRST *ADD)

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

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

Stderr1:                /* Standard error handling routine */

Chgjob:

             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