Index: cI39E40.mac.rou
===================================================================
diff -u -r734 -r3542
--- cI39E40.mac.rou	(.../cI39E40.mac.rou)	(revision 734)
+++ cI39E40.mac.rou	(.../cI39E40.mac.rou)	(revision 3542)
@@ -1,173 +1,174 @@
-cI39E40 ;Instellen P4 (euro) ; 18 Sep 2003  2:45 PM ; [ 05/17/01  5:26 PM ]
- ;
-TEST S FOUTCODE=2   ; Testen uitvoeren
- ;
- ; Basisgegevens
-1 s ba39=@("^"_Q_"BA(39)")
-11 ;i '$p(ba39,D,6) d FOUT("BA(39) eerstvolgend boekjaar in euro is niet gekend")
-13 ;i $$BJ^cAFE1(Q,DJ_"."_DM)'=$p(ba39,D,6) d FOUT("BA(39) eerstvolgend boekjaar in euro verschilt van huidig boekjaar")
-15 i $l($p(ba39,D,11)) d FOUT("BA(39) conversie naar euro is reeds gebeurd")
-17 s vm="" f  s vm=$o(@("^"_Q_"BA(11,vm)")) q:vm=""  d
- . s n=^(vm) d MUNT($p(n,D))
-19 i '$d(^("EUR")) d FOUT("BA(11) muntcode EUR is onbekend")
- ;
- ; Rekeningen
-2 s i1=0 f  s i1=$o(@("^"_Q_"AR(i1)")) q:i1=""  d
- . s n=^(i1,0),vm=$p(n,D,11)
- . i vm="" s vm=$p(ba39,D)
- . i '$d(@("^"_Q_"BA(11,vm)")) d FOUT("AR "_i1_"heeft een onbekende muntcode") q
- . d MUNT($p(^(vm),D)) i 'y d FOUT("AR "_i1_"heeft geen ISO-muntcode")
- ;
- ; Winkelverkopen
-21 i $d(@("^"_Q_"BA")@(20))#10,$p(^(20),D) d
- . s i1=$p(^(20),D,3) i 'i1 s i1=0
- . s i1=$o(@("^"_Q_"PV")@(i1)) i i1="" q
- . i $$BJ^cAFE1(Q,$e(i1,1,6)/100)<$p(ba39,D,6) d FOUT("PV nog boekhoudkundig te verwerken")
- ;
- ; Controle vaste muntpariteiten
-22 S i2="" F  S i2=$O(@("^"_Q_"BA(11,i2)")) Q:i2=""  D
- . S LIJN=^(i2)
- . I i2'=$P(LIJN,D) D FOUT("Geen ISO-muntcodes") q
- . I $P(LIJN,D,12)=1 D
- .. I i2="ATS"&($J($P(LIJN,D,11),0,6)'=$J(13.7603,0,6)) D FOUT("BA(11) ATS foutieve muntpariteit") q
- .. I i2="BEF"&($J($P(LIJN,D,11),0,6)'=$J(40.3399,0,6)) D FOUT("BA(11) BEF foutieve muntpariteit") q
- .. I i2="DEM"&($J($P(LIJN,D,11),0,6)'=$J(1.95583,0,6)) D FOUT("BA(11) DEM foutieve muntpariteit") q
- .. I i2="ESP"&($J($P(LIJN,D,11),0,6)'=$J(166.386,0,6)) D FOUT("BA(11) ESP foutieve muntpariteit") q
- .. I i2="FIM"&($J($P(LIJN,D,11),0,6)'=$J(5.94573,0,6)) D FOUT("BA(11) FIM foutieve muntpariteit") q 
- .. I i2="FRF"&($J($P(LIJN,D,11),0,6)'=$J(6.55957,0,6)) D FOUT("BA(11) FRF foutieve muntpariteit") q
- .. I i2="IEP"&($J($P(LIJN,D,11),0,6)'=$J(0.787564,0,6)) D FOUT("BA(11) IEP foutieve muntpariteit") q
- .. I i2="ITL"&($J($P(LIJN,D,11),0,6)'=$J(1936.27,0,6)) D FOUT("BA(11) ITL foutieve muntpariteit") q
- .. I i2="LUF"&($J($P(LIJN,D,11),0,6)'=$J(40.3399,0,6)) D FOUT("BA(11) LUF foutieve muntpariteit") q
- .. I i2="NLG"&($J($P(LIJN,D,11),0,6)'=$J(2.20371,0,6)) D FOUT("BA(11) NLG foutieve muntpariteit") q
- .. I i2="PTE"&($J($P(LIJN,D,11),0,6)'=$J(200.482,0,6)) D FOUT("BA(11) PTE foutieve muntpariteit") q
- ;
- ; Lock
-3 L +@("^"_Q_"BA"):2 E  D FOUT("BA basisbestand is in gebruik")
-31 L +@("^"_Q_"AR"):2 E  D FOUT("AR rekeningenbestand is in gebruik")
-32 L +@("^"_Q_"KL"):2 E  D FOUT("KL klantenbestand is in gebruik")
-33 L +@("^"_Q_"LE"):2 E  D FOUT("LE leveranciersbestand is in gebruik")
-34 ; L +@("^"_Q_"FIA"):2 E  D FOUT("FIA boekingsreeksen zijn in gebruik")
- ;
- ; Overige bestanden
-4 ; i $l($o(@("^"_Q_"K3")@(""))) d FOUT("K3 er zijn nog domicili�ringen aanwezig")
-41 ; i $l($o(@("^"_Q_"K4")@(""))) d FOUT("K4 er zijn nog gestructureerde mededelingen aanwezig")
-42 ; i $l($o(@("^"_Q_"K6")@(""))) d FOUT("K6 er zijn nog betalingen aan klanten aanwezig")
-43 ; i $l($o(@("^"_Q_"L3")@(""))) d FOUT("L3 er zijn nog leveranciersbetalingen aanwezig")
-44 i $l($o(@("^"_Q_"FID")@(""))) d FOUT("FID er zijn nog diverse doorboekingen interne kosten")
-45 i $l($o(@("^e"_Q_"BA")@(""))) d FOUT("eBA de basisgegevens werden reeds geconverteerd")
-46 ; i $l($o(@("^e"_Q_"AR")@(""))) d FOUT("eAR de rekeningen werden reeds geconverteerd")
-47 i $l($o(@("^e"_Q_"KL")@(""))) d FOUT("eKL de klanten werden reeds geconverteerd")
-48 i $l($o(@("^e"_Q_"LE")@(""))) d FOUT("eLE de leveranciers werden reeds geconverteerd")
- i $l($o(@("^e"_Q_"WI")@(""))) d FOUT("eWI de wissels werden reeds geconverteerd")
-49 G YZ
- ;
-CONV S FOUTCODE=2   ; Conversie uitvoeren
- ;
-5 s ba39=@("^"_Q_"BA(39)"),qd=+$g(^(34)),bj=$p(^(2),D,2)\1,R="01.01.03"
-51 s @("^e"_Q_"BA(39)")=ba39,^(34)=qd
-52 m ^eDIN(Q)=^DIN(Q) f i=2,4,bj,bj+1 m @("^e"_Q_"BA(i)")=@("^"_Q_"BA(i)")
-53 s $p(ba39,D)=$p(ba39,D,7),$p(ba39,D,11)=DT,$p(ba39,D,12)=R
-55 s @("^"_Q_"BA(39)")=ba39,^(34)=$p(ba39,D,8),QD=^(34)        ;basisgeg.
-57 s $p(^(7,1),D,2)=2,$p(^(1),D,3)=0,$p(^(1),D,4)=1
- ;
-6 s vm="" f  s vm=$o(@("^"_Q_"BA(11,vm)")) q:vm=""  d         ;muntcodes
- . s (ba11,n)=^(vm) d MUNT($p(n,D)) w ".",$C(8)
- . s $p(ba11,D,13)=y i y s $p(ba11,D,12)=+$p(^(0),D,3)
- . s $p(ba11,D,4)=$p(n,D,8)
- . s $p(ba11,D,5)=$p(n,D,8)
- . s $p(ba11,D,6)=$p(n,D,8)
- . s $p(ba11,D,8)=$p(n,D,4)
- . s $p(ba11,D,9)=$p(n,D,4)
- . s $p(ba11,D,10)=$p(n,D,4)
- . i $p(n,D)=$p(ba39,D) s $p(ba11,D,30)=0
- . s @("^"_Q_"BA(11,vm)")=ba11 w " ",$C(8)
- . s @("^e"_Q_"BA(11,vm)")=n
-61 w " AR" s i1=0 f  s i1=$o(@("^"_Q_"AR(i1)")) q:i1=""  d     ;rekeningen
- . s n=^(i1,0) w $e(i1),$C(8)
- . d W^cAN220("AR",9,i1,104,$p(n,D,11)) w " ",$C(8)
- . i K="-" d FOUT("AR "_i1_"werd niet geconverteerd") q
- . i $p(n,D,11)="" s $p(n,D,11)=$p(ba39,D)
- . i '$d(@("^"_Q_"BA(11,$p(n,D,11))")) d FOUT("AR "_i1_"heeft een onbekende muntcode") q
- . d MUNT($p(^($p(n,D,11)),D))
- . i 'y d FOUT("AR "_i1_"heeft geen ISO-muntcode") q
- . i '$p(^(0),D,3) q
- . d W^cAN220("AR",9,i1,111,$p(ba39,D))
- . i K="-" d FOUT("AR "_i1_"werd niet geconverteerd naar euro")
-62 s i1=0 f  s i1=$o(@("^"_Q_"BA")@("%A",1,"AR",i1)) q:i1=""  d  ; patroon
- . s n=^(i1,0) s @("^e"_Q_"BA")@("%A",1,"AR",i1,0)=n
- . i $p(n,D,11)="?" q
- . i $p(n,D,11)="" s $p(n,D,11)=$p(ba39,D)
- . i '$d(@("^"_Q_"BA(11,$p(n,D,11))")) k @("^"_Q_"BA")@("%A",1,"AR",i1) q
- . d MUNT($p(^($p(n,D,11)),D))
- . i 'y k @("^"_Q_"BA")@("%A",1,"AR",i1) q
- . i '$p(^(0),D,3) q
- . s $p(@("^"_Q_"BA")@("%A",1,"AR",i1,0),D,11)=$p(ba39,D)
-620 i Q="TC" g 7   ; Centrale programma's bij TBK
-63 w " KL" s i1=0 f  s i1=$o(@("^"_Q_"KL(i1)")) q:i1=""  d     ;klanten
- . s n=$g(^(i1,2)) w $e(i1),$C(8)
- . i $p(n,D,7) d W^cAN220("KL",0,i1,307,$J($$BEDR^cAFE1(Q,$p(n,D,7),$p(ba39,D,9),$p(ba39,D),"V"),0,2))
- . s i2=9999 f  s i2=$o(@("^"_Q_"KL(i1,i2)")) q:i2'?5.6n  d
- .. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
- .. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"V"),0,2)
- .. s $p(^(i2),D,11)="" i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
- .. s @("^e"_Q_"KL(i1,i2)")=n w " ",$C(8)
-64 w " VEB" s i1=0 f  s i1=$o(@("^"_Q_"VEB(i1)")) q:i1=""  d   ;opstart
- . s i2=0 f  s i2=$o(@("^"_Q_"VEB(i1,i2)")) q:i2=""  d
- .. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
- .. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"V"),0,2)
- .. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
- .. s @("^e"_Q_"VEB(i1,i2)")=n
-65 w " LE" s i1=0 f  s i1=$o(@("^"_Q_"LE(i1)")) q:i1=""  d     ;leveranc.
- . s n=$g(^(i1,2)) w $e(i1),$C(8)
- . i $p(n,D,7) d W^cAN220("LE",0,i1,307,$J($$BEDR^cAFE1(Q,$p(n,D,7),$p(ba39,D,9),$p(ba39,D),"A"),0,2))
- . s i2=9999 f  s i2=$o(@("^"_Q_"LE(i1,i2)")) q:i2'?5.6n  d
- .. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
- .. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"A"),0,2)
- .. s $p(^(i2),D,11)="",$p(^(i2),D,12)="",$p(^(i2),D,13)=""
- .. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
- .. s @("^e"_Q_"LE(i1,i2)")=n w " ",$C(8)
-66 w " AAB" s i1=0 f  s i1=$o(@("^"_Q_"AAB(i1)")) q:i1=""  d   ;opstart
- . s i2=0 f  s i2=$o(@("^"_Q_"AAB(i1,i2)")) q:i2=""  d
- .. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
- .. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"A"),0,2)
- .. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
- .. s @("^e"_Q_"AAB(i1,i2)")=n
-67 k @("^"_Q_"K3"),@("^"_Q_"K4"),@("^"_Q_"K5"),@("^"_Q_"K6"),@("^"_Q_"L2"),@("^"_Q_"L3")
-68 f g="BVS","BVB" d                                           ;betalingen
- . w " ",g d DMS^cAN000("uqc","usc",g,1) i uqc=""!(usc="") q
- . s UI1=0,UREF=^DMC(uqc,usc,"DATA","REF")
- . f  s UI1=$O(@UREF) q:UI1=""  D X^cAN220(g,0,UI1) W K
-69 w " WI" s i1=0 f  s i1=$o(@("^"_Q_"WI(i1)")) q:i1=""  d     ;wissels
- . w ".",$C(8)
- . s i2=0 f  s i2=$o(@("^"_Q_"WI(i1,i2)")) q:i2'?6n  d
- .. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
- .. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"F"),0,2)
- .. s $p(^(i2),D,11)="" i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
- .. s @("^e"_Q_"WI(i1,i2)")=n w " ",$C(8)
- ;
-690 ; Toonbankverkopen : kassituatie
- I '$D(@("^"_Q_"BA(20,0)")) G 699
- S b=^(0)
- S @("^e"_Q_"BA(20,0)")=b
- F i=1:1:4 I $L($P(b,D,i)) S $P(b,D,i)=$J($$BEDR^cAFE1(Q,$P(b,D,i),$p(ba39,D,9),$p(ba39,D),"F"),0,2)
- S @("^"_Q_"BA(20,0)")=b
-699 ;
- ;
- ; Lock
-7 L -@("^"_Q_"BA")
-71 L -@("^"_Q_"AR")
-72 L -@("^"_Q_"KL")
-73 L -@("^"_Q_"LE")
-74 ; D S1^V6FIA(Q) L -@("^"_Q_"FIA")
- ;
-YZ Q
- ;
- ; test op ISO-muntcode
-MUNT(x) s y=0 f  s y=$o(^ISO(0,"ISO.MUNT",y)) q:y=""  i $p(^(y,0),D)=x q
- i 'y d FOUT("BA(11) muntcode "_x_" is geen ISO-muntcode")
- q
- ;
- ; foutboodschap
-FOUT(x) S FOUTCODE=1 D FOUT^cI39E4(x) Q
- ;
-ZZ ; 18.05.01 - 11 u 18 * V7.86
\ No newline at end of file
+cI39E40	;Instellen P4 (euro) ;%I39E ; [ 05/17/01  5:26 PM ]  ; Compiled December 8, 2011 08:24:22
+	;
+TEST	S FOUTCODE=2   ; Testen uitvoeren
+	;
+	; Basisgegevens
+1	s ba39=@("^"_Q_"BA(39)")
+11	i '$p(ba39,D,6) d FOUT("BA(39) eerstvolgend boekjaar in euro is niet gekend")
+13	i $$BJ^cAFE1(Q,DJ_"."_DM)'=$p(ba39,D,6) d FOUT("BA(39) eerstvolgend boekjaar in euro verschilt van huidig boekjaar")
+15	i $l($p(ba39,D,11)) d FOUT("BA(39) conversie naar euro is reeds gebeurd")
+17	s vm="" f  s vm=$o(@("^"_Q_"BA(11,vm)")) q:vm=""  d
+	. s n=^(vm) d MUNT($p(n,D))
+19	i '$d(^("EUR")) d FOUT("BA(11) muntcode EUR is onbekend")
+	;
+	; Rekeningen
+2	s i1=0 f  s i1=$o(@("^"_Q_"AR(i1)")) q:i1=""  d
+	. s n=^(i1,0),vm=$p(n,D,11)
+	. i vm="" s vm=$p(ba39,D)
+	. i '$d(@("^"_Q_"BA(11,vm)")) d FOUT("AR "_i1_"heeft een onbekende muntcode") q
+	. d MUNT($p(^(vm),D)) i 'y d FOUT("AR "_i1_"heeft geen ISO-muntcode")
+	;
+	; Winkelverkopen
+21	i $d(@("^"_Q_"BA")@(20))#10,$p(^(20),D) d
+	. s i1=$p(^(20),D,3) i 'i1 s i1=0
+	. s i1=$o(@("^"_Q_"PV")@(i1)) i i1="" q
+	. i $$BJ^cAFE1(Q,$e(i1,1,6)/100)<$p(ba39,D,6) d FOUT("PV nog boekhoudkundig te verwerken")
+	;
+	; Controle vaste muntpariteiten
+22	S i2="" F  S i2=$O(@("^"_Q_"BA(11,i2)")) Q:i2=""  D
+	. S LIJN=^(i2)
+	. I i2'=$P(LIJN,D) D FOUT("Geen ISO-muntcodes") q
+	. I $P(LIJN,D,12)=1 D
+	.. I i2="ATS"&($J($P(LIJN,D,11),0,6)'=$J(13.7603,0,6)) D FOUT("BA(11) ATS foutieve muntpariteit") q
+	.. I i2="BEF"&($J($P(LIJN,D,11),0,6)'=$J(40.3399,0,6)) D FOUT("BA(11) BEF foutieve muntpariteit") q
+	.. I i2="DEM"&($J($P(LIJN,D,11),0,6)'=$J(1.95583,0,6)) D FOUT("BA(11) DEM foutieve muntpariteit") q
+	.. I i2="ESP"&($J($P(LIJN,D,11),0,6)'=$J(166.386,0,6)) D FOUT("BA(11) ESP foutieve muntpariteit") q
+	.. I i2="FIM"&($J($P(LIJN,D,11),0,6)'=$J(5.94573,0,6)) D FOUT("BA(11) FIM foutieve muntpariteit") q 
+	.. I i2="FRF"&($J($P(LIJN,D,11),0,6)'=$J(6.55957,0,6)) D FOUT("BA(11) FRF foutieve muntpariteit") q
+	.. I i2="IEP"&($J($P(LIJN,D,11),0,6)'=$J(0.787564,0,6)) D FOUT("BA(11) IEP foutieve muntpariteit") q
+	.. I i2="ITL"&($J($P(LIJN,D,11),0,6)'=$J(1936.27,0,6)) D FOUT("BA(11) ITL foutieve muntpariteit") q
+	.. I i2="LUF"&($J($P(LIJN,D,11),0,6)'=$J(40.3399,0,6)) D FOUT("BA(11) LUF foutieve muntpariteit") q
+	.. I i2="NLG"&($J($P(LIJN,D,11),0,6)'=$J(2.20371,0,6)) D FOUT("BA(11) NLG foutieve muntpariteit") q
+	.. I i2="PTE"&($J($P(LIJN,D,11),0,6)'=$J(200.482,0,6)) D FOUT("BA(11) PTE foutieve muntpariteit") q
+	;
+	; Lock
+3	L +@("^"_Q_"BA"):2 E  D FOUT("BA basisbestand is in gebruik")
+31	L +@("^"_Q_"AR"):2 E  D FOUT("AR rekeningenbestand is in gebruik")
+32	L +@("^"_Q_"KL"):2 E  D FOUT("KL klantenbestand is in gebruik")
+33	L +@("^"_Q_"LE"):2 E  D FOUT("LE leveranciersbestand is in gebruik")
+34	; L +@("^"_Q_"FIA"):2 E  D FOUT("FIA boekingsreeksen zijn in gebruik")
+	;
+	; Overige bestanden
+4	; i $l($o(@("^"_Q_"K3")@(""))) d FOUT("K3 er zijn nog domicili�ringen aanwezig")
+41	; i $l($o(@("^"_Q_"K4")@(""))) d FOUT("K4 er zijn nog gestructureerde mededelingen aanwezig")
+42	; i $l($o(@("^"_Q_"K6")@(""))) d FOUT("K6 er zijn nog betalingen aan klanten aanwezig")
+43	; i $l($o(@("^"_Q_"L3")@(""))) d FOUT("L3 er zijn nog leveranciersbetalingen aanwezig")
+44	i $l($o(@("^"_Q_"FID")@(""))) d FOUT("FID er zijn nog diverse doorboekingen interne kosten")
+45	i $l($o(@("^e"_Q_"BA")@(""))) d FOUT("eBA de basisgegevens werden reeds geconverteerd")
+46	; i $l($o(@("^e"_Q_"AR")@(""))) d FOUT("eAR de rekeningen werden reeds geconverteerd")
+47	i $l($o(@("^e"_Q_"KL")@(""))) d FOUT("eKL de klanten werden reeds geconverteerd")
+48	i $l($o(@("^e"_Q_"LE")@(""))) d FOUT("eLE de leveranciers werden reeds geconverteerd")
+	i $l($o(@("^e"_Q_"WI")@(""))) d FOUT("eWI de wissels werden reeds geconverteerd")
+49	G YZ
+	;
+CONV	S FOUTCODE=2   ; Conversie uitvoeren
+	;
+5	s ba39=@("^"_Q_"BA(39)"),qd=+$g(^(34)),bj=$p(^(2),D,2)\1,R="01.01.03"
+51	s @("^e"_Q_"BA(39)")=ba39,^(34)=qd
+52	m ^eDIN(Q)=^DIN(Q) f i=2,4,bj,bj+1 m @("^e"_Q_"BA(i)")=@("^"_Q_"BA(i)")
+53	s $p(ba39,D)=$p(ba39,D,7),$p(ba39,D,11)=DT,$p(ba39,D,12)=R
+55	s @("^"_Q_"BA(39)")=ba39,^(34)=$p(ba39,D,8),QD=^(34)        ;basisgeg.
+57	s $p(^(7,1),D,2)=2,$p(^(1),D,3)=0,$p(^(1),D,4)=1
+	;
+6	s vm="" f  s vm=$o(@("^"_Q_"BA(11,vm)")) q:vm=""  d         ;muntcodes
+	. s (ba11,n)=^(vm) d MUNT($p(n,D)) w ".",$C(8)
+	. s $p(ba11,D,13)=y i y s $p(ba11,D,12)=+$p(^(0),D,3)
+	. s $p(ba11,D,4)=$p(n,D,8)
+	. s $p(ba11,D,5)=$p(n,D,8)
+	. s $p(ba11,D,6)=$p(n,D,8)
+	. s $p(ba11,D,8)=$p(n,D,4)
+	. s $p(ba11,D,9)=$p(n,D,4)
+	. s $p(ba11,D,10)=$p(n,D,4)
+	. i $p(n,D)=$p(ba39,D) s $p(ba11,D,30)=0
+	. s @("^"_Q_"BA(11,vm)")=ba11 w " ",$C(8)
+	. s @("^e"_Q_"BA(11,vm)")=n
+61	w " AR" s i1=0 f  s i1=$o(@("^"_Q_"AR(i1)")) q:i1=""  d     ;rekeningen
+	. s n=^(i1,0) w $e(i1),$C(8)
+	. d W^cAN220("AR",9,i1,104,$p(n,D,11)) w " ",$C(8)
+	. i K="-" d FOUT("AR "_i1_"werd niet geconverteerd") q
+	. i $p(n,D,11)="" s $p(n,D,11)=$p(ba39,D)
+	. i '$d(@("^"_Q_"BA(11,$p(n,D,11))")) d FOUT("AR "_i1_"heeft een onbekende muntcode") q
+	. d MUNT($p(^($p(n,D,11)),D))
+	. i 'y d FOUT("AR "_i1_"heeft geen ISO-muntcode") q
+	. i '$p(^(0),D,3) q
+	. d W^cAN220("AR",9,i1,111,$p(ba39,D))
+	. i K="-" d FOUT("AR "_i1_"werd niet geconverteerd naar euro")
+62	s i1=0 f  s i1=$o(@("^"_Q_"BA")@("%A",1,"AR",i1)) q:i1=""  d  ; patroon
+	. s n=^(i1,0) s @("^e"_Q_"BA")@("%A",1,"AR",i1,0)=n
+	. i $p(n,D,11)="?" q
+	. i $p(n,D,11)="" s $p(n,D,11)=$p(ba39,D)
+	. i '$d(@("^"_Q_"BA(11,$p(n,D,11))")) k @("^"_Q_"BA")@("%A",1,"AR",i1) q
+	. d MUNT($p(^($p(n,D,11)),D))
+	. i 'y k @("^"_Q_"BA")@("%A",1,"AR",i1) q
+	. i '$p(^(0),D,3) q
+	. s $p(@("^"_Q_"BA")@("%A",1,"AR",i1,0),D,11)=$p(ba39,D)
+620	i Q="TC" g 7   ; Centrale programma's bij TBK
+63	w " KL" s i1=0 f  s i1=$o(@("^"_Q_"KL(i1)")) q:i1=""  d     ;klanten
+	. s n=$g(^(i1,2)) w $e(i1),$C(8)
+	. i $p(n,D,7) d W^cAN220("KL",0,i1,307,$J($$BEDR^cAFE1(Q,$p(n,D,7),$p(ba39,D,9),$p(ba39,D),"V"),0,2))
+	. s i2=9999 f  s i2=$o(@("^"_Q_"KL(i1,i2)")) q:i2'?5.6n  d
+	.. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
+	.. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"V"),0,2)
+	.. s $p(^(i2),D,11)="" i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
+	.. s @("^e"_Q_"KL(i1,i2)")=n w " ",$C(8)
+64	w " VEB" s i1=0 f  s i1=$o(@("^"_Q_"VEB(i1)")) q:i1=""  d   ;opstart
+	. s i2=0 f  s i2=$o(@("^"_Q_"VEB(i1,i2)")) q:i2=""  d
+	.. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
+	.. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"V"),0,2)
+	.. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
+	.. s @("^e"_Q_"VEB(i1,i2)")=n
+65	w " LE" s i1=0 f  s i1=$o(@("^"_Q_"LE(i1)")) q:i1=""  d     ;leveranc.
+	. s n=$g(^(i1,2)) w $e(i1),$C(8)
+	. i $p(n,D,7) d W^cAN220("LE",0,i1,307,$J($$BEDR^cAFE1(Q,$p(n,D,7),$p(ba39,D,9),$p(ba39,D),"A"),0,2))
+	. s i2=9999 f  s i2=$o(@("^"_Q_"LE(i1,i2)")) q:i2'?5.6n  d
+	.. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
+	.. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"A"),0,2)
+	.. s $p(^(i2),D,11)="",$p(^(i2),D,12)="",$p(^(i2),D,13)=""
+	.. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
+	.. s @("^e"_Q_"LE(i1,i2)")=n w " ",$C(8)
+66	w " AAB" s i1=0 f  s i1=$o(@("^"_Q_"AAB(i1)")) q:i1=""  d   ;opstart
+	. s i2=0 f  s i2=$o(@("^"_Q_"AAB(i1,i2)")) q:i2=""  d
+	.. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
+	.. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"A"),0,2)
+	.. i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
+	.. s @("^e"_Q_"AAB(i1,i2)")=n
+67	k @("^"_Q_"K3"),@("^"_Q_"K4"),@("^"_Q_"K5"),@("^"_Q_"K6"),@("^"_Q_"L2"),@("^"_Q_"L3")
+68	f g="BVS","BVB" d                                           ;betalingen
+	. w " ",g d DMS^cAN000("uqc","usc",g,1) i uqc=""!(usc="") q
+	. s UI1=0,UREF=^DMC(uqc,usc,"DATA","REF")
+	. f  s UI1=$O(@UREF) q:UI1=""  D X^cAN220(g,0,UI1) W K
+69	w " WI" s i1=0 f  s i1=$o(@("^"_Q_"WI(i1)")) q:i1=""  d     ;wissels
+	. w ".",$C(8)
+	. s i2=0 f  s i2=$o(@("^"_Q_"WI(i1,i2)")) q:i2'?6n  d
+	.. s n=^(i2),b=$p(n,D,5),vm=$p(n,D,9) i $l(vm),vm'=$p(ba39,D,9) s b=$p(n,D,10)
+	.. s $p(^(i2),D,10)=$J($$BEDR^cAFE1(Q,b,$p(ba39,D,9),$p(ba39,D),"F"),0,2)
+	.. s $p(^(i2),D,11)="" i vm="" s $p(^(i2),D,9)=$p(ba39,D,9)
+	.. s @("^e"_Q_"WI(i1,i2)")=n w " ",$C(8)
+	;
+690	; Toonbankverkopen : kassituatie
+	I '$D(@("^"_Q_"BA(20,0)")) G 699
+	S b=^(0)
+	S @("^e"_Q_"BA(20,0)")=b
+	F i=1:1:4 I $L($P(b,D,i)) S $P(b,D,i)=$J($$BEDR^cAFE1(Q,$P(b,D,i),$p(ba39,D,9),$p(ba39,D),"F"),0,2)
+	S @("^"_Q_"BA(20,0)")=b
+699	;
+	;
+	; Lock
+7	L -@("^"_Q_"BA")
+71	L -@("^"_Q_"AR")
+72	L -@("^"_Q_"KL")
+73	L -@("^"_Q_"LE")
+74	; D S1^V6FIA(Q) L -@("^"_Q_"FIA")
+	;
+YZ	Q
+	;
+	; test op ISO-muntcode
+MUNT(x)	s y=0 f  s y=$o(^ISO(0,"ISO.MUNT",y)) q:y=""  i $p(^(y,0),D)=x q
+	i 'y d FOUT("BA(11) muntcode "_x_" is geen ISO-muntcode")
+	q
+	;
+	; foutboodschap
+FOUT(x)	S FOUTCODE=1 D FOUT^cI39E4(x) Q
+	;
+ZZ	; 18.05.01 - 11 u 18 * V7.86
+