| 
PGM PARM(&OPTION &S36 &RMTLOCNAME &PASSWORD + &FRMFIC &TOFIC &REPLACE &FRMLIB &TOLIB + &FRMMBR &TOMBR) /* VARIABLES RECUES DE LA COMMANDE FTS */ DCL &OPTION *CHAR 1 /* S=SEND, R=RCV */ DCL &S36 *LGL /* S36 ELOIGNE ?*/ DCL &RMTLOCNAME *CHAR 8 /* NOM DE LIEU */ DCL &PASSWORD *CHAR 10 /* MOT DE PASSE */ DCL &FRMFIC *CHAR 10 /* PF ORIGINE */ DCL &TOFIC *CHAR 10 /* PF DESTINATION*/ DCL &REPLACE *CHAR 1 /* Y OU N */ DCL &FRMLIB *CHAR 10 /* BIBLI ORIGINE */ DCL &TOLIB *CHAR 10 /* BIBLI DESTIN. */ DCL &FRMMBR *CHAR 10 /* MEMBRE ORIGI. */ DCL &TOMBR *CHAR 10 /* MEMBRE DESTIN */ /* VARIABLES DE TRAVAIL */ DCL &TYPE *CHAR 6 /* NON UTILISE */ DCL &DATE *CHAR 6 /* NON UTILISE */ DCL &RTNCOD *CHAR 1 /* CODE RETOUR 0 =OK */ /* 1 = ERR SUR SOURCE */ /* 2 = ERR SUR CIBLE */ DCL &ERRID *CHAR 8 /* CODE ERR SI RTNCOD <> 0 */ DCL &ATR *CHAR 10 /* SAVOIR SI PF */ DCL &REP *CHAR 1 /* REPONSE AUX MSG */ /* VARIABLES UTILISEES PAR LA GESTION DE MESSGAES */ 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) /* CORPS DU PROGRAMME */ /*******************************************************************/ /* RENSEIGNEMENT DES VARIABLES PAR DEFAUT */ /*******************************************************************/ IF (&TOFIC = '*') THEN(CHGVAR &TOFIC &FRMFIC) IF (&FRMMBR = '*') THEN(CHGVAR &FRMMBR &FRMFIC) IF (&TOMBR = '*') THEN(CHGVAR &TOMBR &TOFIC) IF &S36 DO IF (&OPTION = 'S') DO |
|
CHGVAR &TOLIB ' ' CHGVAR &TOMBR ' ' ENDDO ELSE DO CHGVAR &FRMLIB ' ' CHGVAR &FRMMBR ' ' ENDDO ENDDO /*******************************************************************/ /* ENVOI DE FICHIER */ /*******************************************************************/ /* *SND */ IF (&OPTION = 'S') THEN(DO) /*******************************************************************/ /* VERIFICATION QU'IL S'AGIT D'UN FICHIER PHYSIQUE */ /*******************************************************************/ CHKOBJ OBJ(&FRMLIB/&FRMFIC) OBJTYPE(*FILE) + MBR(&FRMMBR) AUT(*USE) RTVOBJD OBJ(&FRMLIB/&FRMFIC) OBJTYPE(*FILE) + OBJATR(&ATR) IF (%SST(&ATR 1 2) *NE 'PF') DO SNDPGMMSG MSGID(CPF8056) MSGF(QCPFMSG) + MSGDTA(&FRMFIC *CAT &FRMLIB) MSGTYPE(*ESCAPE) ENDDO ENDDO /* *RCV */ ELSE DO /*******************************************************************/ /* RECEPTION DE FICHIER (ALLER CHERCHER) */ /*******************************************************************/ /*******************************************************************/ /* VERIFICATION DE L'EXISTANCE DU FICHIER ET DU MEMBRE */ /*******************************************************************/ CHKOBJ OBJ(&TOLIB/&TOFIC) OBJTYPE(*FILE) + MBR(&TOMBR) AUT(*USE) MONMSG (CPF9801) EXEC(DO) /* FICHIER NON TROUVE */ /*******************************************************************/ /* SI LE FICHIER A RECEVOIR N'EXISTE PAS SUR AS */ /* DEUX POSSIBILITES 1/ CREATION IMPLICITE */ /* 2/ CONFIRMATION DE LA CREATION VIA FTS */ /* PAR ENVOI DE MESSAGE */ /* */ /* ACTUELLEMENT OPTION 1 (CREATION IMPLICITE) */ /* ENLEVER LE GOTO APPEL POUR PASSER A L'OPTION 2 */ |
|
/*******************************************************************/
GOTO APPEL /* <-- à ENLEVER */
SNDUSRMSG MSG('Fichier' *BCAT &TOFIC *BCAT 'non +
trouvé.(G = Création par FTS,C = +
Annulation)') VALUES(C G) DFT(C) MSGRPY(&REP)
IF (&REP = 'C') DO
SNDPGMMSG MSG('Commande annulée') MSGTYPE(*DIAG)
RETURN
ENDDO
ELSE GOTO APPEL
ENDDO
MONMSG (CPF9815) EXEC(DO) /* MEMBRE NON TROUVE */
/*******************************************************************/
/* SI LE MEMBRE DEVANT RECEVOIR N'EXISTE PAS SUR AS */
/* DEUX POSSIBILITES 1/ CREATION IMPLICITE */
/* 2/ CONFIRMATION DE LA CREATION VIA FTS */
/* PAR ENVOI DE MESSAGE */
/* */
/* ACTUELLEMENT OPTION 1 (CREATION IMPLICITE) */
/* ENLEVER LE GOTO APPEL POUR PASSER A L'OPTION 2 */
/*******************************************************************/
GOTO APPEL /* <-- à ENLEVER */
SNDUSRMSG MSG('Membre' *BCAT &TOMBR *BCAT 'non trouvé +
dans' *BCAT &TOFIC *BCAT '(G = +
Création par FTS,C = Annulation)') +
VALUES(C G) DFT(C) MSGRPY(&REP)
IF (&REP = 'C') DO
SNDPGMMSG MSG('Commande annulée') MSGTYPE(*DIAG)
RETURN
ENDDO
ENDDO
/*******************************************************************/
/* LE FICHIER EXISTE SUR AS */
/* VERIFICATION QU'IL S'AGIT D'UN FICHIER PHYSIQUE */
/*******************************************************************/
RTVOBJD OBJ(&TOLIB/&TOFIC) OBJTYPE(*FILE) +
OBJATR(&ATR)
IF (%SST(&ATR 1 2) *NE 'PF') DO
SNDPGMMSG MSGID(CPF8056) MSGF(QCPFMSG) +
MSGDTA(&TOFIC *CAT &TOLIB) MSGTYPE(*ESCAPE)
ENDDO
ENDDO /* FIN DE RECEPTION*/
|
|
/*******************************************************************/
/* PARTIE COMMUNE / APPEL DU PGM SYSTEME EXECUTANT LA FONCTION FTS*/
/*******************************************************************/
APPEL: CALL QSYS/QY2FTML PARM(&OPTION +
&FRMLIB +
&FRMFIC +
&FRMMBR +
&TYPE +
&TOLIB +
&TOFIC +
&TOMBR +
&DATE +
&REPLACE +
&RMTLOCNAME +
&PASSWORD +
&RTNCOD +
&ERRID )
/*******************************************************************/
/* TEST SUR CODE RETOUR SI = '0' TOUT VA BIEN */
/*******************************************************************/
IF (&RTNCOD = '0') THEN(DO)
SNDPGMMSG MSG('Fonction FTS éxécutée normalement') +
MSGTYPE(*COMP)
ENDDO
ELSE DO
/*******************************************************************/
/* TEST SUR CODE RETOUR SI = '1' ERREUR SUR SYSTEME SOURCE */
/*******************************************************************/
IF (&RTNCOD = '1') THEN(DO)
CHGVAR VAR(&MSGDTA) VALUE('Fonction FTS non éxécuté +
suite à erreur sur systeme source, CODE :' +
*BCAT &ERRID)
ENDDO
ELSE DO
/*******************************************************************/
/* TEST SUR CODE RETOUR SI = '2' ERREUR SUR SYSTEME CIBLE */
/*******************************************************************/
CHGVAR VAR(&MSGDTA) VALUE('Fonction FTS non éxécuté +
suite à erreur sur systeme cible, CODE :' +
*BCAT &ERRID)
ENDDO
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
|
|
MSGTYPE(*ESCAPE) ENDDO /* RENVOI DES MESSAGES DE TYPE *COMP SI FIN NORMALE */ COMPMSG: RCVMSG MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) IF (&MSGID *EQ ' ') RETURN /* FIN DU PGM */ SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*COMP) GOTO COMPMSG /* BOUCLE SUR MESSAGES *COMP */ /*----------------------------------------*/ 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 */ /* RENVOI DES MESSAGES DE TYPE *DIAG SI FIN ANORMALE */ DIAGMSG: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) IF (&MSGID *EQ ' ') GOTO EXCPMSG SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*DIAG) GOTO DIAGMSG /* BOUCLE SUR MESSAGES *DIAG */ /* RENVOI DU MESSAGE D'ERREUR */ EXCPMSG: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) ENDPGM |
