kitvb1
23rd April 2008, 22:13
This command will copy multiple physical files (tables) with multiple members (partitions) to a single physical file. One can optionally choose from which libraries (schema) as well as the from and to members.
Important:
1. If the to-file does not exist, it will be created.
2. If the to-file, or a logical file (index) built over the file, has a unique key (primary index), the duplicate records will be ignored.
3. Format option of *NOCHK is used. i.e. the data is copied without checking the validity of the contents.
4. If a from-file is empty, the command will issue a message and continue with the next file.
Objects created to v510. Tested from v520 thru v540.
Contents of ZIP file is a savf containing the CMD and the CLLE. Hope you will find it useful.Command
/* ---------------------------------------------------------------------*/
/* System Name .....: SYSTEMS */
/* Company..........: Ecofit Ltd */
/* Author...........: Deon A von Blerk */
/* Date.............: 23.04.08 */
/* Description......: Copy many files to one file */
/* */
/* MODIFICATION CONTROL */
/* ==================== */
/* Date Nr By/Reason */
/* ==== == ========= */
/* ---------------------------------------------------------------------*/
CMD PROMPT('Copy Multiple PFs to 1 File')
PARM KWD(FRFILE) TYPE(QUAL1) MIN(1) PROMPT('From +
File(s)')
PARM KWD(TOFILE) TYPE(QUAL2) MIN(1) PROMPT('To +
File')
PARM KWD(FRMBR) TYPE(*GENERIC) LEN(10) DFT(*ALL) +
SPCVAL((*FIRST) (*ALL)) +
PROMPT('From member')
PARM KWD(TOMBR) TYPE(*NAME) LEN(10) +
DFT(*FIRST) SPCVAL((*FIRST) (*FROMMBR)) +
PROMPT('To member')
QUAL1: QUAL TYPE(*GENERIC) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*USRLIBL) (*CURLIB) (*ALL) +
(*ALLUSR)) PROMPT('Library')
QUAL2: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
CLLE Program
/* ---------------------------------------------------------------------*/
/* System Name .....: SYSTEMS */
/* Company..........: Ecofit Ltd */
/* Author...........: Deon A von Blerk */
/* Date.............: 23.04.08 */
/* Description......: Copy many files to one file */
/* */
/* MODIFICATION CONTROL */
/* ==================== */
/* Date Nr By/Reason */
/* ==== == ========= */
/* ---------------------------------------------------------------------*/
PGM PARM(&FRFILELIB &TOFILELIB &FRMBR &TOMBR)
DCL VAR(&FRFILELIB) TYPE(*CHAR) LEN(20)
DCL VAR(&TOFILELIB) TYPE(*CHAR) LEN(20)
DCL VAR(&FRFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&FRLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TOFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&TOLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&FRMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&TOMBR) TYPE(*CHAR) LEN(10)
DCLF FILE(CPYMLTF)
CHGVAR VAR(&FRFILE) VALUE(%sst(&frfilelib 1 10))
CHGVAR VAR(&FRLIB) VALUE(%sst(&frfilelib 11 10))
CHGVAR VAR(&TOFILE) VALUE(%sst(&tofilelib 1 10))
CHGVAR VAR(&TOLIB) VALUE(%sst(&tofilelib 11 10))
/* get the file names */
CLRPFM FILE(QTEMP/CPYMLTF)
MONMSG MSGID(CPF0000)
DSPOBJD OBJ(&FRLIB/&FRFILE) OBJTYPE(*FILE) +
DETAIL(*BASIC) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/CPYMLTF)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Could not find source file/s')
ENDDO
OVRDBF FILE(CPYMLTF) TOFILE(QTEMP/CPYMLTF) +
OVRSCOPE(*CALLLVL)
CLRPFM FILE(&TOLIB/&FRLIB)
MONMSG MSGID(CPF0000)
/* copy the Files */
RCVF
MONMSG MSGID(CPF0864) EXEC(DO)
SNDPGMMSG MSG('Could not find anything to copy')
GOTO CMDLBL(END)
ENDDO
LOOP1:
IF COND(&ODOBAT *EQ 'PF') THEN(DO)
CPYF FROMFILE(&ODLBNM/&ODOBNM) +
TOFILE(&TOLIB/&TOFILE) FROMMBR(&FRMBR) +
TOMBR(&TOMBR) MBROPT(*ADD) CRTFILE(*YES) +
FMTOPT(*NOCHK) ERRLVL(*NOMAX)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Could not copy one or more from file. +
Check the joblog for more details')
SNDPGMMSG MSG('Continuing with next file')
ENDDO
ENDDO
/* copy the Files */
RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDLOOP1))
GOTO CMDLBL(LOOP1)
ENDLOOP1:
SUCCESS: SNDPGMMSG MSG('Completed succesfully')
END: ENDPGM
Important:
1. If the to-file does not exist, it will be created.
2. If the to-file, or a logical file (index) built over the file, has a unique key (primary index), the duplicate records will be ignored.
3. Format option of *NOCHK is used. i.e. the data is copied without checking the validity of the contents.
4. If a from-file is empty, the command will issue a message and continue with the next file.
Objects created to v510. Tested from v520 thru v540.
Contents of ZIP file is a savf containing the CMD and the CLLE. Hope you will find it useful.Command
/* ---------------------------------------------------------------------*/
/* System Name .....: SYSTEMS */
/* Company..........: Ecofit Ltd */
/* Author...........: Deon A von Blerk */
/* Date.............: 23.04.08 */
/* Description......: Copy many files to one file */
/* */
/* MODIFICATION CONTROL */
/* ==================== */
/* Date Nr By/Reason */
/* ==== == ========= */
/* ---------------------------------------------------------------------*/
CMD PROMPT('Copy Multiple PFs to 1 File')
PARM KWD(FRFILE) TYPE(QUAL1) MIN(1) PROMPT('From +
File(s)')
PARM KWD(TOFILE) TYPE(QUAL2) MIN(1) PROMPT('To +
File')
PARM KWD(FRMBR) TYPE(*GENERIC) LEN(10) DFT(*ALL) +
SPCVAL((*FIRST) (*ALL)) +
PROMPT('From member')
PARM KWD(TOMBR) TYPE(*NAME) LEN(10) +
DFT(*FIRST) SPCVAL((*FIRST) (*FROMMBR)) +
PROMPT('To member')
QUAL1: QUAL TYPE(*GENERIC) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*USRLIBL) (*CURLIB) (*ALL) +
(*ALLUSR)) PROMPT('Library')
QUAL2: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
CLLE Program
/* ---------------------------------------------------------------------*/
/* System Name .....: SYSTEMS */
/* Company..........: Ecofit Ltd */
/* Author...........: Deon A von Blerk */
/* Date.............: 23.04.08 */
/* Description......: Copy many files to one file */
/* */
/* MODIFICATION CONTROL */
/* ==================== */
/* Date Nr By/Reason */
/* ==== == ========= */
/* ---------------------------------------------------------------------*/
PGM PARM(&FRFILELIB &TOFILELIB &FRMBR &TOMBR)
DCL VAR(&FRFILELIB) TYPE(*CHAR) LEN(20)
DCL VAR(&TOFILELIB) TYPE(*CHAR) LEN(20)
DCL VAR(&FRFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&FRLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&TOFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&TOLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&FRMBR) TYPE(*CHAR) LEN(10)
DCL VAR(&TOMBR) TYPE(*CHAR) LEN(10)
DCLF FILE(CPYMLTF)
CHGVAR VAR(&FRFILE) VALUE(%sst(&frfilelib 1 10))
CHGVAR VAR(&FRLIB) VALUE(%sst(&frfilelib 11 10))
CHGVAR VAR(&TOFILE) VALUE(%sst(&tofilelib 1 10))
CHGVAR VAR(&TOLIB) VALUE(%sst(&tofilelib 11 10))
/* get the file names */
CLRPFM FILE(QTEMP/CPYMLTF)
MONMSG MSGID(CPF0000)
DSPOBJD OBJ(&FRLIB/&FRFILE) OBJTYPE(*FILE) +
DETAIL(*BASIC) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/CPYMLTF)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Could not find source file/s')
ENDDO
OVRDBF FILE(CPYMLTF) TOFILE(QTEMP/CPYMLTF) +
OVRSCOPE(*CALLLVL)
CLRPFM FILE(&TOLIB/&FRLIB)
MONMSG MSGID(CPF0000)
/* copy the Files */
RCVF
MONMSG MSGID(CPF0864) EXEC(DO)
SNDPGMMSG MSG('Could not find anything to copy')
GOTO CMDLBL(END)
ENDDO
LOOP1:
IF COND(&ODOBAT *EQ 'PF') THEN(DO)
CPYF FROMFILE(&ODLBNM/&ODOBNM) +
TOFILE(&TOLIB/&TOFILE) FROMMBR(&FRMBR) +
TOMBR(&TOMBR) MBROPT(*ADD) CRTFILE(*YES) +
FMTOPT(*NOCHK) ERRLVL(*NOMAX)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('Could not copy one or more from file. +
Check the joblog for more details')
SNDPGMMSG MSG('Continuing with next file')
ENDDO
ENDDO
/* copy the Files */
RCVF
MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(ENDLOOP1))
GOTO CMDLBL(LOOP1)
ENDLOOP1:
SUCCESS: SNDPGMMSG MSG('Completed succesfully')
END: ENDPGM