Code en Stock : RPG ILE + ProcStoc pur SQL
Ressources
- IBM ILE RPG reference
- IBM SQL messages and codes
- IBM Determining equivalent SQL and RPG data types
- iseries SQL DATA types
- Get Diagnostics
- SQL Procedure Language Differences across platforms
- ibm iseries SQL programming
Outillage SQL
Génération automatique de spécifications cartes D
-- Requete 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
/* Factures avec ZZID de différentes insitutions.*/
SET o_code_mtf_etat_fact = '43';
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
/***Montants factures différents de ZZID ****/
SET o_code_mtf_etat_fact = '12';
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 = 'Cod.Fonct.: ' || 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