cT820 ;Fin & div: domiciliëring ;%T80 ; [ 01/04/01 2:06 PM ] G 1 ; T0 ;Fin & div: domiciliëring ; T1 ;Dom. ; T2 ;Factuur : ; van klant : ; T3 ;Niet teruggevonden !!! Betaalde bedrag : ; ---> .[] = ok ; ; T0F ;Fin & div: domiciliation ; T1F ;Dom. ; T2F ;Facture : ; du client : ; T3F ;Ne pas retrouve !!! Montant payé : ; ---> .[] = ok ; ; T0E ;Financial & miscellaneous transactions: domicilation ; T1E ;Dom. ; T2E ;Invoice : ; of customer : ; T3E ;Not found !!! Payed amount : ; ---> .[] = ok ; ; T0D ;Fin & Div: Domicilierung ; T1D ;Dom. ; T2D ;Rechnung : ; von Kunde : ; T3D ;Nicht gefunden !!! Bezahlte Betrag : ; ---> .[] = ok ; ; S1 S X=D,$P(X,D,23)=D F S1=BJ:.01:BJ+.02 I '$D(^(S1)) S ^(S1)=X S1A F X=0,1 I BC(X) S S1=X*.02+BJ,$P(^(S1),D,BX)=$P(^(S1),D,BX)+BC(X) S1B S BH=BH\1 D:BPE @BPEC S S1="B"_RB_"#"_BNR_D S1C S HIS=1 S1D S BH=BH+.01 S:BH#1=0 HIS=0,BH=BH-1 D ^cT00:'HIS G S1C:'HIS,S1D:$D(^(BH+.01)) S:'$D(^(BH)) ^(BH)="" S1E I ^(BH)'[S1 G S1D:$L(^(BH))+$L(S1)>255 S ^(BH)=^(BH)_S1 S1Z S (BC(0),BC(1))=0 Q ; 1 S SW="K",K1="K",JA="^"_Q_"K3(PRO,J1",JB=JA_",J2)",JC=JA_",J2,J3)",JA=JA_")",JD="^"_Q_"K1(J2)" 11 S Q3="^"_Q_"KL(I1,0)",Q6="^"_Q_"VF(FNR)",(J1,J2)=0 13 S J1=$O(@JA) I J1="" S UO=HUX_" "_HBF,R=129 D F2 G YZ 15 S N=^(J1) I $P(N,D)-HUX!($P(N,D,3)'=PRO)!'$P(N,D,4)!($P(N,D,7)'=HBF) G 13 ; 2 S J2=$O(@JB),J3=0 G Y:J2="" S I1=@JD,N=@Q3,KC=$P(N,D),KN=$P(N,D,2) 21 S J3=$O(@JC) I J3="" G 2 23 S N=^(J3),FC=$P(N,D,9),FNR=$P(N,D,14),OM=$P($T(@("T1"_QT)),U,2)_FNR,X=$D(@Q3) 24 S BEF=$P(N,D,11)+$P(N,D,12),VM=$P(N,D,15) I VM="" S VM=BF S K=$$OMREK^cAFE1(Q,BEF,VM,HBF,"F",HQD),HBE=$P(N,D,16),KX=0 I 'HBE S HBE=$$OMREK^cAFE1(Q,$P(N,D,11),VM,HBF,"F",HQD) ; VJ 18.12.00 I $P(N,D,12) S KX=K-HBE,HBE=K 25 G 3:$D(^(FNR)) S FP=2303+F60 W @F,$P($T(@("T2"_QT)),U,2),FNR,$P($T(@("T2"_QT)),U,3),KC," ",KN,@F1 27 W !?2,$P($T(@("T3"_QT)),U,2),HBE,$P($T(@("T3"_QT)),U,3),@F0 R X:2 W @F,@F1 G 21:X=".",25 ; 3 S N=^(FNR),VM=$P(N,D,9),QA=HQD,PARF=1 S:VM="" VM=BF,QA=QD 31 I VM'=BF,$D(@("^"_Q_"BA(11,VM)")) S QA=+$P(^(VM),D,7),PARF=$$CNVC^cAFE1(Q,BJ,1,VM,"F",99) 33 I '$D(VM(VM)) S VM(VM)=$P($G(^(VM),VM),D) 35 S OB=$J($P(N,D,10),0,QD),OBF=$J($P(N,D,5),0,QA) 37 S BE=$J(HBE*PAR,0,QD) ; 4 S R=DAT_D_$P(N,D,2) D ^cA326 S ADA1=R,R=DAT_D_$P(N,D,3) D ^cA326 S ADA2=R 41 S BNR=@Q93,@Q93=BNR+1 G 41:$D(@Q95) S BC(FC="F")=BE,X=@Q3 D S1 43 S S1=OB-BE,$P(N,D,5)=OBF-BEF,$P(N,D,10)=$$BEDR^cAFE1(Q,S1,BF,$P(MNTO,D),"F") I S1 S ^(FNR)=N 45 E K ^(FNR),@Q6 47 S CO=$E("CDDC",3+(FC="F")) S:CO="D" HUX=HUX+HBE,UX=UX+BE S:CO="C" HUX=HUX-HBE,UX=UX-BE 49 S K=D_DAT_D_NUM_D_CD_D_BE_D_CO_D_K1_D_KC_"#"_KN_D_OM_D_BPE_D_HBE_D_ADA1_D_FNR_D_SRT_D_D_D_D_ADA2_D_HUXB_"#"_HUXV_D_UX_D_HUX_D_D_HBF_D_VM_D_BEF_D_PARF_D ; 5 S T(0+(CO="C"))=T(0+(CO="C"))+BE 51 S $P(K,D)=$T(+0),$P(K,D,28)=$H,$P(K,D,29)=$G(QU),@Q95=K D S6^cT809 ; ; GM 19.05.04 Extra cumuls D ECUM^cTA180("FI",BP,RB,BNR) ; 6 I KX S OM1="" D ^cT817 61 G 21 ; Y K @JA YZ K ADA1,ADA2,BE,BEF,HBE,OB,OBF,FC,FNR,SW,KX,I1,CO,N,KC,KN,OM,JA,JB,JC,JD,J1,J2,J3,UO Q ; F1 S R=250 F2 D TXT^cAFA1(R) FZ K R Q ; ZZ ; 24.06.04 - 10 u 48 * V8