D o m i n i q u e   G u e b e y    J u n g l e      Bazar informatique

Code en Stock : RPG ILE + ProcStoc pur SQL

Sommaire

Ressources

Outillage SQL

Génération automatique de spécifications cartes D
-- Reqete pour generer carte D
select 
 case DATA_TYPE 
 WHEN 'INTEGER'  THEN
	'     D '|| substr(TABLE_NAME,1,3) || substr(COLUMN_NAME,1,11) || '10i 0' 
	WHEN 'SMALLINT'  THEN
	'     D '|| substr(TABLE_NAME,1,3) || substr(COLUMN_NAME,1,11) || ' 5i 0' 
   WHEN 'DECIMAL'  THEN
	'     D '|| substr(TABLE_NAME,1,3)|| substr(COLUMN_NAME,1,11)  || LENGTH || 'P ' || NUMERIC_SCALE
   WHEN 'NUMERIC'  THEN
	'     D '|| substr(TABLE_NAME,1,3)|| substr(COLUMN_NAME,1,11)  || LENGTH || 'P ' || NUMERIC_SCALE
   WHEN ('CHAR')  THEN
	'     D '|| substr(TABLE_NAME,1,3)||substr(COLUMN_NAME,1,11) || LENGTH || 'A '
   WHEN ('VARCHAR')  THEN
	'     D '|| substr(TABLE_NAME,1,3)||substr(COLUMN_NAME,1,11) || LENGTH || 'A '
	   WHEN ('DATE')  THEN
	'     D '|| substr(TABLE_NAME,1,3)||substr(COLUMN_NAME,1,11) || '    D '
		   WHEN ('TIME')  THEN
	'     D '|| substr(TABLE_NAME,1,3)||substr(COLUMN_NAME,1,11) || '    T '
   ELSE
	'     D '|| substr(TABLE_NAME,1,3)|| COLUMN_NAME || '     ' || DATA_TYPE 
  END CASE
FROM QSYS2/SYSCOLUMNS
WHERE TABLE_NAME = 'PARAM_GEN' and TABLE_SCHEMA = 'MABIBLIO'			
order by ORDINAL_POSITION;
Générer spécif. pour zones avec *NULL
--requête pour générer liste des indicateurs de NULL d'une table 
select '     D I'|| substr(TABLE_NAME, 1, 3)  || substr(COLUMN_NAME, 1, 11)  || ' 5I 0'
FROM QSYS2/SYSCOLUMNS
WHERE IS_NULLABLE = 'Y' and TABLE_NAME = 'PARAM_GEN' and TABLE_SCHEMA = 'MABIBLIO'
order by ORDINAL_POSITION;

Clauses /COPY

Spécifications de contrôle
          // MBRSRC51    (carte H)                  
     H DATFMT(*ISO) TIMFMT(*hms.) ALWNULL(*USRCTL)
     H DFTACTGRP(*NO) ACTGRP(*CALLER)             
Paramètres techniques
       // MBRSRC52                                      
     Dbuff_par_tech    DS            64               
       //   Nom de la procédure stockée               
     D  nom_orch                       32a   inz(*blank)
       //   Version                                   
     D  version_po                    2a   inz(*blank)
       //   Appel                                     
     D  type_appel                    2a   inz(*blank)
Codes retour, nombre d'occurences et diagnostic
       // MBRSRC50                                              
       //    Code fonction (30=insert, 40=updat, 50=delete...)
     Dzones_std        DS           256                       
     D   code_retour                  4B 0 inz(*zero )        
     D   sql_stat                     5    inz(*blank)        
     D   msg_err                    100    inz(*blank)        
     D   code_fonc                    2a   inz(*blank)        
     D   occur                        4B 0 inz(*zero )        
     Dnul_code_retour                 5I 0 inz(-1)            
     Dnul_sql_stat                    5I 0 inz(-1)            
     Dnul_msg_err                     5I 0 inz(-1)            
     Dnul_code_fonc                   5I 0 inz(0 )            
     Dnul_occur                       5I 0 inz(-1)            
Exemples de Data Structure d’échange
       // MBRSRC6301                                    
     Dzones_01         DS          2000               
     DZ01ID_PRO                     9b 0 inz(*zero )
     DZ01no_com                      15s 0 inz(*zero )
     DZ01no_lig_com                   4b 0 inz(*zero )
     DZ01contra                       4b 0 inz(*blank)
     DZ01ref_spe                      2s 0 inz(*zero )
     DZ01type_cont                    4a   inz(*blank)
     DZ01code_comp_a                  1a   inz(*blank)
     DZ01code_inst                    6a   inz(*blank)
     DZ01code_tiers_                  3a   inz(*blank)
     DZ01no_validt                   16a   inz(*blank)
     DZ01id_xxxxx_ext                30a   inz(*blank)
     DZ01no_FOURN                    9a   inz(*blank)
     DZ01code_etat                    2a   inz(*blank)
     DZ01code_motif                   2a   inz(*blank)
     DZ01date_acti                     d   inz(*loval)
     DZ01mt_honor                    15s 2 inz(*zero )
     DZ01mt_RO                       15s 2 inz(*zero )
     DZ01mt_RC                       15s 2 inz(*zero )
     DZ01mt_restapaya                15s 2 inz(*zero )

Champs NULL associés

       // MBRSRC6401                                
     Ddsnull_01        DS          1000           
     DZ01nID_PRO                      5I 0 inz( 0)
     DZ01nno_com                      5I 0 inz( 0)
     DZ01nno_lig_com                  5I 0 inz( 0)
     DZ01ncontra                      5I 0 inz( 0)
     DZ01nref_spe                     5I 0 inz( 0)
     DZ01ntype_cont                   5I 0 inz( 0)
     DZ01ncode_comp_a                 5I 0 inz( 0)
     DZ01ncode_inst                   5I 0 inz( 0)
     DZ01ncode_tiers_                 5I 0 inz( 0)
     DZ01nno_validt                   5I 0 inz( 0)
     DZ01nid_xxxxx_ex                 5I 0 inz( 0)
     DZ01nno_FOURN                    5I 0 inz( 0)
     DZ01ncode_etat                   5I 0 inz( 0)
     DZ01ncode_motif                  5I 0 inz(-1)
     DZ01ndate_acti                   5I 0 inz( 0)
     DZ01nmt_honor                    5I 0 inz( 0)
     DZ01nmt_RO                       5I 0 inz( 0)
     DZ01nmt_RC                       5I 0 inz( 0)
     DZ01nmt_restapay                 5I 0 inz( 0)
