KPSELA G 1 ;RAADPLEGEN - WIJZIGEN SELEKTIES VOOR LISTINGS (bepalen scherm + tonen rubrieken) ;KPSEL;Do van KPSELB [ 01/28/2003  4:01 PM ]
 ;
T1 ;SELEKTIE 
T2 ;ER BESTAAN ;SCHERMEN.
T3 ;WELK SCHERM : ;x[] = Scherm 1-7    ;-[] = einde programma   ;6[] = klassifikatie   ;5[] = leverancier   ;N[] = naam of nummer selektie   
T4 ;SCHERM 
T5 ;KLASSIF.;LEVERANC.
 ;
 ;
S2 S U2=A(U1) K K,U3 G S2B:'$D(B($S(SW2>SW4:$P("I\J",D,(SW2=SWL)+1),1:"")_$P(U2,U,16))) S (K,U3)=$P(B($S(SW2>SW4:$P("I\J",D,(SW2=SWL)+1),1:"")_$P(U2,U,16)),D,1),KT=$P(B($S(SW2>SW4:$P("I\J",D,(SW2=SWL)+1),1:"")_$P(U2,U,16)),D,2)
S2A S KD=$P(B($S(SW2>SW4:$P("I\J",D,(SW2=SWL)+1),1:"")_$P(U2,U,16)),D,3) S:KT>6 U3=$E(PNT,1,$P(KD,",",1)-1)_K_$E(PNT,1,$P(U2,U,9)-$P(KD,",",2)) I $L($P(U2,U,8)),KT<7 X "S U3="_$P(U2,U,8)
S2B S FP=$P(U2,U,5)*100+$P(U2,U,6) I '$P(U2,U,23) S FP=FP-3 W @F,@F9,": "
S2C I SW5 S FP=$P(U2,U,2)*100+$P(U2,U,3) W:$P(U2,U,22) @F,$J(U1#100,2) I '$P(U2,U,23) S FP=FP+2 W @F,@F6,$P(U2,U,1),@F9
S2D S FP=$P(U2,U,5)*100+$P(U2,U,6)
S2E W:'SW5 @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
S2F S:$D(U3) FP=FP-2 W @F W:$D(U3) $P("> \>=\= \< \<=\<>\x=\x=",D,$P(B($S(SW2>SW4:$P("I\J",D,(SW2=SWL)+1),1:"")_$P(U2,U,16)),D,2)),U3 W:'$D(U3) $E(PNT,1,$P(U2,U,9))
S2Z Q
 ;
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=100 D S1 G 23
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) G 35
 ;
21 S SW5=0
23 S R="K\2000\DE SELEKTIE\SL\SL1" D S4^KPSELI I K="-" G 35:SW4>1,YZ
24 S I2=K,X1=$P(^(I2,0),D,1),X2=$P(^(0),D,2),FP=455 W @F,@F2,$P($T(T1),U,2),X1 S FP=555 W @F,@F2,$E(X2,1,25)
25 K B F I=1:1:SW3 S $P(B(I),D,25)=D I $D(^(I)) S B(I)=^(I)
26 S I=0 F X=1:1 S I=$N(^(I)) Q:I=-1  S B(I)=^(I)
27 I SW4>1 S U1=101 D S2 S U1=102 D S2 G 41
28 I WIJZ L @("^"_Q_"SL1(Q1,X1)"):2 E  S FP=2403+F60 W @F,@F4,$P($T(T1),U,2),X1," IS IN GEBRUIK  [] = ok ",@F5,@F2,@F0 R K G 23
29 S U1=$N(A(U1)) I U1>0 D S2 G 29
31 D:WIJZ ^KPSELB G 21
 ;
35 S FP=2203+F60,K=$P($T(T3),U,2) W @F,@F1,K,!?2,$P($T(T3),U,3) W:SWK $P($T(T3),U,5)
36 W:WIJZ!(SWK)!(SWL) !?2 W $P($T(T3),U,6) W $P($T(T3),U,4) W:WIJZ $P($T(T3),U,7) S FP=FP+$L(K)
37 W @F,".",@F2,@F,@F0 R U4 S U4=$S(U4=5:"L",U4=6:"K",1:U4) G YZ:U4="-"
38 I WIJZ,U4="N" S SW2=U4 D S3,^KPSELP G 23:SW4=1,35:SW5 S SW5=1,U1=101 D S2 S U1=102 D S2 S SW5=0 G 35
39 G 40:U4="K"&SWK,40:U4="L"&SWL,37:U4'?1N,37:'U4!(U4>SW4)
40 S FP=2103+F60 W @F,@F1 S FP=355 W @F,@F2,$P($T(T4),U,2),$S(U4?.N:U4,1:$P($T(T5),U,(U4="L")+2)) S:U4'?.N U4=@("SW"_U4) G 23:SW5
41 I SW2'=U4!SW5 S SW2=U4,SW5=1,FP=601 W @F,@F1 D S3,S1
42 S U1=SW2*100+2 G 28
 ;
YZ K A,B Q
 ;
S1 S Y=$D(@("^"_Q_Q1_"(0,0)")),Y=SW2+1*100,(X,K)=SW2*100,K=SW2>1*2+K
S1A S X=$N(^(X)) I X>0,X<Y S K=K+1,A(K)=^(X) G S1A
S1Z Q
 ;
S3 S X=102
S3A S X=$N(A(X)) I X>0 K A(X) G S3A
S3Z Q
 ;