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 subprogram 2  Display Fields Logicals  Display Fields Create objects CL

Display Fields create objects source

This command and CL program is used to create the DspFld command and all of its programs. When the command is run, the program will submit itself to batch. The parameters for the command are the source library - the library where the source files exist, and the object library - the library where the programs and files are to be created.

/**************************************************************************/
/***        NAME: CrtDspFld                                             ***/
/*** DESCRIPTION: Creates the command, files and programs necessary for ***/
/*** the DspFld command.                                                ***/
/***                                                                    ***/
/*** Copyright 1995 by John H. Daily III                                ***/
/**************************************************************************/
             CMD        PROMPT('Create Display Fields Program')
             PARM       KWD(SRCLIB) TYPE(*CHAR) LEN(10) +
                          CHOICE('Name') PROMPT('Source library')
             PARM       KWD(OBJLIB) TYPE(*CHAR) LEN(10) +
                          CHOICE('Name') PROMPT('Object library')


/**************************************************************************/
/***        NAME: CRTDSPFLD                                             ***/
/*** DESCRIPTION: This program will create all of the programs,         ***/
/*** commands, and other objects necessary for the  DSPFLD - Display    ***/
/*** Fields - command.                                                  ***/
/***                                                                    ***/
/*** Inputs:                                                            ***/
/***   &SRCLIB - library where the source files are located             ***/
/***   &OBJLID - library where the objects are to be created.           ***/
/***                                                                    ***/
/*** Copyright 1996 by John H. Daily III                                ***/
/**************************************************************************/

PGM                     PARM(&SRCLIB &OBJLIB)

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

             DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
             DCL        VAR(&DDSSRC) TYPE(*CHAR) LEN(500) +
                          VALUE('DSPFLDDF  DSPMBRDF  ')
             DCL        VAR(&CLSRC) TYPE(*CHAR) LEN(500) +
                          VALUE('DSPFLD    DSPFLD1   DSPFLD2    +
                          DSPMBRD   ')
             DCL        VAR(&RPGLESRC) TYPE(*CHAR) LEN(500) +
                          VALUE('DSPFLDR   ')
             DCL        VAR(&CMDSRC) TYPE(*CHAR) LEN(500) +
                          VALUE('DSPFLD    DSPMBRD   ')
             DCL        VAR(&SRCFILES) TYPE(*CHAR) LEN(500) +
                          VALUE('QDDSSRC   QCLSRC    QRPGLESRC +
                          QCMDSRC   ')
             DCL        VAR(&SRCFILE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBR) TYPE(*CHAR) LEN(10)
             DCL        VAR(&MBRX) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PGMTYPE) TYPE(*CHAR) LEN(1)
             DCL        VAR(&SUB) TYPE(*DEC) LEN(5 0) VALUE(1)
             DCL        VAR(&SUB1) TYPE(*DEC) LEN(5 0) VALUE(1)

/***                                                                    ***/
/*** Variables to retrieve the program name.                            ***/
/***                                                                    ***/
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(20)
             DCL        VAR(&PROGNAME) TYPE(*CHAR) LEN(10)
             DCL        VAR(&PROGLIB) TYPE(*CHAR) LEN(10)

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

             MONMSG     MSGID(CPF2105)

             RTVJOBA    TYPE(&PGMTYPE)
             IF         COND(&PGMTYPE *EQ '0') THEN(GOTO CMDLBL(BATCH))

/***                                                                    ***/
/*** Make sure the from and to libraries exist.                         ***/
/***                                                                    ***/

             CHKOBJ     OBJ(&SRCLIB) OBJTYPE(*LIB)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(NOFROMLIB))
             CHKOBJ     OBJ(&OBJLIB) OBJTYPE(*LIB)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(NOTOLIB))


/**************************************************************************/
/*** RETRIEVE PROGRAM NAME                                              ***/
/**************************************************************************/

/***                                                                    ***/
/*** Make sure that a file doesn't exist in QTEMP; remove the message   ***/
/*** that is sent.                                                      ***/
/***                                                                    ***/
             DLTF       FILE(QTEMP/NOTFOUND)
             MONMSG     MSGID(CPF2105) EXEC(DO)
                  RCVMSG     MSGTYPE(*EXCP)
             ENDDO

