*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- *-Maintenance frame - Created on 13 Nov 2012 at 16:40:31 *-============================================================ *-Descent : 04/01/21 at 14:59:34 MemoId : LEGALLCL *-Reason : EVOLUTION PONCTUELL *-Package : TIEM200045PGM015 *-More : CG2101 reinit top environnement belge *-============================================================ *-Descent : 20/03/20 at 12:04:19 MemoId : CRENNTH *-Reason : RUBIS 327196 - GRESHAM DÉRACINEMENT *-Package : TIEO200002PGM003 *-More : TCR-200320 *-============================================================ *-Descent : 20/03/19 at 15:50:41 MemoId : LEGALLCL & DAVIDSE *-Reason : SA0000037978099 *-More : Bidouille pour passer la réservation des IC pour * CREATIS - CG0319 *-============================================================ *-Descent : 12/02/19 at 16:13:43 MemoId : DAVIDSE *-Reason : RUBIS 266154 - PAYSURF ET TIEZBBAN *-Package : TIEM190004PGM002 *-More : *SDA120219 *-============================================================ *-Descent : 15/11/18 at 09:30:39 MemoId : DAVIDSE *-Reason : RUBIS 260005 - EVOLUTION TIEZBBAN CIC BRUXELLES *-Package : TIEM180039PGM002 *-More : *SDA151118 *-============================================================ *-Descent : 03/10/18 at 14:53:34 MemoId : DAVIDSE *-Reason : RUBIS 231962 - ADAPTATION TIEZBBAN COF ES *-Package : TIEM180036PGM002 *-More : *SDA031018 *-============================================================ *-Descent : 19/09/18 MemoId : DAVIDSE *-Reason : Rubis 254738 - creation de REF EXT type BBAN * non raciné pour CM-CIC *-Package : TIEM180031PGM002 *-More : *SDA190918 *-============================================================ *-Descent : 29/03/18 at 17:11:04 MemoId : MESNARCE *-Reason : pour debug mod probleme dans la fonction de *- controle *-More : *-============================================================ *-Descent : 21/03/18 MemoId : DAVIDSE *-Reason : Correction TIEZBBAN pour Monabanq *-Package : TIEM180011PGM002 *-More : *SDA210318 *-============================================================ *-Descent : 01/02/18 at 09:11:38 MemoId : MESNARCE *-Reason : EVOLUTION DU TIEZBBAN ET DU TIEL0004 POUR *- BEO *-Package : TIEM170026PGM002 *-More : CD260318 => cardlink *-============================================================ *-Descent : 23/01/18 at 16:01:09 MemoId : MESNARCE *-Reason : debugg mode pour hottinguer *-Package : TIEM170026PGM002 *-More : *-Descent : 16/01/18 at 09:30:55 MemoId : MESNARCE *-Reason : Hottinguer => a traiter comme international *-Reason : CD160118 * -============================================================ *-Descent : 30/10/17 at 09:30:55 MemoId : MESNARCE *-Reason : paramerage Hottinguer R225374 + beo *-More : CD171117 *-============================================================ *-Descent : 12/04/17 at 09:29:25 MemoId : LEGALLCL *-Reason : ajout controle SITEX gestion caisse *- : CG0417 *-MORE : CONTROLE NON FAIT POUR TITRE ET FONCTION RESERVATION *-============================================================ *-Descent : 30/11/16 at 15:21:06 MemoId : MESNARCE *-Reason : pour resoudre probleme reinit KO FLAG-PAYS-ETT-GES *-More : *-============================================================ *-Descent : 14/11/16 at 14:07:57 MemoId : MESNARCE *-Reason : CREATION COMPTE DE CAISSE COFIDIS BELGIQUE *-Package : TIEM160001PGM002 *-More : *-============================================================ *-Descent : 14/11/16 at 09:41:01 MemoId : MESNARCE *-Reason : CREATION COMPTE DE CAISSE COFIDIS BELGIQUE *-Package : TIEM160001PGM002 *-More : *-============================================================ *-Descent : 10/11/16 at 09:02:08 MemoId : MESNARCE *-Reason : CREATION COMPTE DE CAISSE COFIDIS BELGIQUE *-Package : TIEM160001PGM002 *-More : *-============================================================ *-Descent : 08/11/16 at 15:41:22 MemoId : MESNARCE *-Reason : pour debloqué la situation cof belgique *-More : *-============================================================ *-Descent : 07/01/16 at 14:43:10 MemoId : MESNARCE *-Reason : CREATION COMPTE DE CAISSE COFIDIS BELGIQUE *-Package : TIEM160001PGM002 *-More : CD201016 *-============================================================ *-Descent : 06/10/15 at 15:06:37 MemoId : CLOTEAPH *-Reason : Cofidis ES - modif booleen I18N *-More : *-============================================================ *-Descent : 04/12/14 at 17:20:03 MemoId : VANDEMCL *-Reason : Activation de la gestion pour COFIDIS Espagne *-More : *-============================================================ *-Descent : 03/11/14 at 17:16:11 MemoId : VANDEMCL *-Reason : ouverture du mode targo es à cofidis es *-More : - CVM061114 - *- : !!!! EN STAND-BY car BORG n'a pas encore la !!!! *- : !!!! conversion ett-ges pour Cofidis Espagne !!! *-============================================================ *-Descent : 08/08/14 at 13:41:48 MemoId : MARTINA5 *-Reason : Alimentation de la nouvelle donnée TYP-PRD *- pour TIEZCKEY *-More : *-============================================================ *-Descent : 24/02/14 at 09:00:00 MemoId : VANDEMCL *-Reason : Ouverture traitement racine pour CREATIS, produits *- A, B, D (SARA SA0000022234436) *-More : - CVM240214 - *-============================================================ *-Descent : 22/01/14 at 14:24:00 MemoId : VANDEMCL *-Reason : Nouveau numéroteur pour TARGO Espagne *-More : - CVM220114 - *-============================================================ *-Descent : 02/12/13 at 08:39:31 MemoId : VANDEMCL *-Reason : Ajout numéroteur pour Cofidis *-More : - CVM021213 - *-============================================================ *-Descent : 08/11/13 at 09:03:36 MemoId : VANDEMCL *-Reason : Autoriser l'attribution d'un même type série pour *- : produit A et nouveau produit D 0716 4 (PEA-PME) *-Incident: RUBIS97482 *-More : - CVM081113 - *-============================================================ *-Descent : 07/11/13 at 14:42:36 MemoId : VANDEMCL *-Reason : Ajout numéroteur pour Creatis - cessions sur salaire *-Incident: RUBIS95297 *-More : - CVM071113 - *-============================================================ *-Descent : 08/04/13 at 14:42:45 MemoId : VANDEMCL *-Reason : Ajout numeroteur pour nouvelle fédé BLUE *-Incident: RUBIS83826 *-More : - CVM080413 - *-============================================================ *-Descent : 19/12/12 at 17:05:59 MemoId : VANDEMCL *-Reason : Correction gestion TIEFAL lors des appels (utilisation *-More : de TIEFALS) *-============================================================ *-Descent : 13/11/12 at 16:40:31 MemoId : VANDEMCL *-Reason : Livraison sur l'environnement WI *-More : *-============================================================ *-End of frame *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- IDENTIFICATION DIVISION. PROGRAM-ID. TIEZBBAN. *--------------------------------------------------------------* * SOUS-PRO D'ATTRIBUTION DU BBAN * ------------------------------- * * * * PROGRAMME : TIEZBBAN * * --------- * * * * AUTEUR : VAN DE MOORTEL CLEMENCE * * DATE : 06/08/2012 * * * *--------------------------------------------------------------* * >>>>>>>>>>>>>>>>>>>>>>> MODIFICATIONS <<<<<<<<<<<<<<<<<<<<< * *--------------------------------------------------------------* **************************************************************** * VANDEMCL ! 21/11/12 ! APPEL DE IMACTR-L1017 PLUTOT QUE L1018 * - CVM211112 - DANS LA FONCTION EXI-BBAN, AFIN DE * GERER L'EXCEPTION DES COMPTES TITRE MONA **************************************************************** * ! ! * ! ! **************************************************************** *REMARKS. COPY=YTIEBAE * COPY=YTIEBAS * COPY=YTIEFAL * COPY=YTIEFALS * COPY=YTIEFRE * COPY=YTIEVAL * COPY=YISCSIT * COPY=YISCPAR * COPY=YTIEORG * COPY=YTIEE01 * COPY=YTIES01 * COPY=YTIEE03 * COPY=YTIES03 * COPY=YTIEE64 * COPY=YTIES64 * COPY=YTIEE13 * COPY=YTIES13 * COPY=YTIEFON * COPY=YTIECOI * COPY=YI03PCB * COPY=YI03PCBA *--- CVM220114 * COPY=YSTRFAL * COPY=YSTRFRE * COPY=YSTRILE * COPY=YSTRODE * COPY=YSTROLE * COPY=YTIEKEY * * ENVIRONMENT DIVISION. CONFIGURATION SECTION . SOURCE-COMPUTER. IBM-370 * WITH DEBUGGING MODE . OBJECT-COMPUTER. IBM-370. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. * WORKING-STORAGE SECTION. * *... LISTE DES SOUS PROGRAMMES APPELES * 01 NOM-PGM PIC X(08) VALUE 'TIEZBBAN'. 01 ZISC PIC X(08) VALUE '£ISC '. 01 ACCEPTA2 PIC X(08) VALUE 'ACCEPTA2'. 01 TIEGMSGS PIC X(08) VALUE 'TIEGMSGS'. 01 TIEZORGA PIC X(08) VALUE 'TIEZORGA'. 01 TIEL0001 PIC X(08) VALUE 'TIEL0001'. 01 TIEL0003 PIC X(08) VALUE 'TIEL0003'. 01 TIEL0004 PIC X(08) VALUE 'TIEL0004'. 01 TIELI004 PIC X(08) VALUE 'TIELI004'. 01 TIEL0006 PIC X(08) VALUE 'TIEL0006'. *--- CVM220114 01 STRGAPEL PIC X(08) VALUE 'STRGAPEL'. 01 TIEZCKEY PIC X(08) VALUE 'TIEZCKEY'. * *... CONSTANTES DU PROGRAMME 01 C-TIERS PIC X(05) VALUE 'TIERS'. 01 C-MONABANQ PIC X(08) VALUE 'MONABANQ'. 01 C-FED-MONABANQ PIC X(05) VALUE '42'. *--- CVM080413 01 C-BLUE PIC X(08) VALUE 'BLUE '. 01 C-FED-BLUE PIC X(05) VALUE '60'. *--- CVM071113 (CESAR = CESSION SUR SALAIRE) 01 C-CREATIS PIC X(08) VALUE 'CREATIS '. 01 C-FED-CREATIS PIC X(05) VALUE '41'. *--- CVM021213 01 C-COFIDIS PIC X(08) VALUE 'COFIDIS '. 01 C-FED-COFIDIS PIC X(05) VALUE '40'. *--- CVM220114 *--- CVM061114 *01 C-TARGO-ES PIC X(08) VALUE 'TBE '. 01 C-ESPAGNE PIC X(08) VALUE 'TBE '. 01 C-FED-TARGO-ES PIC X(05) VALUE '94'. * *--- CM071116 01 C-BELGIQUE PIC X(08) VALUE 'BELGIQUE'. *---CD171117 01 C-BEO PIC X(08) VALUE 'BEO'. 01 C-FED-BELGIQUE PIC X(05). 88 C-FED-COF-BEL VALUE '90'. 88 C-FED-BEO VALUE '18'. *---CD171117 01 C-HOTTINGUER PIC X(08) VALUE 'HOTTING '. 01 C-FED-HOTTINGUER PIC X(05) VALUE '86'. *SDA190918 DEB 01 C-CMCIC PIC X(08) VALUE 'CMCIC '. *SDA190918 FIN *SDA031018 DEB 01 C-FED-COF-ES PIC X(05) VALUE '16'. *SDA031018 FIN *SDA120219 DEB 01 C-PAYSURF PIC X(07) VALUE 'PAYSURF'. 01 C-FED-PAYSURF PIC X(05) VALUE '36'. *SDA120219 FIN *--- TCR-200320 DEB 01 C-GRESHAM PIC X(07) VALUE 'GRESHAM'. 01 C-FED-GRESHAM PIC X(05) VALUE '89'. *--- TCR-200320 FIN * PARAMETRES D'APPEL A £ISC * 77 PT-SITE-LOCAL USAGE IS POINTER. 01 ISCPAR. COPY YISCPAR SUPPRESS. 01 WS-SITE-TRAIT PIC X(02). * 01 WK-SITE-TRAITEMENT PIC X(02). 88 SITE-DE-TEST VALUE 'NI' 'TI' 'DI' 'QI' 'QF' 'NY'. * * --BOOLEENS 01 FLAG-TRT PIC X(03). 88 FIN-TRT VALUE 'OUI'. 88 NON-FIN-TRT VALUE 'NON'. 01 TYPE-TRT PIC X(01). *SDA190918 DEB 88 TRT-CMCIC-NRC VALUE '0'. *SDA190918 FIN 88 TRT-MONABANQ VALUE '1'. 88 TRT-RACINE VALUE '2'. *--- CVM080413 88 TRT-BLUE VALUE '3'. *--- CVM071113 88 TRT-CREATIS VALUE '4'. *--- CVM021213 88 TRT-COFIDIS VALUE '5'. *--- CVM220114 *--- CVM061114 * 88 TRT-TARGO-ES VALUE '6'. 88 TRT-ESPAGNE VALUE '6'. *--- CM070126 88 TRT-BELGIQUE VALUE '7'. *---CD171117 88 TRT-HOTTINGUER VALUE '8'. *--- SDA120219 88 TRT-PAYSURF VALUE '9'. *--- TCR-200320 88 TRT-GRESHAM VALUE 'A'. 01 INFO-NUM-TIERS PIC X(03). 88 PRESENCE-TIERS VALUE 'OUI'. 88 ABSENCE-TIERS VALUE 'NON'. *--- CVM071113 : BOOLEEN DE TEST DE L'UNICITE DU BBAN 01 FLAG-UNICITE-BBAN PIC X(01). 88 BBAN-DOUBLON VALUE '1'. 88 BBAN-UNIQUE VALUE '2'. *--- CVM220114 : BOOLEEN POUR IDENTIFIER LE PAYS DE L'ETT GES 01 FLAG-PAYS-ETT-GES PIC X(02). 88 ETT-GES-ES VALUE 'ES'. 88 ETT-GES-BE VALUE 'BE'. * --VARIABLES DE STOCKAGE 01 W-BANQUE-CAISSE-BE. 10 W-BANQUE-INT-BE PIC X(05). 10 W-CAISSE-INT-BE PIC X(05). 01 W-BANQUE PIC X(05). 01 W-CAISSE PIC X(05). 01 W-BANQUE-ES PIC X(04). 01 W-BANQUE-BE PIC X(03). 01 W-CAISSE-ES PIC X(04). 01 W-CLE-ES PIC X(02). 01 W-CLE-BE PIC X(02). 01 W-FEDE-TIEFAL PIC X(02). 01 W-FEDE-TIEBAE PIC X(02). 01 W-BANQUE-HOT PIC X(05). 01 W-CAISSE-HOT PIC X(05). *SDA031018 DEB 01 W-BANQUE-CAISSE-ES. 10 W-BANQUE-INT-ES PIC X(05). 10 W-CAISSE-INT-ES PIC X(05). *SDA031018 FIN 01 W-NB-TIERS PIC 9(02). 01 TABLEAU-TIERS. 05 NUMEROS-TIERS OCCURS 99. 10 W-NUM-TIE PIC 9(13). 10 W-NUM-TIE-EI PIC 9(13). 01 NB-RECH-BBAN PIC 9(02). 01 NB-MAX-RECH-BBAN PIC 9(02) VALUE 10. * --INDICES 01 I PIC 9(04) COMP. 01 K PIC 9(04) COMP VALUE 0. 01 L PIC 9(04) COMP VALUE 0. *----------------------------------------------------------------* * LOCAL-STORAGE SECTION *----------------------------------------------------------------* LOCAL-STORAGE SECTION. *----------------------------------------------------------------* * PARAMETRES D'APPEL A TIEZORGA * *----------------------------------------------------------------* 01 TIEORG. COPY YTIEORG. * *----------------------------------------------------------------* * PARAMETRES D'APPEL TIEL0001 * *----------------------------------------------------------------* 01 TIEE01. COPY YTIEE01 SUPPRESS. 01 TIES01. COPY YTIES01 SUPPRESS. * *----------------------------------------------------------------* * PARAMETRES D'APPEL TIEL0003 * *----------------------------------------------------------------* 01 TIEE03. COPY YTIEE03 SUPPRESS. 01 TIES03. COPY YTIES03 SUPPRESS. * *----------------------------------------------------------------* * PARAMETRES D'APPEL TIELI004 * *----------------------------------------------------------------* 01 TIEFALS. COPY YTIEFALS. 01 TIEE64. COPY YTIEE64 SUPPRESS. 01 TIES64. COPY YTIES64 SUPPRESS. * *----------------------------------------------------------------* * PARAMETRES D'APPEL TIEL0006 * *----------------------------------------------------------------* 01 TIEE13. COPY YTIEE13 SUPPRESS. 01 TIES13. COPY YTIES13 SUPPRESS. * *--- CVM220114 *----------------------------------------------------------------* * PARAMETRES D'APPEL STRGAPEL * *----------------------------------------------------------------* 01 STRFAL. COPY YSTRFAL SUPPRESS. 01 STRFRE. COPY YSTRFRE SUPPRESS. 01 STRILE. COPY YSTRILE SUPPRESS. 01 STRODE. COPY YSTRODE SUPPRESS. 01 STROLE. COPY YSTROLE SUPPRESS. * *----------------------------------------------------------------* * PARAMETRES D'APPEL TIEZCKEY * *----------------------------------------------------------------* 01 TIEKEY. COPY YTIEKEY SUPPRESS. *----------------------------------------------------------------* * AUTRES COPY * *----------------------------------------------------------------* 01 TIEFON. COPY YTIEFON. 01 TIECOI. COPY YTIECOI. 01 TIEVAL. COPY YTIEVAL. * *----------------------------------------------------------------* * DIVERS * *----------------------------------------------------------------* 01 NUM-ERR. 05 NUM-ERR9 PIC 9(04). 01 WS-DATE. 05 WS-DATE-SSAA PIC 9(04). 05 WS-DATE-MM PIC 9(02). 05 WS-DATE-JJ PIC 9(02). 01 WS-HEURE. 05 FILLER PIC X(06). 05 WS-HEURE-CC PIC X(02). 01 WS-NUX0. 05 WS-NUX0-10 PIC X(01). 05 FILLER PIC X(01) VALUE '0'. 77 WS-NUM-11 PIC 9(11). 77 WS-NUM-10 PIC 9(10). 77 WS-NUM-07 PIC 9(07). * LINKAGE SECTION. *---> PARAM ALLER 01 TIEFAL. COPY YTIEFAL. 01 TIEBAE. COPY YTIEBAE. *---> PARAM RETOUR VERS APPELLANT 01 TIEFRE. COPY YTIEFRE. 01 TIEBAS. COPY YTIEBAS. * *-- DIVERS 01 ISCSIT. COPY YISCSIT SUPPRESS. 01 IOPCB. COPY YI03PCB SUPPRESS. 01 ALTPCB. COPY YI03PCBA SUPPRESS. *---------------------------------------------------------------- PROCEDURE DIVISION USING TIEFAL TIEBAE TIEFRE TIEBAS. *---------------------------------------------- DDECLARATIVES. *------------* DDECLARATION SECTION. D USE FOR DEBUGGING ON ALL PROCEDURES. DAFFICHAGE-PARAGRAPHE. D DISPLAY NOM-PGM '==> ' DEBUG-NAME. DFIN-DECLARATION. EXIT. DEND DECLARATIVES. *---------------------------------------------------------------- TRAITEMENT-GENERAL. *------------------- D DISPLAY 'TIEBAE : ' TIEBAE D DISPLAY 'TIEFAL : ' TIEFAL PERFORM INITIALISATIONS IF TIEFRE-TRT-CORRECT PERFORM CONTROLE-ARG-ENTREE END-IF IF TIEFRE-TRT-CORRECT PERFORM TRAITEMENT END-IF IF (NOT TIEFRE-TRT-CORRECT) AND (NUM-ERR9 > ZERO) PERFORM APPEL-TIEGMSGS END-IF D DISPLAY 'TIEFRE EN SORTIE : ' TIEFRE D DISPLAY 'TIEBAS : ' TIEBAS GOBACK . *----------------------------------------------------------------* * INITIALISATIONS * *----------------------------------------------------------------* INITIALISATIONS. *---------------- INITIALIZE TIEBAS MOVE TIEFAL TO TIEFALS SET TIEFRE-TRT-CORRECT TO TRUE MOVE ZERO TO NUM-ERR9 MOVE ZERO TO NB-RECH-BBAN *--- CVM220114 *-- INITIALISATION DE LA COPY STRFAL PERFORM INIT-STRFAL * MOVE SPACES TO STRILE INITIALIZE STRILE *-- DATE ET HEURE SYSTEME CALL 'ZCALLPGM' USING ACCEPTA2 WS-DATE WS-HEURE END-CALL *-- RECHERCHE SITE PERFORM RECHERCHE-SITE *-- RECHERCHE FEDERATION POUR DETERMINER LE TYPE DE TRAITEMENT IF TIEFRE-TRT-CORRECT PERFORM CONTROLE-ETT-GES END-IF . *----------------------------------------------------------------* * CONTROLE DES ARGUMENTS EN ENTREE * *----------------------------------------------------------------* CONTROLE-ARG-ENTREE. *-------------------- D DISPLAY 'TIEBAE-FONCTION : ' TIEBAE-FONCTION EVALUATE TRUE WHEN TIEBAE-ATT-BBAN PERFORM CTL-ARG-ATT-BBAN WHEN TIEBAE-RES-BBAN PERFORM CTL-ARG-RES-BBAN WHEN TIEBAE-ANU-BBAN PERFORM CTL-ARG-ANU-BBAN WHEN TIEBAE-EXI-BBAN PERFORM CTL-ARG-EXI-BBAN END-EVALUATE . *----------------------------------------------------------------* * CONTROLE DES ARGUMENTS DE LA FONCTION ATT-BBAN * *----------------------------------------------------------------* CTL-ARG-ATT-BBAN. *----------------- *--- CVM071113 : POUR CREATIS, ON N'ACCEPTE QUE LES PRODUITS * I CESA1 (CESSIONS SUR SALAIRE) IF TRT-CREATIS IF TIEBAE-ATT-TYP-PRD NOT = 'I' OR TIEBAE-ATT-REF-PRD NOT = 'CESA1' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 25 TO NUM-ERR9 END-IF ELSE *--- CVM021213 : POUR COFIDIS, ON N'ACCEPTE QUE LES PRODUITS A IF TRT-COFIDIS IF TIEBAE-ATT-TYP-PRD NOT = 'A' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 26 TO NUM-ERR9 END-IF ELSE * SINON, TYPE PRODUIT DOIT ETRE A, B OU D (PRODUITS RIBES) IF TIEBAE-ATT-TYP-PRD NOT = 'A' AND NOT = 'B' AND NOT = 'D' ***CD260318 IF TIEBAE-ATT-TYP-PRD NOT = 'BE' OR TIEBAE-ATT-REF-PRD (1:1) NOT = 'O' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 9 TO NUM-ERR9 END-IF END-IF END-IF END-IF *--- SI TRAITEMENT EN MODE RACINE, CONTROLES SUPPLEMENTAIRES IF TRT-RACINE AND TIEFRE-TRT-CORRECT * RACINE OBLIGATOIRE IF TIEBAE-ATT-RACINE = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 10 TO NUM-ERR9 END-IF * REF PRODUIT ET DATE OUV OBLIGATOIRES IF TIEFRE-TRT-CORRECT IF TIEBAE-ATT-REF-PRD = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 11 TO NUM-ERR9 ELSE IF TIEBAE-ATT-DAT-OUV = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 23 TO NUM-ERR9 END-IF END-IF END-IF * CONTROLE DES N° DE TIERS S'ILS SONT ALIMENTES * (ON SE PLACE D'ORES ET DEJA SUR LA CIBLE (PAS DE RACINE)) SET ABSENCE-TIERS TO TRUE IF TIEFRE-TRT-CORRECT AND TIEBAE-ATT-ALIM-TIE-OUI * ON REGARDE SI AU MOINS UN N° DE TIERS EST RENSEIGNE PERFORM VARYING K FROM 1 BY 1 UNTIL PRESENCE-TIERS OR K > 99 IF TIEBAE-ATT-NUM-TIE (K) > ZERO SET PRESENCE-TIERS TO TRUE D DISPLAY 'PRESENCE TIERS' END-IF END-PERFORM END-IF IF PRESENCE-TIERS * ON VERIFIE COHERENCE AVEC TIEBAE-ATT-NB-TIE MOVE ZERO TO W-NB-TIERS PERFORM VARYING L FROM 1 BY 1 UNTIL L > 99 IF TIEBAE-ATT-NUM-TIE (L) = ZERO OR TIEBAE-ATT-NUM-TIE (L) NOT NUMERIC MOVE 100 TO L ELSE ADD 1 TO W-NB-TIERS END-IF D DISPLAY 'W-NB-TIERS : ' W-NB-TIERS END-PERFORM IF TIEBAE-ATT-NB-TIE NOT = W-NB-TIERS SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 19 TO NUM-ERR9 END-IF * ON VERIFIE QUE LES TIERS RENSEIGNES EXISTENT BIEN IF TIEFRE-TRT-CORRECT PERFORM CTL-EXIST-TIERS END-IF ELSE IF TIEBAE-ATT-ALIM-TIE-OUI SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 18 TO NUM-ERR9 END-IF END-IF END-IF . *----------------------------------------------------------------* * CONTROLE DES ARGUMENTS DE LA FONCTION RES-BBAN * *----------------------------------------------------------------* CTL-ARG-RES-BBAN. *----------------- * FONCTION OUVERTE UNIQUEMENT EN MODE RACINE (PAS POUR LA * FEDE MONABANQ) *--- CVM080413 : FONCTION NON OUVERTE POUR LA FEDE BLUE *--- CVM071113 : FONCTION NON OUVERTE POUR CREATIS *--- CVM021213 : FONCTION NON OUVERTE POUR COFIDIS *--- CD171117 : FONCTION NON OUVERTE POUR HOTTINGUER *--- SDA120219 : FONCTION NON OUVERTE POUR PAYSURF * IF TRT-MONABANQ OR TRT-BLUE IF NOT TRT-RACINE *--- SET TIEFRE-TRT-NON-AUTORISE TO TRUE MOVE 1 TO NUM-ERR9 END-IF * TYPE PRODUIT DOIT ETRE A OU B (PRODUITS RIBES) IF TIEFRE-TRT-CORRECT IF TIEBAE-RES-TYP-PRD NOT = 'A' AND NOT = 'B' AND NOT = 'D' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 14 TO NUM-ERR9 END-IF END-IF IF TIEFRE-TRT-CORRECT * RACINE OBLIGATOIRE IF TIEBAE-RES-RACINE = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 10 TO NUM-ERR9 END-IF * REF PRODUIT ET DATE OUV OBLIGATOIRES IF TIEFRE-TRT-CORRECT IF TIEBAE-RES-REF-PRD = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 11 TO NUM-ERR9 ELSE IF TIEBAE-RES-DAT-OUV = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 23 TO NUM-ERR9 END-IF END-IF END-IF * CONTROLE DES N° DE TIERS S'ILS SONT ALIMENTES * (ON SE PLACE D'ORES ET DEJA SUR LA CIBLE (PAS DE RACINE)) SET ABSENCE-TIERS TO TRUE IF TIEFRE-TRT-CORRECT AND TIEBAE-RES-ALIM-TIE-OUI * ON REGARDE SI AU MOINS UN N° DE TIERS EST RENSEIGNE PERFORM VARYING K FROM 1 BY 1 UNTIL PRESENCE-TIERS OR K > 99 IF TIEBAE-RES-NUM-TIE (K) > ZERO SET PRESENCE-TIERS TO TRUE END-IF END-PERFORM END-IF IF PRESENCE-TIERS * ON VERIFIE COHERENCE AVEC TIEBAE-RES-NB-TIE MOVE ZERO TO W-NB-TIERS PERFORM VARYING L FROM 1 BY 1 UNTIL L > 99 IF TIEBAE-RES-NUM-TIE (L) = ZERO OR TIEBAE-RES-NUM-TIE (L) NOT NUMERIC MOVE 100 TO L ELSE ADD 1 TO W-NB-TIERS END-IF D DISPLAY 'W-NB-TIERS : ' W-NB-TIERS END-PERFORM IF TIEBAE-RES-NB-TIE NOT = W-NB-TIERS SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 19 TO NUM-ERR9 END-IF * ON VERIFIE QUE LES TIERS RENSEIGNES EXISTENT BIEN IF TIEFRE-TRT-CORRECT PERFORM CTL-EXIST-TIERS END-IF ELSE IF TIEBAE-RES-ALIM-TIE-OUI SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 18 TO NUM-ERR9 END-IF END-IF END-IF . *----------------------------------------------------------------* * CONTROLE DE L'EXISTENCE DES TIERS EN ENTREE * *----------------------------------------------------------------* CTL-EXIST-TIERS. *---------------- * ON MET LES N° DE TIERS DANS DES VARIABLES DE TRAVAIL CAR * CONTROLE IDENTIQUE POUR LES FONCTIONS ATT ET RES PERFORM VARYING K FROM 1 BY 1 UNTIL K > W-NB-TIERS EVALUATE TRUE WHEN TIEBAE-ATT-BBAN MOVE TIEBAE-ATT-NUM-TIE (K) TO W-NUM-TIE (K) MOVE TIEBAE-ATT-NUM-TIE-EI (K) TO W-NUM-TIE-EI (K) WHEN TIEBAE-RES-BBAN MOVE TIEBAE-RES-NUM-TIE (K) TO W-NUM-TIE (K) MOVE TIEBAE-RES-NUM-TIE-EI (K) TO W-NUM-TIE-EI (K) END-EVALUATE END-PERFORM PERFORM VARYING K FROM 1 BY 1 UNTIL K > W-NB-TIERS OR NOT TIEFRE-TRT-CORRECT * APPEL A TIERS-L0001 POUR VERIFIER QUE LE TIERS EXISTE PERFORM APPEL-TIERS-L0001 IF TIEFRE-TRT-CORRECT * SI LE NUM DE TIERS EI EST RENSEIGNE IF W-NUM-TIE-EI (K) > ZERO * APPEL A RELTIE-L0005 POUR VERIFIER QU'IL Y A BIEN * UNE RELATION EI OUVERTE ENTRE LES TIERS PERFORM APPEL-RELTIE-L0005 IF NOT TIEFRE-TRT-CORRECT SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 21 TO NUM-ERR9 END-IF END-IF ELSE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 20 TO NUM-ERR9 END-IF END-PERFORM . *----------------------------------------------------------------* * APPEL DE TIERS-L0001 POUR VERIFIER L'EXISTENCE DES TIERS * *----------------------------------------------------------------* APPEL-TIERS-L0001. *------------------ INITIALIZE TIEE01 INITIALIZE TIEE01-L0001-ARG MOVE WS-DATE TO TIEE01-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE01-HEU-FRAICHEUR MOVE W-NUM-TIE (K) TO TIEE01-L0001-TIE-NUM SET TIEE01-L0001-APE-CPL TO TRUE SET TIEE01-L0001-CODIF-PAY-ISO TO TRUE SET TIE-TIERS-L0001 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIEL0001 TO TIEFALS-PGM-CIB SET TIEFALS-ACN-LECTURE-UNIQUE TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE PERFORM APPEL-TIEL0001 . *----------------------------------------------------------------* * APPEL DE RELTIE-L0005 POUR VERIFIER LA RELATION EI * *----------------------------------------------------------------* APPEL-RELTIE-L0005. *------------------- INITIALIZE TIEE03 INITIALIZE TIEE03-L0005-ARG MOVE WS-DATE TO TIEE03-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE03-HEU-FRAICHEUR MOVE W-NUM-TIE (K) TO TIEE03-L0005-TIE-NUM-SRE MOVE W-NUM-TIE-EI (K) TO TIEE03-L0005-TIE-NUM-DST MOVE 'EI' TO TIEE03-L0005-TYP-DEB TIEE03-L0005-TYP-FIN MOVE 'C' TO TIEE03-L0005-CYC-VIE-DEB TIEE03-L0005-CYC-VIE-FIN SET TIE-RELTIE-L0005 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIEL0003 TO TIEFALS-PGM-CIB SET TIEFALS-ACN-LEC-BLOC-SUIVANT TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE PERFORM APPEL-TIEL0003 . *----------------------------------------------------------------* * CONTROLE DES ARGUMENTS DE LA FONCTION ANU-BBAN * *----------------------------------------------------------------* CTL-ARG-ANU-BBAN. *----------------- * FONCTION OUVERTE UNIQUEMENT EN MODE RACINE (PAS POUR LA * FEDE MONABANQ) *--- CVM080413 : FONCTION NON OUVERTE POUR LA FEDE BLUE *--- CVM071113 : FONCTION NON OUVERTE POUR LA CREATIS - CESAR * IF TRT-MONABANQ OR TRT-BLUE IF NOT TRT-RACINE *--- SET TIEFRE-TRT-NON-AUTORISE TO TRUE MOVE 1 TO NUM-ERR9 END-IF * TYPE PRODUIT DOIT ETRE A OU B (PRODUITS RIBES) IF TIEFRE-TRT-CORRECT IF TIEBAE-ANU-TYP-PRD NOT = 'A' AND NOT = 'B' AND NOT = 'D' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 14 TO NUM-ERR9 END-IF END-IF *--- CONTROLES SUPPLEMENTAIRES IF TIEFRE-TRT-CORRECT * RACINE OBLIGATOIRE IF TIEBAE-ANU-NUM-CTR (1:9) = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 10 TO NUM-ERR9 END-IF * REF PRODUIT ET TYPE SERIE OBLIGATOIRES IF TIEFRE-TRT-CORRECT IF TIEBAE-ANU-REF-PRD = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 11 TO NUM-ERR9 ELSE IF TIEBAE-ANU-NUM-CTR (10:2) = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 24 TO NUM-ERR9 END-IF END-IF END-IF END-IF . *----------------------------------------------------------------* * CONTROLE DES ARGUMENTS DE LA FONCTION EXI-BBAN * *----------------------------------------------------------------* CTL-ARG-EXI-BBAN. *----------------- *--- CVM071113 : FONCTION NON OUVERTE POUR CREATIS - CESAR * CAR PRODUITS I ET FONCTIONS DU TIELI004 OUVERTES POUR A,B,D IF TRT-CREATIS SET TIEFRE-TRT-NON-AUTORISE TO TRUE MOVE 1 TO NUM-ERR9 END-IF * TYPE PRODUIT DOIT ETRE A, B OU D (PRODUITS RIBES) IF TIEFRE-TRT-CORRECT IF TIEBAE-EXI-TYP-PRD NOT = 'A' AND NOT = 'B' AND NOT = 'D' SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 9 TO NUM-ERR9 END-IF END-IF *--- CONTROLES SUPPLEMENTAIRES IF TIEFRE-TRT-CORRECT * RACINE OBLIGATOIRE SI FEDE GERANT LES RACINES * NUMERO DE CONTRAT OBLIGATOIRE SI FEDE MONABANQ OU BLUE IF TRT-RACINE IF TIEBAE-EXI-NUM-CTR (1:9) = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 10 TO NUM-ERR9 END-IF ELSE IF TIEBAE-EXI-NUM-CTR = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 22 TO NUM-ERR9 END-IF END-IF * TYPE SERIE OBLIGATOIRE SI FEDE GERANT LES RACINES IF TIEFRE-TRT-CORRECT IF TRT-RACINE IF TIEBAE-EXI-NUM-CTR (10:2) = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 24 TO NUM-ERR9 END-IF END-IF END-IF * REFERENCE PRODUIT OBLIGATOIRE IF TIEFRE-TRT-CORRECT IF TIEBAE-EXI-REF-PRD = SPACE SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 11 TO NUM-ERR9 END-IF END-IF END-IF . *----------------------------------------------------------------* * TRAITEMENT * *----------------------------------------------------------------* TRAITEMENT. *----------- EVALUATE TRUE WHEN TIEBAE-ATT-BBAN *--- CVM080413 : AJOUT NUMEROTATION INCREMENTALE POUR BLUE *--- CVM071113 : AJOUT NUMEROTATION INCREMENTALE PR CREATIS CESAR *--- CVM021213 : AJOUT NUMEROTATION INCREMENTALE PR COFIDIS *--- CVM220114 : REFONTE DE LA STRUCTURE DU PARAGRAPHE AVEC DES * EVALUATE POUR GERER AU MIEUX LES DIFFERENTES SPECIFICITES ET * INTEGRER LE NUMEROTEUR TARGO ESPAGNE IF NOT TRT-RACINE EVALUATE TRUE * WHEN TRT-CREATIS * SET BBAN-DOUBLON TO TRUE * PERFORM NUMEROTATION-INCREMENTALE * VARYING I FROM 1 BY 1 UNTIL BBAN-UNIQUE * OR NOT TIEFRE-TRT-CORRECT *--- CVM061114 * WHEN TRT-TARGO-ES WHEN TRT-ESPAGNE WHEN TRT-BELGIQUE WHEN TRT-HOTTINGUER *--- TCR-200320 WHEN TRT-GRESHAM PERFORM CONVERSION-BANQCAI-FORMAT-EXT IF TIEFRE-TRT-CORRECT PERFORM NUMEROTATION-INCREMENTALE END-IF IF TIEFRE-TRT-CORRECT ***cd160118 deb => pas de cle pour hottinguer et formatage *** BBAN deja fait dans NUMEROTATION-INCREMENTALE IF NOT TRT-HOTTINGUER *--- TCR-200320 AND NOT TRT-GRESHAM PERFORM CALCUL-CLE END-IF END-IF IF TIEFRE-TRT-CORRECT IF NOT TRT-HOTTINGUER *--- TCR-200320 AND NOT TRT-GRESHAM PERFORM FORMATAGE-BBAN END-IF ***CD160118 FIN END-IF WHEN OTHER SET BBAN-DOUBLON TO TRUE PERFORM NUMEROTATION-INCREMENTALE VARYING I FROM 1 BY 1 UNTIL BBAN-UNIQUE OR NB-RECH-BBAN > NB-MAX-RECH-BBAN OR NOT TIEFRE-TRT-CORRECT D DISPLAY 'NB-RECH-BBAN = ' NB-RECH-BBAN IF NB-RECH-BBAN > NB-MAX-RECH-BBAN SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 6 TO NUM-ERR9 END-IF * PERFORM NUMEROTATION-INCREMENTALE END-EVALUATE ELSE PERFORM ATTRIBUTION-TYPE-SERIE END-IF WHEN TIEBAE-RES-BBAN PERFORM RESERVATION-TYPE-SERIE WHEN TIEBAE-ANU-BBAN PERFORM ANNULATION-TYPE-SERIE WHEN TIEBAE-EXI-BBAN PERFORM EXISTENCE-TYPE-SERIE END-EVALUATE . *----------------------------------------------------------------* * FEDE MONABANQ (SANS RACINE) -> NUMEROTATION INCREMENTALE * * FEDE BLUE (SANS RACINE) -> NUMEROTATION INCREMENTALE * * FEDE CREATIS (SANS RACINE) -> NUMEROTATION INCREMENTALE * * FEDE COFIDIS (SANS RACINE) -> NUMEROTATION INCREMENTALE * * FEDE TARGO-ES (SANS RACINE) -> NUMEROTATION INCREMENTALE * * FEDES CMCIC SANS RACINES -> NUMEROTATION INCREMENTALE * * FEDE PAYSURF (SANS RACINE) -> NUMEROTATION INCREMENTAKE * *----------------------------------------------------------------* NUMEROTATION-INCREMENTALE. *-------------------------- * APPEL MODULE TIEL0006 - FONCTION TEC-M0001 SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE SET TIEFALS-ACN-MODIFICATION TO TRUE MOVE TEC-M0001 TO TIEFALS-IDE-FON MOVE TIEL0006 TO TIEFALS-PGM-CIB INITIALIZE TIEE13 MOVE WS-DATE TO TIEE13-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE13-HEU-FRAICHEUR *--- CVM080413 : AJOUT DU NUMEROTEUR BLUE *--- CVM071113 : AJOUT DU NUMEROTEUR CREATIS CESAR *--- CVM021213 : AJOUT DU NUMEROTEUR COFIDIS *--- CVM220114 : AJOUT DU NUMEROTEUR TARGO ESPAGNE EVALUATE TRUE WHEN TRT-MONABANQ MOVE C-MONABANQ TO TIEE13-M0001-OBJ WHEN TRT-BLUE MOVE C-BLUE TO TIEE13-M0001-OBJ WHEN TRT-CREATIS MOVE C-CREATIS TO TIEE13-M0001-OBJ WHEN TRT-COFIDIS MOVE C-COFIDIS TO TIEE13-M0001-OBJ *--- CD171117 WHEN TRT-HOTTINGUER *--- TCR-200320 *--- Utilisation du même numéroteur qu'HOTTINGUER pour GRESHAM WHEN TRT-GRESHAM MOVE C-HOTTINGUER TO TIEE13-M0001-OBJ *--- CVM061114 * WHEN TRT-TARGO-ES * MOVE C-TARGO-ES TO TIEE13-M0001-OBJ WHEN TRT-ESPAGNE MOVE C-ESPAGNE TO TIEE13-M0001-OBJ *--- CD171117 WHEN TRT-BELGIQUE IF C-FED-COF-BEL MOVE C-BELGIQUE TO TIEE13-M0001-OBJ ELSE IF C-FED-BEO MOVE C-BEO TO TIEE13-M0001-OBJ ELSE *SDA151118 DEB * SET TIEFRE-ERREUR-FATALE TO TRUE * MOVE 10 TO NUM-ERR9 MOVE C-BELGIQUE TO TIEE13-M0001-OBJ *SDA151118 FIN END-IF END-IF *--- *SDA190918 DEB WHEN TRT-CMCIC-NRC MOVE C-CMCIC TO TIEE13-M0001-OBJ *SDA190918 FIN *SDA120219 DEB WHEN TRT-PAYSURF MOVE C-PAYSURF TO TIEE13-M0001-OBJ *SDA120219 FIN END-EVALUATE *--- ATTRIBUTION DU CODE NATURE * TIEE13-M0001-NAT = ['NU'NN] AVEC NN => 10' SECONDE *--- CVM021213 : POUR COFIDIS, 1 SEUL NUMEROTEUR => NATURE 'NUM' * IF TRT-COFIDIS OR TRT-BELGIQUE *SDA151118 DEB IF (TRT-COFIDIS OR C-FED-COF-BEL OR (TRT-BELGIQUE AND NOT C-FED-BEO) ) *SDA151118 FIN MOVE 'NUM ' TO TIEE13-M0001-NAT ELSE IF WS-HEURE-CC IS NUMERIC * ON TRANSFERE LE CHIFFRE DES DIZIEMES POUR CHOISIR LE POSTE * DANS LA TABLE TTIETEC MOVE WS-HEURE-CC(1:1) TO WS-NUX0-10 STRING 'NU' WS-NUX0 DELIMITED BY SIZE INTO TIEE13-M0001-NAT ELSE MOVE 'NU00' TO TIEE13-M0001-NAT END-IF END-IF MOVE TIEORG-CENTRE TO TIEE13-M0001-STE *--- APPEL DU TIEL0006 - FONCTION TEC-M0001 PERFORM APPEL-TIEL0006 *--- VERIFICATION DES CODES RETOUR * RETOUR KO -> MSG SPECIFIQUE IF NOT TIEFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 2 TO NUM-ERR9 * ELSE END-IF * RETOUR OK -> FORMATAGE DU BBAN ET ECRITURE DANS LA COPY *--- CVM071113 : POUR CREATIS CESAR, ON VA PAR PRECAUTION VERIFIER * QUE LE NUMERO N'EST PAS DEJA DS LES TABLES IC (IMACTR-L1018) *--- CVM170214 : ON ETEND CE CONTROLE A TOUS LES NUMEROTEURS *--- CVM220114 : RESTRUCTURATION DE CE PAVE PAR UN EVALUATE *--- CD171117 : AJOUT PARAMETRAGE HOTTINGUER IF TIEFRE-TRT-CORRECT EVALUATE TRUE WHEN TRT-MONABANQ WHEN TRT-BLUE WHEN TRT-COFIDIS WHEN TRT-CREATIS WHEN TRT-HOTTINGUER *--- TCR-200320 WHEN TRT-GRESHAM *SDA190918 DEB WHEN TRT-CMCIC-NRC *SDA190918 FIN *SDA120219 DEB WHEN TRT-PAYSURF *SDA120219 FIN MOVE TIES13-M0001-CMR TO WS-NUM-11 PERFORM VERIF-EXISTENCE-BBAN ADD 1 TO NB-RECH-BBAN IF TIEFRE-DONNEES-NON-TROUVEES SET BBAN-UNIQUE TO TRUE SET TIEFRE-TRT-CORRECT TO TRUE MOVE ZERO TO TIEFRE-COD-RET-SCD MOVE SPACES TO TIEFRE-MSG-ERR-MET MOVE SPACE TO TIEBAS **cd1601118 IF TRT-HOTTINGUER *--- TCR-200320 OR TRT-GRESHAM STRING W-BANQUE-HOT W-CAISSE-HOT WS-NUM-11 DELIMITED BY SIZE INTO TIEBAS-ATT-BBAN ELSE STRING TIEBAE-ATT-BANQUE TIEBAE-ATT-CAISSE WS-NUM-11 DELIMITED BY SIZE INTO TIEBAS-ATT-BBAN END-IF END-IF D DISPLAY 'TIEBAS-ATT-BBAN =' TIEBAS-ATT-BBAN * WHEN TRT-MONABANQ * WHEN TRT-BLUE * WHEN TRT-COFIDIS * MOVE TIES13-M0001-CMR TO WS-NUM-11 * MOVE SPACE TO TIEBAS * STRING TIEBAE-ATT-BANQUE * TIEBAE-ATT-CAISSE * WS-NUM-11 * DELIMITED BY SIZE INTO TIEBAS-ATT-BBAN *--- CVM061114 * WHEN TRT-TARGO-ES WHEN TRT-ESPAGNE MOVE TIES13-M0001-CMR TO WS-NUM-10 WHEN TRT-BELGIQUE MOVE TIES13-M0001-CMR TO WS-NUM-07 END-EVALUATE END-IF . *--- CVM220114 - DEB *----------------------------------------------------------------* * CONVERSION DU COUPLE BANQUE / CAISSE AU FORMAT INTERNE DANS LE * * FORMAT EXTERNE DU PAYS REFERENT - APPEL A BORG VIA LE STRGAPEL * *----------------------------------------------------------------* CONVERSION-BANQCAI-FORMAT-EXT. *------------------------------ SET STRFAL-EIE TO TRUE SET STRFAL-FCT-L100E TO TRUE SET STRFAL-ACN-LECTURE-UNIQUE TO TRUE EVALUATE TRUE *--- CVM061114 * WHEN TRT-TARGO-ES WHEN TRT-ESPAGNE SET STRILE-PAYS-ES TO TRUE *****SDA190617 DEB SET STRILE-TYP-INT-GUI TO TRUE STRING W-BANQUE W-CAISSE DELIMITED BY SIZE INTO STRILE-VAL-INT *****SDA190617 FIN *--- CM070116 WHEN TRT-BELGIQUE SET STRILE-PAYS-BE TO TRUE *****SDA190617 DEB SET STRILE-TYP-INT-BAN TO TRUE MOVE W-BANQUE TO STRILE-VAL-INT *****SDA190617 FIN *****CD160118 WHEN TRT-HOTTINGUER *--- TCR-200320 WHEN TRT-GRESHAM MOVE 'FR' TO STRILE-PAYS SET STRILE-TYP-INT-GUI TO TRUE STRING W-BANQUE W-CAISSE DELIMITED BY SIZE INTO STRILE-VAL-INT ******CD160118 WHEN OTHER CONTINUE END-EVALUATE SET STRILE-SO-EXT-REG TO TRUE *SDA190617 * SET STRILE-TYP-INT-GUI TO TRUE * STRING W-BANQUE W-CAISSE * DELIMITED BY SIZE INTO STRILE-VAL-INT SET STRILE-HISTO-JN TO TRUE PERFORM APPEL-STRGAPEL IF NOT STRFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 03 TO NUM-ERR9 D DISPLAY ' TIEZBBAN STRFRE-TRT-KO ' STRFRE ELSE EVALUATE TRUE WHEN TRT-ESPAGNE D DISPLAY 'BANQUE ES : ' STRODE-VAL-EXT (1:4) D DISPLAY 'CAISSE ES : ' STRODE-VAL-EXT (5:4) D DISPLAY 'ETT G ES : ' STRODE-VAL-EXT MOVE STRODE-VAL-EXT (1:4) TO W-BANQUE-ES MOVE STRODE-VAL-EXT (5:4) TO W-CAISSE-ES WHEN TRT-BELGIQUE MOVE STRODE-VAL-EXT (1:3) TO W-BANQUE-BE D DISPLAY ' STRODE-VAL-EXT =' STRODE-VAL-EXT (1:3) ***CD16018 WHEN TRT-HOTTINGUER *--- TCR-200320 WHEN TRT-GRESHAM MOVE STRODE-VAL-EXT (1:5) TO W-BANQUE-HOT MOVE STRODE-VAL-EXT (6:5) TO W-CAISSE-HOT D DISPLAY 'STRODE-VAL-EXT (1:5) ' STRODE-VAL-EXT (1:5) D DISPLAY 'STRODE-VAL-EXT (6:5) ' STRODE-VAL-EXT (6:5) END-EVALUATE END-IF . *----------------------------------------------------------------* * CONVERSION DU COUPLE BANQUE / CAISSE AU FORMAT EXTERNE DANS LE * * FORMAT INTERNE - APPEL A BORG VIA LE STRGAPEL * *----------------------------------------------------------------* CONVERSION-BANQCAI-FORMAT-INT. *------------------------------ D DISPLAY 'TIEZBBAN : CONVERSION-BANQCAI-FORMAT-INT' SET STRFAL-EIE TO TRUE SET STRFAL-FCT-L100E TO TRUE SET STRFAL-ACN-LECTURE-UNIQUE TO TRUE EVALUATE TRUE WHEN ETT-GES-ES SET STRILE-TYP-INT-GUI TO TRUE SET STRILE-PAYS-ES TO TRUE STRING TIEBAE-EXI-BANQUE-ES TIEBAE-EXI-CAISSE-ES DELIMITED BY SIZE INTO STRILE-VAL-EXT WHEN ETT-GES-BE SET STRILE-PAYS-BE TO TRUE MOVE TIEBAE-EXI-BANQUE-BE TO STRILE-VAL-EXT ***CD160118 DEB WHEN W-FEDE-TIEFAL = C-FED-HOTTINGUER D display 'trt hottinguer conversion' MOVE 'FR' TO STRILE-PAYS STRING TIEBAE-EXI-BANQUE TIEBAE-EXI-CAISSE DELIMITED BY SIZE INTO STRILE-VAL-EXT SET STRILE-TYP-INT-GUI TO TRUE ***CD160118 FIN WHEN OTHER SET STRILE-TYP-INT-GUI TO TRUE CONTINUE END-EVALUATE SET STRILE-SO-EXT-REG TO TRUE ***CD201016 * SET STRILE-TYP-INT-GUI TO TRUE * STRING TIEBAE-EXI-BANQUE-ES TIEBAE-EXI-CAISSE-ES * DELIMITED BY SIZE INTO STRILE-VAL-EXT SET STRILE-HISTO-JN TO TRUE PERFORM APPEL-STRGAPEL IF NOT STRFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 05 TO NUM-ERR9 ELSE MOVE STRODE-VAL-INT (1:5) TO W-BANQUE MOVE STRODE-VAL-INT (6:5) TO W-CAISSE END-IF . *----------------------------------------------------------------* CONV-BANQCAI-FORMAT-INT-BE. *-------------------------------- SET STRFAL-EIE TO TRUE SET STRFAL-FCT-L000E TO TRUE SET STRFAL-ACN-LEC-BLOC-SUIVANT TO TRUE SET STRILE-PAYS-BE TO TRUE MOVE TIEBAE-EXI-BANQUE-BE TO STRILE-VAL-EXT SET STRILE-ETAT-ACTIF TO TRUE SET STRILE-SO-EXT-REG TO TRUE SET STRILE-HISTO-JN TO TRUE MOVE SPACES TO STRFRE STROLE CALL 'ZCALLPGM' USING STRGAPEL STRFAL STRFRE STRILE STROLE OMITTED END-CALL D DISPLAY 'STRFRE : ' STRFRE D DISPLAY 'STRODE : ' STROLE IF NOT STRFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 05 TO NUM-ERR9 D DISPLAY 'TIEZBBAN - STRFRE-TRT-KO ' STRFRE ELSE *SDA190617 DEB * Dans la 1ère occ. on n'a que la banque (c'est pour ça qu'on * prenait la 2è) ; on va changer le test sur l'ETT-GES pour ne * faire le test que sur le code banque pour toute la Belgique. * MOVE STROLE-VAL-INT (2) TO W-BANQUE-CAISSE-BE MOVE STROLE-VAL-INT (1) TO W-BANQUE-CAISSE-BE MOVE W-BANQUE-INT-BE TO W-BANQUE * MOVE W-CAISSE-INT-BE TO W-CAISSE *SDA190617 FIN END-IF . *SDA031018 DEB *----------------------------------------------------------------* CONV-BANQCAI-FORMAT-INT-COFES. *-------------------------------- SET STRFAL-EIE TO TRUE SET STRFAL-FCT-L000E TO TRUE SET STRFAL-ACN-LEC-BLOC-SUIVANT TO TRUE SET STRILE-PAYS-ES TO TRUE MOVE TIEBAE-EXI-BANQUE-ES TO STRILE-VAL-EXT SET STRILE-ETAT-ACTIF TO TRUE SET STRILE-SO-EXT-REG TO TRUE SET STRILE-HISTO-JN TO TRUE MOVE SPACES TO STRFRE STROLE CALL 'ZCALLPGM' USING STRGAPEL STRFAL STRFRE STRILE STROLE OMITTED END-CALL D DISPLAY 'STRFRE : ' STRFRE D DISPLAY 'STRODE : ' STROLE IF NOT STRFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 05 TO NUM-ERR9 D DISPLAY 'TIEZBBAN - STRFRE-TRT-KO ' STRFRE ELSE MOVE STROLE-VAL-INT (1) TO W-BANQUE-CAISSE-ES MOVE W-BANQUE-INT-ES TO W-BANQUE END-IF . *SDA031018 FIN *--- TCR-200320 DEB *----------------------------------------------------------------* CONV-BANQCAI-FORMAT-INT-GRESH. *-------------------------------- * Conversion "Entité externe -> entité interne" pour le cas * particulier de la banque GRESHAM * On appelle la fonction L000E car il peut y avoir n * correspondances internes pour 1 entité externe *-------------------------------- SET STRFAL-EIE TO TRUE SET STRFAL-FCT-L000E TO TRUE SET STRFAL-ACN-LEC-BLOC-SUIVANT TO TRUE MOVE 'FR' TO STRILE-PAYS STRING TIEBAE-EXI-BANQUE TIEBAE-EXI-CAISSE DELIMITED BY SIZE INTO STRILE-VAL-EXT SET STRILE-ETAT-ACTIF TO TRUE SET STRILE-TYP-INT-GUI TO TRUE SET STRILE-SO-EXT-REG TO TRUE SET STRILE-HISTO-JN TO TRUE MOVE SPACES TO STRFRE STROLE CALL 'ZCALLPGM' USING STRGAPEL STRFAL STRFRE STRILE STROLE OMITTED END-CALL D DISPLAY 'STRFRE : ' STRFRE D DISPLAY 'STRODE : ' STROLE IF NOT STRFRE-TRT-CORRECT SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 08 TO NUM-ERR9 D DISPLAY 'TIEZBBAN - STRFRE-TRT-KO ' STRFRE ELSE MOVE STROLE-VAL-INT(1) (1:5) TO W-BANQUE MOVE STROLE-VAL-INT(1) (6:5) TO W-CAISSE END-IF D DISPLAY 'W-BANQUE <' W-BANQUE '>' D DISPLAY 'W-CAISSE <' W-CAISSE '>' . *--- TCR-200320 *----------------------------------------------------------------* * CALCUL DE LA CLE DE CONTROLE * *----------------------------------------------------------------* CALCUL-CLE. *----------- **********SDA081018 MOVE SPACES TO TIEKEY **********SDA081018 SET TIEKEY-CAL-CLE TO TRUE MOVE TIEBAE-ATT-TYP-PRD TO TIEKEY-TYP-PRD EVALUATE TRUE WHEN TRT-ESPAGNE SET TIEKEY-CLE-RE-ES TO TRUE MOVE W-BANQUE-ES TO TIEKEY-ES-BQE-CAL MOVE W-CAISSE-ES TO TIEKEY-ES-CAI-CAL MOVE WS-NUM-10 TO TIEKEY-ES-NUM-CAL WHEN TRT-BELGIQUE SET TIEKEY-CLE-RE-BE TO TRUE MOVE W-BANQUE-BE TO TIEKEY-BE-BQE-CAL MOVE WS-NUM-07 TO TIEKEY-BE-NUM-CAL END-EVALUATE PERFORM APPEL-TIEZCKEY IF TIEFRE-TRT-CORRECT EVALUATE TRUE WHEN TRT-ESPAGNE MOVE TIEKEY-CAL-CLE-CTL TO W-CLE-ES WHEN TRT-BELGIQUE MOVE TIEKEY-CAL-CLE-CTL TO W-CLE-BE END-EVALUATE END-IF . *----------------------------------------------------------------* * FORMATAGE DU BBAN AVEC L'ENSEMBLE DES ZONES * *----------------------------------------------------------------* FORMATAGE-BBAN. *--------------- MOVE SPACES TO TIEBAS EVALUATE TRUE *--- CVM061114 * WHEN TRT-TARGO-ES WHEN TRT-ESPAGNE STRING W-BANQUE-ES W-CAISSE-ES W-CLE-ES WS-NUM-10 DELIMITED BY SIZE INTO TIEBAS-ATT-BBAN-ES WHEN TRT-BELGIQUE MOVE W-BANQUE-BE TO TIEBAS-ATT-BANQUE-BE MOVE WS-NUM-07 TO TIEBAS-ATT-NUM-CTR-BE MOVE W-CLE-BE TO TIEBAS-ATT-CLE-CTL-BE WHEN OTHER CONTINUE END-EVALUATE . *--- CVM220114 - FIN *--- CVM071113 - DEB *----------------------------------------------------------------* * VERIFICATION QUE LE BBAN ATTRIBUE PAR LE NUMEROTEUR INCREMENTAL* * N'EXISTE PAS DEJA => APPEL DE LA FONCTION IMACTR-L1018 * *----------------------------------------------------------------* VERIF-EXISTENCE-BBAN. *--------------------- SET TIEFALS-ACN-LEC-BLOC-SUIVANT TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE SET TIE-IMACTR-L1018 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-L1018-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR ***cd160118 IF TRT-HOTTINGUER *--- TCR-200320 OR TRT-GRESHAM STRING W-BANQUE-HOT W-CAISSE-HOT WS-NUM-11 DELIMITED BY SIZE INTO TIEE64-L1018-REF-EXT30-DEB STRING W-BANQUE-HOT W-CAISSE-HOT WS-NUM-11 DELIMITED BY SIZE INTO TIEE64-L1018-REF-EXT30-FIN ELSE STRING TIEBAE-ATT-BANQUE TIEBAE-ATT-CAISSE WS-NUM-11 DELIMITED BY SIZE INTO TIEE64-L1018-REF-EXT30-DEB STRING TIEBAE-ATT-BANQUE TIEBAE-ATT-CAISSE WS-NUM-11 DELIMITED BY SIZE INTO TIEE64-L1018-REF-EXT30-FIN END-IF MOVE SPACE TO TIEE64-L1018-TYP-PRD-DEB MOVE SPACE TO TIEE64-L1018-TYP-PRD-FIN MOVE SPACE TO TIEE64-L1018-REF-PRD-DEB MOVE SPACE TO TIEE64-L1018-REF-PRD-FIN SET TIEE64-L1018-TOUTES TO TRUE PERFORM APPEL-TIELI004 . *--- CVM071113 - FIN *----------------------------------------------------------------* * PARCOURS DES TABLES IC POUR TROUVER LE PROCHAIN TS LIBRE * *----------------------------------------------------------------* ATTRIBUTION-TYPE-SERIE. *----------------------- SET TIEFALS-ACN-LEC-BLOC-SUIVANT TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE SET TIE-IMACTR-L1017 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-L1017-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR STRING TIEBAE-ATT-BANQUE TIEBAE-ATT-CAISSE TIEBAE-ATT-RACINE DELIMITED BY SIZE INTO TIEE64-L1017-REF-EXT30 MOVE TIEBAE-ATT-TYP-PRD TO TIEE64-L1017-TYP-PRD MOVE TIEBAE-ATT-REF-PRD TO TIEE64-L1017-REF-PRD MOVE TIEBAE-ATT-DAT-OUV TO TIEE64-L1017-DAT-OUV-CTR * --APPEL DU TIELI004 - FONCTION IMACTR-L1017 PERFORM APPEL-TIELI004 * --VERIFICATION DES CODES RETOUR (PAS DE MSG SPECIFIQUE, ON * REPREND LE MESSAGE DU TIELI004) IF TIEFRE-TRT-CORRECT MOVE TIES64-L1017-REF-EXT30 TO TIEBAS-ATT-BBAN END-IF . *----------------------------------------------------------------* * RESERVATION DU TYPE SERIE DANS LA TABLE TTIERIB * *----------------------------------------------------------------* RESERVATION-TYPE-SERIE. *----------------------- SET TIEFALS-ACN-INSERTION TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE SET TIE-IMACTR-I1001 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-ICX-LTC-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR MOVE TIEVAL-MAJ-I-APR TO I MOVE TIEBAE-RES-TYP-PRD TO TIEE64-ICX-TYP-PRD (I) MOVE TIEBAE-RES-REF-PRD TO TIEE64-ICX-REF-PRD (I) MOVE TIEBAE-RES-DAT-OUV TO TIEE64-ICX-DAT-DEB (I) SET TIEE64-DEMANDE-RESERVATION TO TRUE MOVE TIEBAE-RES-BANQUE TO TIEE64-ICX-REF-EXT30 (I) (1:5) MOVE TIEBAE-RES-CAISSE TO TIEE64-ICX-REF-EXT30 (I) (6:5) MOVE TIEBAE-RES-REF TO TIEE64-ICX-REF-EXT30 (I) (11:11) MOVE TIEFALS-IDE-LGE TO TIEE64-ICX-IVN-LGE (I) MOVE TIEFALS-IDE-PHY TO TIEE64-ICX-IVN-PHY (I) EVALUATE TRUE WHEN TIEFALS-TEMPS-REEL-IMS MOVE 'T' TO TIEE64-ICX-MOD-MAJ (I) WHEN TIEFALS-TEMPS-DIFFERE-IMS WHEN TIEFALS-TEMPS-DIFFERE-TSO MOVE 'B' TO TIEE64-ICX-MOD-MAJ (I) END-EVALUATE *CG0319 IF TIEFALS-FEDE = C-FED-CREATIS MOVE SPACES TO TIEFALS-FEDE END-IF *CG0319 * --APPEL DU TIELI004 - FONCTION IMACTR-I1001 PERFORM APPEL-TIELI004 IF TIEFRE-TRT-CORRECT MOVE TIES64-ICX-REF-EXT30 TO TIEBAS-RES-BBAN END-IF . *----------------------------------------------------------------* * ANNULATION DE LA RESERVATION DU TYPE SERIE DANS TTIERIB * *----------------------------------------------------------------* ANNULATION-TYPE-SERIE. *---------------------- SET TIEFALS-ACN-SUPPRESSION TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE SET TIE-IMACTR-S1001 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-ICX-LTC-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR *--- CE SONT LES DONNEES DE LA 1ERE OCCURENCE QUI SONT UTILISEES * DANS LE TIEP035 POUR SUPPRIMER LA RESERVATION DE LA TTIERIB MOVE TIEVAL-MAJ-I-AVT TO I MOVE TIEBAE-ANU-TYP-PRD TO TIEE64-ICX-TYP-PRD (I) MOVE TIEBAE-ANU-REF-PRD TO TIEE64-ICX-REF-PRD (I) SET TIEE64-ANNUL-RESERVATION TO TRUE MOVE TIEBAE-ANU-REF-EXT TO TIEE64-ICX-REF-EXT30 (I) MOVE TIEFALS-IDE-LGE TO TIEE64-ICX-IVN-LGE (I) MOVE TIEFALS-IDE-PHY TO TIEE64-ICX-IVN-PHY (I) EVALUATE TRUE WHEN TIEFALS-TEMPS-REEL-IMS MOVE 'T' TO TIEE64-ICX-MOD-MAJ (I) WHEN TIEFALS-TEMPS-DIFFERE-IMS WHEN TIEFALS-TEMPS-DIFFERE-TSO MOVE 'B' TO TIEE64-ICX-MOD-MAJ (I) END-EVALUATE * --APPEL DU TIELI004 - FONCTION IMACTR-S1001 PERFORM APPEL-TIELI004 . *----------------------------------------------------------------* * CONTROLE D'EXISTENCE DU TYPE SERIE * *----------------------------------------------------------------* EXISTENCE-TYPE-SERIE. *---------------------- *--- CVM211112 : ON APPELLE LA L1018 POUR LES COMPTES TITRE PEA, * (CAR CONTRÔLES L1017, ON REFUSE LES COMPTES TITRE PEA) * LA L1017 POUR LES AUTRES PRODUITS *--- CVM061114 : SI TIEFAL-ESPAGNE, ON APPELLE LA L1018 CAR LA * L1017 NE MARCHE QUE POUR DES REF EXTERNES SUR 19 OU 21 SET TIEFALS-ACN-LEC-BLOC-SUIVANT TO TRUE SET TIEFALS-ACCESSEUR-LOGIQUE TO TRUE */// COMPTES TITRE PEA (D 0716 ET D0736) /////////////////////// *--- CVM081113 : AJOUT DU NOUVEAU PRODUIT PEA-PME "D 0716 4" * IF TIEBAE-EXI-TYP-PRD = 'D' AND * (TIEBAE-EXI-REF-PRD = '0716' OR '0736' OR '0716 4') IF (TIEBAE-EXI-TYP-PRD = 'D' AND (TIEBAE-EXI-REF-PRD = '0716' OR '0736' OR '0716 4')) OR TIEFAL-ESPAGNE ***cm OR TIEFAL-BELGIQUE SET TIE-IMACTR-L1018 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-L1018-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR MOVE TIEBAE-EXI-REF-EXT TO TIEE64-L1018-REF-EXT30-DEB MOVE TIEBAE-EXI-REF-EXT TO TIEE64-L1018-REF-EXT30-FIN MOVE SPACE TO TIEE64-L1018-TYP-PRD-DEB MOVE SPACE TO TIEE64-L1018-TYP-PRD-FIN MOVE SPACE TO TIEE64-L1018-REF-PRD-DEB MOVE SPACE TO TIEE64-L1018-REF-PRD-FIN SET TIEE64-L1018-TOUTES TO TRUE PERFORM APPEL-TIELI004 * --VERIFICATION DES CODES RETOUR : SI DONNEES NON TROUVEES OK * LE TYPE SERIE EST LIBRE,SINON MSG ERREUR SPECIFIQUE IF TIEFRE-TRT-CORRECT SET TIEFRE-CLE-DEJA-EXISTANTE TO TRUE MOVE 1 TO NUM-ERR9 D DISPLAY 'cle existe deja' ELSE IF TIEFRE-DONNEES-NON-TROUVEES * ON REMET TIEFRE-TRT-CORRECT SI DONNEES NON TROUVEES SET TIEFRE-TRT-CORRECT TO TRUE D DISPLAY 'cle n existe pas ' END-IF END-IF */// AUTRES PRODUITS /////////////////////////////////////////// ELSE SET TIE-IMACTR-L1017 TO TRUE MOVE TIEFON-IDE-FON TO TIEFALS-IDE-FON MOVE TIELI004 TO TIEFALS-PGM-CIB INITIALIZE TIEE64-L1017-ARG MOVE WS-DATE TO TIEE64-DAT-FRAICHEUR MOVE WS-HEURE TO TIEE64-HEU-FRAICHEUR MOVE TIEBAE-EXI-REF-EXT TO TIEE64-L1017-REF-EXT30 MOVE TIEBAE-EXI-TYP-PRD TO TIEE64-L1017-TYP-PRD MOVE TIEBAE-EXI-REF-PRD TO TIEE64-L1017-REF-PRD PERFORM APPEL-TIELI004 * --VERIFICATION DES CODES RETOUR : SI CLE-DEJA-EXISTANTE * => TS NON LIBRE IF TIEFRE-CLE-DEJA-EXISTANTE MOVE 1 TO NUM-ERR9 END-IF END-IF . *----------------------------------------------------------------* * RECHERCHE SITE * *----------------------------------------------------------------* RECHERCHE-SITE. *--------------- SET PAR-ISC-FONCTION-SITE-LOCAL TO TRUE CALL 'ZCALLPGM' USING ZISC ISCPAR END-CALL SET ADDRESS OF ISCSIT TO PAR-ISC-POINTEUR-YISCSIT SET PT-SITE-LOCAL TO PAR-ISC-POINTEUR-YISCSIT IF NOT PAR-ISC-RETOUR-NORMAL SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 7 TO NUM-ERR9 ELSE MOVE SIT-ISC-CODE-IMS TO WS-SITE-TRAIT END-IF D DISPLAY 'WS-SITE-TRAIT : ' WS-SITE-TRAIT . *--- CVM220114 - DEB *----------------------------------------------------------------* * CONTROLE DE L'ENTITE GESTIONNAIRE *----------------------------------------------------------------* CONTROLE-ETT-GES. *----------------- *--- FONCTION EXI => CONTROLES SPECIFIQUES AVEC LA TIEFAL IF TIEBAE-EXI-BBAN MOVE TIEFAL-IDE-EXT-BQE TO W-BANQUE MOVE TIEFAL-IDE-EXT-CAI TO W-CAISSE *...... Recherche de la fédé à partir de la TIEFAL PERFORM RECHERCHE-FEDE IF TIEFRE-TRT-CORRECT MOVE TIEORG-FEDE TO W-FEDE-TIEFAL *......... Détermination du pays de l'entité gestionnaire PERFORM DETERMINATION-PAY-ETT-GES * Si entité étrangère, conversion des données de la * TIEBAE au format interne *SDA031018 DEB IF (ETT-GES-ES OR (W-FEDE-TIEFAL = C-FED-HOTTINGUER) *--- TCR-200320 OR (W-FEDE-TIEFAL = C-FED-GRESHAM)) * IF ETT-GES-ES OR ETT-GES-BE IF TIEORG-FEDE = C-FED-COF-ES PERFORM CONV-BANQCAI-FORMAT-INT-COFES ELSE *--- TCR-200320 DEB IF W-FEDE-TIEFAL = C-FED-GRESHAM PERFORM CONV-BANQCAI-FORMAT-INT-GRESH ELSE *--- TCR-200320 FIN PERFORM CONVERSION-BANQCAI-FORMAT-INT *--- TCR-200320 END-IF END-IF ELSE IF ETT-GES-BE PERFORM CONV-BANQCAI-FORMAT-INT-BE ELSE MOVE TIEBAE-EXI-BANQUE TO W-BANQUE MOVE TIEBAE-EXI-CAISSE TO W-CAISSE END-IF *SDA210318 DEB *SDA031018 FIN END-IF *** pour hottinger, recherche de la caisse au format interne *SDA210318 FIN *......... Recherche de la fédé à partir de la TIEBAE IF TIEFRE-TRT-CORRECT *SDA190617 DEB IF ETT-GES-BE * Belgique : si cohérence banque en sortie de STRGAPEL * et banque de la TIEFAL => détermination type trt IF W-BANQUE-INT-BE = TIEFAL-IDE-EXT-BQE PERFORM DETERMINATION-TYP-TRT * Sinon, anomalie ELSE SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 4 TO NUM-ERR9 END-IF ELSE *SDA190617 FIN *SDA031018 DEB IF (ETT-GES-ES AND TIEORG-FEDE = C-FED-COF-ES) * COF ES : si cohérence banque en sortie de STRGAPEL * et banque de la TIEFAL => détermination type trt * (idem que pour Belgique) IF W-BANQUE-INT-ES = TIEFAL-IDE-EXT-BQE PERFORM DETERMINATION-TYP-TRT * Sinon, anomalie ELSE SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 4 TO NUM-ERR9 END-IF ELSE *SDA031018 FIN PERFORM RECHERCHE-FEDE IF TIEFRE-TRT-CORRECT MOVE TIEORG-FEDE TO W-FEDE-TIEBAE * Si cohérence entre fédé de la TIEFAL et fédé de * la TIEBAE, détermination du type de traitement IF W-FEDE-TIEFAL = W-FEDE-TIEBAE PERFORM DETERMINATION-TYP-TRT * Sinon, anomalie ELSE SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 4 TO NUM-ERR9 END-IF END-IF *SDA031018 DEB END-IF *SDA031018 FIN *SDA190617 DEB END-IF *SDA190617 FIN END-IF END-IF ELSE *--- AUTRES FONCTIONS => CONTROLES A PARTIR DE TIEBAE UNIQUEMENT EVALUATE TRUE WHEN TIEBAE-ATT-BBAN MOVE TIEBAE-ATT-BANQUE TO W-BANQUE MOVE TIEBAE-ATT-CAISSE TO W-CAISSE WHEN TIEBAE-RES-BBAN MOVE TIEBAE-RES-BANQUE TO W-BANQUE MOVE TIEBAE-RES-CAISSE TO W-CAISSE WHEN TIEBAE-ANU-BBAN MOVE TIEBAE-ANU-BANQUE TO W-BANQUE MOVE TIEBAE-ANU-CAISSE TO W-CAISSE WHEN OTHER SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 15 TO NUM-ERR9 END-EVALUATE * Si banque ou caisse non renseignée : anomalie IF TIEFRE-TRT-CORRECT IF W-BANQUE > SPACE AND W-CAISSE > SPACE PERFORM RECHERCHE-FEDE IF TIEFRE-TRT-CORRECT PERFORM DETERMINATION-TYP-TRT END-IF * CG0417-DEB IF TIEFRE-TRT-CORRECT PERFORM CONTROLE-SITEX END-IF * CG0417-FIN ELSE SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 1 TO NUM-ERR9 END-IF END-IF END-IF . *--- CVM220114 - FIN *----------------------------------------------------------------* * RECHERCHE FEDE * *----------------------------------------------------------------* RECHERCHE-FEDE. *--------------- *----INITIALISATION DES DONNEES INITIALIZE TIEORG SET TIEORG-FCT-01 TO TRUE MOVE C-TIERS TO TIEORG-ENVIRONNEMENT MOVE W-BANQUE TO TIEORG-ETT-GES-BC-BQE MOVE W-CAISSE TO TIEORG-ETT-GES-BC-CAI D DISPLAY 'TIEORG-ETT-GES-BC-BQE =' TIEORG-ETT-GES-BC-BQE D DISPLAY 'TIEORG-ETT-GES-BC-CAI =' TIEORG-ETT-GES-BC-CAI EVALUATE TRUE WHEN TIEFALS-TEMPS-REEL-IMS SET TIEORG-TP TO TRUE WHEN TIEFALS-TEMPS-DIFFERE-IMS SET TIEORG-BMP TO TRUE WHEN TIEFALS-TEMPS-DIFFERE-TSO SET TIEORG-BATCH TO TRUE WHEN OTHER SET TIEORG-BATCH TO TRUE END-EVALUATE * --APPEL SOUS-PROGRAMME TIEZORGA PERFORM APPEL-TIEZORGA IF NOT TIEORG-TRT-CORRECT SET TIEFRE-ARG-RECH-ERRONE TO TRUE MOVE 1 TO NUM-ERR9 *--- CVM061114 ELSE MOVE TIEORG-TOP-INT TO TIEFAL-TOP-INT TIEFALS-TOP-INT MOVE TIEORG-CTT-I18N TO TIEFAL-CTT-I18N TIEFALS-CTT-I18N *--- END-IF * --EVALUATION DE LA REPONSE * IF TIEORG-TRT-CORRECT * DETERMINATION DE LA FEDE * EVALUATE TRUE * WHEN TIEORG-FEDE = C-FED-MONABANQ * MOVE TIEORG-FEDE TO TIEFALS-FEDE * SET TRT-MONABANQ TO TRUE * WHEN TIEORG-FEDE = C-FED-BLUE * MOVE TIEORG-FEDE TO TIEFALS-FEDE * SET TRT-BLUE TO TRUE * WHEN TIEORG-FEDE = C-FED-CREATIS * MOVE TIEORG-FEDE TO TIEFALS-FEDE * SET TRT-CREATIS TO TRUE * WHEN TIEORG-FEDE = C-FED-COFIDIS * MOVE TIEORG-FEDE TO TIEFALS-FEDE * SET TRT-COFIDIS TO TRUE *--- CVM220114 * WHEN TIEORG-FEDE = C-FED-TARGO-ES * MOVE TIEORG-FEDE TO TIEFALS-FEDE * SET TRT-TARGO-ES TO TRUE *--- GROSSE VERRUE TEMPORAIRE - A OTER !!!! * IF TIEFAL-IDE-LGE NOT = 'NNPR3HE' * SET TIEFRE-TRT-NON-AUTORISE TO TRUE * MOVE 1 TO NUM-ERR9 * END-IF * WHEN OTHER * SET TRT-RACINE TO TRUE * END-EVALUATE * * ELSE * SET TIEFRE-ARG-RECH-ERRONE TO TRUE * MOVE 1 TO NUM-ERR9 * END-IF . *--- CVM220114 - DEB *----------------------------------------------------------------* * DETERMINATION DU TYPE DE TRAITEMENT EN FONCTION DE LA FEDE * *----------------------------------------------------------------* DETERMINATION-TYP-TRT. *---------------------- * CG2101 DEB * PB POSITIONNEMENT NON REINITIALISE MOVE SPACE TO C-FED-BELGIQUE * CG2101 FIN * EVALUATE TRUE WHEN TIEORG-FEDE = C-FED-MONABANQ MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-MONABANQ TO TRUE WHEN TIEORG-FEDE = C-FED-BLUE MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-BLUE TO TRUE *--- CVM240214 * WHEN (TIEORG-FEDE = C-FED-CREATIS) AND (TIEBAE-ATT-TYP-PRD = 'I') AND (TIEBAE-ATT-REF-PRD = 'CESA1') MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-CREATIS TO TRUE WHEN TIEORG-FEDE = C-FED-COFIDIS MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-COFIDIS TO TRUE *--- CVM220114 WHEN TIEFAL-ESPAGNE MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-ESPAGNE TO TRUE * WHEN TIEFAL-BELGIQUE MOVE TIEORG-FEDE TO TIEFALS-FEDE *--- CD171117 C-FED-BELGIQUE SET TRT-BELGIQUE TO TRUE *--- CD171117 WHEN TIEORG-FEDE = C-FED-HOTTINGUER MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-HOTTINGUER TO TRUE *SDA120219 DEB WHEN TIEORG-FEDE = C-FED-PAYSURF MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-PAYSURF TO TRUE *SDA120219 FIN *--- TCR-200320 DEB WHEN TIEORG-FEDE = C-FED-GRESHAM MOVE TIEORG-FEDE TO TIEFALS-FEDE SET TRT-GRESHAM TO TRUE *--- TCR-200320 FIN WHEN OTHER *SDA190918 DEB IF ((TIEBAE-ATT-BBAN AND TIEBAE-ATT-TOP-NON-RACINE) OR (TIEBAE-EXI-BBAN AND TIEBAE-EXI-TOP-NON-RACINE)) SET TRT-CMCIC-NRC TO TRUE ELSE SET TRT-RACINE TO TRUE END-IF *SDA190918 FIN END-EVALUATE D DISPLAY 'TYPE-TRT : ' TYPE-TRT . *----------------------------------------------------------------* * VERIFICATION QUE LE SITE D'EXéCUTION CORRESPOND AU SITEX CAISSE* *----------------------------------------------------------------* CONTROLE-SITEX. *---------------- IF WS-SITE-TRAIT NOT = TIEORG-CENTREL MOVE WS-SITE-TRAIT TO WK-SITE-TRAITEMENT IF SITE-DE-TEST OR TIEBAE-ATT-BBAN CONTINUE ELSE SET TIEFRE-ERREUR-FATALE TO TRUE MOVE 27 TO NUM-ERR9 END-IF END-IF . *----------------------------------------------------------------* * DETERMINATION DU PAYS DE L'ENTITE GESTIONNAIRE * *----------------------------------------------------------------* DETERMINATION-PAY-ETT-GES. *-------------------------- D display 'TIEORG-PAYS-CAI =' TIEORG-PAYS-CAI EVALUATE TRUE WHEN TIEORG-PAYS-CAI = '134' SET ETT-GES-ES TO TRUE WHEN TIEORG-PAYS-CAI = '131' SET ETT-GES-BE TO TRUE WHEN OTHER * CONTINUE MOVE SPACE TO FLAG-PAYS-ETT-GES END-EVALUATE . *----------------------------------------------------------------* * INITIALISATION DE LA COPY STRFAL * *----------------------------------------------------------------* INIT-STRFAL. *------------ * MOVE SPACES TO STRFAL INITIALIZE STRFAL MOVE TIEFAL-BLOC-EME TO STRFAL-BLO-EME MOVE TIEFAL-APL-EME TO STRFAL-APN-EME MOVE TIEFAL-PGM-EME TO STRFAL-PGM-EME MOVE TIEFAL-MOD-TRT TO STRFAL-MOD-TRT MOVE TIEFAL-IDE-LGE TO STRFAL-IDE-LGQ MOVE TIEFAL-IDE-PHY TO STRFAL-IDE-PHY MOVE TIEFAL-IDE-EXTERNE TO STRFAL-IDE-EXI MOVE TIEFAL-DATE TO STRFAL-DAT MOVE TIEFAL-HEURE TO STRFAL-HEU . *--- CVM220114 - FIN *----------------------------------------------------------------* * APPEL TIEL0001 * *----------------------------------------------------------------* APPEL-TIEL0001. *--------------- D DISPLAY 'TIEFAL : ' TIEFALS D DISPLAY 'TIEE01 : ' TIEE01 CALL 'ZCALLPGM' USING TIEL0001 TIEFALS TIEE01 TIEFRE TIES01 END-CALL D DISPLAY 'TIES01 : ' TIES01 D DISPLAY 'TIEFRE : ' TIEFRE . *----------------------------------------------------------------* * APPEL TIEL0003 * *----------------------------------------------------------------* APPEL-TIEL0003. *--------------- D DISPLAY 'TIEFAL : ' TIEFALS D DISPLAY 'TIEE03 : ' TIEE03 CALL 'ZCALLPGM' USING TIEL0003 TIEFALS TIEE03 TIEFRE TIES03 END-CALL D DISPLAY 'TIES03 : ' TIES03 D DISPLAY 'TIEFRE : ' TIEFRE . *----------------------------------------------------------------* * APPEL TIELI004 * *----------------------------------------------------------------* APPEL-TIELI004. *--------------- D DISPLAY 'TIEFAL : ' TIEFALS D DISPLAY 'TIEE64 : ' TIEE64 CALL 'ZCALLPGM' USING TIELI004 TIEFALS TIEE64 TIEFRE TIES64 END-CALL D DISPLAY 'TIES64 : ' TIES64 D DISPLAY 'TIEFRE : ' TIEFRE . *----------------------------------------------------------------* * APPEL TIEL0006 * *----------------------------------------------------------------* APPEL-TIEL0006. *--------------- D DISPLAY 'TIEFAL : ' TIEFALS D DISPLAY 'TIEE13 : ' TIEE13 CALL 'ZCALLPGM' USING TIEL0006 TIEFALS TIEE13 TIEFRE TIES13 END-CALL D DISPLAY 'TIES13 : ' TIES13 D DISPLAY 'TIEFRE : ' TIEFRE . *----------------------------------------------------------------* * APPEL TIEZORGA * *----------------------------------------------------------------* APPEL-TIEZORGA. *--------------- D DISPLAY 'TIEORG AVANT TIEZORGA : ' TIEORG CALL 'ZCALLPGM' USING TIEZORGA TIEORG END-CALL D DISPLAY 'TIEORG-CODE-RETOUR = ' TIEORG-CODE-RETOUR D DISPLAY 'TIEORG APRES TIEZORGA : ' TIEORG . *----------------------------------------------------------------* * GESTION MESSAGE ANO * *----------------------------------------------------------------* APPEL-TIEGMSGS. *--------------- MOVE NOM-PGM TO TIEFRE-MET-PGM MOVE NUM-ERR9 TO TIEFRE-COD-RET-SCD CALL 'ZCALLPGM' USING TIEGMSGS TIEFAL TIEFRE END-CALL . *--- CVM220114 - DEB *----------------------------------------------------------------* * APPEL STRGAPEL * *----------------------------------------------------------------* APPEL-STRGAPEL. *--------------- MOVE SPACES TO STRFRE STRODE D DISPLAY 'STRFAL : ' STRFAL D DISPLAY 'STRILE : ' STRILE CALL 'ZCALLPGM' USING STRGAPEL STRFAL STRFRE STRILE STRODE OMITTED END-CALL D DISPLAY 'STRFRE : ' STRFRE D DISPLAY 'STRODE : ' STRODE . *----------------------------------------------------------------* * APPEL TIEZCKEY * *----------------------------------------------------------------* APPEL-TIEZCKEY. *--------------- D DISPLAY 'TIEFAL : ' TIEFALS D DISPLAY 'TIEKEY - AVANT : ' TIEKEY CALL 'ZCALLPGM' USING TIEZCKEY TIEFALS TIEKEY TIEFRE END-CALL D DISPLAY 'TIEKEY - APRES : ' TIEKEY D DISPLAY 'TIEFRE : ' TIEFRE . *--- CVM220114 - FIN *============================================================== END PROGRAM TIEZBBAN. *==============================================================