cT831 ;Fin & div: int. betaling ;%T80 ; [ 01/12/01  10:01 AM ]
 G 1
 ;
T0 ;Fin & div: int. betaling ;
T1 ;Internat.;
T2 ;Document ; van leverancier ;
T3 ;Niet teruggevonden! Betaalde bedrag : ;   .[] = ok ;
T4 ;Code onbekend of geen EMU-munt, bedrag : ;   .[] = ok ;
 ;
T0F ;Fin & div: paiement int. ;
T1F ;Internat.;
T2F ;Document ; du fournisseur ;
T3F ;Ne pas retrouvé! Montant payé : ;   .[] = ok ;
T4F ;Code inconnu ou pas de code UME, montant : ;   .[] = ok ;
 ;
T0E ;Financial & miscellaneous transactions: int. payment ;
T1E ;Internat.;
T2E ;Document ; of supplier ;
T3E ;Not found! Payed amount : ;   .[] = ok ;
T4E ;Unknown code or not ECU-currency, amount : ;   .[] = ok ;
 ;
 ; test op buitenlandse betalingen
OK N I S I=0
OKA S I=$O(^(I)) I $L(I) S OK=$P(^(I),D,9) I 'OK G OKA
OKZ Q
 ;
 ; cumuls & historiek (naked)
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="L",JA="^"_Q_"L3(PRO,J1",JB=JA_",J2)",JC=JA_",J2,J3)",JA=JA_")",JD="^"_Q_"L1(J2)"
11 S Q3="^"_Q_"LE(I1,0)",Q6="^"_Q_"AF(FNR)",(J1,J2)=0
12 S K=$$OMREK^cAFE1(Q,1,HBF,"EUR","F",99) I $P(BA39,D,11)'="" S K=$$OMREK^cAFE1(Q,1,"EUR",$P(BA39,D,9),"F",99)
13 S J1=$O(@JA) I $L(J1) S N=^(J1),$P(N,D,30)='$P(N,D,9),^(J1)=N G 13
15 D ^cAN103("J1",18,0,"L3") I K="-" G YZ
 ;
 ; volgende leverancier
2 S J2=$O(@JB),J3=0 G Y:J2="" S I1=@JD,N=@Q3,KC=$P(N,D),KN=$P(N,D,1,2)
21 S J3=$O(@JC) I J3="" G 2 ; volgende factuur
23 S N=^(J3),FC=$P(N,D,9),FNR=$P(N,D,14),OM=$P($T(@("T1"_QT)),U,2)_FNR
24 S BEF=$P(N,D,11),HBE=$P(N,D,17),KX=$P(N,D,12),VM=$P(N,D,16) S:'HBE HBE=BEF
25 I KX S BEF=BEF+KX,K=$$OMREK^cAFE1(Q,BEF,VM,HBF,"F",HQD),KX=K-HBE,HBE=K
26 S X=$D(@Q3) G 3:$D(^(FNR))
27 S K=$T(@("T2"_QT)) W /CUP(23,3),@F4,$P(K,U,2),FNR,$P(K,U,3),$TR(KN,D," ")," ",@F5,@F1
28 S K=$T(@("T3"_QT)) D MSG^cAFA1($P(K,U,2)_HBE_" "_VM_$P(K,U,3),1,"K="".""") W /CUP(23,1),@F1 G 21
 ;
 ; openstaande factuur
3 S N=^(FNR),VM=$P(N,D,9),QA=HQD,PARF=1 S:VM="" VM=BF,QA=QD
30 G 9:'$D(@("^"_Q_"BA(11,VM)")),9:'$P(^(VM),D,12)   ; moet EMU-munt zijn
31 S VM(VM)=$P(^(VM),D),QA=+$P(^(VM),D,7),PARF=$$CNVC^cAFE1(Q,BJ,1,VM,"F",99)
33 S OB=$J($P(N,D,10),0,QD),OBF=$J($P(N,D,5),0,QA)
35 S BE=$J(HBE*PAR,0,QD),BEF=$J(BEF,0,QA),HBE=$J(HBE,0,HQD)
36 I KX,VM(HBF)=VM(BF),BE>OB S KX=OB-BE+KX,(BE,HBE)=OB
37 S:VM(VM)=VM(BF) BE=BEF,OB=OBF S:BEF=OBF BE=OB S:VM(VM)=VM(HBF) HBE=BEF
 ;
 ; factuur afboeken
4 S BNR=@Q93,@Q93=BNR+1 G 4:$D(@Q95) S BC(FC="C")=BE,X=@Q3 D S1
41 S S1=OB-BE I S1 D  G 45
 . I $P(N,D,12) D
 .. S $P(N,D,12)=$P(N,D,12)-BEF ; betaling onderweg
 .. S $P(N,D,13)=$P(N,D,13)-$$BEDR^cAFE1(Q,BE,BF,$P(MNTO,D),"F")
 . S $P(N,D,5)=OBF-BEF,$P(N,D,10)=$$BEDR^cAFE1(Q,S1,BF,$P(MNTO,D),"F"),^(FNR)=N
43 K ^(FNR),@Q6
45 S CO=$E("CDDC",3+(FC="C")) S:CO="D" HUX=HUX+HBE,UX=UX+BE S:CO="C" HUX=HUX-HBE,UX=UX-BE
47 S K=D_DAT_D_NUM_D_CD_D_BE_D_CO_D_K1_D_$TR(KN,D,"#")_D_OM_D_BPE_D_HBE_D_D_FNR_D_SRT_D_D_D_D_D_HUXB_"#"_HUXV_D_UX_D_HUX_D_D_HBF_D_VM_D_BEF_D_PARF_D
 ;
5 S T(2+(CO="C"))=T(2+(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
 ;
 ; korting contant
6 I KX S OM1="" D ^cT817
61 G 21
 ;
 ; foutmelding ivm VM (onbekend/niet-EMU)
9 S K=$T(@("T2"_QT)) W /CUP(23,3),@F4,$P(K,U,2),FNR,$P(K,U,3),$TR(KN,D," ")," ",@F5,@F1
91 S K=$T(@("T4"_QT)) D MSG^cAFA1($P(K,U,2)_HBE_" "_VM_$P(K,U,3),1,"K="".""") W /CUP(23,1),@F1 G 21
 ;
 ; opkuis bestanden
Y K @JA I J1?8N1"."4.N D W^cAN220("BVB",0,$P(J1,".",2),130,1)
YZ K 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 ; 05.02.01 - 16 u 23 * V7.84