Programme appelant
      *---------------------------------------------------------------*   
      *                   -  MBRSRC02     -                             *   
      *---------------------------------------------------------------*   
                                                                          
      /COPY *LIBL/QRPGLESRC,MBRSRC51                                        
                                                                          
      // En entrée :                                                      
      // -----------                                                      
      //    Entête                                                        
     FF1_FACT   UP   E           K DISK    prefix(AD)                     
     F                                     rename(AD_FACT:en_format)      
      //    Détail                                                        
     FF1_DE00001IF   E           K DISK    prefix(AE)                     
     F                                     rename(F1_DE00001:de_format)   
                                                                          
      // Evènements AJEVEN                                           
     FAJ_EV00001UF A E           K DISK    prefix(EV)                     
     F                                      rename(AJ_EV00001:ev_format)  
      // Retours d'info                     
     FRETINF    UF A E           K DISK                                   
      // Lien CMD-Facture                                                 
     FFA_LI00001UF A E           K DISK    prefix(LA)                     
     F                                      rename(FA_LI00001:la_format)  
      // Livr. AMDFACTU                                          
     FAM_DE00001IF   E           K DISK    prefix(AM)                     
     F                                     rename(AM_DE00001:am_format)   
      // Liens LFLINKMETACT                              
     FLF_LI00001IF   E           K DISK    prefix(LF)                     
     F                                     rename(LF_LI00001:LF_format)   
      // Correspondances rejets : TPH_ERR                                
     FTPH_ERR  IF   E           K DISK    prefix(TP)                     
      // Bénéficiaires (RB_PROENT - RB_PROENTX14)                       
     FRB_PROENTIF   E           K DISK    prefix(IX)                     
     F                                     rename(RB_PROENT:RB_format)   
                                                                          
      // Paramètres en entrée                                             
     DINTER            PR                  EXTPGM('MBRSRC02    ')           
     D Z_ETATS                      100                                   
     DINTER            PI                                                 
     D Z_ETATS                      100                                   
      // Paramètres mis dans tableau                                      
     DW_DS             DS                                                 
     D W_ETATS                      100                                   
     DT_DS             DS                                                 
     D T_ETATS                        2a   DIM(50)                        
     DI_ETATS          S              4s 0                                
                                                                          
      // Pour utilisation de procédures stockées                          
        // par. techniques : nom version type                             
      /COPY *LIBL/QRPGLESRC,MBRSRC52                                        
        // zone comm. Codes retour et fonction                            
      /COPY *LIBL/QRPGLESRC,MBRSRC50                                        
        // Historique BLGGEN                                              
        // Contrôle doublons factures                                     
      /COPY *LIBL/QRPGLESRC,MBRSRC6303                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC6403                                      
          // ds_sldroit    partenaire/institution/taux                    
      /COPY *LIBL/QRPGLESRC,MBRSRC61$D                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC62$D                                      
        // Contrôle conventionnement PS                                   
      /COPY *LIBL/QRPGLESRC,MBRSRC61$L                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC62$L                                      
        // Contrôle date début des soins                                  
      /COPY *LIBL/QRPGLESRC,MBRSRC6300                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC6400                                      
          //  Procédure stockée de calcul                                 
      /COPY *LIBL/QRPGLESRC,MBRSRC61$A                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC62$A                                      
          //  Pour appel CRUD AI_DET_com                                  
      /COPY *LIBL/QRPGLESRC,MBRSRC61AI                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC62AI                                      
          // zones_01      rapprochement factures-ZZID                     
      /COPY *LIBL/QRPGLESRC,MBRSRC6301                                      
          // dsnull_01                                                    
      /COPY *LIBL/QRPGLESRC,MBRSRC6401                                      
          // buffer de remplissage                                        
      /COPY *LIBL/QRPGLESRC,MBRSRC62$                                       
                                                                          
        // Appel du programme pour email erreur informatique              
     Derr_mail         PR                  EXTPGM('MBRSRC91CLP')            
     D                               44a    const                         
     D                             5000a    const                         
     D mail_objet      S             44a                                  
     D mail_texte      S           5000a                                  
                                                                          
        // Appel du programme SQLRPGLE lançant procédure stockée          
     Dappel_crud       PR                  EXTPGM(nom_rpg)                
     D                               64a    const                         
     D                              256a    const                         
     D                             1000a    const                         
     D                             2000a    const                         
     D buff_param      S           2000a                                  
     D   nom_rpg       s             10a                                  
     Dwwdr             S              9a                                  
     DwwDTRT           S              8S 0                                
     DwwNFACT          S             15a                                  
     Dwwd_min          S               d                                  
     Dwwd_max          S               d                                  
     Dwwcode_evt       S                   like(evCODE_EVT  )             
     Dsv_etat          S                   like(ADcode_00003)             
     Dsv_motif         S                   like(ADcode_00004)             
     D                 DS                                                 
     D ds_nais8                1      8  0                                
     D ds_nais6                3      8  0                                
     D ds_siecl                1      2  0                                
                                                                          
     D w_rnais         S              4  0                                
                                                                          
     D i_for           s              5S 0                                
     D it              s              5S 0                                
     D ix              s              5S 0                                
     D v_inst          s              6a                                  
     D v_part          s              3a                                  
     D v_adh_ext       s             30a                                  
                                                                          
     D w_timstp        s               z   inz(*sys)                      
     D w_heure         s               t   inz(*sys)                      
     D w_date          s               d   inz(*sys)                      
     D w_date27        s               d                                  
                                                                          
     D                SDS                                                 
     D Prog                    1     10                                   
     D Util                  254    263                                   
                                                                          
      /free                                                               
                                                                          
       //////////////////////////////////////////                         
       // Lecture séquentielle des entêtes de facture                     
                                                                          
       // Métier :                                                        
       if (ADCODE_MET = 'DT');                                            
         // Code état : cf liste transmise via dataarea                   
         if (ADcode_00003 <> '  ')                        ;               
           I_ETATS = %lookup(ADcode_00003:T_ETATS);                       
           if I_ETATS > 0;                                                
             EXSR      SRENTETE;                                          
           endif;                                                         
         endif;                                                           
       endif;                                                             
                                                                          
       // ****************************************************            
       //                 R O U T I N E S                                 
       // ****************************************************            
                                                                          
       /////////////////////////////////////////////                      
       ////////        INITIALISATION       ////////                      
       /////////////////////////////////////////////                      
       begsr *INZSR    ;                                                  
          W_ETATS = Z_ETATS ;                                             
          T_DS    = W_DS    ;                                             
       endsr ;                                                            
                                                                          
       /////////////////////////////////////////////                      
       ////////     Traitement ENTETE       ////////                      
       /////////////////////////////////////////////                      
          begsr SRENTETE ;                                                
                                                                          
       *in26 = '0';                                                       
       v_inst    = ADCODE_INST;                                           
       v_part    = ADCODE_00001;                                          
       v_adh_ext = ADID_AD00001;                                          
       sv_etat   = ADcode_00003;                                          
       sv_motif  = ADcode_00004;                                          
                                                                          
       for i_for = 1 to 1 by 1;                                           
                                                                          
       //  Contrôle bénéficiaire                                          
       chain(e) ADID_PRO RB_PROENT;                                    
       if not %found;                                                     
           ADCODE_00003 = '40';                                           
           ADCODE_00004 = '11';                                           
           leave;                                                         
       endif;                                                             
                                                                          
       // RG_080 Date facture non nulle                                   
       if %nullind(ADDATE_FACT) = '1';                                    
           ADCODE_00003 = '40';                                           
           ADCODE_00004 = '38';                                           
           leave;                                                         
       else;                                                              
       // RG_070 Date facture non future                                  
         if ADDATE_FACT >  w_date;                                        
             ADCODE_00003 = '40';                                         
             ADCODE_00004 = '38';                                         
             leave;                                                       
         endif;                                                           
       endif;                                                             
                                                                          
       // RG_108 recherche doublons de facture NOE41DTM/BLGGEN            
       //   Voir dans BLGGEN si le bénéficiaire est le même               
                                                                          
       clear ds_ctrlfact;                                                 
           nom_orch     = 'ORCH_CTRLF ';                            
           type_appel = '01';                                             
           version_po = '01';                                             
           code_fonc  = '01';                                             
           A03ID_FACT     = ADID_FACT   ;                                 
           A03DATE_FACT   = ADDATE_FACT ;                                 
           A03NO_FOURN   = ADNO_FOURN ;                                 
           A03NO_FACT_EXT = ADNO_FA00001;                                 
           A03NO_LOT_EXT  = ADNO_LOT_EXT;                                 
           A03NO_INSEE_TR = ADno_in00001;                                 
           A03DATE_NAIS_T = ADdate_00001;                                 
           A03NO_RANG_NAI = ADno_ra00001;                                 
                                                                          
           A03NID_FACT    =  0 ;                                          
           A03NDATE_FACT  =  0 ;                                          
           A03NNO_FOURN  =  0 ;                                          
           A03NNO_FACT_EXT=  0 ;                                          
           A03NNO_LOT_EXT =  0 ;                                          
         A03NNO_INSEE_TR =  0 ;                                           
         A03NDATE_NAIS_T =  0 ;                                           
         A03NNO_RANG_NAI =  0 ;                                           
         A03NCOD_ETAT    = -1 ;                                           
         A03NCOD_MOTIF   = -1 ;                                           
                                                                          
           nom_rpg = 'MBRSRC11';                                            
         buff_param = ds_ctrlfact ;                                       
           appel_crud (buff_par_tech:zones_std:dsnulctfact:ds_ctrlfact ); 
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail;    // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX       
         endif;                                                           
                                                                          
         if A03COD_ETAT <> '00' and A03COD_ETAT <> '  ';                  
           if ADCODE_00003 <> '44' ;                                      
             ADCODE_00003 = A03COD_ETAT ;                                 
             %nullind(ADCODE_00004) = '0';                                
             ADCODE_00004 = A03COD_MOTIF;                                 
           endif;                                                         
           leave;                                                         
                                                                          
       else;                                                              
       // voir aussi dans F1_FACT      
           code_fonc  = '02';                                             
         buff_param = ds_ctrlfact ;                                       
           appel_crud (buff_par_tech:zones_std:dsnulctfact:ds_ctrlfact ); 
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
         if A03COD_ETAT <> '00' and A03COD_ETAT <> '  ';                  
           if ADCODE_00003 <> '44' ;                                      
             ADCODE_00003 = A03COD_ETAT ;                                 
             %nullind(ADCODE_00004) = '0';                                
             ADCODE_00004 = A03COD_MOTIF;                                 
           endif;                                                         
         leave;                                                           
         endif;                                                           
       endif;                                                             
                                                                          
       // RG_110 recherche conventionnement du PS                         
       clear ds_ps_conv  ;                                                
       //clear dsnps_conv  ;                                              
       nom_orch     = 'ORCH_CONV                   ';                   
       type_appel = '01';                                                 
       version_po = '01';                                                 
       code_fonc  = '01';                                                 
       $L_FOURN    = ADNO_FOURN     ;                                   
       $L_code_met  = ADCODE_MET      ;                                   
       $L_date_fact = ADDATE_FACT     ;                                   
       $L_code_conv = *blank          ;                                   
       $L_COD_ETAT  = *blank          ;                                   
       $LNIDPRO    =  0              ;                                   
       $LNcode_met  =  0              ;                                   
       $LNdate_fact =  0              ;                                   
       $LNcode_conv = -1              ;                                   
       $LNCOD_ETAT  =  0              ;                                   
       $LNCOD_MOTIF =  -1  ;                                              
           nom_rpg = 'MBRSRC11';                                            
         buff_param = ds_ps_conv  ;                                       
       appel_crud (buff_par_tech:zones_std:dsnps_conv:ds_ps_conv  );      
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
       //if code_retour = 100  ; // Pas trouvé                            
       //    ADCODE_00003 = '40';                                         
       //    ADCODE_00004 = '09';                                         
       //    leave;                                                       
       //endif;                                                           
       if $L_COD_ETAT <> '00' and $L_COD_ETAT <> '  ';                    
         if ADCODE_00003 <> '44';                                         
           ADCODE_00003 = $L_COD_ETAT ;                                   
           %nullind(ADCODE_00004) = '0';                                  
           ADCODE_00004 = $L_COD_MOTIF;                                   
         endif;                                                           
       endif;                                                             
                                                                          
       // . . . . . . . . . . . . . . . . . . .                           
         EXSR      SRDETAIL;                                              
       // . . . . . . . . . . . . . . . . . . .                           
                                                                          
       //  Contrôle des droits                                            
       clear ds_sldroit   ;                                               
       //clear dsnul$d      ;                                             
       if wwd_min > *loval and wwd_max > *loval;                          
       nom_orch     = 'ORCH_DROIT                  ';                   
       type_appel = '01';                                                 
       version_po = '01';                                                 
       code_fonc  = '02';                                                 
       AC_ID_PRO     = ADID_PRO      ;                                
       if v_inst <> *blank;                                               
         AC_CODE_INST    = v_inst        ;                                
       else;                                                              
         AC_CODE_INST    = *blank        ;                                
       endif;                                                             
       if v_part <> *blank;                                               
         AC_CODE_tiers_  = v_part        ;                                
       else;                                                              
         AC_CODE_tiers_  = *blank        ;                                
       endif;                                                             
       if v_part <> *blank;                                               
         AC_ID_xxxxx_ex  = v_adh_ext     ;                                
       else;                                                              
         AC_ID_xxxxx_ex  = *blank        ;                                
       endif;                                                             
       AC_TX_GAR       = *zero           ;                                
       AC_DATE_DEB_VA  = wwd_min         ;                                
       AC_DATE_FIN_VA  = wwd_max         ;                                
       AC_NO_ORDR_DRO  = 0               ;                                
        ACNCOD_MOTIF =  -1  ;                                             
       nom_rpg = 'MBRSRC11';                                                
         buff_param = ds_sldroit  ;                                       
       appel_crud (buff_par_tech:zones_std:dsnul$d   :ds_sldroit    );    
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
             if AC_COD_ETAT <> '00' and AC_COD_ETAT <> '  ';              
                 if ADCODE_00003 <> '44' ;                                
                   ADCODE_00003 = AC_COD_ETAT ;                           
                   ADCODE_00004 = AC_COD_MOTIF;                           
                   %nullind(ADCODE_00004) = '0';                          
                 endif;                                                   
                 //ADCODE_00003 = '40';                                   
                 //ADCODE_00004 = '69';                                   
                 leave;                                                   
             else;                                                        
               if v_adh_ext = *blank and AC_ID_xxxxx_ex <> *blank;        
                 v_adh_ext = AC_ID_xxxxx_ex;                              
               endif;                                                     
               if v_inst    = *blank and AC_CODE_INST   <> *blank ;       
                 v_inst    = AC_CODE_INST  ;                              
               endif;                                                     
               if v_part    = *blank and AC_CODE_tiers_ <> *blank ;       
                 v_part    = AC_CODE_tiers_;                              
               endif;                                                     
               //          AC_TX_GAR     ;                                
             endif;                                                       
                                                                          
         else;                                                            
               if ADCODE_00003 <> '44';                                   
                 ADCODE_00003 = '40';                                     
                 ADCODE_00004 = '69';                                     
                 leave;                                                   
               endif;                                                     
         endif;                                                           
                                                                          
         if ADCODE_00003 = '44' or ADCODE_00003 = '40';                   
           leave;                                                         
         endif;                                                           
                                                                          
       leave;                                                             
                                                                          
       endfor;                                                            
                                                                          
       //  - - - - - - - - - - - - - - - - - - - - -                      
       // RG_290                                                          
        %nullind(ADCODE_00004) = '0';                                     
       if ADCODE_00003 <> '40' and ADCODE_00003 <> '41'                   
       and ADCODE_00003 <> '60' and ADCODE_00003 <> '44';                 
        ADCODE_00003 = '60';                                              
        ADCODE_00004 = '  ';                                              
        %nullind(ADCODE_00004) = '1';                                     
       //  Sortie dans liens CMD-facture                                  
       setll(e) ADID_FACT F1_DE00001;                                     
       reade(e) ADID_FACT F1_DE00001;                                     
       dow not %eof(F1_DE00001);                                          
          if AENO_DEM_com > 0;                                            
               %nullind(AENO_DEM_ZZID) = *off      ;                       
               %nullind(AEcontra_ZZID) = *off      ;                       
               chain(e) (ADID_FACT:AENO_DEM_ZZID:AEcontra_ZZID) FA_LI00001; 
                  LADATE_MAJ   = w_date           ;                       
                  LAUTIL_MAJ   = Prog             ;                       
               if not %found;                                             
                  LAID_FACT    = ADID_FACT        ;                       
                  LANO_DEM_com = AENO_DEM_com     ;                       
                  LAcontra_com = AEcontra_com     ;                       
                  LADATE_00001 = w_date           ;                       
                  LAUTIL_00001 = Prog             ;                       
                  monitor;                                                
                    write la_format;                                      
                  on-error;                                               
                    // violation de contrainte : ZZID inexistante          
                  endmon;                                                 
               else;                                                      
                  update la_format;                                       
               endif;                                                     
          endif;                                                          
       reade(e) ADID_FACT F1_DE00001;                                     
       enddo;                                                             
                                                                          
       // Sinon rejet                                                     
       else;  // RG_270 revenir sur les maj faites DETOPAGE               
         if *in26 = '1';                                                  
           clear zds_ai_det_zzid;                                          
           nom_orch     = 'ORCH_DET_CDE              ';               
           type_appel = '01';                                             
           version_po = '01';                                             
           code_fonc  = '42';                                             
             AI_ID_FACT     = aeid_fact   ;                               
             AI_UTIL_MAJ    = Prog        ;                               
           nom_rpg = 'MBRSRC10';                                            
         buff_param = zds_ai_det_zzid;                                     
         appel_crud (buff_par_tech:zones_std:dsnulai_det:zds_ai_det_zzid); 
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
         endif;                                                           
       endif;                                                             
                                                                          
       //    maj F1_FACT  (codes ETAT/MOTIF)                              
        if ADCODE_INST = *blank;                                          
           ADCODE_INST = v_inst;                                          
        endif;                                                            
        if ADCODE_00001= *blank;                                          
           ADCODE_00001= v_part;                                          
        endif;                                                            
        if ADID_AD00001= *blank;                                          
           ADID_AD00001= v_adh_ext;                                       
        endif;                                                            
                                                                          
       //  RG_300 - sortie dans retours PS avirsp                         
       if ADCODE_00003 = '40' or ADCODE_00003 = '44';                     
         exsr avirsp;                                                     
       endif;                                                             
       //  - sortie dans évènements                                       
       if ADCODE_00003 = '40' or ADCODE_00003 = '44';                     
         exsr maj_eve;                                                    
       endif;                                                             
                                                                          
       endsr;                                                             
                                                                          
       /////////////////////////////////////////////                      
       ////////     Traitement DETAIL       ////////                      
       /////////////////////////////////////////////                      
       begsr SRDETAIL ;                                                   
                                                                          
       // Date début de soins                                             
       wwd_min = *loval;                                                  
       wwd_max = *loval;                                                  
       *in99 = '0';                                                       
                                                                          
       setll(e) ADID_FACT F1_DE00001;                                     
       reade(e) ADID_FACT F1_DE00001;                                     
       dow not %eof(F1_DE00001);                                          
                                                                          
       // ***** Chargement dates de soins pour contrôle droits ******** //
         if %nullind(AEDATE_00002) = '1';                                 
            %nullind(AEDATE_00002) = '0';                                 
            AEDATE_00002 = AEDATE_00001 ;                                 
         endif;                                                           
         if *in99 = '0';           // 1ère ligne                          
           wwd_min = AEDATE_00001;                                        
           wwd_max = AEDATE_00002;                                        
           *in99 = '1';                                                   
         else;                     // Lignes suivantes                    
           if AEDATE_00001 < wwd_min;                                     
             wwd_min = AEDATE_00001;                                      
           endif;                                                         
           if AEDATE_00002 > wwd_max;                                     
             wwd_max = AEDATE_00002;                                      
           endif;                                                         
         endif;                                                           
         if %nullind(AEDATE_00001) = '1';                                 
           if ADCODE_00003 <> '44';                                       
             ADCODE_00003 = '40';                                         
             ADCODE_00004 = '41';                                         
             leave;                                                       
           endif;                                                         
         endif;                                                           
                                                                          
         //  Calcul date moins 27 mois                                    
         clear ds_deb_acti;                                               
           nom_orch     = 'ORCH_CTRL_DATE         ';               
           type_appel = '01';                                             
           version_po = '01';                                             
           code_fonc  = '01';                                             
         monitor;                                                         
           Z00datmin   = w_date       - %MONTHS(27);                      
           Z00id_fact  = ADID_FACT          ;                             
           Z00Nid_fact   = 0                ;                             
           Z00Ndatmin    = 0                ;                             
           Z00N_ok       = 0                ;                             
           Z00NCOD_ETAT  =  -1              ;                             
           Z00NCOD_MOTIF =  -1 ;                                          
           nom_rpg = 'MBRSRC11';                                            
         buff_param = ds_deb_acti ;                                       
           appel_crud (buff_par_tech:zones_std:dsndeb_acti:ds_deb_acti);  
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
           //if Z00_ok <> 'OK'     ; // date fausse                       
            if Z00COD_ETAT  <> '00' and Z00COD_ETAT <> '  ';              
             if ADCODE_00003 <> '44' ;                                    
               //ADCODE_00003 = '40';                                     
               //ADCODE_00004 = '42';                                     
                 ADCODE_00003 = Z00COD_ETAT ;                             
                 %nullind(ADCODE_00004) = '0';                            
                 ADCODE_00004 = Z00COD_MOTIF;                             
             endif;                                                       
                 leave;                                                   
            endif;                                                        
         on-error;                                                        
             if ADCODE_00003 <> '44' ;                                    
             ADCODE_00003 = '40';                                         
             ADCODE_00004 = '41';                                         
             endif;                                                       
             leave;                                                       
         endmon;                                                          
                                                                          
       // ************* Rapprochement avec ZZID **************** //        
                                                                          
       clear zones_01;                                                    
           nom_orch     = 'ORCH_CTRL_ACCO             ';               
           type_appel = '01';                                             
           version_po = '01';                                             
           *in98 = '0';                                                   
       if aeNO_DEM_com > 0; // n. ZZID renseigné                           
           code_fonc  = '01';                                             
       else;                // n. ZZID non renseigné                       
           *in98 = '1';                                                   
           code_fonc  = '02';                                             
       endif;                                                             
           Z01ID_PRO    = adID_PRO  ;                                 
           Z01no_com      = aeno_dem_zzid;                                 
           Z01no_lig_com  = aeno_lig_zzid;                                 
           Z01contra      = 1           ;                                 
           Z01code_etat   = *blank      ;                                 
           Z01code_motif  = *blank      ;                                 
           Z01nID_PRO   =  0 ;                                          
           Z01nno_com     =  0 ;                                          
           Z01nno_lig_com =  0 ;                                          
           Z01ncontra     =  0 ;                                          
           Z01ntype_cont  =  0 ;                                          
           Z01ncode_comp_a=  0 ;                                          
           Z01ncode_inst  =  0 ;                                          
           Z01ncode_tiers_=  0 ;                                          
           Z01nno_validt  =  0 ;                                          
           Z01nid_xxxxx_ex=  0 ;                                          
           Z01nno_FOURN  =  0 ;                                          
           Z01ncode_etat  =  0 ;                                          
           Z01ncode_motif = -1 ;                                          
           Z01nmt_honor   =  0 ;                                          
           Z01nmt_RO      =  0 ;                                          
           Z01nmt_RC      =  0 ;                                          
           Z01nmt_restapay=  0 ;                                          
           chain(e) (AEID_FACT:AENO_LI00001) AM_DE00001;                  
           if %found;                                                     
             Z01ref_spe     = AMref_spe ;                                 
             Z01nref_spe    = 0         ;                                 
           else;                                                          
             Z01ref_spe     = 0         ;                                 
             Z01nref_spe    = -1        ;                                 
           endif;                                                         
           Z01type_cont   = aetype_cont ;                                 
           Z01code_comp_a = aecode_00003;                                 
           Z01no_validt   = adno_ac00001 ;                                
           if adcode_inst <> *blank;                                      
             Z01code_inst   = adcode_inst ;                               
             Z01code_tiers_ = adcode_00001;                               
           else;                                                          
             Z01code_inst   = v_inst      ;                               
             Z01code_tiers_ = v_part      ;                               
           endif;                                                         
           Z01id_xxxxx_ext= adid_ad00001;                                 
           Z01no_FOURN   = adno_FOURN ;                                 
           Z01date_acti   = aedate_00001; // date de début (cf JS)        
           Z01mt_honor    = aemt_honorr ;                                 
           Z01mt_RO       = aemt_ro     ;                                 
           Z01mt_RC       = aemt_rc     ;                                 
           Z01mt_restapaya= aemt_re00001;                                 
           nom_rpg = 'MBRSRC11';                                            
         buff_param = zones_01    ;                                       
           appel_crud (buff_par_tech:zones_std:dsnull_01:zones_01    );   
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
                                                                          
           if occur > 0;                                                  
             *in26 = '1';                                                 
             // UPDATE du détail ZZID si pas encore à jour                 
             if *in98 = '1';                                              
               clear zds_ai_det_zzid;                                      
               nom_orch     = 'ORCH_DET_CDE              ';           
               type_appel = '01';                                         
               version_po = '01';                                         
               code_fonc  = '41';                                         
       // i_no_dem_com                                                    
               AI_NO_DEM_com = Z01no_com     ;                            
               AI_contra_com = Z01contra     ;                            
               AI_NO_LIG_com = Z01no_lig_com ;                            
               AI_CODE_ETAT_D= '62'          ;                            
               AI_ID_FACT    = aeid_fact     ;                            
               AI_NO_LIG_FACT= aeno_li00001  ;                            
               AI_DATE_MAJ   = w_date        ;                            
               AI_HEURE_MAJ  = w_heure       ;                            
               AI_UTIL_MAJ   = Prog          ;                            
           nom_rpg = 'MBRSRC10';                                            
         buff_param = zds_ai_det_zzid;                                     
       appel_crud (buff_par_tech:zones_std:dsnulai_det:zds_ai_det_zzid);   
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
             endif;                                                       
           endif;                                                         
                                                                          
       if v_inst    = *blank and Z01code_inst <> *blank;                  
          v_inst    = Z01code_inst   ;                                    
       endif;                                                             
       if v_part    = *blank and Z01code_tiers_ <> *blank;                
          v_part    = Z01code_tiers_ ;                                    
       endif;                                                             
       if v_adh_ext = *blank and Z01id_xxxxx_ext <> *blank;               
          v_adh_ext = Z01id_xxxxx_ext;                                    
       endif;                                                             
         if Z01code_etat <> *blank;                                       
            ADCODE_00003 = Z01code_etat   ;                               
         endif;                                                           
         if Z01code_motif   <> *blank;                                    
            ADCODE_00004 = Z01code_motif  ;                               
         endif;                                                           
                                                                          
       // Acte NON SOUMIS à ZZID  Contrôle montants  RG_266                
       // A faire après le rapprochement (qui récupère le taux)           
       chain(e) (adCODE_MET:aetype_cont:AeCODE_00003) LF_LI00001;         
       if not %found or LFTOP_com = 'N';                                  
                                                                          
       if aemt_base_ro <> 0;                                              
       clear ds_calfac   ;                                                
       //clear dsnul$A     ;                                              
       nom_orch     = 'ORCH_CTRL_MONTAN              ';                   
       type_appel = '01';                                                 
       version_po = '01';                                                 
       code_fonc  = '01';                                                 
       $A_base_ro      = aemt_base_ro    ;                                
       $A_mt_ro        = aemt_ro         ;                                
       $A_taux         = aetx_ro         ;                                
       $A_mt_fact      = aemt_rc         ;                                
       $A_COD_ETAT     = '  ' ;                                           
       $ANbase_ro      =  0 ;                                             
       $ANmt_ro        =  0 ;                                             
       $ANtaux         =  0 ;                                             
       $ANmt_fact      =  0 ;                                             
       $ANCOD_ETAT     =  0 ;                                             
       $ANCOD_MOTIF    = -1 ;                                             
       nom_rpg = 'MBRSRC09';                                                
         buff_param = ds_calfac     ;                                     
       appel_crud (buff_par_tech:zones_std:dsnul$A   :ds_calfac    );     
         // Envoi d'un email d'anomalie et arrêt du programme             
         if (code_retour < 0 and code_retour <> -803)                     
           or code_retour = 99;                                           
         //exsr sr_mail; // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX          
         endif;                                                           
       //if $A_ok  <> 'OK'     ; // ligne rejetée                         
         if $A_COD_ETAT  <> '00' and $A_COD_ETAT <> '  ';                 
           if ADCODE_00003 <> '44' ;                                      
             //ADCODE_00003 = '44';                                       
             //ADCODE_00004 = '12';                                       
             ADCODE_00003 = $A_COD_ETAT ;                                 
             if $ANCOD_MOTIF =  0 ;                                       
               %nullind(ADCODE_00004) ='0' ;                              
               ADCODE_00004 = $A_COD_MOTIF;                               
             endif;                                                       
             //iter;                                                      
               leave;                                                     
           endif;                                                         
         endif;                                                           
                                                                          
       endif; // test mt_base_ro                                          
       endif; // test acte non soumis ZZID                                 
                                                                          
       reade(e) ADID_FACT F1_DE00001;                                     
       enddo;                                                             
                                                                          
       endsr ;                                                            
                                                                          
       /////////////////////////////////////////////                      
       ////////        EVENEMENTS           ////////                      
       /////////////////////////////////////////////                      
       begsr maj_eve   ;                                                  
       if ADCODE_00003 <> sv_etat or ADCODE_00004 <> sv_motif;            
          select;                           // cle (2)                    
           when ADCODE_00003 = '40';                                      
            wwCODE_EVT   = 'CONTRO'        ;                              
           when AdCODE_00003 = '44';                                      
            wwCODE_EVT   = 'REJET'        ;                              
          endsl;                                                          
                                                                          
          evNO_OR00001 = *HIVAL;              // cle (3)                  
       // setgt (evID_FACT:evCODE_EVT:evNO_OR00001) AJ_EV00001;           
          setgt (ADID_FACT:wwCODE_EVT:evNO_OR00001) AJ_EV00001;           
          readpe(e) (adID_FACT:wwCODE_EVT)          AJ_EV00001;           
          if %eof  ;                                                      
            evNO_OR00001 = 1               ;                              
          else;                                                           
            evNO_OR00001 = evNO_OR00001 + 1;                              
          endif;                                                          
                                                                          
          evID_FACT    = ADID_FACT        ;  // cle (1)                   
          evCODE_EVT   = wwCODE_EVT       ;  // cle (1)                   
          evCODE_00001 = Util            ;                                
          evTS_EVT     = w_timstp        ;                                
          evCODE_00002 = ADCODE_00003      ;  // état                     
          evCODE_00003 = ADCODE_00004      ;  // motif                    
          evDATE_00001 = w_date          ;                                
          evHEURE00001 = w_heure         ;                                
          evUTIL_00001 = Prog            ;                                
          evDATE_MAJ   = w_date          ;                                
          evHEURE_MAJ  = w_heure         ;                                
          evUTIL_MAJ   = Prog            ;                                
                                                                          
          write(e) ev_format;                                             
                                                                          
       endif;                                                             
       endsr ;                                                            
                                                                          
       /////////////////////////////////////////////                      
       ////////     Retours info PS         ////////                      
       /////////////////////////////////////////////                      
       begsr avirsp    ;                                                  
          AVNPS  = %dec(ADNO_FOURN:9:0) ; // AVNPS   IDPRO              
          AVNLOT = AdNO_LOT_EXT;           // AVNLOT  N° LOT              
          evalr AVNFAC = %char(ADNO_FA00001); // AVNFAC  N° FACTURE       
          AVNMUT = *blank      ;                                          
          AVNMUT = %XLATE(' ':'0':AVNMUT);                                
          AVTYPR = 1           ;  // AVTYPR  TYPE RETOUR                  
          AVETAT = 'R'         ;  // AVETAT  ETAT PAIEMENT                
          AVDCPT = %dec(w_date) ; // AVDCPT  DATE VIR OU REJET            
          AVVIR1 = *blank      ;  // AVVIR1  LIB VIR LIGNE 1              
          AVVIR2 = *blank      ;  // AVVIR2  LIB VIR LIGNE 2              
          chain(e) ADCODE_00004 TPH_ERR;                                 
          if %found;                                                      
            AVCREJ = TPREJCOD;      // AVCREJ  CODIF REJET                
          else;                                                           
            AVCREJ = '068'       ;                                        
          endif;                                                          
          AVTOP  = *blank      ;  // TOP TRAIT ZONE                       
          AVNVER = 10          ;  // AVNVER  VERSION FORMAT               
          AVDENR = %dec(w_date) ; // AVDENR  DATE CREATION ENREG          
          AVFLR1 = *blank      ;  // AVFLR1  FILLER                       
          AVMARQ = '@'         ;  // AVMARQ  MARQUEUR FIN ENREG           
       write(e) RETINF   f;                                               
                                                                          
       endsr ;                                                            
                                                                          
       ////////////////////////////////////////////////////               
       ////////     eMail d'anomalie informatique    //////               
       ////////////////////////////////////////////////////               
        begsr sr_mail   ;                                                 
           *in33 = '1';                                                   
           mail_objet = *blank;                                           
           mail_objet = 'Erreur sur ' + %trim(nom_orch) +                   
              ' (' + %trim(prog) + ')';                                   
           mail_texte = *blank;                                           
           mail_texte = 'Le programme ' + %trim(prog)      +              
              ' s''est interrompu suite à une erreur liée à l''appel ' +  
              'de la procédure stockée ' + %trim(nom_orch) +                
              ' avec le code fonction ' + %trim(code_fonc) +              
              ' via le programme ' + %trim(nom_rpg) +                     
              '. :/P Code retour : ' + %char(code_retour)  +              
              '  :/N SQL Stat : ' + sql_stat               +              
              '  :/N Message : ' + %trim(msg_err)          +              
              '  :/N Chaîne de paramètres : ' + buff_param                
              ;                                                           
           err_mail (mail_objet:mail_texte);                              
                                                                          
             //////////////////////                                       
                  return;                                                 
             //////////////////////                                       
                                                                          
        endsr;                                                            
                                                                          
      /end-free                                                           
