KPSELC G 1 ;OPENEN SELEKTIES VOOR LISTINGS ;KPSEL;Do naar KPSELD, KPSELJ, KPSELN [ 01/28/2003  4:11 PM ]
 ;
T1 ;SELEKTIE 
T2 ;ER BESTAAN ;SCHERMEN.
T3 ;WELK SCHERM : ;x[] = Scherm 1-7    ;-[] = volgende selektiekode;6[] = klassifikatie   ;5[] = leverancier   
T4 ;SCHERM 
T5 ;NUMMER SELEKTIE : ;[] = automatisch nummer   .[] = synoniemen   -[] = einde programma
T6 ;NAAM SELEKTIE   : 
T7 ;KLASSIF.;LEVERANC.
 ;
1 S U=";",SW3=0,(SW2,SW4,SW5)=1,PNT="........................................",Y=100
11 S X=$P(@("^"_Q_Q1_"(0,0)"),D,1)
13 I ($N(^(SW4+1*100)))\100=(SW4+1) S SW4=SW4+1 G 13
14 S SWK=$N(^(SW4+1*100))\100,SWL=0 I SWK S SWL=$N(^(SWK+1*100))\100
15 S Y=$N(^(Y)) I Y>0 S X=$P(^(Y),U,16)\100 S:X>SW3 SW3=X G 15
16 S A(101)=^(101),A(102)=^(102) I SW4=1 S U1=SW2*100 D S1^KPSELG G 2
17 S FP=269 W @F,@F1,@F5 S FP=254,K=$T(T2) W @F,@F5,$P(K,U,2),@F4,SW4," ",@F5,$P(K,U,3)
 ;
2 I SW4>1 S FP=301 W @F,@F1
21 S FP=2203+F60,K=$P($T(T5),U,2) W @F,@F1,K,!?2,$P($T(T5),U,3) S FP=FP+$L(K)
22 W @F,"......",@F2,@F,@F0 R X1 W @F2 I X1="." S R="X1\1800\DE SELEKTIE\SL\SL1" D S4^KPSELJ G 21
23 G 21:X1[D,21:X1?.E1C.E,YZ:X1="-",25:X1="",21:X1'?.N!('X1)!($L(X1)>6)
24 I $D(@("^"_Q_"SL1(Q1,X1)")) X ^cTXT(0,"N",12) R K G 21
25 S FP=2303+F60,K=$P($T(T6),U,2) W @F,@F1,K S FP=FP+100 W @F,$P($T(T6),U,3) S FP=FP-100+$L(K)
26 W @F,PNT,@F2,@F,@F0 R X2 W @F2 G 26:X2[D,26:X2?.E1C.E,21:X2="-",26:$L(X2)>40!'$L(X2)
27 G 29:$L(X1) L @("^"_Q_"SL(0,Q1,1)") S X1=@("^"_Q_"SL(0,Q1,1)")
28 I $D(@("^"_Q_"SL1(Q1,X1)")) S X1=X1+1 G 28
280 S @("^"_Q_"SL(0,Q1,1)")=X1+1
29 L @("^"_Q_"SL1(Q1,X1)")
 ;
3 S I2=$$UPTRIMAN^vhRtn1(X2)
31 S I2=I2_" "_X1
32 S FP=2203+F60 W @F,@F1 S FP=455 W @F,@F2,$P($T(T1),U,2),X1 S FP=555 W @F,@F2,$E(X2,1,25)
33 I SW4=1 S SW2=1 G 358
34 K B F I=1:1:SW3 S B(I)="\\\\\\\\\\\\\\\\\\\\\\\\\"
35 S FP=2103+F60,K=$P($T(T3),U,2) W @F,@F1,!?2,K,!?2,$P($T(T3),U,3) W:SWK $P($T(T3),U,5) W:SWK!(SWL) !?2 W $P($T(T3),U,6) W:SWL $P($T(T3),U,4) S FP=FP+100+$L(K)
350 W @F,".",@F2,@F,@F0 R U4 S U4=$S(U4=5:"L",U4=6:"K",1:U4) G 36:U4="-" S:U4="K" U4=SWK S:U4="L" U4=SWL
352 G 354:U4=SWK,354:U4=SWL,350:U4'?1N,350:'U4!(U4>SW4)
354 S FP=2103+F60 W @F,@F1 S FP=355 W @F,$P($T(T4),U,2),@F2 W:U4'>SW4 U4 W:U4>SW4 $P($T(T7),U,(U4=SWL)+2)
358 D ^KPSELG,@("^KPSEL"_$S(SW2>SW4:"N",1:"D")) G 35
36 G 39:$N(B(100))=-1 S @%Q1=0,@("^"_Q_"SL1(Q1,X1)")=I2,@("^"_Q_"SL(Q1,I2,0)")=X1_D_X2_D
37 S I=0 F X=1:1 S I=$N(B(I)) Q:I=-1  S ^(I)=B(I)
38 S @%Q1=1
39 S SW5=1 G 2:SW4>1 S FP=455 W @F,@F2 S FP=555 W @F,@F2 G 2
 ;
YZ Q
 ;