cT178 ;Berekening actueel betalingsgedrag ;%T178 ; [ 01/03/01  6:07 PM ]
 G 1
 ;
T0 ;Berekening actueel betalingsgedrag ;
T1 ;Vorige update : ;
T2 ;Nieuwe update\"jjjj.mm[] = specif. maand   [] = "_BP1_"   -[] = einde programma";
T3 ;Betaald;
T4 ;Vervallen;
T5 ;Periode : ;
T6 ;Bevestiging\"[] = ok   ,[] = hernemen";
T7 ;Nieuwe periode kleiner dan vorige periode   [] = ok   -[] = hernemen : ;
T8 ;Meerdere muntcodes in de geselecteerde maanden/jaren ;
 ;
T0F ;Calcul du statistiqe de paiement ;
T1F ;Dernière mise à jour : ;
T2F ;Nouvelle mise à jour\"aaaa.mm[] = mois spéc.   [] = "_BP1_"   -[] = fin du programme";
T3F ;Payé;
T4F ;Echu;
T5F ;Période : ;
T6F ;Confirmation\"[] = ok   ,[] = reprendre";
T7F ;Nouvelle période antérieure à l'ancienne   [] = ok   -[] = reprendre : ;
T8F ;Plusieurs codes mon. dans les mois/années sélectionné(e)s ;
 ;
T0E ;Calculation of actual payment behaviour ;
T1E ;Previous update : ;
T2E ;New update\"yyyy.mm[] = specif. month   [] = "_BP1_"   -[] = end program";
T3E ;Payed;
T4E ;Overdue;
T5E ;Period : ;
T6E ;Confirmation\"[] = ok   ,[] = retry";
T7E ;New period smaller than current period   [] = ok   -[] = retry : ;
T8E ;More than one currency in the selected months/years ;
 ;
1 S K=$P($T(@("T0"_QT)),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 S Q1="^"_Q_"BA(96)",BP=0 L @Q1:2 E  D TXT^cAFA1(14) G YZ
13 I $D(@Q1) S R=$P(^(96),D),K=$P(R,".",3) S:K<80 K=K+100 S BP=1900+K_$E(R,3,5),FP=403 W @F,$P($T(@("T1"_QT)),U,2),BP,"   (",R,")"
15 S BP1=$E(DM/100+DJ_0,1,7),R="BP2\22\3\"_$P($T(@("T2"_QT)),U,2)_"\7\\""-""[K!(K?4N1"".""2N&(K#1)&(K#1<.13)&(K'>BP1))" D R0 G YZ:K="-"
17 S:'K BP2=BP1 S R="01."_$E(BP2,6,7)_"."_$E(BP2,3,4)_"\0DEM" D ^cA104 S DAT=R I BP2=BP1 S DAT=DT
171 S FP=603 W @F,@F1,$P($P($T(@("T2"_QT)),U,2),D)," : ",BP2,"   (",DAT,")" S BP1=BP2\1+.01 S FP=803 W @F,$P($T(@("T5"_QT)),U,2),BP1," - ",BP2
172 I BP2<BP S FP=2403+F60 W @F,@F4,$P($T(@("T7"_QT)),U,2),@F5,@F2,@F0 R K G 15:K="-"!(K=","),172:$L(K)
173 S BJ1=$$BJ^cAFE1(Q,BP1),MNT1=$$MNTC^cAFE1(Q,BJ1)
174 S BJ2=$$BJ^cAFE1(Q,BP2),MNT2=$$MNTC^cAFE1(Q,BJ2)
175 I MNT1'=MNT2 S K=$P($T(@("T8"_QT)),U,2) D TXT^cAFA1(250) G 15
19 S R="K\22\3\"_$P($T(@("T6"_QT)),U,2)_"\1\\""-,""[K" D R0 I $L(K) G 15
 ;
2 S BP=BP1,FP=1003 W @F,@F1,$P($T(@("T3"_QT)),U,2),! K ^HULP(boot,$J) S @%Q1=0
21 W "   ",BP S (REK,VNR)=""
23 S REK=$O(@("^"_Q_"FI(BP,REK)")) I REK="" G 3:BP=BP2 S BP=$E(BP+.01_0,1,7) G 21
25 S VNR=$O(@("^"_Q_"FI(BP,REK,VNR)")) G 23:VNR="" S L=^(VNR) G 25:$P(L,D,7)'="K"
27 S KC=$P($P(L,D,8),"#"),BE=$P(L,D,5),AD=$P(L,D,12)*BE S:$P(L,D,6)="D" BE=-BE,AD=0 S L=D I $D(^HULP(boot,$J,KC)) S L=^(KC)
29 S AD=AD+$P(L,D),BE=BE+$P(L,D,2),^(KC)=AD_D_BE G 25
 ;
3 S FP=1403,I1=" " W @F,$P($T(@("T4"_QT)),U,2),@F1
31 S I1=$O(@("^"_Q_"KL(I1)")) I I1="" S L=D S:$D(@Q1) L=^(96) S ^(96)=DAT_D_$P(L,D),@%Q1=1 K ^HULP(boot,$J) G YZ
33 S FP=1504,FNR=9999,KC=$P(^(I1,0),D),(AD,BE)=0 W @F,KC," - ",@F2,$P(^(0),D,2) K ^HULP(boot,$J+.01)
35 S FNR=$O(@("^"_Q_"KL(I1,FNR)")) I FNR?5.6N S L=^(FNR),B=+$P(L,D,10),R=DAT_D_$P(L,D,3) S:$P(L,D)="C" B=-B D S3 S:R>0 ^HULP(boot,$J+.01,B_"."_FNR)=R_D_B G 35
37 D S1 S L=D S:$D(^HULP(boot,$J,KC)) L=^(KC) S $P(L,D,3)=AD,$P(L,D,4)=BE
39 S BE=$P(L,D,2),AD=$S(+BE=0:0,1:$J($P(L,D)/BE,0,0)),B=AD_D_BE_D
41 S BE=$P(L,D,4),AD=$S(+BE=0:0,1:$J($P(L,D,3)/BE,0,0)),B=B_AD_D_BE_D
43 S A="" S:$D(@("^"_Q_"KL(I1,12)")) A=$P(^(12),D,1,4) S ^(12)=B_A_D G 31
 ;
YZ Q
 ;
S1 S S1="",(AD,BE)=0
S1A S S1=$O(^HULP(boot,$J+.01,S1)),S3=0 G S1E:S1="" S S2=$P(^(S1),D,2) I S2'<0 G S1A
S1B S S3=$O(^(S3)) G S1A:S3="" S S4=$P(^(S3),D,2)+S2
S1C I S4<0 K ^(S3) S S2=S4,$P(^(S1),D,2)=S2 G S1B
S1D K ^(S1) S $P(^(S3),D,2)=S4 G S1A
S1E S S1=$O(^(S1)) I S1'="" S S2=^(S1),S3=$P(S2,D,2),AD=$P(S2,D)*S3+AD,BE=S3+BE G S1E
S1Z K S1,S2,S3,S4,^HULP(boot,$J+.01) Q
 ;
S3 D ^cA326 S X=R,R=DAT_D_$P(L,D,2) D ^cA326 S:R>0 R=X Q
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84