cA3331 ;Ingeven pariteit ;%A333 ;Do uit %T640, %T680 ; [ 01/04/01  2:00 PM ]
 G YZ
 ;
T0 ;Ingeven pariteit ;
T1 ;Pariteit;
 ;
T0F ;Inputation parité ;
T1F ;Parité;
 ;
T0E ;Input rate ;
T1E ;Rate;
 ;
 ; PAriteit komt binnen tov muntcode cumuls
 ; moet worden getoond tov EUR
S1(VM,PA,SP)       ; VM=muntcode ; PA=pariteit tov bf ; SP=soort par. (A/V/F)
S1A I DJ>1998,PA N MNTC S MNTC=$P($$MNTC^cAFE1(Q,BJ),D),PA=$P(@("^"_Q_"BA(11,MNTC)"),D,11)/PA
S1B S PA=$J(PA,0,$S(PA<10:6,PA<100:5,PA<1000:4,PA<10000:3,1:2))
S1Z Q PA
 ;
VM(VM) ; ingeven pariteit ; VM=muntcode
1 S $ZT="TRAP^cAN000" N A,B,BA39,R2,R22,R27,WZ
11 S BA39=@("^"_Q_"BA(39)"),A(1)=^(11,VM),B(1)=A(1),WZ="",R3=""
13 I DJ<1999 S R2="11.1",R27=104 G 8
15 S R2="11.P2.1",R27=111
19 I $P(B(1),D,12) S K="" G YZ   ; ISO-munt -> vaste koers
 ;
 ; opzoeken vraag in ^BIB
2 S R3=$O(@("^"_QT_"BIB")@("%T",R2,R3)) I R3="" G YZ
21 S R22=^(R3) I $P(R22,U,16)'=R27 G 2
23 D EUR^cA333
25 I K S K=K/$P(B(1),D,3) N MNTC S MNTC=$P($$MNTC^cAFE1(Q,BJ),D),K=$P(@("^"_Q_"BA(11,MNTC)"),D,11)/K
29 G YZ
 ;
 ; opzoeken vraag in ^BIB (tem 1998)
8 S R3=$O(@("^"_QT_"BIB")@("%T",R2,R3)) I R3="" G YZ
81 S R22=^(R3) I $P(R22,U,16)'=R27 G 8
83 D VM^cA333
85 I K S K=K/$P(B(1),D,3)
87 G YZ
 ;
YZ Q
 ;
CONV ; opzetten "EUR" + conversie tabel (do uit %A333)
CONVA S ^("EUR")="EUR\Euro\1\40.3399\40.3399\40.3399\2\1\1\1\1\",VM=""
CONVB S VM=$O(@("^"_Q_"BA")@(11,VM)) I VM="" G CONVZ
CONVC S X=^(VM)
CONVD S $P(X,D,8)=$$OMREK^cAFE1(Q,1,VM,"EUR","A",99)*$P(X,D,3)
CONVE S $P(X,D,9)=$$OMREK^cAFE1(Q,1,VM,"EUR","V",99)*$P(X,D,3)
CONVF S $P(X,D,10)=$$OMREK^cAFE1(Q,1,VM,"EUR","F",99)*$P(X,D,3)
CONVG S $P(X,D,11)=$$OMREK^cAFE1(Q,1,"EUR",VM,"F",99)*1
CONVH S $P(X,D,12)=0,$P(X,D,13)="",$P(X,D,30)=0,^(VM)=X
CONVI S I=0 F  S I=$O(^ISO(0,"ISO.MUNT",I)) Q:'I  I $P(^(I,0),D)=$P(X,D) Q
CONVJ I I S $P(X,D,13)=I,$P(X,D,12)=+$P(^(0),D,3)
CONVK S @("^"_Q_"BA")@(11,VM)=X G CONVB
CONVZ Q
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84