| 
PGM PARM(&FICLIB &TABLIB &DATA)
DCL &FICLIB *CHAR 20
DCL &TABLIB *CHAR 20
DCL &FIC *CHAR 10
DCL &LIBF *CHAR 10
DCL &TAB *CHAR 10
DCL &LIBT *CHAR 10
DCL &DATA *CHAR 4
DCLF FILE(QDDSSRC)
DCL &NAME *CHAR 10
DCL &DDSTYP *CHAR 1
DCL &TYPE *CHAR 8
DCL &DDSLEN *CHAR 5
DCL &DDSDEC *CHAR 1
DCL &SQL *CHAR 2000
DCL VAR(&LEN) TYPE(*DEC) LEN(15 5) VALUE(2000)
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 */
MONMSG MSGID(CPF0000) EXEC(GOTO STDERR1) /* Std err */
CHGVAR &FIC %SST(&FICLIB 1 10)
CHGVAR &LIBF %SST(&FICLIB 11 10)
CHGVAR &TAB %SST(&TABLIB 1 10)
CHGVAR &LIBT %SST(&TABLIB 11 10)
CHKOBJ OBJ(RTVPFSRC) OBJTYPE(*FILE)
MONMSG CPF9801 EXEC(DO)
CRTSRCPF FILE(QTEMP/RTVPFSRC)
GOTO SUITE
ENDDO
RMVM FILE(RTVPFSRC) MBR(RTVPFSRC)
SUITE: RTVPFSRC FILE(&LIBF/&FIC) SRCFILE(QTEMP/RTVPFSRC) +
SRCMBR(RTVPFSRC)
OVRDBF FILE(QDDSSRC) TOFILE(QTEMP/RTVPFSRC) +
MBR(RTVPFSRC)
CHGVAR VAR(&SQL) VALUE('CRTSQLTAB ' *CAT &LIBT *TCAT +
'/' *CAT &TAB *TCAT ' ZONE(')
LECTU: RCVF
MONMSG CPF0864 EXEC(GOTO CREATE)
IF (%SST(&SRCDTA 17 1) *NE ' ') GOTO LECTU
IF (%SST(&SRCDTA 19 1) *EQ ' ') GOTO LECTU
CHGVAR &NAME %SST(&SRCDTA 19 10)
CHGVAR &SQL (&SQL *BCAT '(' *CAT &NAME)
|
|
CHGVAR &DDSLEN %SST(&SRCDTA 30 5)
CHGVAR &DDSTYP %SST(&SRCDTA 35 1)
CHGVAR &DDSDEC %SST(&SRCDTA 37 1)
IF (&DDSDEC = ' ') THEN( +
CHGVAR VAR(&TYPE) VALUE('*CHAR'))
ELSE DO
IF COND(&DDSTYP = 'S') THEN(CHGVAR VAR(&TYPE) +
VALUE('*ZONED'))
IF COND((&DDSTYP = ' ') *OR (&DDSTYP = 'P')) +
THEN(CHGVAR VAR(&TYPE) VALUE('*DEC'))
IF COND(&DDSTYP = 'B') THEN(DO)
IF COND(%SST(&DDSLEN 4 2) < '04') THEN(CHGVAR +
VAR(&TYPE) VALUE('*BIN2'))
ELSE CMD(CHGVAR VAR(&TYPE) VALUE('*BIN4'))
ENDDO
ENDDO
CHGVAR &SQL (&SQL *BCAT &TYPE)
CHGVAR &SQL (&SQL *BCAT &DDSLEN)
IF (&DDSDEC *NE ' ') THEN( +
CHGVAR &SQL (&SQL *BCAT &DDSDEC))
ELSE CHGVAR &SQL (&SQL *BCAT '*N')
CHGVAR VAR(&SQL) VALUE(&SQL *TCAT ' *YES)')
GOTO LECTU
CREATE: CHGVAR VAR(&SQL) VALUE(&SQL *TCAT ') AUT(*EXCLUDE)')
CALL PGM(QCMDEXC) PARM(&SQL &LEN)
GRTOBJAUT OBJ(&LIBT/&TAB) OBJTYPE(*FILE) +
REFOBJ(&LIBF/&FIC)
IF (&DATA *EQ '*YES') THEN(DO)
CPYF FROMFILE(&LIBF/&FIC) TOFILE(&LIBT/&TAB) +
MBROPT(*ADD)
ENDDO
RETURN /* Normal end of program */
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
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) MSGFLIB(&MSGFLIB)
|
|
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) ENDPGM |
