CLP source of SET181CPYS

LANSA

previous page next page
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(&COPYFLAG) 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(&COPYFLAG) 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(&COPYFLAG) 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(&COPYFLAG = 'TXT') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &XLS_EXT)
CHGVAR VAR(&COPYFLAG) VALUE('XLS')
GOTO CMDLBL(COPY)
ENDDO

IF COND(&COPYFLAG = 'XLS') THEN(DO)
CHGVAR VAR(&TOOBJ) VALUE(&TOOBJ *TCAT &DTA_EXT)
CHGVAR VAR(&COPYFLAG) VALUE('DTA')
GOTO CMDLBL(COPY)
ENDDO

/* Delete .tmp file */

DEL OBJLNK(&TOSTMF)

END: ENDPGM

previous page start next page