/***                                                                    ***/
/*** Override the printer file using OVRDBF to generate an error.  Then ***/
/*** dump the CL program.                                               ***/
/***                                                                    ***/
             OVRDBF     FILE(QPPGMDMP) TOFILE(QTEMP/NOTFOUND)
             DMPCLPGM

/***                                                                    ***/
/*** Ignore the *DIAG message and receive the *EXCP message that has    ***/
/*** the program name and library in the message data.  The format of   ***/
/*** the data is: 'PGMNAME   PGMLIB    '.                               ***/
/***                                                                    ***/
             MONMSG     MSGID(CPF0570) EXEC(DO)
                  RCVMSG     MSGTYPE(*DIAG)
                  RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA)
                  CHGVAR     VAR(&PROGNAME) VALUE(%SST(&MSGDTA 1 10))
                  CHGVAR     VAR(&PROGLIB) VALUE(%SST(&MSGDTA 11 10))
             ENDDO

/***                                                                    ***/
/*** Delete the override.                                               ***/
/***                                                                    ***/
             DLTOVR     FILE(QPPGMDMP)


/**************************************************************************/
/*** SUBMIT JOB TO BATCH                                                ***/
/**************************************************************************/

             SBMJOB     CMD(CALL PGM(&PROGLIB/&PROGNAME) +
                          PARM(&SRCLIB &OBJLIB)) JOB(&PROGNAME)
             GOTO       CMDLBL(ENDPGM)


/**************************************************************************/
/*** BATCH PROCESSING                                                   ***/
/**************************************************************************/
Batch:

/***                                                                    ***/
/*** Create the binding directory and the necessary service programs.   ***/
/***                                                                    ***/

             CHKOBJ     OBJ(&OBJLIB/JHDUTIL) OBJTYPE(*BNDDIR)
             MONMSG     MSGID(CPF0000) EXEC(DO)

/***                                                                    ***/
/*** Create the gFmtStr service program.                                ***/
/***                                                                    ***/
                  CRTBNDDIR  BNDDIR(&OBJLIB/JHDUTIL)
                  CRTRPGMOD  MODULE(&OBJLIB/GFMTSTR) +
                               SRCFILE(&SRCLIB/QRPGLESRC)
                  CRTSRVPGM  SRVPGM(&OBJLIB/GFMTSTR) EXPORT(*ALL)
                  ADDBNDDIRE BNDDIR(&OBJLIB/JHDUTIL) +
                               OBJ((&OBJLIB/GFMTSTR))
                  DLTSPLF    FILE(GFMTSTR) SPLNBR(*LAST)

/***                                                                    ***/
/*** Create the gMsgSfl service program.                                ***/
/***                                                                    ***/
                  CRTRPGMOD  MODULE(&OBJLIB/GMSGSFL) +
                               SRCFILE(&SRCLIB/QRPGLESRC)
                  CRTSRVPGM  SRVPGM(&OBJLIB/GMSGSFL) EXPORT(*ALL)
                  ADDBNDDIRE BNDDIR(&OBJLIB/JHDUTIL) +
                               OBJ((&OBJLIB/GMSGSFL))
                  DLTSPLF    FILE(GMSGSFL) SPLNBR(*LAST)

/***                                                                    ***/
/*** Create the gRtvDate service program.                               ***/
/***                                                                    ***/
                  CRTRPGMOD  MODULE(&OBJLIB/GRTVDATE) +
                               SRCFILE(&SRCLIB/QRPGLESRC)
                  CRTSRVPGM  SRVPGM(&OBJLIB/GRTVDATE) EXPORT(*ALL)
                  ADDBNDDIRE BNDDIR(&OBJLIB/JHDUTIL) +
                               OBJ((&OBJLIB/GRTVDATE))
                  DLTSPLF    FILE(GRTVDATE) SPLNBR(*LAST)

