cA333 ;Instellen muntpariteiten ;%A333 ; [ 01/03/01  9:07 AM ]
 G 1
 ;
T0 ;Instellen muntpariteiten ;
T1 ;Pariteit;
 ;
T0F ;Etablissement des parités monétaires ;
T1F ;Parité;
 ;
T0E ;Exchange rates ;
T1E ;Rate;
 ;
 ; beheer codes
1 D T^cA612($P($T(@("T0"_QT)),U,2),2,0,7,1,1) L +@("^"_Q_"BA(11)"):2 E  D BUSY^cAFA1 G YZ
10 S BA39=@("^"_Q_"BA(39)")
11 I '$D(^(11,"EUR")) D CONV^cA3331   ; opzetten + conversie tabel
13 S RGL="BA",RBIB="BIB",RR1="%T"
15 I DJ<1999 S RR2=11  ; vóór 1999: tov muntcode boekhouding
17 E  S RR2="11.P2"    ; vanaf 1999: tov euro
TESTP2 ; S RR2="11.P2" S R="" D ^cA3330,2 L -@("^"_Q_"BA(11)") G YZ
TESTP4 ; S RR2="11.P2",$P(BA39,D,11)=DT S R="" D ^cA3330,2 L -@("^"_Q_"BA(11)") G YZ
19 S R="" D ^cA3330,2 L -@("^"_Q_"BA(11)") G YZ
 ;
 ; tov euro P2/P3
2 I DJ<1999 G 8
201 S @%Q1=0,VM="EUR",$P(@("^"_Q_"BA(11,VM)"),D,30)=0,PB=0,VM=""
202 I $L($P(BA39,D,11)) G 4
21 S VM=$O(^(VM)) G 3:VM="" S X=^(VM)
23 S PA=$S($P(X,D,11):1/$P(X,D,11),1:0),$P(X,D,8)=PA,$P(X,D,9)=PA,$P(X,D,10)=PA
27 S ^(VM)=X I VM=$P(BA39,D) S PB=$P(X,D,11)*$P(X,D,3)
29 G 21
 ;
 ; tov muntcode boekhouding via driehoeksregel op euro
3 S VM=$O(^(VM)) G YZ:VM="" S X=^(VM)
31 S PA=$S($P(X,D,11):PB/$P(X,D,11),1:0),$P(X,D,4)=PA,$P(X,D,5)=PA,$P(X,D,6)=PA
33 S $P(X,D,31)="",^(VM)=X
35 G 3
 ;
4 ; tov euro P4/P5
41 S VM=$O(^(VM)) G 5:VM="" S X=^(VM)
43 S PA=$S($P(X,D,11):1/$P(X,D,11),1:0),$P(X,D,4)=PA,$P(X,D,5)=PA,$P(X,D,6)=PA
47 S ^(VM)=X I VM=$P(BA39,D,9) S PB=$P(X,D,11)*$P(X,D,3)
49 G 41
 ;
 ; tov oude muntcode boekhouding via driehoeksregel op euro
5 S VM=$O(^(VM)) G YZ:VM="" S X=^(VM)
51 S PA=$S($P(X,D,11):PB/$P(X,D,11),1:0),$P(X,D,8)=PA,$P(X,D,9)=PA,$P(X,D,10)=PA
53 S $P(X,D,31)="",^(VM)=X
55 G 5
 ;
 ; tov muntcode boekhouding (tem 31.12.98)
8 S @%Q1=0,VM="EUR",X=@("^"_Q_"BA(11,VM)"),PE=$P(X,D,4)/$P(X,D,3),VM=""
81 S VM=$O(^(VM)) I VM="" G YZ
83 S X=^(VM),PA=$P(X,D,4),$P(X,D,5)=PA,$P(X,D,6)=PA
85 S PA=PA/PE,$P(X,D,8)=PA,$P(X,D,9)=PA,$P(X,D,10)=PA
87 S $P(X,D,11)=1/PA,$P(X,D,31)="",^(VM)=X
89 G 81
 ;
YZ S @%Q1=1 Q
 ;
EUR ; pariteit voor EMU-munten
EURA S R="K\22\3\"_$P($T(@("T1"_QT)),U,2)_"\C1\"_$P(R22,U,9)_"\\"_$P(R22,U,11)_"!(""-,""[K&($L(K)!$D(WZ)))" D R0
EURB I K="" S K=$J($P(A(R27\100),D,R27#100),0,6)
EURZ Q
 ;
C1 W !?2,"1 EUR = nn.nnnn ",$P(B(1),D) I $P(B(1),D,3)=100 w " * 100"
C1A I $D(WZ) W "   [] = ",$J($P(A(R27\100),D,R27#100),0,6)
C1Z Q
 ;
ISO ; pariteit voor niet-EMU-munten
ISOA S R="K\22\3\"_$P($T(@("T1"_QT)),U,2)_"\C2\"_$P(R22,U,9)_"\\"_$P(R22,U,11)_"!(""-,""[K&($L(K)!$D(WZ)))" D R0
ISOB I K="" S K=$P(A(R27\100),D,R27#100)
ISOZ Q
 ;
C2 W !?2,$P(B(1),D,3)," ",$P(B(1),D)," = nn.nnnn EUR"
C2A I $D(WZ) W "   [] = ",$J($P(A(R27\100),D,R27#100),0,6)
C2Z Q
 ;
VM ; pariteit tov muntcode boekhouding
VMA S R="K\22\3\"_$P($T(@("T1"_QT)),U,2)_"\C3\"_$P(R22,U,9)_"\\"_$P(R22,U,11)_"!(""-,""[K&($L(K)!$D(WZ)))" D R0
VMB I K="" S K=$P(A(R27\100),D,R27#100)
VMZ Q
 ;
C3 W !?2,$P(B(1),D,3)," ",$P(B(1),D)," = nn.nnnn ",$P(BA39,D)
C3A I $D(WZ) W "   [] = ",$J($P(A(R27\100),D,R27#100),0,6)
C3Z Q
 ;
 ; test op ISO-muntcode
ISOMUNT(X) 
 N R
 S K=$$UC^cAFA1(X),R=""
 F  S R=$O(^ISO(0,"ISO.MUNT",R)) Q:R=""  I K=$P(^(R,0),D) Q
ISOMUNTZ Q R
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84