KPE3 G 1 ;VERWIJDEREN KLASSIFIKATIES ; [ 08/05/2002   1:05 PM ]
 ;
T1 ;VERWIJDEREN 
T2 ;   [] = vervolg
T3 ;VERWIJDEREN VAN : .
T4 ;- = einde programma
T5 ;V = verwijderen : .
T6 ;V = verwijderen definitief : .
T7 ;OMSCHR NEDERL
T8 ;OMSCHR FRANS 
T9 ;OMSCHR DUITS 
T10 ;GEMID PRIJS;; (Telbaar); (Niet telbaar)
T11 ;TELBAAR;;JA;NEEN
T12 ;VERDELING
T13 ;" IS VERWIJDERD  [] = ok   
 ;
S2 S FP=I+3+(I>1)*100+18 W @F,@F5,":" S FP=I+3+(I>1)*100+2 W @F,I," ",@F6 W:I=1 SEL W:I>1 $P($T(@("T"_(I+5+(I>4&(BST="PSG"))))),U,2) W @F5
S2Z Q
 ;
S1 W !?2 F I="HG","GR","SG","MK" S Y=$P(@I,D,2) I Y'="" W $E(Y,1)," = ",$P(@I,D,4),"   "
S1A W !?2,$P($T(T4),U,2)
S1Z Q
 ;