Programme SQLRPGLE interface
      /COPY *LIBL/QRPGLESRC,MBRSRC51                                           
      *---------------------------------------------------------------*      
      *                   -  MBRSRC11     -                             *      
      *---------------------------------------------------------------*      
      *  Appel procédures stockées pour Services de Lecture           *      
      *---------------------------------------------------------------*      

     DSL_PO            PR                  EXTPGM('MBRSRC11    ')              
     D  w_par_tech                   64                                      
     D  w_std                       256                                      
     D  w_indnull                  1000                                      
     D  w_buff                     2000a                                     
                                                                             
     DSL_PO            PI                                                    
     D  w_par_tech                   64                                      
     D  w_std                       256                                      
     D  w_indnull                  1000                                      
     D  w_buff                     2000a                                     
                                                                             
          // paramètres techniques                                           
      /COPY *LIBL/QRPGLESRC,MBRSRC52                                           
          // zones de contrôle général                                       
      /COPY *LIBL/QRPGLESRC,MBRSRC50                                           
          // NOE41DTA/BLGGEN historique factures                             
      /COPY *LIBL/QRPGLESRC,MBRSRC61BL                                         
      /COPY *LIBL/QRPGLESRC,MBRSRC62BL                                         
          // ds_ps_conv   controle conventionnement PS                       
      /COPY *LIBL/QRPGLESRC,MBRSRC61$L                                         
      /COPY *LIBL/QRPGLESRC,MBRSRC62$L                                         
          // ds_sldroit                                                      
      /COPY *LIBL/QRPGLESRC,MBRSRC61$D                                         
      /COPY *LIBL/QRPGLESRC,MBRSRC62$D                                         
          // ds_deb_acti      contrôle date début soins                      
      /COPY *LIBL/QRPGLESRC,MBRSRC6300                                         
      /COPY *LIBL/QRPGLESRC,MBRSRC6400                                         
          // zones_01      rapprochement factures-ZZID                        
      /COPY *LIBL/QRPGLESRC,MBRSRC6301                                         
          // znull_01                                                        
      /COPY *LIBL/QRPGLESRC,MBRSRC6401                                         
          //               rapprochement factures-ZZID                        
      /COPY *LIBL/QRPGLESRC,MBRSRC6303                                         
      /COPY *LIBL/QRPGLESRC,MBRSRC6403                                         
                                                                             
     D w_heure         s               t   inz(*sys)                         
                                                                             
      /free                                                                  
                                                                             
       // charge depuis buffers reçus                                        
          buff_par_tech = w_par_tech;                                        
          zones_std = w_std ;                                                
                                                                             
       //   initialise                                                       
           code_retour = 0;                                                  
           sql_stat = *blank;                                                
           msg_err  = *blank;                                                
           occur    = 0;                                                     
                                                                             
       // traîtement selon le type d'appel -------------                     
       select ;                                                              
                                                                             
         // -----------------------------------------------                  
         when type_appel = '01';                                             
           select ;                                                          
                                                                             
           //  -------------                                                 
           //when nom_orch = 'ORCH_FACTUR';                            
           //  exsr srcontrfac;                                              
           //                                                                
           //  -------------                                                 
             when nom_orch = 'ORCH_CTRLF     ';                        
               exsr srctrlfact;                                              
                                                                             
           //  -------------                                                 
             when nom_orch = 'ORCH_DROIT     ';                            
               exsr srdroit   ;                                              
                                                                             
           //  -------------                                                 
             when nom_orch = 'ORCH_CONV      ';                            
               exsr srpsconv  ;                                              
                                                                             
           //  -------------                                                 
             when nom_orch = 'ORCH_CTRL_DATE';                        
               exsr srdatdsoin;                                              
                                                                             
           //  -------------                                                 
             when nom_orch = 'ORCH_CTRL_ACCO';                            
               exsr srpecrapp ;                                              
                                                                             
           //  -------------                                                 
           other                  ;                                          
             msg_err='Nom de procédure ' + %trim(nom_orch) + ' non valable';   
             code_retour = 99;                                               
                                                                             
           endsl;                                                            
                                                                             
         // -----------------------------------------------                  
         when type_appel = '99';                                             
           exec sql commit;                                                  
                                                                             
         // -----------------------------------------------                  
         other ;                                                             
           msg_err='Type d''appel ' + type_appel + ' non valable';           
           code_retour = 99;                                                 
                                                                             
         endsl;                                                              
                                                                             
       // -----------------------------------------------                    
       if SQLCOD < *zero;                                                    
       code_retour = SQLCOD;                                                 
       exec SQL get diagnostics EXCEPTION 1                                  
                   :msg_err  = MESSAGE_TEXT,                                 
                   :sql_stat = RETURNED_SQLSTATE                             
                   ;                                                         
       endif;                                                                
                                                                             
       // -----------------------------------------------                    
                                                                             
       // charge les données de retour dans buffer passé en paramètres       
           w_std = zones_std;                                                
                                                                             
        *inlr = *On;                                                         
                                                                             
       // -----------------------------------------------                    
       //  Controle doublons de factures                                     
       // -----------------------------------------------                    
          begsr srctrlfact ;                                                 
                                                                             
         ds_ctrlfact  = w_buff;                                              
         dsnulctfact   = w_indnull ;                                         
         select;                                                             
         when version_po < '02' ;                                            
           exec sql call :nom_orch             (                               
            :code_retour:nul_code_retour   ,                                 
            :sql_stat   :nul_sql_stat      ,                                 
            :msg_err    :nul_msg_err       ,                                 
            :code_fonc  :nul_code_fonc     ,                                 
            :occur      :nul_occur         ,                                 
            :A03ID_FACT    :A03NID_FACT,                                     
            :A03DATE_FACT  :A03NDATE_FACT,                                   
            :A03NO_FOURN  :A03NNO_FOURN  ,                                 
            :A03NO_FACT_EXT:A03NNO_FACT_EXT,                                 
            :A03NO_LOT_EXT :A03NNO_LOT_EXT ,                                 
            :A03NO_INSEE_TR:A03NNO_INSEE_TR,                                 
            :A03DATE_NAIS_T:A03NDATE_NAIS_T,                                 
            :A03NO_RANG_NAI:A03NNO_RANG_NAI,                                 
            :A03COD_ETAT   :A03NCOD_ETAT,                                    
            :A03COD_MOTIF  :A03NCOD_MOTIF                                    
            );                                                               
          other;                                                             
            exsr err_po;                                                     
         endsl;                                                              
         w_buff = ds_ctrlfact   ;                                            
         w_indnull    = dsnulctfact;                                         
                                                                             
          endsr;                                                             
       // -----------------------------------------------                    
       //  Contrôle convention                                 
       // -----------------------------------------------                    
          begsr srpsconv   ;                                                 
                                                                             
         ds_ps_conv   = w_buff;                                              
         dsnps_conv   = w_indnull ;                                          
         select;                                                             
         when version_po < '02' ;                                            
           exec sql call :nom_orch             (                               
            :code_retour   :nul_code_retour   ,                              
            :sql_stat      :nul_sql_stat      ,                              
            :msg_err       :nul_msg_err       ,                              
            :code_fonc     :nul_code_fonc     ,                              
            :occur         :nul_occur   ,                                    
            :$L_FOURN      :$LNIDPRO   ,                                    
            :$L_code_met   :$LNcode_met ,                                    
            :$L_date_fact  :$LNdate_fact,                                    
            :$L_code_conv  :$LNCODE_CONV,                                    
            :$L_COD_ETAT   :$LNCOD_ETAT ,                                    
            :$L_COD_MOTIF  :$LNCOD_MOTIF                                     
            );                                                               
          other;                                                             
            exsr err_po;                                                     
         endsl;                                                              
         w_buff     = ds_ps_conv    ;                                        
         //if %nullind($L_CODE_CONV) = '0';                                  
         //  $LNCODE_CONV = 0  ;                                             
         //else;                                                             
         //  $LNCODE_CONV = -1 ;                                             
         //endif;                                                            
         w_indnull  = dsnps_conv    ;                                        
                                                                             
          endsr;                                                             
       // -----------------------------------------------                    
       // Contrôle date de début des soins                                   
       // -----------------------------------------------                    
          begsr srdatdsoin ;                                                 
                                                                             
         dsndeb_acti  = w_indnull ;                                          
         ds_deb_acti   = w_buff;                                             
         select;                                                             
         when version_po < '02' ;                                            
           exec sql call :nom_orch             (                               
            :code_retour   :nul_code_retour   ,                              
            :sql_stat      :nul_sql_stat      ,                              
            :msg_err       :nul_msg_err       ,                              
            :code_fonc     :nul_code_fonc     ,                              
            :occur         :nul_occur         ,                              
            :Z00id_fact    :Z00Nid_fact    ,                                 
            :Z00datmin     :Z00Ndatmin     ,                                 
            :Z00COD_ETAT   :Z00N_ok        ,                                 
            :Z00COD_MOTIF  :Z00NCOD_ETAT                                     
            );                                                               
          other;                                                             
            exsr err_po;                                                     
         endsl;                                                              
                                                                             
         w_buff = ds_deb_acti      ;                                         
         w_indnull = dsndeb_acti   ;                                         
                                                                             
          endsr;                                                             
       // -----------------------------------------------                    
       //  RG_134 contrôle des droits pour une facture                       
       // -----------------------------------------------                    
          begsr srdroit    ;                                                 
                                                                             
         ds_sldroit    = w_buff;                                             
         dsnul$d       = w_indnull     ;                                     
         select;                                                             
         when version_po < '02' ;                                            
           exec sql call :nom_orch             (                               
            :code_retour   :nul_code_retour   ,                              
            :sql_stat      :nul_sql_stat      ,                              
            :msg_err       :nul_msg_err       ,                              
            :code_fonc     :nul_code_fonc     ,                              
            :occur         :nul_occur         ,                              
            :AC_ID_PRO   :ACNID_PRO   ,                                  
            :AC_CODE_INST  :ACNCODE_INST  ,                                  
            :AC_CODE_tiers_:ACNCODE_tiers_,                                  
            :AC_ID_xxxxx_ex:ACNID_xxxxx_ex,                                  
            :AC_TX_GAR     :ACNTX_GAR     ,                                  
            :AC_DATE_DEB_VA:ACNDATE_DEB_VA,                                  
            :AC_DATE_FIN_VA:ACNDATE_FIN_VA,                                  
            :AC_NO_ORDR_DRO:ACNNO_ORDR_DRO,                                  
            :AC_COD_ETAT,  :ACNCOD_ETAT   ,                                  
            :AC_COD_MOTIF  :ACNCOD_MOTIF                                     
            );                                                               
          other;                                                             
            exsr err_po;                                                     
         endsl;                                                              
         w_buff    = ds_sldroit    ;                                         
         w_indnull = dsnul$d       ;                                         
                                                                             
          endsr;                                                             
                                                                             
       // -----------------------------------------------                    
       //  Rapprochement  FACTURES - ZZID                                     
       // -----------------------------------------------                    
          begsr srpecrapp  ;                                                 
                                                                             
         dsnull_01    = w_indnull ;                                          
         zones_01     = w_buff;                                              
         select;                                                             
         when version_po < '02' ;                                            
           exec sql call :nom_orch             (                               
            :code_retour    :nul_code_retour   ,                             
            :sql_stat       :nul_sql_stat      ,                             
            :msg_err        :nul_msg_err       ,                             
            :code_fonc      :nul_code_fonc     ,                             
            :occur          :nul_occur         ,                             
            :Z01ID_PRO    :Z01nID_PRO   ,                                
            :Z01no_com      :Z01nno_com     ,                                
            :Z01no_lig_com  :Z01nno_lig_com ,                                
            :Z01contra      :Z01ncontra     ,                                
            :Z01ref_spe     :Z01nref_spe    ,                                
            :Z01type_cont   :Z01ntype_cont  ,                                
            :Z01code_comp_a :Z01ncode_comp_a,                                
            :Z01code_inst   :Z01ncode_inst  ,                                
            :Z01code_tiers_ :Z01ncode_tiers_,                                
            :Z01no_validt   :Z01nno_validt  ,                                
            :Z01id_xxxxx_ext:Z01nid_xxxxx_ex,                                
            :Z01no_FOURN   :Z01nno_FOURN  ,                                
            :Z01code_motif  :Z01ncode_motif ,                                
            :Z01code_etat   :Z01ncode_etat  ,                                
            :Z01date_acti   :Z01ndate_acti  ,                                
            :Z01mt_honor    :Z01nmt_honor   ,                                
            :Z01mt_RO       :Z01nmt_RO      ,                                
            :Z01mt_RC       :Z01nmt_RC      ,                                
            :Z01mt_restapaya:Z01nmt_restapay                                 
            );                                                               
          other;                                                             
            exsr err_po;                                                     
         endsl;                                                              
         w_buff = zones_01    ;                                              
          w_indnull    = dsnull_01   ;                                       
                                                                             
          endsr;                                                             
       // -----------------------------------------------                    
       //  Erreur                                                            
       // -----------------------------------------------                    
        begsr err_po    ;                                                    
            msg_err = 'Version ' + version_po +                              
              ' pour procédure '+%trim(nom_orch)+' non valable';               
        endsr;                                                               
       // -----------------------------------------------                    
                                                                             
      /end-free                                                              
