CLP source of SET181CPYS
PGM PARM(&CODEPAGE &ACTION &PCASCII &TOSTMF &TOOBJ)
/* PARAMETERS: */
/* */
/* &CODEPAGE: used only for OS/400 V4R1 and V4R2. It is the ASCII */
/* code page for the file created in the IFS. The */
/* CPYTOIMPF creates the file in the IFS but with an */
/* EBCDIC codepage. Hence the two steps, first create */
/* the file with CPYTOIMPF and the CPY with the */
/* ASCII code page */
/* */
/* &ACTION: this program is called twice from SET181A. First time */
/* it creates a temporary file with the extension .tmp */
/* using the CPYTOIMPF. Second time it uses the CPY */
/* The value of &ACTION will be 'CPYTOIMPF' the first */
/* Time and CPY the second time it is called. */
/* */
/* &PCASCII: will be either blank or 'PCASCII' depending on the */
/* OS/400 version. This is determined in the function */
/* SET181A. */
/* */
/* &TOSTMF: the partial value of the parameter TOSTMF in the */
/* CPYTOIMPF and CPY command. The extension will be */
/* added in this program. */
/* */
/* &TOOBJ : the partial value of the parameter TOOBJ in the */
/* CPY command. The extension will be added in this */
/* program. */
/* */
/* Declare parameter fields */
/* */
DCL VAR(&ACTION) TYPE(*CHAR) LEN(10)
DCL VAR(&CODEPAGE) TYPE(*DEC) LEN(5 0)
DCL VAR(&TOSTMF) TYPE(*CHAR) LEN(255)
DCL VAR(&TOOBJ) TYPE(*CHAR) LEN(255)
DCL VAR(&PCASCII) TYPE(*CHAR) LEN(8)
/* */
/* Working fields */
/* */
DCL VAR(&TMPVAR) TYPE(*CHAR) LEN(255)
DCL VAR(©FLAG) TYPE(*CHAR) LEN(3)
/* */
/* File extensions created. */
/* */
/* The TMP extension is for the file created by CPYTOIMPF command */
/* The other files (.txt, .xls and .dta) will be copied from it. */
/* */
DCL VAR(&TMP_EXT) TYPE(*CHAR) LEN(3) VALUE(TMP)
DCL VAR(&TXT_EXT) TYPE(*CHAR) LEN(3) VALUE(TXT)
DCL VAR(&XLS_EXT) TYPE(*CHAR) LEN(3) VALUE(XLS)
DCL VAR(&DTA_EXT) TYPE(*CHAR) LEN(3) VALUE(DTA)
/* */
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(END))
/* Use CPYTOIMPF to create EBCDIC flat file in IFS */
/* Note that the CPYTOIMPF command has a range of possible values */
/* to control field delimiters, end of record character, etc. */
IF COND(&ACTION = 'CPYTOIMPF') THEN(DO)
CHGVAR VAR(&TMPVAR) VALUE(&TOSTMF)
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CPYTOIMPF FROMFILE(QTEMP/SETPSL) TOSTMF(&TOSTMF) +
MBROPT(*REPLACE) RCDDLM(*CRLF)
CHGVAR VAR(&TOSTMF) VALUE(&TMPVAR)
GOTO CMDLBL(END)
ENDDO
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CHGVAR VAR(&TMPVAR) VALUE(&TOOBJ)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &TXT_EXT)
CHGVAR VAR(©FLAG) VALUE('TXT')
/* Perform three CPY commands to create SETPSLnnn.txt, SETPSLnnn.xsl*/
/* and SETPSLnnn.dta */
COPY: IF COND((&ACTION = 'CPY') *AND (&PCASCII = +
'*PCASCII')) THEN(CPY OBJ(&TOSTMF) +
TOOBJ(&TOOBJ) TOCODEPAGE(&PCASCII) +
DTAFMT(*TEXT))
IF COND((&ACTION = 'CPY') *AND (&PCASCII = ' +
')) THEN(CPY OBJ(&TOSTMF) TOOBJ(&TOOBJ) +
TOCODEPAGE(&CODEPAGE) DTAFMT(*TEXT))
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CHGVAR VAR(&TMPVAR) VALUE(&TOOBJ)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &TXT_EXT)
CHGVAR VAR(©FLAG) VALUE('TXT')
/* Perform three CPY commands to create SETPSLnnn.txt, SETPSLnnn.xsl*/
/* and SETPSLnnn.dta */
COPY: IF COND((&ACTION = 'CPY') *AND (&PCASCII = +
'*PCASCII')) THEN(CPY OBJ(&TOSTMF) +
TOOBJ(&TOOBJ) TOCODEPAGE(&PCASCII) +
DTAFMT(*TEXT))
IF COND((&ACTION = 'CPY') *AND (&PCASCII = ' +
')) THEN(CPY OBJ(&TOSTMF) TOOBJ(&TOOBJ) +
TOCODEPAGE(&CODEPAGE) DTAFMT(*TEXT))
CHGVAR VAR(&TOOBJ) VALUE(&TMPVAR)
IF COND(©FLAG = 'TXT') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &XLS_EXT)
CHGVAR VAR(©FLAG) VALUE('XLS')
GOTO CMDLBL(COPY)
ENDDO
IF COND(©FLAG = 'XLS') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &DTA_EXT)
CHGVAR VAR(©FLAG) VALUE('DTA')
GOTO CMDLBL(COPY)
ENDDO
/* Delete .tmp file */
DEL OBJLNK(&TOSTMF)
END: ENDPGM
PGM PARM(&CODEPAGE &ACTION &PCASCII &TOSTMF &TOOBJ)
/* PARAMETERS: */
/* */
/* &CODEPAGE: used only for OS/400 V4R1 and V4R2. It is the ASCII */
/* code page for the file created in the IFS. The */
/* CPYTOIMPF creates the file in the IFS but with an */
/* EBCDIC codepage. Hence the two steps, first create */
/* the file with CPYTOIMPF and the CPY with the */
/* ASCII code page */
/* */
/* &ACTION: this program is called twice from SET181A. First time */
/* it creates a temporary file with the extension .tmp */
/* using the CPYTOIMPF. Second time it uses the CPY */
/* The value of &ACTION will be 'CPYTOIMPF' the first */
/* Time and CPY the second time it is called. */
/* */
/* &PCASCII: will be either blank or 'PCASCII' depending on the */
/* OS/400 version. This is determined in the function */
/* SET181A. */
/* */
/* &TOSTMF: the partial value of the parameter TOSTMF in the */
/* CPYTOIMPF and CPY command. The extension will be */
/* added in this program. */
/* */
/* &TOOBJ : the partial value of the parameter TOOBJ in the */
/* CPY command. The extension will be added in this */
/* program. */
/* */
/* Declare parameter fields */
/* */
DCL VAR(&ACTION) TYPE(*CHAR) LEN(10)
DCL VAR(&CODEPAGE) TYPE(*DEC) LEN(5 0)
DCL VAR(&TOSTMF) TYPE(*CHAR) LEN(255)
DCL VAR(&TOOBJ) TYPE(*CHAR) LEN(255)
DCL VAR(&PCASCII) TYPE(*CHAR) LEN(8)
/* */
/* Working fields */
/* */
DCL VAR(&TMPVAR) TYPE(*CHAR) LEN(255)
DCL VAR(©FLAG) TYPE(*CHAR) LEN(3)
/* */
/* File extensions created. */
/* */
/* The TMP extension is for the file created by CPYTOIMPF command */
/* The other files (.txt, .xls and .dta) will be copied from it. */
/* */
DCL VAR(&TMP_EXT) TYPE(*CHAR) LEN(3) VALUE(TMP)
DCL VAR(&TXT_EXT) TYPE(*CHAR) LEN(3) VALUE(TXT)
DCL VAR(&XLS_EXT) TYPE(*CHAR) LEN(3) VALUE(XLS)
DCL VAR(&DTA_EXT) TYPE(*CHAR) LEN(3) VALUE(DTA)
/* */
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(END))
/* Use CPYTOIMPF to create EBCDIC flat file in IFS */
/* Note that the CPYTOIMPF command has a range of possible values */
/* to control field delimiters, end of record character, etc. */
IF COND(&ACTION = 'CPYTOIMPF') THEN(DO)
CHGVAR VAR(&TMPVAR) VALUE(&TOSTMF)
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CPYTOIMPF FROMFILE(QTEMP/SETPSL) TOSTMF(&TOSTMF) +
MBROPT(*REPLACE) RCDDLM(*CRLF)
CHGVAR VAR(&TOSTMF) VALUE(&TMPVAR)
GOTO CMDLBL(END)
ENDDO
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CHGVAR VAR(&TMPVAR) VALUE(&TOOBJ)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &TXT_EXT)
CHGVAR VAR(©FLAG) VALUE('TXT')
/* Perform three CPY commands to create SETPSLnnn.txt, SETPSLnnn.xsl*/
/* and SETPSLnnn.dta */
COPY: IF COND((&ACTION = 'CPY') *AND (&PCASCII = +
'*PCASCII')) THEN(CPY OBJ(&TOSTMF) +
TOOBJ(&TOOBJ) TOCODEPAGE(&PCASCII) +
DTAFMT(*TEXT))
IF COND((&ACTION = 'CPY') *AND (&PCASCII = ' +
')) THEN(CPY OBJ(&TOSTMF) TOOBJ(&TOOBJ) +
TOCODEPAGE(&CODEPAGE) DTAFMT(*TEXT))
CHGVAR VAR(&TOSTMF) VALUE(&TOSTMF *TCAT &TMP_EXT)
CHGVAR VAR(&TMPVAR) VALUE(&TOOBJ)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &TXT_EXT)
CHGVAR VAR(©FLAG) VALUE('TXT')
/* Perform three CPY commands to create SETPSLnnn.txt, SETPSLnnn.xsl*/
/* and SETPSLnnn.dta */
COPY: IF COND((&ACTION = 'CPY') *AND (&PCASCII = +
'*PCASCII')) THEN(CPY OBJ(&TOSTMF) +
TOOBJ(&TOOBJ) TOCODEPAGE(&PCASCII) +
DTAFMT(*TEXT))
IF COND((&ACTION = 'CPY') *AND (&PCASCII = ' +
')) THEN(CPY OBJ(&TOSTMF) TOOBJ(&TOOBJ) +
TOCODEPAGE(&CODEPAGE) DTAFMT(*TEXT))
CHGVAR VAR(&TOOBJ) VALUE(&TMPVAR)
IF COND(©FLAG = 'TXT') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &XLS_EXT)
CHGVAR VAR(©FLAG) VALUE('XLS')
GOTO CMDLBL(COPY)
ENDDO
IF COND(©FLAG = 'XLS') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &DTA_EXT)
CHGVAR VAR(©FLAG) VALUE('DTA')
GOTO CMDLBL(COPY)
ENDDO
/* Delete .tmp file */
DEL OBJLNK(&TOSTMF)
END: ENDPGM