S7 S S4=$P(R,D,1)+1+F60,S0=0,SA=$P(R,D,2),S8="^"_Q_$P(R,D,3),S9="^"_Q_$P(R,D,4),FP=S4 W @F,@F1
S7A S FP=2403+F60 W @F,@F1,$P($T(T1),U,2),SA W:S0 $P($T(T2),U,2) W " : ",@F0
S7B R K G S7A:K?.E1C.E S:$L(K) S0=0 S FP=S4,S10=0 W @F,@F1 G S7Z:K="-" I K="" K ST G S7D:'S0 S S1=S4 G S7H
S7C G S7D:'$D(ST(K)) S S3=ST(K) G S7M
S7D K ST S S6=$$UPTRIMAN^vhRtn1(K)
S7E S S5=$E(S6,1,28) S:S6="" S5=" " S S1=S4,(S2,S3)=S5 G S7M:$D(@(S9_"(S2_"" "")")) S:S5?.N S5=S5_" " S (S2,S3)=$N(@(S9_"(S2)")) G S7K:S2=-1 S S2=$N(^(S2))
S7F I $E(S2,1,$L(S6))'=S6&'S0&($E(S3,1,$L(S6))=S6) S S7=$D(@(S8_"("""_S3_""")")) G S7M
S7G S S2=S5
S7H S S2=$N(@(S9_"(S2)")) G S7K:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S7L:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S7A
S7I S FP=S1,S10=S10+1,ST(S10)=S2,S11=$P(^(S2),D,2)_" " W @F,$C(13),?2,S10,". ",?6,S11
 I S8="^KPGR",$D(@(S8_"1("""_S11_""")")) W ?20,$J($P(^(S11),D,4),10,0)," (",$P("Telbaar\Niet telbaar",D,'$P(^(S11),D,4)+1),")"
 I S8="^KPSG",$D(@(S8_"1("""_S11_""")")) W ?35,$P("Niet telbaar\Telbaar",D,'$P(^(S11),D,5)+1),?55,$P("Verdeelbaar\Niet verdeelbaar",D,($O(^(S11,""))="")+1)
S7J S S1=S1+100 G S7H:S1<(2300+F60) S S0=1 G S7A
S7K X ^cTXT(0,"N",156) R K
S7L S (S2,S0)=0 G S7A
S7M S:$E(S3,$L(S3))'=" " S3=S3_" " S R=S3
S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,SA,ST Q
 ;
TELB N HG,GR,SG
 S Z="" F  S Z=$O(^KPSG1(Z)) Q:Z=""  S HG="" F  S HG=$O(^KPSG1(Z,HG)) Q:HG=""  S GR="" F  S GR=$O(^KPSG1(Z,HG,GR)) Q:GR=""  K ^(GR,KS_" ")
 Q
 ;
1 S K=$P($T(+1),U,2)_QN_" " S FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
10 S Y=$N(@("^"_Q_"PR(0,"" "")")),Y=" "
11 S Q1="^"_Q_"PM(I1)",Q2="^"_Q_"PM(I1,I2)",Q3="^"_Q_"PM(I1,I2,I3)",Q4="^"_Q_"PM(I1,I2,I3,I4)"
13 S Y=$N(^(Y)) G 15:Y=-1 S @Y=^(Y) G 13
15 S (SW,SEL)="",FP=301 W @F,@F1 F I="HG","GR","SG","MK" S Y=$P(@I,D,2) S:Y="" SEL=SEL_" " S SEL=SEL_$E(Y,1)
25 S FP=2203 W @F,@F1,$P($T(T3),U,2) K IK D S1,IK^PROC1 G 25:R=" ",25:SEL_"-"'[R
 G YZ:R="-" S K=$F(SEL,R)-1
30 S Y=$P("HG\GR\SG\MK",D,K),BST="P"_Y,SEL=$P(@Y,D,2),LGT=$P(@Y,D,1)
40 S FP=379 W @F,@F5 S FP=366-$L(SEL) W @F,@F4,$P($T(T1),U,2),SEL," ",@F5
45 S FP=1021 W @F,@F1
50 S R=1300_D_SEL_D_BST_D_BST D S7 G 15:K="-" S SR=R
60 S KS=$P(@("^"_Q_BST_"(R)"),D,2),K=@("^"_Q_BST_1_"(KS_"" "")"),KN=$P(K,D,1),KF=$P(K,D,2),KD=$P(K,D,3),KP=$P(K,D,4),KT=$P(K,D,5)
65 I BST="PGR",'KP S KT=1
70 F I=1:1:$S(BST="PHG":4,BST="PGR":5,1:6) D:'SW S2 S FP=I+3+(I>1)*100+21 W @F,@F2,@$P("KS\KN\KF\KD\$S(BST=""PGR"":+KP,1:"""")_$P($T(@(""T""_(10+(BST=""PSG"")))),U,KT+4)\""""",D,I)
75 S FP=2303 W @F,@F1,$P($T(T5),U,2) I BST'="PSG" K IK D IK^PROC1 G 45:R="-",80:R="V",75
76 D ^KPEDVS(KS_" ") I '$D(KPED) D ^KPEDSV(KS_" ")
77 I '$D(KPED) K IK D IK^PROC1 G 80:R="V",45:R="-",77
78 D SL^PROC I R'="V" G 45:R="-",78
80 S SW=1,SO=KS,SP=SO_" ",SK="Z"
90 S (I1,II1,III1,I2,II2,III2,I3,II3,III3,I4,II4,III4)=""
100 S (Y,E1)=0 F I="MK","HG","GR","SG" S Y=Y+1 I $E(BST,2,3)=I S @("II"_Y)=SO,@("III"_Y)=SK
110 S I1=$N(@Q1) I I1=-1!(II1'=""&(I1]SP)) G 210
120 G 110:II1'=""&(I1'=SP) G 190:I1=SP
130 S I2=$N(@Q2) I I2=-1!(II2'=""&(I2]SP)) S I2="" G 110
140 G 130:II2'=""&(I2'=SP) G 190:I1=SP
150 S I3=$N(@Q3) I I3=-1!(II3'=""&(I3]SP)) S I3="" G 130
160 G 150:II3'=""&(I3'=SP) G 190:I1=SP
170 S I4=$N(@Q4) I I4=-1!(II4'=""&(I4]SP)) S I4="" G 150
180 G 170:II4'=""&(I4'=SP)
190 X ^cTXT(0,"N",65) R K G 45
210 S FP=2403 W @F,@F2,$P($T(T6),U,2) K IK D IK^PROC1 G 45:R="-",210:R'="V"
220 K @("^"_Q_BST_"(SR)"),@("^"_Q_BST_1_"(KS_"" "")")
225 D TELB
230 S FP=2403+F60 W @F,@F2,@F4,SEL," """,KS,$P($T(T13),U,2),@F5,@F0 R K G 45
YZ Q
 ;