/***                                                                    ***/
/*** Create the gRtvSysVal service program.                             ***/
/***                                                                    ***/
                  CRTRPGMOD  MODULE(&OBJLIB/GRTVSYSVAL) +
                               SRCFILE(&SRCLIB/QRPGLESRC)
                  CRTSRVPGM  SRVPGM(&OBJLIB/GRTVSYSVAL) EXPORT(*ALL)
                  ADDBNDDIRE BNDDIR(&OBJLIB/JHDUTIL) +
                               OBJ((&OBJLIB/GRTVSYSVAL))
                  DLTSPLF    FILE(GRTVSYSVAL) SPLNBR(*LAST)
             ENDDO

/***                                                                    ***/
/*** Create any necessary temporary files.                              ***/
/***                                                                    ***/

             CRTDUPOBJ  OBJ(QAFDLGL) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(ATR)
             ADDPFM     FILE(QTEMP/ATR) MBR(ATR)
             MONMSG     MSGID(CPF0000)
             CRTLF      FILE(QTEMP/DSPFLDL2) OPTION(*NOSRC *NOLIST)

             CRTDUPOBJ  OBJ(QAFDPHY) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(ATR1)
             ADDPFM     FILE(QTEMP/ATR1) MBR(ATR1)
             MONMSG     MSGID(CPF0000)
             CRTLF      FILE(QTEMP/DSPFLDL3) OPTION(*NOSRC *NOLIST)

             CRTDUPOBJ  OBJ(QAFDACCP) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(ACCPTH)
             ADDPFM     FILE(QTEMP/ACCPTH) MBR(ACCPTH)
             MONMSG     MSGID(CPF0000)

             CRTDUPOBJ  OBJ(QADSPFFD) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(FLDLST)
             ADDPFM     FILE(QTEMP/FLDLST) MBR(FLDLST)
             MONMSG     MSGID(CPF0000)
             CRTLF      FILE(QTEMP/DSPFLDL) SRCFILE(&SRCLIB/QDDSSRC) +
                          OPTION(*NOSRC *NOLIST)

             CRTDUPOBJ  OBJ(QAFDSELO) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(SELECT)
             ADDPFM     FILE(QTEMP/SELECT) MBR(SELECT)
             MONMSG     MSGID(CPF0000)

             CRTDUPOBJ  OBJ(QADSPDBR) FROMLIB(QSYS) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(DBR)
             ADDPFM     FILE(QTEMP/DBR) MBR(DBR)
             MONMSG     MSGID(CPF0000)
             CRTLF      FILE(QTEMP/DSPFLDL1) OPTION(*NOSRC *NOLIST)

             CRTDUPOBJ  OBJ(ACCPTH) FROMLIB(QTEMP) OBJTYPE(*FILE) +
                          TOLIB(QTEMP) NEWOBJ(ACCPTH1)

/***                                                                    ***/
/*** Set up the overrides and create the last file for creating the     ***/
/*** PRTFILE program objects.                                           ***/
/***                                                                    ***/
             CRTPRTF    FILE(DSPFLDPR) SRCFILE(&SRCLIB/QDDSSRC) +
                          DEVTYPE(*SCS) OPTION(*NOSRC *NOLIST) +
                          PAGESIZE(*N 96) CPI(12) PAGRTT(0) +
                          REPLACE(*NO)

             DSPFD      FILE(QSYS/QADBXATR) TYPE(*ACCPTH) +
                          OUTPUT(*OUTFILE) OUTFILE(QTEMP/DBR2)

/***                                                                    ***/
/*** Create the DLTOBJ command if it does not exist.                    ***/
/***                                                                    ***/
             CHKOBJ     OBJ(&OBJLIB/DLTOBJ) OBJTYPE(*PGM)
             MONMSG     MSGID(CPF9801) EXEC(DO)
                  CRTCLPGM   PGM(&OBJLIB/DLTOBJ) +
                               SRCFILE(&SRCLIB/QCLSRC)
                  DLTSPLF    FILE(DLTOBJ) SPLNBR(*LAST)
                  CRTCMD     CMD(&OBJLIB/DLTOBJ) PGM(&OBJLIB/DLTOBJ) +
                               SRCFILE(&SRCLIB/QCMDSRC)
                  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(START))
                  DLTSPLF    FILE(DLTOBJ) SPLNBR(*LAST)
             ENDDO