Procédure stockée d’orchestration — exemple 1
CREATE PROCEDURE ZIJPRS/ORCH_CTRL_ACCO (
                       OUT         o_code_retour                INTEGER, 
                       OUT         o_sqlstate                   CHAR(5), 
                       OUT         o_message_erreur             CHAR(100),
                     IN            i_code_fonction              CHAR(2),   
                       OUT         o_occurence                  INTEGER, 
                     IN            i_ID_PRO                   INTEGER,
                     INOUT         io_no_dem_com                DECIMAL(15,0),
                       OUT         o_no_lig_com                 SMALLINT,
                     INOUT         io_contra_com                SMALLINT, 
                     IN            i_ref_spe                    SMALLINT,
                     IN            i_type_cont                  CHAR(4)  CCSID 1147,
                     IN            i_code_cmpl_acte             CHAR(1)  CCSID 1147,
                     INOUT         io_code_inst                 CHAR(6)  CCSID 1147,
                     INOUT         io_code_tiers_               CHAR(3)  CCSID 1147,
                     INOUT         io_no_validt                 CHAR(16)  CCSID 1147,
                       OUT         o_id_xxxxx_ext               CHAR(30)  CCSID 1147,   
                     IN            i_no_FOURN                  CHAR(9)  CCSID 1147,    
                       OUT         o_code_mtf_etat_fact         CHAR(2)  CCSID 1147,
                       OUT         o_code_etat_fact             CHAR(2)  CCSID 1147,
                     IN            i_date_deb_acti              DATE,
                     IN            i_mt_honorr                  DECIMAL(15,2),
                     IN            i_mt_RO                      DECIMAL(15,2),
                     IN            i_mt_RC                      DECIMAL(15,2),
                     IN            i_mt_rest_a_charge           DECIMAL(15,2) 
                     )
			LANGUAGE SQL 
			SET OPTION COMMIT=*CS, DATFMT=*ISO, TIMFMT=*ISO 
