KA333 ;INSTELLEN MUNTPARITEITEN ;KA333 ;do naar %A319,%A328 ; [ 03/22/2001  9:42 AM ]
 G 1
 ;
T1 ;AFK : OFF : OMSCHRIJVING         : EH. : AANKOOP : VERKOOP : FIN+DIV : DEC :;
T2 ;AFKORTING MUNTKODE\;OMSCHRIJVING\"[] = ;EENHEID\"[] = 1   .[] = 100";AANTAL DECIMALEN\;
T3 ;MUNTKODE REEDS GEOPEND ;MUNTKODE STAAT NIET OP HET SCHERM (DEATIL VRAGEN A.U.B.) ;
T4 ;AANKOOP;VERKOOP;FIN+DIV; - PARITEIT PER EENHEID\;
T5 ;UW KEUZE\SC1;.[] = openen   W[] = wijzigen   V[] = verwijderen;   [] = vervolg;D[] = detail   -[] = einde;
T6 ;WIJZIGEN\SC2;1[] = off. kode   2[] = omschrijving   3[] = eenheid   4[] = aankoop;5[] = verkoop     6[] = fin + div      7[] = decimalen;
T7 ;BEVESTIGING\",[] = hernemen   V[] = DEFINITIEF verwijderen";
 ;
S1 F C=7:1:18 S C(C)="" D S2
S1Z K A S C=7 Q
 ;
S2 S VM=C(C),S1=$S($L(VM):A(VM),1:D),S3="\3\20\3\7\7\7\2",FP=C*100+3 W @F,VM,$J("",3-$L(VM))
S2A F S2=2:1:8 S FP=C*100+$P("\9\15\38\44\54\64\75",D,S2) W @F,$E($P(S1,D,S2),1,$P(S3,D,S2)),$J("",$P(S3,D,S2)-$L($P(S1,D,S2)))
S2Z K S1,S2,S3 Q
 ;