/***                                                                    ***/
/*** Start creating the objects.                                        ***/
/***                                                                    ***/
Start:
             CHGVAR     VAR(&SRCFILE) VALUE(%SST(&SRCFILES &SUB1 10))
             CHGVAR     VAR(&SUB1) VALUE(&SUB1 + 10)
             CHGVAR     VAR(&SUB) VALUE(1)
             IF         COND(&SRCFILE *EQ '          ') THEN(GOTO +
                          CMDLBL(ENDPGM))
             IF         COND(&SRCFILE *EQ 'QDDSSRC   ') THEN(GOTO +
                          CMDLBL(STARTDDS))
             ELSE       CMD(IF COND(&SRCFILE *EQ 'QCLSRC    ') +
                          THEN(GOTO CMDLBL(STARTCL)))
             ELSE       CMD(IF COND(&SRCFILE *EQ 'QRPGLESRC ') +
                          THEN(GOTO CMDLBL(STARTRPG)))
             ELSE       CMD(IF COND(&SRCFILE *EQ 'QCMDSRC   ') +
                          THEN(GOTO CMDLBL(STARTCMD)))
             ELSE       CMD(GOTO CMDLBL(START))

/***                                                                    ***/
/*** Create the files.                                                  ***/
/***                                                                    ***/
StartDDS:
             CHGVAR     VAR(&MBR) VALUE(%SST(&DDSSRC &SUB 10))
             IF         COND(&MBR *EQ ' ') THEN(GOTO CMDLBL(START))
             CHGVAR     VAR(&MBRX) VALUE(&MBR *TCAT 'X')

/***                                                                    ***/
/*** Delete the file if it exists and increment the subscript.          ***/
/***                                                                    ***/
             DLTF       FILE(&OBJLIB/&MBR)
             MONMSG     MSGID(CPF0000)
             CHGVAR     VAR(&SUB) VALUE(&SUB + 10)

/***                                                                    ***/
/*** Get the member type from the description.                          ***/
/***                                                                    ***/
             RTVMBRD    FILE(&SRCLIB/&SRCFILE) MBR(&MBR) +
                          SRCTYPE(&TYPE)
/***                                                                    ***/
/*** Create the object if this is a physical file...                    ***/
/***                                                                    ***/
             IF         COND(&TYPE *EQ 'PF') THEN(DO)
                  CRTPF      FILE(&OBJLIB/&MBR) +
                               SRCFILE(&SRCLIB/QDDSSRC) +
                               SIZE(*NOMAX) REUSEDLT(*YES) +
                               AUT(*EXCLUDE)
                  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTDDS))
             ENDDO
/***                                                                    ***/
/*** ...else if it is a logical file...                                 ***/
/***                                                                    ***/
             ELSE       CMD(IF COND(&TYPE *EQ 'LF') THEN(DO))
                  CRTLF      FILE(&OBJLIB/&MBR) +
                               SRCFILE(&SRCLIB/QDDSSRC) +
                               AUT(*EXCLUDE)
                  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTDDS))
             ENDDO
/***                                                                    ***/
/*** ...else if it is a printer file...                                 ***/
/***                                                                    ***/
             ELSE       CMD(IF COND(&TYPE *EQ 'PRTF') THEN(DO))
                  CRTPRTF    FILE(&OBJLIB/&MBR) +
                               SRCFILE(&SRCLIB/QDDSSRC) +
                               AUT(*EXCLUDE)
                  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTDDS))
             ENDDO
/***                                                                    ***/
/*** ...otherwise it is a display file.                                 ***/
/***                                                                    ***/
             ELSE       CMD(IF COND(&TYPE *EQ 'DSPF') THEN(DO))
                  CRTDSPF    FILE(&OBJLIB/&MBR) +
                               SRCFILE(&SRCLIB/QDDSSRC) +
                               RSTDSP(*YES) AUT(*EXCLUDE)
                  MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTDDS))
             ENDDO
/***                                                                    ***/
/*** Delete the spooled file and return to start the next member.       ***/
/***                                                                    ***/
             DLTSPLF    FILE(&MBR) SPLNBR(*LAST)
             GOTO       CMDLBL(STARTDDS)

/***                                                                    ***/
/*** Create the CL programs.                                            ***/
/***                                                                    ***/
StartCL:
             CHGVAR     VAR(&MBR) VALUE(%SST(&CLSRC &SUB 10))
             IF         COND(&MBR *EQ ' ') THEN(GOTO CMDLBL(START))
             CHGVAR     VAR(&MBRX) VALUE(&MBR *TCAT 'X')

