KPSELP G 1 ;WIJZIGEN SELEKTIES VOOR LISTINGS (nummer + omschrijving) ;KPSEL;Quit naar KPSELA [ 08/05/2002  10:20 AM ]
 ;
T1 ;NUMMER SELEKTIE;6;K?.N&K!(K="-")
T2 ;NAAM SELEKTIE;40;$L(K)
T3 ;SELEKTIE ELEMENT
T4 ;SELEKTIE 
 ;
S4 S R4=$P(R,D,2)+1,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_Q_$P(R,D,5),FP=R4 W @F,@F1
S4A X ^cTXT(0,"N",15)
S4B R K G S4A:K?.E1C.E!(K?20N.N) S:$L(K) R0=0 S FP=R4 W @F,@F1 G S4Z:K="-" I K="" S R1=R4 G S4H:R0,S4D
S4C G S4D:K'?.N,S4K:'$D(@(R9_"(Q1,K)")) S R3=^(K) I $D(@(R8_"(Q1,R3)")) G S4M
S4D S R6=$$UPTRIMAN^vhRtn1(K)
S4E S R5=$E(R6,1,24) S:R6="" R5=" " S R1=R4,R2=R5,(R2,R3)=$N(@(R8_"(Q1,R2)")) G S4K:R2=-1 S R2=$N(^(R2))
S4F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6) S R7=$D(^(R3)) G S4M
S4G S R2=R5
S4H S R2=$N(@(R8_"(Q1,R2)")) G S4K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G S4L:R2=-1 I $E(R2,1,$L(R6))'=R6 S R0=0 G S4A
S4I S FP=R1 W @F,$C(13),$J(+^(R2,0),6),?7,$P(^(0),D,2)
S4J S R1=R1+100 G S4H:R1<(2300+F60) S R0=1 G S4A
S4K X ^cTXT(0,"N",8) R K
S4L S (R2,R0)=0 G S4A
S4M S (@$P(R,D,1),K)=R3
S4Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,RA Q  ;V4 23.05.85
 ;
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))," ",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)
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,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2,$E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,K'[D&(K'?.E1C.E),@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V5 02.01.86
 ;
1 S SW5=1,FP=355 W @F,@F1 I $D(I2),$D(@("^"_Q_"SL(Q1,I2)")) S K=I2 G 5
3 S R="K\2000\DE SELEKTIE\SL\SL1" D S4 G 37:K="-" S I2=K
5 S K=^(K,0),(OX1,X1)=$P(K,D,1),(OX2,X2)=$P(K,D,2)
6 K B S I=0 F X=1:1 S I=$N(^(I)) Q:I=-1  S B(I)=^(I)
7 I SW5 S FP=421 W @F,@F9,":" S FP=403 W @F,"1 ",@F6,$P($T(T1),U,2),@F9
9 S FP=424 W @F,$J("",6),@F,OX1
11 I SW5 S FP=521 W @F,@F9,":" S FP=503 W @F,"2 ",@F6,$P($T(T2),U,2),@F9
13 S SW5=0,FP=524 W @F,$J("",40),@F,OX2
15 S R="NRE\22\3\"_$P($T(T3),U,2)_"\\1\\""-12""[K&($L(K)=1)" D R0 I K="-" G 3:OX1=X1&(OX2=X2),25
17 S R="K\22\3\"_$P($T(@("T"_NRE)),U,2)_"\\"_$P($T(@("T"_NRE)),U,3)_"\\"_$P($T(@("T"_NRE)),U,4) D R0 G 15:K="-"
19 I NRE=2 S X2=K,FP=524 W @F,$J("",40),@F,K G 15
21 I K'=OX1,$D(@("^"_Q_"SL1(Q1,K)")) X ^cTXT(0,"N",12) R K G 17
23 S X1=K,FP=424 W @F,$J("",6),@F,K G 15
25 L (@("^"_Q_"SL1(Q1,OX1)"),@("^"_Q_"SL1(Q1,X1)"))
27 S NI2=$$UPTRIMAN^vhRtn1(X2)
29 S NI2=NI2_" "_X1,@%Q1=0,@("^"_Q_"SL(Q1,NI2,0)")=X1_D_X2_D
31 S I=0 F X=1:1 S I=$N(B(I)) Q:I=-1  S ^(I)=B(I)
33 K @("^"_Q_"SL(Q1,I2)"),@("^"_Q_"SL1(Q1,OX1)") S ^(X1)=NI2
35 S @%Q1=1,I2=NI2 L @("^"_Q_"SL1(Q1,X1)") G 3
37 S FP=355 W @F,@F1 I 'SW5 S FP=455 W @F,$P($T(T4),U,2),X1 S FP=555 W @F,$E(X2,1,25)
YZ K NI2,OX1,OX2,NRE Q
 ;