KPSBW ;STOCKBEHEER (TONEN WEEKGEGEVENS) ;KPSB ; [ 08/05/2002   4:54 PM ]
 G 1
 ;
T1 ;Dit produkt is niet van de leverancier in behandeling
T2 ;Dit produkt is niet opgenomen in de selektie
T3 ;  [] = ok 
 ;
S1 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
S1A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) Q:R6'>R5  S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
S1B S:$P(R,D,5) R3="*" W ?$P(R,D,3),$J(R0,R1),R4,R3
S1Z K R0,R1,R2,R3,R4,R5,R6 Q
 ;
S2 SET FP=(7-SOffset+I)_"01" WRITE @F WRITE:I=SSelect @F92 I I>SMax W @F2,@F93 Q
S21 SET R=$P(PAR(2),D,I),R=$E(R,1,2)_"/"_$E(R,3,4) WRITE $C(13),$J(R,6),?7,"|" SET R=$P(B(5),D,I)_"\10" D S1
S22 WRITE ?19,"|" SET R=$P(B(4),D,I)_"\10\\\"_$P(B(7),D,I) D S3 WRITE ?31,"|"
S23 S R=$P(B(3),D,I)_"\10\\\"_$P(B(6),D,I) W:$E($P(B(1),D,I),1)="B" @FMTK D S3 W @FMTk
S24 WRITE ?43,"| ",$S($L($P(B(1),D,I)):$E($P(B(1),D,I),1),1:$S(I=1:" ",1:"-"))," |" S R=$P(B(2),D,I)_"\10" D S3
	W " |" S R=$P($G(B(8)),D,I)_"\10" D S3 
	WRITE @F93
S25 Q
 ;
S3 I +R D S1
S3A E  W $J("",11)
S3Z Q
 ;
S4 I SCHTYP="O" S SCHTYP="",K="O" D ^KPSBZ G S4C
S4A I SCHTYP="T" S K="T" D ^KPSBZ G S4C
S4B S K="!"
S4C S:K K=$C(K)
S4Z Q
 ;
S7 S B=$P(B(0),D,1),$P(B,U,2)="*",$P(B(0),D,1)=B
S7Z Q
 ;
S8 S FP=813 W @FSC
S8Z Q
 ;
S9 S FP=124 W @FSC
S9Z Q
 ;
 ; selectie naar boven bewegen, eventueel lijst naar beneden bewegen
SUP IF SSelect=1 WRITE @F0 Q
 SET I=SSelect,SSelect=SSelect-1 DO S2 ;Weghalen van bold
 IF SSelect=SOffset SET SOffset=SOffset-1,FP=(7+1)_"01" WRITE @F,@FIN
 SET I=SSelect DO S2
 Q
 ;
 ; selectie naar beneden bewegen, eventueel lijst naar boven bewegen
SDN IF SSelect'<SMax WRITE @F0 Q
 SET I=SSelect,SSelect=SSelect+1 DO S2 ;Weghalen van bold
 IF SSelect=(SOffset+13-6) SET SOffset=SOffset+1,FP=(7+1)_"01" WRITE @F,@FDL
 SET I=SSelect DO S2
 Q
 ;
1 G 21:K="("!(K=")") D ^KPSBW1
11 I LC'=LCX D M1 G 2
13 I LC'=LCX!'$D(@Q0) D M2
 ;
2 D IK^KPSBY
21 I K="I" D INFO^KPSB G 2
 I K="W" D WEEK^KPSB(PR) G 2
 I K="(" D S8,SUP,S9,S4 G 21
23 I K=")" D S8,SDN,S9,S4 G 21
25 I SCHTYP="T" G 2:"ABE<>KLDUT?POSHNWV-()"'[K
26 E  G 2:"ABE<>KLDUT?POSHN-()"'[K
27 I SCHTYP="S",K="L" S SCHTYP=""
28 I SCHTYP="P" G 2:"BE<>DU"[K
29 S SKIPT=0
 ;
3 G 4:LC'=LCX,4:SCHTYP="P" S HGSS=HGS G 35:SCHTYP'="P",4:'$D(@Q0) S HGS=$P(^(PR),D,2) G 35:Q1'["HULP"
31 S VSB=HGS I '$D(^HULP($J,0,PR)) S B(0)=@("^"_Q_"PSB(LC,VSB,0)") D S7 G 37
33 S HGS=^(PR)
35 S B(0)=@Q3 D S7 F I=0,1 S ^(I)=B(I)
37 I VSB S @("^"_Q_"PSB(LC,VSB,0)")=B(0),^(1)=B(1)
39 S HGS=HGSS
 ;
4 S PRX=PR
 ;
YZ Q
 ;
M1 S K=$P($T(T1),U,2) G MY
M2 S K=$P($T(T2),U,2) G MY
MY S FP=2403 W @F,@F1,@F4,K,$P($T(T3),U,2),@F5,@F0 R K S FP=2401 W @F,@F1
MZ Q
 ;
Z X ^cZ Q
ZZ ; 24.05.91 - 13 u 49