/***                                                                    ***/
/*** Delete the CL program if it exists.                                ***/
/***                                                                    ***/
             DLTOBJ     OBJECT(&OBJLIB/&MBR) TYPE(CLP)
             MONMSG     MSGID(CPF0000)
             CHGVAR     VAR(&SUB) VALUE(&SUB + 10)

/***                                                                    ***/
/*** Create the CL program.                                             ***/
/***                                                                    ***/
             CRTCLPGM   PGM(&OBJLIB/&MBR) SRCFILE(&SRCLIB/QCLSRC) +
                          LOG(*NO) ALWRTVSRC(*NO) AUT(*EXCLUDE)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTCL))
             DLTSPLF    FILE(&MBR) SPLNBR(*LAST)
             GOTO       CMDLBL(STARTCL)

/***                                                                    ***/
/*** Create the RPG programs.                                           ***/
/***                                                                    ***/
StartRPG:
             CHGVAR     VAR(&MBR) VALUE(%SST(&RPGLESRC &SUB 10))
             IF         COND(&MBR *EQ ' ') THEN(GOTO CMDLBL(START))
             CHGVAR     VAR(&MBRX) VALUE(&MBR *TCAT 'X')

/***                                                                    ***/
/*** Delete the program if it exists.                                   ***/
/***                                                                    ***/
             DLTOBJ     OBJECT(&OBJLIB/&MBR) TYPE(RPGLE)
             MONMSG     MSGID(CPF0000)
             CHGVAR     VAR(&SUB) VALUE(&SUB + 10)

/***                                                                    ***/
/*** Create the new program.                                            ***/
/***                                                                    ***/
             CRTBNDRPG  PGM(&OBJLIB/&MBR) SRCFILE(&SRCLIB/&SRCFILE) +
                          AUT(*EXCLUDE)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(STARTRPG))
             DLTSPLF    FILE(&MBR) SPLNBR(*LAST)
             GOTO       CMDLBL(STARTRPG)

/***                                                                    ***/
/*** Create the commands.                                               ***/
/***                                                                    ***/
StartCMD:
             CHGVAR     VAR(&MBR) VALUE(%SST(&CMDSRC &SUB 10))
             IF         COND(&MBR *EQ ' ') THEN(GOTO CMDLBL(START))
             CHGVAR     VAR(&MBRX) VALUE(&MBR *TCAT 'X')

/***                                                                    ***/
/*** Delete the command if it exists.                                   ***/
/***                                                                    ***/
             DLTOBJ     OBJECT(&OBJLIB/&MBR) TYPE(CMD)
             MONMSG     MSGID(CPF0000)
             CHGVAR     VAR(&SUB) VALUE(&SUB + 10)

/***                                                                    ***/
/*** Create the command.                                                ***/
/***                                                                    ***/
             CRTCMD     CMD(&OBJLIB/&MBR) PGM(&OBJLIB/&MBR) +
                          SRCFILE(&SRCLIB/QCMDSRC) ALLOW(*INTERACT +
                          *IPGM *IREXX *IMOD) AUT(*EXCLUDE)

/***                                                                    ***/
/*** Delete the spooled file and return to create the next command.     ***/
/***                                                                    ***/
             DLTSPLF    FILE(&MBR) SPLNBR(*LAST)
             GOTO       CMDLBL(STARTCMD)


/**************************************************************************/
/*** FROM LIBRARY DOES NOT EXIST                                        ***/
/**************************************************************************/
NoFromLib:
             SNDPGMMSG  MSG('The from library' *BCAT &SRCLIB *BCAT +
                          'does not exist - program ended')
             GOTO       CMDLBL(ENDPGM)


/**************************************************************************/
/*** TO LIBRARY DOES NOT EXIST                                          ***/
/**************************************************************************/
NoToLib:
             SNDPGMMSG  MSG('The to library' *BCAT &OBJLIB *BCAT +
                          'does not exist - program ended')
             GOTO       CMDLBL(ENDPGM)


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


Endpgm:
 ENDPGM