BEGIN
	DECLARE EXIT HANDLER FOR SQLEXCEPTION BEGIN
		GET DIAGNOSTICS CONDITION 1 
			o_message_erreur = MESSAGE_TEXT,
			o_code_retour = DB2_RETURNED_SQLCODE,
			o_sqlstate = RETURNED_SQLSTATE  
		;
	END;
	DECLARE EXIT HANDLER FOR SQLWARNING BEGIN
		GET DIAGNOSTICS CONDITION 1 
			o_message_erreur = MESSAGE_TEXT,
			o_code_retour = DB2_RETURNED_SQLCODE,
			o_sqlstate = RETURNED_SQLSTATE  
		;
	END;
	SET o_code_retour = 0;
	SET o_sqlstate = ' ';
	SET o_message_erreur = ' ';
	SET o_occurence = 0;
	
	CASE i_code_fonction
		-- Fonctions de lecture 
		WHEN '01' THEN
			Call PS_IJ_SL_ZZID_01_RAPPR_CTRL_CONNUE (
                                o_code_retour,
                                o_sqlstate,
                                o_message_erreur,
                                o_occurence,
                                i_ID_PRO,                 
                                i_no_FOURN,                 
                                i_type_cont,                  
                                i_code_cmpl_acte,             
                                i_ref_spe,                   
                                i_date_deb_acti,            
                                i_mt_honorr,                
                                i_mt_RO,                       
                                i_mt_RC,                       
                                i_mt_rest_a_charge,          
                                io_code_inst,                 
                                io_code_tiers_,
                                io_no_validt,
                                io_no_dem_zzid,               
                                io_contra_zzid,                         
                                o_no_lig_zzid,           
                                o_id_xxxxx_ext,               
                                o_code_mtf_etat_fact,         
                                o_code_etat_fact    
                                );
		WHEN '02' THEN
			Call PS_IJ_SL_ZZID_02_RAPPR_CTRL_INCONNUE (
                                o_code_retour,
                                o_sqlstate,
                                o_message_erreur,
                                o_occurence,
                                i_ID_PRO,                 
                                i_no_FOURN,                 
                                i_type_cont,                  
                                i_code_cmpl_acte,             
                                i_ref_spe,                   
                                i_date_deb_acti,            
                                i_mt_honorr,                
                                i_mt_RO,                       
                                i_mt_RC,                       
                                i_mt_rest_a_charge,          
                                io_code_inst,
                                io_code_tiers_,
                                io_no_dem_zzid,
                                io_contra_zzid,
                                o_no_lig_zzid,
                                o_id_xxxxx_ext,               
                                o_code_mtf_etat_fact,         
                                o_code_etat_fact     
                                );

	ELSE 
		SET o_code_retour = 12 ;
		SET o_message_erreur = 'Code Fonction : '  || i_code_fonction || ' incorrect.';
		RETURN ;
	END CASE;
