cPE14 ;WIJZIGEN KLASSIFIKATIES ; [ 11/08/2003 3:30 PM ] G 1 ; T1 ;WIJZIGEN T2 ;Wxx[] = wijzigen volgnummer xx T3 ;[] = vervolg T4 ;NIEUWE T5 ;W[] = wijzigen : T6 ;W[] = wijzigen definitief : T7 ;WIJZIGING T8 ; : VAN " T9 ;" NAAR " T10 ;" [] = ok T11 ;WIJZIGEN VAN : . T12 ;-[] = einde programma T13 ; BESTAAT REEDS ! [] = ok ; L1 W @F,$J(T,4) S T=T+1 Q ; S7 S S4=$P(R,D,1)+1+F60,S0=0,SA=$P(R,D,2),S8="^"_Q_$P(R,D,3),FP=S4 W @F,@F1 S7A S FP=2203+F60 W @F,@F1,SA," : ",$E(PNT,1,LGT) S FP=2303+F60 W @F W:$D(ST) $P($T(T2),U,2) W:S0 $P($T(T3),U,2) S FP=2206+F60+$L(SA) W @F,@F0 S7B R K G S7A:K?.E1C.E!($L(K)>LGT),S7C:$L(K)>1&($L(K)<4)&($E(K,1)="W")&($E(K,2,3)?.N) S:$L(K) S0=0 S FP=S4,S9=0 W @F,@F1 G S7Z:K="-" I K="" K ST S S1=S4 G S7F:S0 S7C G S7D:($L(K)<2)!($L(K)>3)!($E(K,1)'="W")!($E(K,2,3)'?.N),S7A:'$D(ST($E(K,2,3))) S FP=2203+F60 W @F,@F2,SA," : ",$P(^(ST($E(K,2,3))),D,2) S7C1 S FP=2211+F60+$L(SA)+LGT W @F,@F1,$P($T(T4),U,2),SA," : ",$E(PNT,1,LGT),@F0 S FP=FP+10+$L(SA) W @F S7C2 R SK G S7C1:SK?.E1C.E,S7A:SK="-",S7C1:$L(SK)>LGT!(SK="") S SX="" F Y=1:1:$L(SK) I $E(SK,Y)'?1P S SX=SX_$E(SK,Y) S7C3 S SX=SX_" " I SX'=ST($E(K,2,3)) G S7C4:'$D(^(SX)) S FP=2403+F60 W @F,@F2,@F4,SEL," ",SK,$P($T(T13),U,2),@F5,@F0 R K1 G S7C1 S7C4 I $D(^(SX)) G S7A:D_SK=^(SX) S7C5 S FP=2303+F60 W @F,@F1,$P($T(T5),U,2),@F0 R SKK G S7C5:SKK?.E1C.E,S7C6:SKK="W",S7A:SKK="-",S7C5 S7C6 S FP=2403+F60 W @F,$P($T(T6),U,2),@F0 R SKK G S7C6:SKK?.E1C.E,S7C7:SKK="W",S7A:SKK="-",S7C6 S7C7 S SO=$P(^(ST($E(K,2,3))),D,2),SP=SO_" ",FP=4+$E(K,2,3)*100+7 W @F,@F2,SK K ^(ST($E(K,2,3))) S ^(SX)=D_SK,ST($E(K,2,3))=SX S7C8 S FP=2301+F60 W @F,@F1 S FP=2403+F60 W @F,@F4,$P($T(T7),U,2),SA,$P($T(T8),U,2),SO,$P($T(T9),U,2),SK,""" ",@F5,@F0 S FP=2471,T=1 S7C9 S (I1,II1,III1,I2,II2,III2,I3,II3,III3,I4,II4,III4,I5,II5,III5)="" S7CA S (Y,E1)=0,@%Q1=0 F I="MK","HG","GR","SG" S Y=Y+1 I $E(BST,2,3)=I S @("II"_Y)=SO,@("III"_Y)=SK S7CB S I1=$N(@Q1) I I1=-1!(II1'=""&(I1]SP)) S I1="" G S7CU S7CC G S7CB:II1'=""&(I1'=SP) S7CD S I2=$N(@Q2) I I2=-1!(II2'=""&(I2]SP)) S I2="" G S7CB S7CE G S7CD:II2'=""&(I2'=SP) S7CF S I3=$N(@Q3) I I3=-1!(II3'=""&(I3]SP)) S I3="" G S7CD S7CG G S7CF:II3'=""&(I3'=SP) S7CH S I4=$N(@Q4) I I4=-1!(II4'=""&(I4]SP)) S I4="" G S7CF S7CI G S7CH:II4'=""&(I4'=SP) S7CJ S I5=$N(@Q5) I I5=-1 S I5="" G S7CH S7CK S PC=@Q5,PC1=@Q6 K @Q5,@Q6 F I=1:1:5 I @("II"_I)'="" S @("I"_I)=SK_" " S7CL S @Q5=PC,@Q6=PC1 D L1 F I=1:1:5 I @("II"_I)'="" S @("I"_I)=SO S7CM G S7CQ:BST="PMK" S IX="I" S7CN S IX=$N(@Q8) G S7CJ:$E(IX,1)'="I" S X=@Q8 I BST="PHG" S:$P(X,D,1)=SO @Q8=SK_D_$P(X,D,2,99) D L1 G S7CN S7CO I BST="PGR" S:$P(X,D,2)=SO @Q8=$P(X,D,1)_D_SK_D_$P(X,D,3,99) D L1 G S7CN S7CP I BST="PSG" S:$P(X,D,3)=SO @Q8=$P(X,D,1,2)_D_SK_D_$P(X,D,4,99) D L1 G S7CN S7CQ S IX="J" S7CR S IX=$N(@Q8) G S7CJ:$E(IX,1)'="J" S X=@Q8 S7CS G S7CT:$P(X,D,2)'=SO S @Q8=$P(X,D,1)_D_SK_D_$P(X,D,3,99),IL=$P(X,D,1),IR=$P(X,D,3) S7CSS S:$E(IL,$L(IL))'=" " IL=IL_" " S:$E(IR,$L(IR))'=" " IR=IR_" " S:$L(IR)=1 IR=IR_" " S:$E(I1,$L(I1))'=" " I1=I1_" " S PC=@Q7 K @Q7 S I1=SK S:$E(I1,$L(I1))'=" " I1=I1_" " S @Q7=PC D L1 S7CT S I1=SO,@%Q1=1 G S7CR S7CU S I=@(S8_"(SX)") G S7A S7D K ST S S6="" F S7=1:1:$L(K) I $E(K,S7)'?1P S S6=S6_$E(K,S7) S7E S S5=$E(S6,1,28) S:S6="" S5=" " S:S5?.N S5=S5_" " S S1=S4,S2=S5 G S7G:$D(@(S8_"(S2)")),S7I:$N(@(S8_"(S2)"))=-1 S7F S S2=$N(@(S8_"(S2)")) G S7I:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S7J:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S7A S7G S FP=S1,S9=S9+1,ST(S9)=S2 W @F,$C(13),?2,$J(S9,2),". ",?6,$P(^(S2),D,2) S7H S S1=S1+100 G S7F:S1<(2100+F60) S S0=1 G S7A S7I X ^cTXT(0,"N",156) R K S7J S (S2,S0)=0 G S7A S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,ST 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 L (@("^"_Q_"PR"),@("^"_Q_"PR1")):2 E X ^cTXT(0,"N",14) R K G YZ 11 S Q1="^"_Q_"PM(I1)",Q2="^"_Q_"PM(I1,I2)",Q3="^"_Q_"PM(I1,I2,I3)",Q4="^"_Q_"PM(I1,I2,I3,I4)",Q5="^"_Q_"PM(I1,I2,I3,I4,I5)" 12 S Q6="^"_Q_"PH(I2,I3,I4,I1,I5)",Q7="^"_Q_"PL(IL,I1,IR,I5)",Q8="^"_Q_"PR(PC,IX)" 13 S PNT="..............................",Y=$N(@("^"_Q_"PR(0,"" "")")),Y=" " 14 S Y=$N(^(Y)) G 15:Y=-1 S @Y=^(Y) G 14 15 S FP=401 W @F,@F1 S SEL="",FP=2203+F60 W @F,$P($T(T11),U,2) 20 S FP=2303+F60 W @F F I="HG","GR","SG","MK" S Y=$P(@I,D,2) S:Y="" SEL=SEL_" " S SEL=SEL_$E(Y,1) I Y'="" W $E(Y,1),"[] = ",$P(@I,D,4)," " 25 S FP=2403+F60 W @F,$P($T(T12),U,2),@F0 27 S FP=2202+$L($P($T(T11),U,2)) W @F R K G 15:K?.E1C.E,YZ:K="-",25:K="",15:K=" "!(SEL'[K) S K=$F(SEL,K)-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=478 W @F,@F5 S FP=467-$L(SEL) W @F,@F4,$P($T(T1),U,2),SEL," ",@F5 50 S R=500_D_SEL_D_BST D S7 G 15 YZ L Q ; Z X ^cZ Q ZZ ; 15.12.88 - 13 u 57