BTWUL96 ;CONVERSIE BTW-CODES BONS ;BTWUL ; [ 12/18/95  12:08 PM ]
 G 1
 ;
T1 ;DE BESTANDEN ZIJN IN GEBRUIK ! ;
T2 ;;
T3 ;EINDE CONVERSIE ;
T4 ;BEVESTIGING\".[] = doorgaan   -[] = einde programma";
 ;
S1 I INCL S S1=$P(B(1),D,6),$P(B(1),D,6)=$J(S1/(1+(PTXT(K\10)+PBTW(K#10)/100))*(1+(PBTW(X)/100)),0,QD)
S1A I INCL,'$P(B(1),D,3) S S1=$P(B(1),D,29),$P(B(1),D,29)=$J(S1/(1+(PTXT(K\10)+PBTW(K#10)/100))*(1+(PBTW(X)/100)),0,QD)
S1Z S $P(B(1),D,8)=X K S1 Q
 ;
S2 S WZ=1,K=$P(B(1),D,29),U3=K,VJ=X D S3 I K["-" S K="-"_(+K)
S2Z S X=VJ,$P(B(1),D,29)=$J(K,0,QD) Q
 ;
S3 G S3Z:$S('$D(B(1)):1,1:0) S:$D(WZ)!$D(ASW)&'$L(K) K=U3 S:$E(K,$L(K))="-" K=-K S UA=$P(B(1),D,3) S:'UA UA=1 S:$P(B(1),D,3) K=$P(B(1),D,6)
S3A S K=UA*K,K=$S($E($P(B(1),D,7),$L($P(B(1),D,7)))="%":100+$P(B(1),D,7)*K/100,1:$P(B(1),D,7)*$S(K<0:-1,1:1)+K)
S3B S K=$J(K,0,QD+8),$P(B(1),D,9)=K,$P(B(1),D,10)=K,$P(B(1),D,16)=$J(UA*$S($P(B(1),D,3):$P(B(1),D,6),1:K),0,QD+8)
S3C I $D(UGL),UGL'="PV",'$P(@("^"_Q_UGL_"(KC,US,UR,1)"),D,5) G S3Z
S3D I '$D(PBTW) S Y=$D(@("^"_Q_"BA(18,0)")) F Y=0:1:9 S:$D(^(Y)) PBTW(Y)=$P(^(Y),D,1) S:$D(^(Y+10)) PTXT(Y)=$P(^(Y+10),D,1)
S3E S X=PBTW($P(B(1),D,8)#10) S:$P(B(1),D,8)>10 X=X+PTXT($P(B(1),D,8)\10)
S3F S Y=100/(X+100),$P(B(1),D,9)=$J($P(B(1),D,9)*Y,0,QD+8),$P(B(1),D,10)=$P(B(1),D,9),$P(B(1),D,16)=$J($P(B(1),D,16)*Y,0,QD+8)
S3Z K X,Y,UA 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 L (@("^"_Q_"UL"),@("^"_Q_"OD"),@("^"_Q_"UT"),@("^"_Q_"PW")):2 E  S K=$P($T(T1),U,2) D E G YZ
12 S R="K\22\3\"_$P($T(T4),U,2)_"\1\\""-,.""[K&$L(K)" D ^cA100 I K'="." G YZ
13 K @("^"_Q_"BA(""MENU"",QM,98)") D S1^cA305 S INCL=0,K=""
15 S K=$O(PBTW(K)) I K'="",+PBTW(K)=21 S X=K G 2
17 G 15
 ;
2 S UGL="UL"
21 S US=""
23 S US=$O(@("^"_Q_UGL_"(0,US)")) I US="" S UGL=$S(UGL="OD":"TO",UGL="UL":"OD",1:"") G 21:$L(UGL),5
24 I UGL="TO",US'="T" G 23
25 G 23:'$D(^(US,0)) S FP=803 W @F,@F1,$P($P(^(0),"""",2)," ",2,99)
 ;
3 S KC=0
31 S KC=$O(@("^"_Q_UGL_"(KC)")),UR="" G 23:KC=""
33 S UR=$O(@("^"_Q_UGL_"(KC,US,UR)")),UZ=99 G 31:UR="" S U5=^(UR,1),INCL=$P(U5,D,5),K=$P(U5,D,30)
35 I +PBTW(K#10)=20.5 S $P(U5,D,30)=X,^(1)=U5
37 S FP=843 W @F,@F2,UR
 ;
4 S UZ=$O(@("^"_Q_UGL_"(KC,US,UR,UZ)")) G 45:UZ="" S B(1)=^(UZ),K=$P(B(1),D,8)
41 I +PBTW(K#10)=20.5 D S1,S2:INCL S @("^"_Q_UGL_"(KC,US,UR,UZ)")=B(1)
43 G 4
45 I INCL,$P(U5,D,20) S VJ=X D 7^cFN2000 S X=VJ
47 G 33
 ;
5 I '$D(@("^"_Q_"UT(0,0)")) G 6
51 S FP=1003 W @F,@F1,$P(^(0),U) S I1=0
53 S I1=$O(@("^"_Q_"UT(I1)")),I2=0 I I1="" G 6
55 S I2=$O(@("^"_Q_"UT(I1,I2)")) G 53:I2="" S B(1)=^(I2),K=$P(B(1),D,17)
57 I +PBTW(K#10)=20.5 S $P(B(1),D,17)=X,^(I2)=B(1),FP=1043 W @F,@F1,I1
59 G 55
 ;
6 I '$D(@("^"_Q_"PWT(0,0)")) G Y
61 S FP=1203 W @F,@F1,$P(^(0),U) S I1=0
63 S I1=$O(@("^"_Q_"PWT(I1)")) G Y:I1="",63:'$D(^(I1,0)) S B(1)=^(0),K=$P(B(1),D,24)
65 I +PBTW(K#10)=20.5 S $P(B(1),D,24)=X,^(0)=B(1),FP=1243 W @F,I1
67 G 63
 ;
Y L  S K=$P($T(T3),U,2) D E
YZ Q
 ;
E S FP=2402 W @F,@F4,K,"  [] = ok ",@F5,@F1,@F0 R K Q
 ;
ZZ ; 18.12.95 - 12 u 10