END
Procédure stockée appelée par la précédente
CREATE PROCEDURE ZIJPRS/PS_IJ_SL_ZZID_01_RAPPR_CTRL_CONNUE (
                     INOUT         io_code_retour                INTEGER, 
                     INOUT         io_sqlstate                   CHAR(5), 
                     INOUT         io_message_erreur             CHAR(100), 
                     INOUT         io_occurence                  INTEGER, 
                     IN            i_ID_PRO                    INTEGER,
                     IN            i_no_FOURN                   CHAR(9)  CCSID 1147,    
                     IN            i_type_cont                   CHAR(4)  CCSID 1147,
                     IN            i_code_cmpl_acte              CHAR(1)  CCSID 1147, 
                     IN            i_ref_spe                     SMALLINT,
                     IN            i_date_deb_acti               DATE,
                     IN            i_mt_honorr                   DECIMAL(15,2),
                     IN            i_mt_RO                       DECIMAL(15,2),
                     IN            i_mt_RC                       DECIMAL(15,2),
                     IN            i_mt_rest_a_charge            DECIMAL(15,2),
                     INOUT         io_code_inst                  CHAR(6)  CCSID 1147,
                     INOUT         io_code_tiers_                CHAR(3)  CCSID 1147,                                                                                                      
                     IN            i_no_validt                   CHAR(16),
                       OUT         o_no_dem_com                  DECIMAL(15,0),
                       OUT         o_contra_com                  SMALLINT,                         
                       OUT         o_no_lig_com                  SMALLINT, 
                       OUT         o_id_xxxxx_ext                CHAR(30)  CCSID 1147,
                       OUT         o_code_mtf_etat_fact          CHAR(2)  CCSID 1147,
                       OUT         o_code_etat_fact              CHAR(2)  CCSID 1147
                    )
			LANGUAGE SQL 
			SET OPTION COMMIT=*CS, DATFMT=*ISO, TIMFMT=*ISO 
