PGM
DCL
VAR(&NBRRCD) TYPE(*DEC) LEN(10 0)
DCL
VAR(&FREC#) TYPE(*DEC) LEN(10 0)
DCL
VAR(&TREC#) TYPE(*DEC) LEN(10 0)
DCL
VAR(&FRECA) TYPE(*CHAR) LEN(10)
DCL
VAR(&TRECA) TYPE(*CHAR) LEN(10)
DCL
VAR(&FILE#) TYPE(*DEC) LEN(2 0) VALUE(1)
DCL
VAR(&FILE#A) TYPE(*CHAR) LEN(2)
DCL
VAR(&DOCNAME) TYPE(*CHAR) LEN(12)
DCLF
FILE(SVGENDF)
/*-------------------------------------------------------------------*/
/* CHANGE DEFAULT VALUES HERE!!!!
*/
/*-------------------------------------------------------------------*/
/* FILE TO CONVERT TO SEPERATED VALUE */
CHGVAR VAR(&FILE) VALUE('
')
/* MEMBER TO CONVERT TO SEPERATED VALUE */
CHGVAR VAR(&MEMBER) VALUE('*FIRST')
/* LIBRARY TO CONVERT TO SEPERATED VALUE */
CHGVAR VAR(&LIB) VALUE('*LIBL')
/* 6 CHAR DOCUMENT NAME TO BE SAVED TO IN
AS/400 PC FOLDER */
CHGVAR VAR(&DFTNAM) VALUE('
')
/* 1 CHAR SEPERATER TO USE FOR FIELD
SEPERATING */
CHGVAR VAR(&SEP) VALUE(',')
/* AS/400 PC FOLDER NAME
*/
CHGVAR VAR(&FOLDER) VALUE('
')
/* SEPERATE FILE?
*/
CHGVAR VAR(&BRK) VALUE('Y')
/*-------------------------------------------------------------------*/
/* PROCESS SCREEN UNTIL NO ERRORS
*/
/*-------------------------------------------------------------------*/
RETRY: SNDRCVF
DEV(*FILE) RCDFMT(SCREEN1)
IF COND(&IN03 *EQ '1')
THEN(DO)
GOTO
CMDLBL(END)
ENDDO
CHGVAR VAR(&TEXT) VALUE(*BLANKS)
CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(DO)
CHGVAR VAR(&TEXT) VALUE('FILE NOT FOUND')
GOTO
CMDLBL(RETRY)
ENDDO
MONMSG MSGID(CPF9810) EXEC(DO)
CHGVAR VAR(&TEXT) VALUE('LIBRARY NOT FOUND')
GOTO
CMDLBL(RETRY)
ENDDO
RTVMBRD FILE(&LIB/&FILE) MBR(&MEMBER)
MONMSG MSGID(CPF9815) EXEC(DO)
CHGVAR VAR(&TEXT) VALUE('MEMBER NOT FOUND')
GOTO
CMDLBL(RETRY)
ENDDO
DSPFLR FLR(&FOLDER) OUTPUT(*PRINT)
MONMSG MSGID(OFC8006) EXEC(DO)
CHGVAR VAR(&TEXT) VALUE('AS/400 FOLDER NOT FOUND')
GOTO
CMDLBL(RETRY)
ENDDO
/*-------------------------------------------------------------------*/
/* CHECK FILE AND SEE IF ANY RECORDS ARE IN IT
*/
/*-------------------------------------------------------------------*/
RTVMBRD FILE(&FILE) NBRCURRCD(&NBRRCD)
IF
COND(&NBRRCD *EQ 0) THEN(DO)
CHGVAR VAR(&TEXT) VALUE('No Records In file.')
GOTO
CMDLBL(RETRY)
ENDDO
/*-------------------------------------------------------------------*/
/* IF ANY RECORDS COPY WHOLE FILE TO SEPERATED
WORK FILE */
/*-------------------------------------------------------------------*/
CHGVAR VAR(&TEXT) VALUE('Creating Seperated Export
+
file From ' *CAT &FILE)
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CPYTOIMPF FROMFILE(&LIB/&FILE &MEMBER) TOFILE(SVGENP1) +
MBROPT(*REPLACE) STRDLM(*NONE) FLDDLM(&SEP)
/*-------------------------------------------------------------------*/
/* CHECK NUMBER OF RECORDS AND COPY IN 50000
RECORD BLOCKS */
/*-------------------------------------------------------------------*/
RTVMBRD FILE(&FILE) NBRCURRCD(&NBRRCD)
IF COND(&NBRRCD *LE 50000)
THEN(DO)
GOTO
CMDLBL(ONEFILE)
ENDDO
IF COND(&BRK *EQ 'N')
THEN(DO)
GOTO
CMDLBL(ONEFILE)
ENDDO
AGAIN: CHGVAR
VAR(&FILE#A) VALUE(&FILE#)
CHGVAR VAR(&DOCNAME) VALUE((&DFTNAM) *TCAT +
(&FILE#A) *TCAT '.TXT')
IF COND(&NBRRCD *LE 50000)
THEN(DO)
GOTO
CMDLBL(REMAIN)
ENDDO
IF COND(&NBRRCD *GT 50000)
THEN(DO)
CHGVAR VAR(&TREC#) VALUE(50000 * &FILE#)
CHGVAR VAR(&FREC#) VALUE(&TREC# - 49999)
CHGVAR VAR(&FRECA) VALUE(&FREC#)
CHGVAR VAR(&TRECA) VALUE(&TREC#)
CHGVAR VAR(&FILE#) VALUE(&FILE# + 1)
CHGVAR VAR(&TEXT) VALUE(*BLANKS)
CHGVAR VAR(&TEXT) VALUE('Copying Records ' *CAT +
&FRECA *CAT '-' *CAT &TRECA *BCAT 'to' +
*BCAT &DOCNAME)
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CPYF
FROMFILE(SVGENP1) TOFILE(SVGENP2) +
MBROPT(*REPLACE) FROMRCD(&FREC#) +
TORCD(&TREC#)
CHGVAR VAR(&TEXT) VALUE(*BLANKS)
CHGVAR VAR(&TEXT) VALUE('Moving File To AS/400 PC
+
Document')
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CPYTOPCD FROMFILE(SVGENP2) TOFLR(&FOLDER) +
TODOC(&DOCNAME) REPLACE(*YES)
CHGVAR VAR(&NBRRCD) VALUE(&NBRRCD - 50000)
GOTO
CMDLBL(AGAIN)
ENDDO
/*-------------------------------------------------------------------*/
/* COPY REMAINDER (LESS THAN 50,000)
*/
/*-------------------------------------------------------------------*/
REMAIN: CHGVAR VAR(&FREC#)
VALUE(&TREC# + 1)
CHGVAR VAR(&FRECA) VALUE(&FREC#)
CHGVAR VAR(&TEXT) VALUE(*BLANKS)
CHGVAR VAR(&TEXT) VALUE('Copying Records ' *CAT +
&FRECA *CAT '-' *CAT '*END' *BCAT 'to' +
*BCAT &DOCNAME)
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CPYF
FROMFILE(SVGENP1) TOFILE(SVGENP2) +
MBROPT(*REPLACE) FROMRCD(&FREC#) TORCD(*END)
CHGVAR VAR(&TEXT) VALUE(*BLANKS)
CHGVAR VAR(&TEXT) VALUE('Moving File To AS/400 PC
+
Document')
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CPYTOPCD FROMFILE(SVGENP2) TOFLR(&FOLDER) +
TODOC(&DOCNAME) REPLACE(*YES)
GOTO
CMDLBL(END)
/*-------------------------------------------------------------------*/
/* COPY AS 1 FILE
*/
/*-------------------------------------------------------------------*/
ONEFILE: CHGVAR VAR(&TEXT)
VALUE(*BLANKS)
CHGVAR VAR(&TEXT) VALUE('Moving File To AS/400 PC
+
Document')
SNDF
DEV(*FILE) RCDFMT(SCREEN1)
CHGVAR VAR(&DOCNAME) VALUE((&DFTNAM) *TCAT
'.TXT')
CPYTOPCD FROMFILE(SVGENP1) TOFLR(&FOLDER) +
TODOC(&DOCNAME) REPLACE(*YES)
/*-------------------------------------------------------------------*/
/* END
*/
/*-------------------------------------------------------------------*/
END: ENDPGM