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