KPBIP3 ;SEQ. WIJZIGEN INTERNE PREVISIES PRODUKTEN;KPBIP1;Quit naar KPBIP2 [ 08/05/2002  11:56 AM ]
 G 1
 ;
T1 ;PATROONKODE
T2 ;   [] = vervolg
T3 ;WEEKNUMMER
T4 ;A[] = alle           [] = patroonkode     xx-yy[] = week xx tot yy bep. aantal
T5 ;-[] = vorig prod.   .[] = volgend prod.       I[] = idem als vorig prod.
T6 ;AANTAL
T7 ;WEEK
T8 ; TOT 
T9 ;per 
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_","_$P(R,D,8) S:$P(R,D,7)'="" R7=R7_","_$P($T(@$P(R,D,7)),U,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 W $E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,@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  ;V4 03.10.84
 ;
C1 W !?2,$P($T(T4),U,2),!?2,$P($T(T5),U,2)
C1Z Q
 ;
S1 S SA=$P($T(T1),U,2),S4=2101,S0=0,S8="^"_Q_"PPP(S2)",FP=S4 W @F,@F1
S1A S FP=2403+F60 W @F,SA W:S0 $P($T(T2),U,2) W " : ",@F1,@F0
S1B R K G S1A:K?.E1C.E!($L(K)>5) S:$L(K) S0=0 S FP=S4 W @F,@F1 G S1Z:K="-" I K="" S S1=S4 G S1H:S0
S1E S (S5,S6)=K S:S6="" S5=-1 S S1=S4,(S2,S3)=S5 G S1M:$D(@S8) S (S2,S3)=$N(@S8) G S1K:S2=-1 S S2=$N(^(S2))
S1F I $E(S2,1,$L(S6))'=S6&'S0&($E(S3,1,$L(S6))=S6) S S7=$D(^(S3)) G S1M
S1G S S2=S5
S1H S S2=$N(@S8) G S1K:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S1L:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S1A
S1I S FP=S1 W @F,$C(13),?3,S2,?10,$P(^(S2),D,2) S S1=S1+100 G S1H:S1<(2300+F60) S S0=1 G S1A
S1K X ^cTXT(0,"N",156) R K
S1L S (S2,S0)=0 G S1A
S1M S K=S3
S1Z K SA,S0,S1,S2,S3,S4,S5,S6,S7,S8 Q
 ;
S2 S R=I-BWK+1 S:R<1 R=53-BWK+I S X=R\13*20+13,FP=R#13 S:'FP FP=13,X=X-20 S FP=FP+6*100+X W @F,$J("",7),@F,K
S2Z Q
 ;
S3 S R="K\22\3\"_$P($T(T6),U,2)_" "_$P($T(T7),U,2)_" "_$P(WK,"-",1)
S3A S:$P(WK,"-",2) R=R_$P($T(T8),U,2)_$P(WK,"-",2) S R=R_"\"""_$P($T(T9),U,2)_PVP_"""\7\\K?.N&K!(""-""[K)" D R0
S3B G S3Z:K="-" D S6 I WK?.N S WK=WK_"-"_WK
S3C G S3E:$P(WK,"-",1)>$P(WK,"-",2) F I=$P(WK,"-",1):1:$P(WK,"-",2) D S4
S3D G S3Z
S3E F I=$P(WK,"-",1):1:52 D S4
S3F F I=1:1:$P(WK,"-",2) D S4
S3Z Q
 ;
S4 S:'K K="" I $D(B(I)) S B(I)=K D S2
S4Z Q
 ;
S5 S K=0 I TFA S K=$J(AN/TFA*$P(B,D,I+2),0,0) I K D S6
S5A S TOT=TOT+K
S5Z Q
 ;
S6 S:K#PVP K=K+PVP-(K#PVP)
S6Z Q
 ;
S7 S:'$L($P(B,D,I+2)) $P(B,D,I+2)=100 S TFA=TFA+$P(B,D,I+2)
S7Z Q
 ;
1 S R="WK\22\3\"_$P($T(T3),U,2)_"\C1\5\K1" D R0 G 2:K="I",YZ:K="-",YZ:K=".",3:K="A",4:K="",1:'$D(B(+K))
11 I $P(K,"-",2) G 1:'$D(B($P(K,"-",2)))
13 D S3 G 1
 ;
2 F I=BWK:1:BWK+AWK-1 S K=$P(A(BJR)_A(BJR+.1),D,I) D S6,S4 Q:I=52
21 I BWK+AWK>53 F I=1:1:AWK-(53-BWK) S K=$P(A(BJR+1)_A(BJR+1.1),D,I) D S6,S4
23 G 1
 ;
3 F WK=BWK:1:BWK+AWK-1 D S3 Q:+WK=52&(K'="-")  I K="-" S WK=WK-2 Q:WK<(BWK-1)
31 G 1:K="-"
33 I BWK+AWK>53 F WK=1:1:AWK-(53-BWK) D S3 I K="-" S WK=WK-2 Q:WK<0
35 G 1:K'="-" F WK=52:-1:BWK D S3 I K'="-" S WK=WK+2 Q:WK>53
37 G 1:K="-",33
 ;
4 D S1 G 1:K="-" S B=^(K),TFA=0 F I=BWK:1:BWK+AWK-1 D S7 Q:I=52
41 I BWK+AWK>53 F I=1:1:AWK-(53-BWK) D S7
43 S FP=2103+F60 W @F,$P(B,D,1),"  ",$P(B,D,2)
44 S R="K\22\3\"_$P($T(T6),U,2)_"\"""_$P($T(T9),U,2)_PVP_"""\8\\K?.N&K!(K=""-"")" D R0 G 4:K="-"
45 S FP=2101+F60 W @F,@F1 D S6 S AN=K,TOT=0 F I=BWK:1:BWK+AWK-1 D S5,S4 Q:I=52
47 I BWK+AWK>53 F I=1:1:AWK-(53-BWK) D S5,S4
48 I TOT'=AN S (K,B(I))=B(I)+(AN-TOT) D S2
49 G 1
 ;
YZ Q
 ;
K1 ;K?.N&K&(K<53)!(K?.N1"-".N&$P(K,"-",1)&$P(K,"-",2)&($P(K,"-",1)<53)&($P(K,"-",2)<53)&($P(K,"-",1)'=$P(K,"-",2)))!("-.A"[K&($L(K)<2))!(K="I"&$D(A))
 ;