BEGIN

/************ Déclaration variables locales pour stocker code_inst et code partenaire trouvés ***/	
     DECLARE l_code_inst CHAR(6);
     DECLARE l_code_tiers_ CHAR(3);
/************ Déclaration variable local des traitements intermédiaires ***/	
     DECLARE  l_trouve                  CHAR(1);
     DECLARE  l_top_mt_ok               CHAR(1);
     DECLARE  l_top_date_acti_ok        CHAR(1);
     DECLARE  l_mt_honorr               DECIMAL(15,2);
     DECLARE  l_mt_ro                   DECIMAL(15,2);
     DECLARE  l_mt_rc                   DECIMAL(15,2);
     DECLARE  l_mt_rest_a_charge        DECIMAL(15,2);
     DECLARE  l_date_dem                DATE; 
     DECLARE  l_date_fin_valid_dem      DATE; 

/******* Recherche de N°ZZID  *********/
      DECLARE o_cur_sl_zzid_10 CURSOR  FOR
            SELECT IJAG.CODE_INST,
                   IJAG.CODE_tiers_,
                   IJAG.ID_xxxxx_exT,
                   IJAG.DATE_DEM ,
                   IJAG.DATE_FIN_VALID_DEM,
                   IJAG.NO_DEM_ZZID,
                   IJAG.contra_com 
    
              FROM AG_com IJAG 
     
           WHERE IJAG.CODE_ETAT_DEM_com IN ('40','61')
             AND IJAG.NO_DEM_com = i_no_validt
--             AND IJAG.contra_com = i_contra_zzid
             AND IJAG.NO_FOURN = i_no_FOURN
             AND IJAG.ID_PRO = i_ID_PRO                    
       ;    
/******* Recherche de N°ZZID / lignes ZZID susceptibles de correspondre aux lignes factures  *********/

--  Numero de dent non précisé  

      DECLARE o_cur_sl_zzid_11 CURSOR  FOR 
            SELECT IJAI.NO_LIG_ZZID,
                   IJAI.MT_HONORR ,
                   IJAI.MT_RO ,        
                   IJAI.MT_RC ,           
                   IJAI.MT_REST_A_CHARGE 
                   
            FROM   AI_DET_com IJAI 
                   
            WHERE  IJAI.CODE_ETAT_DEM_com = '40'
              AND  IJAI.NO_DEM_com = o_no_dem_zzid
              AND  IJAI.contra_com = o_contra_zzid
              AND  IJAI.type_cont = i_type_cont
              AND  IJAI.CODE_CMPL_ACTE = i_code_cmpl_acte 
            
            ORDER BY IJAI.NO_LIG_com DESC    

       ;     

--  Numero de dent précisé    

      DECLARE o_cur_sl_zzid_12 CURSOR  FOR
            SELECT IJAI.NO_LIG_ZZID,
                   IJAI.MT_HONORR ,
                   IJAI.MT_RO ,        
                   IJAI.MT_RC ,           
                   IJAI.MT_REST_A_CHARGE  
                                  
              FROM AI_DET_com IJAI,
                   AL_DET_ZZID_DENT IJAL 
                   
             WHERE  IJAI.CODE_ETAT_DEM_com = '40'
               AND  IJAI.NO_DEM_com = o_no_dem_zzid
               AND  IJAI.contra_com = o_contra_zzid
               AND  IJAI.type_cont = i_type_cont
               AND  IJAI.CODE_CMPL_ACTE = i_code_cmpl_acte  
               AND  IJAL.NO_DEM_com = IJAI.NO_DEM_ZZID
               AND  IJAL.contra_com = IJAI.contra_ZZID
               AND  IJAL.NO_LIG_com = IJAI.NO_LIG_ZZID
               AND  IJAL.ref_spe = i_ref_spe                       
             
             ORDER BY IJAI.NO_LIG_com DESC
      ;     


  	DECLARE CONTINUE HANDLER FOR NOT FOUND BEGIN
  	    SET io_occurence = 0;
    END;
		
/* Analyse entête ZZID  */
   
    /**** Validation que la ZZID existe, possède des lignes à 
     *    facturer et corresponde au même IDPRO et Bénéficiaire ****/
    SET io_occurence = 1;
    SET l_trouve = 'N';
    SET l_top_date_acti_ok ='N';  
    
    OPEN  o_cur_sl_zzid_10; 
    
BOUCLE_com : 
    LOOP    
         FETCH  o_cur_sl_zzid_10  
          INTO  l_code_inst,
                l_code_tiers_,
                o_id_xxxxx_ext,
                l_date_dem,
                l_date_fin_valid_dem,
                o_no_dem_zzid,
                o_contra_zzid
             ;
          IF io_occurence = 0 THEN
              LEAVE BOUCLE_com ;
          END IF; 
             
          SET l_trouve = 'O';
          IF  l_date_dem <= i_date_deb_acti AND
              l_date_fin_valid_dem >= i_date_deb_acti THEN
                  SET l_top_date_acti_ok = 'O';
                  SET io_occurence = 0;
                  LEAVE BOUCLE_com ;
          END IF;     
    END LOOP BOUCLE_ZZID;   
    
    CLOSE  o_cur_sl_zzid_10;                      

    /*** ZZID non référencée ***/    
    IF l_trouve ='N' THEN
         SET o_code_mtf_etat_fact = '40'; /* Aucune ZZID trouvée */
         SET o_code_etat_fact  = '40'; /* Recyclage */
         RETURN;
    END IF;
    
    /**** Contrôle que la ZZID est encore valide par rapport à la date de soins ****/
    /*** Date de soin invalide par rapport à la ZZID ***/      
    IF l_top_date_acti_ok = 'N' THEN
         SET o_code_mtf_etat_fact = '41'; /*Date de soin non valide*/
         SET o_code_etat_fact  = '44'; /* Rejet définitif */
         RETURN;
    END IF;
    
    /*** Validation que l'institution est en phase avec la facture ***/
    IF  io_code_inst IS NOT NULL      AND
        io_code_inst <> l_code_inst   THEN 
            SET o_code_mtf_etat_fact = '43'; /* Facutres avec ZZID de différentes insitutions.*/
            SET o_code_etat_fact  = '44'; /*Rejet Définitif */
            RETURN;
    END IF;
    
    IF  io_code_inst IS NULL  THEN
          SET io_code_inst = l_code_inst;
          SET io_code_tiers_ = l_code_tiers_;                   
      
    END IF;

