PDA

View Full Version : CPYMLTF - Copy Multiple PF's to a single PF



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