S3 S R="K\22\3\"_$P($T(T2),U,2)_"\3\\""-,""[K&$L(K)!(K?1.3U)" D R0 G S3Z:K="-"!(K=",") S VM=K
S3A I X=".",$D(@("^"_Q_"BA(11,VM)")) S K=$P($T(T3),U,2) X ^cTXT(0,"N",250) R K G S3
S3B I X="." S C(C)=VM,A(VM)=C D S2
S3C I '$D(A(VM)) S K=$P($T(T3),U,3) X ^cTXT(0,"N",250) R K G S3
S3D S C=$P(A(VM),D),FP=C*100+2 W @F,"*"
S3Z Q
 ;
S4 S R="K\2000\"_TF D ^cA328 I K'="-" S $P(A(VM),D,2)=K D S2
S4Z Q
 ;
S5 S S1=$S($D(^cBA(11,$P(A(VM),D,2),0,TF)):^(TF),1:$P(A(VM),D,3))
S5A S R="K\22\3\"_$P($T(T2),U,3)_S1_"""\20\\" D R0 I K'="-",K'="," S:K="" K=S1 S $P(A(VM),D,3)=K D S2
S5Z Q
 ;
S6 S R="K\22\3\"_$P($T(T2),U,4)_"\1\\""-,.""[K" D R0 I "."[K S $P(A(VM),D,4)=$S(K=""!(VM=BF):1,1:100) D S2
S6Z Q
 ;
S7 S R="K\22\3\"_$P($T(T4),U,$F("AVF",AVF))_$P($T(T4),U,5)_"\7\\""-,""[K!(K?1.2N)!(K?1.2N1""."".N)"
S7A D R0 I K'="-",K'="," S:VM=BF K=1 S $P(A(VM),D,$F("AVF",AVF)+7)=K,$P(A(VM),D,$F("AVF",AVF)+3)=$J(K,7,4) D S2
S7Z Q
 ;
S8 S R="K\22\3\"_$P($T(T2),U,5)_"\1\\""-,""[K!(K?1N)" D R0 I K'="-",K'="," S:VM=BF K=QD S $P(A(VM),D,8)=+K D S2
S8Z Q
 ;
S9 S FP=C*100+2 W @F," " S VM=C(C) K:$L(VM) A(VM) S C(C)="" D S2 Q
 ;
1 S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 S FP=502 W @F,@F4,$P($T(T1),U,2),@F5,@F1
13 S R="401\1978",RH="601#678",RV="407#1907\413#1913\436#1936\442#1942\452#1952\462#1962\472#1972" D ^cA319
15 L @("^"_Q_"BA(11)"):2 E  X ^cTXT(0,"N",14) R K G YZ
17 S BF=$S($D(@("^"_Q_"BA(39)")):^(39),1:D),TF=$P(BF,D,2),BF=$P(BF,D) S:BF="" BF="BF" S:TF="" TF="N"
 ;
2 S I2="" D S1
21 S I2=$O(@("^"_Q_"BA(11,I2)")),SW="" G 3:I2="" S VM=I2,C(C)=VM,A(VM)=C,K=^(I2)
23 S A(VM)=A(VM)_D_$P(K,D,1,3)_D_$J($P(K,D,4),7,4)_D_$J($P(K,D,5),7,4)_D_$J($P(K,D,6),7,4)_D_+$P(K,D,7)_D_$P(K,D,4,6)
25 D S2 I C<18 S C=C+1 G 21
27 S SW=$O(@("^"_Q_"BA(11,I2)"))
 ;
3 S R="X\22\3\"_$P($T(T5),U,2)_"\1\\""-.WVD""[K&($L(K)!$L(SW))" D R0 G YZ:K="-",5:K="W",6:K="V"
31 I "D"[K S:K="D" I2="" D S1 G 21
33 I $L(C(18)) S VM=C(7) K A(VM) F C=7:1:17 S C(C)=C(C+1),VM=C(C),$P(A(VM),D)=C D S2
35 S C=18,C(C)="" D S2 F C=18:-1:7 Q:'$D(C(C-1))  Q:$L(C(C-1))
 ;
4 D S3 I K="-"!(K=",") D S9 G 3
40 D S4 I K="-"!(K=",") D S9 G 4
41 D S5 G 40:K="-" I K="," D S9 G 4
42 D S6 G 41:K="-" I K="," D S9 G 4
43 S AVF="A" D S7 G 42:K="-" I K="," D S9 G 4
44 S:'$P(A(VM),D,10) $P(A(VM),D,10)=$P(A(VM),D,9),$P(A(VM),D,6)=$P(A(VM),D,5)
 S:'$P(A(VM),D,11) $P(A(VM),D,11)=$P(A(VM),D,9),$P(A(VM),D,7)=$P(A(VM),D,5) D S2 G 47
45 S AVF="V" D S7 G 43:K="-" I K="," D S9 G 4
46 S AVF="F" D S7 G 45:K="-" I K="," D S9 G 4
47 D S8 G 46:K="-" I K="," D S9 G 4
48 S @%Q1=0,@("^"_Q_"BA(11,VM)")=$P(A(VM),D,2,4)_D_$P(A(VM),D,9,11)_D_$P(A(VM),D,8)_D I $D(AVF),AVF="A" D ^KPWAMP
49 S @%Q1=1,FP=C*100+2 W @F," " G 2:X="V",3
 ;
5 D S3 G 49:K="-"!(K=",")
51 S R="Y\22\3\"_$P($T(T6),U,2)_"\1\\""-,1234567""[K&$L(K)" D R0 G 48:K="-"!(K=",")
53 S AVF=$E("...AVF.",Y) D S4:Y=1,S5:Y=2,S6:Y=3,S7:Y=4!(Y=5)!(Y=6),S8:Y=7 G 51
 ;
6 D S3 G 49:K="-"!(K=",") I VM=BF S X="" G 49
61 S R="K\22\3\"_$P($T(T7),U,2)_"\1\\""-,V""[K&$L(K)" D R0 I K="V" S @%Q1=0 K @("^"_Q_"BA(11,VM)")
63 G 49
 ;
YZ Q
 ;
SC1 S K=$T(T5) W !?2,$P(K,U,3) W:$L(SW) $P(K,U,4) W !?2,$P(K,U,5) Q
SC2 W !?2,$P($T(T6),U,3),!?2,$P($T(T6),U,4) Q
 ;
R0 S R7=1 S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7)),U,2,99)_")"
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6),R8="",$P(R8,".",R6)="."
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !?2,@F2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2,R8,@F,@F0 R K W @F2 I $L(K)'>R6,K'["""",K'[D,K'?.E1C.E,@R7 S @$P(R,D)=K
R0D E  G R0C
R0E S FP=$P(R,D,9)*100+$P(R,D,10) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,R8 Q  ;V8 05.07.88
 ;
V6 
 New %J,%TC,J,T,R,Munt,MMunt,Old,New,PRNr,LEVNr
 Write @F11,@F1
 Xecute "Set T=$T(T0"_QT_"^cA333)"
 Do T^cA612($P(T,U,2),2,0,7,1,1)
 Do ADD^vhLock("^KBA(11)")
 If %TC Do
 .Set %J=$$%J^vhRtn1()
 .Kill ^HULP(%J)
 .Merge ^HULP(%J)=^KBA(11)
 .Do ^cA333
 .Set (Munt,MMunt)=""
 .For  Set Munt=$O(^KBA(11,Munt)) Quit:Munt=""  Do
 ..Quit:'$D(^HULP(%J,Munt))
 ..Set Old=^HULP(%J,Munt),New=^KBA(11,Munt)
 ..If $P(Old,D,3,4)=$P(New,D,3,4),$P(Old,D,7)=$P(New,D,7) Quit
 ..Set MMunt=MMunt_D_Munt
 .Set $E(MMunt)=""
 .Do:$L(MMunt)
 ..Set FP=2002
 ..Write @F,@F1,"Herrekenen produkten met volgende munten : ",$TR(MMunt,D,",")
 ..For  Do ADD^vhLock("^KPR") Quit:%TC  Do LDISP^vhLock("^KPR","Produkten")
 ..For  Do ADD^vhLock("^KPR1") Quit:%TC  Do LDISP^vhLock("^KPR1","Produkten")
 ..Set FP=2202
 ..Write @F,"Produkt     : "
 ..Set FP=2302
 ..Write @F,"Leverancier : "
 ..Set FP=2402
 ..Write @F,"Munt        : "
 ..Set PRNr=0
 ..For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 ...Set J=$O(^KPR(PRNr,"J"))
 ...Quit:$E(J)'="J"
 ...Set R=^KPR(PRNr,J),LEVNr=$P(R,D),Munt=$P(R,D,17)
 ...Quit:D_MMunt_D'[(D_Munt_D)
 ...Set FP=2216
 ...Write @F,$P(^KPR(PRNr,0),D),@F2
 ...Set FP=2316
 ...Write @F,$P(^KLE(^KL1(LEVNr),0),D,2),@F2
 ...Set FP=2416
 ...Write @F,Munt,@F2
 ...Do RECALC^PRODUKT2(PRNr)
 ..Do REMOVE^vhLock("^KPR"),REMOVE^vhLock("^KPR1")
 .Do REMOVE^vhLock("^KBA(11)")
 Else  Do LDISP^vhLock("^KBA(11)","Muntpariteiten")
 Quit
 ;