/**** Analyse des lignes ZZID *****/
    SET io_occurence = 1;
    SET l_trouve = 'N';
    SET l_top_mt_ok ='N';  
        
    IF  i_ref_spe IS NULL THEN
         OPEN  o_cur_sl_zzid_11 ;
    ELSE 
         OPEN  o_cur_sl_zzid_12 ;            
    END IF ; 
      
BOUCLE_LIG_com : 
    LOOP 
          IF  i_ref_spe IS NULL THEN 
                FETCH o_cur_sl_zzid_11 
                 INTO o_no_lig_zzid,
                      l_mt_honorr,
                      l_mt_RO,
                      l_mt_RC,
                      l_mt_rest_a_charge
                ;        
          ELSE 
                  FETCH o_cur_sl_zzid_12  
                   INTO o_no_lig_zzid,
                        l_mt_honorr,
                        l_mt_RO,
                        l_mt_RC,
                        l_mt_rest_a_charge
                  ;
          END IF;
          
          IF io_occurence = 0 THEN
              LEAVE BOUCLE_LIG_com ;
          END IF; 
             
          SET l_trouve = 'O';
          IF  l_mt_honorr = i_mt_honorr AND
              l_mt_ro = i_mt_RO   AND               
              l_mt_rc = i_mt_RC   AND              
              l_mt_rest_a_charge = i_mt_rest_a_charge   THEN
                  SET l_top_mt_ok = 'O';
                  SET io_occurence = 0;
                  LEAVE BOUCLE_LIG_com ;
          END IF;     
    END LOOP BOUCLE_LIG_ZZID;
    
    IF  i_ref_spe IS NULL THEN    
          CLOSE   o_cur_sl_zzid_11 ;
    ELSE 
          CLOSE   o_cur_sl_zzid_12 ;    
    END IF;         
    
    IF l_trouve = 'O' AND
       l_top_mt_ok = 'O' THEN
              SET io_occurence = 1; 
              SET o_code_mtf_etat_fact = NULL; /***Aucun Rejet ***/
              SET o_code_etat_fact = '00'; /*** Ensemble du rapprochement et 
                         des contrôles ZZID se sont déroulés correctement.*/
              RETURN;
    END IF;
    IF l_trouve = 'O' THEN
              SET o_code_mtf_etat_fact = '12'; /***Montants factures différents de ZZID ****/
              SET o_code_etat_fact  = '44'; /* Rejet définitif */
              RETURN;
    ELSE
         SET o_code_mtf_etat_fact = '40'; 
         SET o_code_etat_fact  = '40'; /* Recyclage */
         RETURN;
    END IF; 

END
Procédure stockée d’orchestration — exemple 2
CREATE PROCEDURE ZIJPRS/ORCH_CTRLF (
                       OUT         o_code_retour                 INTEGER, 
                       OUT         o_sqlstate                    CHAR(5), 
                       OUT         o_message_erreur              CHAR(100), 
                     IN            i_code_fonction               CHAR(2), 
                       OUT         o_occurence                   INTEGER,
                     IN            io_id_fact                    INTEGER,            
                     INOUT         io_date_fact                  DATE,               
                     INOUT         io_no_FOURN                  CHAR(9) CCSID 1147,  
                     INOUT         io_no_fact_ext                DECIMAL(15),        
                     INOUT         io_no_lot_ext                 CHAR(3) CCSID 1147, 
                     INOUT         io_no_insee_trans             CHAR(15) CCSID 1147,  
                     INOUT         io_date_nais_trans            INTEGER,            
                     INOUT         io_no_rang_nais_trans         CHAR(2) CCSID 1147,  
                       OUT         o_code_etat_fact              CHAR(2) CCSID 1147, 
                       OUT         o_code_mtf_etat_fact          CHAR(2) CCSID 1147  
                    )
			LANGUAGE SQL 
			SET OPTION COMMIT=*CS, DATFMT=*ISO, TIMFMT=*ISO 
BEGIN

  DECLARE l_ID_PRO                   INTEGER;
  
	DECLARE EXIT HANDLER FOR SQLEXCEPTION BEGIN
		GET DIAGNOSTICS CONDITION 1 
			o_message_erreur = MESSAGE_TEXT,
			o_code_retour = DB2_RETURNED_SQLCODE,
			o_sqlstate = RETURNED_SQLSTATE  
		;
	END;
	DECLARE EXIT HANDLER FOR SQLWARNING BEGIN
		GET DIAGNOSTICS CONDITION 1 
			o_message_erreur = MESSAGE_TEXT,
			o_code_retour = DB2_RETURNED_SQLCODE,
			o_sqlstate = RETURNED_SQLSTATE  
		;
	END;

	SET o_occurence = 0;

	CASE i_code_fonction
		-- Fonctions de lecture 

		WHEN '01' THEN
			CALL PS_IJ_SL_01_CTRL_FACT (
                                o_code_retour,
                                o_sqlstate,
                                o_message_erreur,
                                o_occurence,
                                io_date_fact, 
                                io_no_FOURN,
                                io_no_fact_ext,
                                io_no_lot_ext,
                                io_no_insee_trans,
                                io_date_nais_trans, 
                                io_no_rang_nais_trans 
                                );

		WHEN '02' THEN
		
			CALL PS_IJAD_02_FACT (
                                o_code_retour,
                                o_sqlstate,
                                o_message_erreur,
                                o_occurence,
                                io_id_fact,
                                io_date_fact, 
                                io_no_FOURN,
                                io_no_fact_ext,
                                io_no_lot_ext,
                                io_no_insee_trans,
                                io_date_nais_trans, 
                                io_no_rang_nais_trans
                                );

  ELSE 
    SET o_code_retour = 12 ;
    SET o_message_erreur = 'Code Fonction : '  || i_code_fonction || ' incorrect.';
    RETURN ;
  END CASE;

  IF o_occurence > 0 THEN
    SET o_code_etat_fact = '44';
    SET o_code_mtf_etat_fact = '15';
  ELSE
    SET o_code_etat_fact = '00';
    SET o_code_mtf_etat_fact = NULL  ;
  END IF;

END
Procédure stockée appelée par la précédente
CREATE PROCEDURE ZIJPRS/PS_IJ_SL_01_CTRL_FACT (
                     INOUT         io_code_retour                INTEGER, 
                     INOUT         io_sqlstate                   CHAR(5), 
                     INOUT         io_message_erreur             CHAR(100), 
                     INOUT         io_occurence                  INTEGER,
                     IN            i_date_fact                   DATE, 
                     IN            i_no_FOURN                   CHAR(9) CCSID 1147, 
                     IN            i_no_fac_ext                  CHAR(9) CCSID 1147,
                     IN            i_no_lot_ext                  CHAR(3) CCSID 1147,
                     IN            i_no_insee_trans              DECIMAL(15,0),
                     IN            i_date_nais_trans             INTEGER, 
                     IN            i_no_rang_nais_trans          CHAR(2) CCSID 1147 
                    )
			LANGUAGE SQL 
			SET OPTION COMMIT=*CS, DATFMT=*ISO, TIMFMT=*ISO 
BEGIN
  
  DECLARE l_lgnmdt CHAR(9) CCSID 1147;
  DECLARE l_lgdtrt DECIMAL(8,0);
  DECLARE l_date_nais_trans DECIMAL(8,0);

	DECLARE EXIT HANDLER FOR NOT FOUND BEGIN
		GET DIAGNOSTICS CONDITION 1 
			io_message_erreur = MESSAGE_TEXT,
			io_code_retour = DB2_RETURNED_SQLCODE,
			io_sqlstate = RETURNED_SQLSTATE  
		;
	END;

  SET io_occurence = 0;
  SET l_lgdtrt = CAST((SUBSTR(CHAR(i_date_fact), 1, 4) || SUBSTR(CHAR(i_date_fact), 6, 2) 
    || SUBSTR(CHAR(i_date_fact), 9, 2)) AS DECIMAL(8, 0));
  SET l_lgnmdt = CAST(i_date_nais_trans AS CHAR(8) CCSID 1147) 
    || SUBSTR(i_no_rang_nais_trans, 1, 1);
    
  SELECT COUNT(*)
    INTO io_occurence
    FROM BLGGEN  
   WHERE lgdtrt = l_lgdtrt
     AND lgntpa = i_no_FOURN
     AND cgnfac = i_no_fac_ext
     AND cgnlot = i_no_lot_ext
     AND lgnsec = i_no_insee_trans
     AND lgnmdt = l_lgnmdt
  ;    
    
END
Programme SQLRPGLE récupérant le next-value d'une séquence
      /COPY *LIBL/QRPGLESRC,MBRSRC51                                      
      *---------------------------------------------------------------* 
      *                   -  MBRSRC92     -                             * 
      *---------------------------------------------------------------* 
      *        Récupère 1er n. facture utilisable                     * 
      *---------------------------------------------------------------* 
                                                                        
     DZ_COMM           PR                  EXTPGM('MBRSRC92    ')         
     D pr_id_fact                     9s 0                              
                                                                        
     DZ_COMM           PI                                               
     D pr_id_fact                     9s 0                              
                                                                        
     Dsql_id_fact      S              9b 0                              
                                                                        
      /free                                                             
                                                                        
        monitor;                                                        
                                                                        
        EXEC SQL                                                        
         select  next value                                             
                    for seq_ijad_id_fact                                
         into :sql_id_fact                                              
         from F1_FACT                                                   
         fetch first 1 row only                                         
        ;                                                               
                                                                        
        on-error;                                                       
          sql_id_fact = 0;                                              
        endmon;                                                         
                                                                        
        pr_id_fact = sql_id_fact;                                       
                                                                        
        *inlr = '1';                                                    
      /end-free                                                         

Cre : 09 fev 2011 - Maj : 26 sep 2011

A propos de ces pages / about these pages : http://www.dg77.net/about.htm
Gen : 22/04/2017-18:09:47,84