| 
PGM PARM(&FROM &TO &OPT &FROMSAVF &TOSAVF &CRT + &DOC &FLR &MAX) DCL &FROM *CHAR 20 DCL &FROMSAVF *LGL DCL &TO *CHAR 20 DCL &TOSAVF *LGL DCL &OPT *CHAR 8 DCL &CRT *CHAR 4 DCL &FROMF *CHAR 10 DCL &FROML *CHAR 10 DCL &TOF *CHAR 10 DCL &TOL *CHAR 10 DCL &EXTEND *CHAR 4 DCL &DOC *CHAR 12 DCL &FLR *CHAR 63 DCL &MAX *DEC (4 0) DCL &FROMDOC *LGL DCL &TODOC *LGL DCL &NBENREG *DEC (10 0) DCL &DEB *DEC (10 0) DCL &FIN *DEC (10 0) DCL &BCL *DEC (02 0) DCL &BCLCHAR *CHAR 02 DCL &DOC2 *CHAR 12 DCL &ERRORSW *LGL /* SWITCH */ DCL &MSGID *CHAR LEN(7) /* ID MSG */ DCL &MSGDTA *CHAR LEN(100) /* DATA */ DCL &MSGF *CHAR LEN(10) /* FICHIER */ DCL &MSGFLIB *CHAR LEN(10) /* BIBLI */ MONMSG MSGID(CPF0000) EXEC(GOTO ERREUR) IF (%SST(&FROM 1 4) = '*DOC') THEN(DO) CHGVAR &FROMDOC '1' CHGVAR &FROMF 'CPYSAVF' CHGVAR &FROML 'QTEMP' CHGVAR &FROMSAVF '0' CRTPF FILE(QTEMP/CPYSAVF) RCDLEN(528) MONMSG MSGID(CPF7302) EXEC(RCVMSG MSGTYPE(*EXCP)) CPYFRMPCD FROMFLR(&FLR) TOFILE(QTEMP/CPYSAVF) + FROMDOC(&DOC) TRNTBL(*NONE) TRNFMT(*NOTEXT) ENDDO ELSE DO |
|
CHGVAR &FROMF %SST(&FROM 1 10)
CHGVAR &FROML %SST(&FROM 11 10)
CHKOBJ OBJ(&FROML/&FROMF) OBJTYPE(*FILE) AUT(*READ)
ENDDO
IF (%SST(&TO 1 4) = '*DOC') THEN(DO)
CHGVAR &TODOC '1'
CHGVAR &TOF 'CPYSAVF'
CHGVAR &TOL 'QTEMP'
CHGVAR &TOSAVF '0'
CHGVAR &CRT '*YES'
ENDDO
ELSE DO
CHGVAR &TOF %SST(&TO 1 10)
CHGVAR &TOL %SST(&TO 11 10)
IF COND(&CRT *EQ '*NO') THEN(DO)
CHKOBJ OBJ(&TOL/&TOF) OBJTYPE(*FILE) AUT(*ADD)
ENDDO
ENDDO
IF &TOSAVF DO
IF (&CRT *EQ '*YES') DO
CRTSAVF FILE(&TOL/&TOF) TEXT('Fichier créé par +
CPYSAVF')
MONMSG CPF0000
ENDDO
IF (&OPT *NE '*REPLACE') CHGVAR &EXTEND '*YES'
ELSE DO
CLRSAVF FILE(&TOL/&TOF)
CHGVAR &EXTEND '*NO'
ENDDO
OVRSAVF FILE(COPYOUT) TOFILE(&TOL/&TOF) EXTEND(&EXTEND)
ENDDO
ELSE DO
IF (&CRT *EQ '*YES') DO
CRTPF FILE(&TOL/&TOF) RCDLEN(528) TEXT('Fichier +
créé par CPYSAVF')
MONMSG CPF0000
ENDDO
IF (&OPT *EQ '*REPLACE') CLRPFM &TOL/&TOF
OVRDBF FILE(COPYOUT) TOFILE(&TOL/&TOF)
ENDDO
IF &FROMSAVF DO
|
|
OVRSAVF FILE(COPYIN) TOFILE(&FROML/&FROMF)
ENDDO
ELSE DO
OVRDBF FILE(COPYIN) TOFILE(&FROML/&FROMF)
ENDDO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Copie en +
cours ...') TOPGMQ(*EXT) MSGTYPE(*STATUS)
CALL £CPYSAVF
IF &TODOC DO
IF (&MAX = 0) GOTO COMPLET
RTVMBRD FILE(QTEMP/CPYSAVF) NBRCURRCD(&NBENREG)
IF (&NBENREG > &MAX) THEN(DO)
CHGVAR &DEB 1
BOUCLE: CHGVAR &BCL (&BCL + 1)
CHGVAR &FIN (&DEB + (&MAX - 1))
IF (&FIN > &NBENREG) CHGVAR &FIN &NBENREG
CPYF FROMFILE(QTEMP/CPYSAVF) TOFILE(QTEMP/CPYDKT) +
MBROPT(*REPLACE) CRTFILE(*YES) +
FROMRCD(&DEB) TORCD(&FIN)
CHGVAR &BCLCHAR &BCL
CHGVAR &DOC2 (%SST(&DOC 1 8) *TCAT '.' *CAT &BCLCHAR)
CPYTOPCD FROMFILE(QTEMP/CPYDKT) TOFLR(&FLR) +
TODOC(&DOC2) REPLACE(*YES) TRNTBL(*NONE) +
TRNFMT(*NOTEXT)
IF (&FIN < &NBENREG) DO
CHGVAR &DEB (&DEB + &MAX)
GOTO BOUCLE
ENDDO
ENDDO
ELSE DO
COMPLET: CPYTOPCD FROMFILE(QTEMP/CPYSAVF) TOFLR(&FLR) +
TODOC(&DOC) REPLACE(*YES) TRNTBL(*NONE) +
TRNFMT(*NOTEXT)
ENDDO
ENDDO
|
|
SNDPGMMSG MSG('Copie terminée') MSGTYPE(*COMP)
RETURN
/*----------------------------------------*/
ERREUR: /* GESTION DES ERREURS */
/*----------------------------------------*/
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* 2EME FOIS*/
/* ARRET PGM*/
CHGVAR &ERRORSW '1' /* MISE EN PLACE DU SWTICH */
DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO EXCPMSG
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */
EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
ENDPGM
|
