KPBPP ;BEHEER PREVISIE-PATRONEN ;KPBPP; [ 08/05/2002  11:56 AM ]
 G 1
 ;
T1 ;KODE PATROON
T2 ;OMSCHRIJVING
T3 ;WEEK
T4 ;xxxxx[] = openen kode   [] = overzicht kode's   -[] = einde programma
T5 ;PATROONKODE
T6 ;WEEKNUMMER
T7 ;A[] = alle   O[] = omschrijving   xx-yy[] = week xx tot yy bep. faktor
T8 ;K[] = kode   V[] = verwijderen
T9 ;,[] = hernemen   V[] = definitief verwijderen
T10 ;FAKTOR
T11 ; TOT 
T12 ;[] = 100
T13 ;   [] = vervolg
 ;
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(T7),U,2),!?2,$P($T(T8),U,2)
C1Z Q
 ;
S1 S SA=$P($T(T5),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(T13),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="K\22\3\"_$P($T(T2),U,2)_"\\25" D R0 I K'="-" S $P(B,D,2)=K,FP=518 W @F,@F2,K
S2Z Q
 ;
S3 F I=1,2 S FP=3+I*100+18 W @F,@F2
S3A F I=1:1:52 S X=I\13*20+13,FP=I#13 S:'FP FP=13,X=X-20 S FP=FP+6*100+X W @F,$J("",3)
S3Z Q
 ;
S4 S R="K\22\3\"_$P($T(T10),U,2)_" "_$P($T(T3),U,2)_" "_$P(WK,"-",1)
S4A S:$P(WK,"-",2) R=R_$P($T(T11),U,2)_$P(WK,"-",2) S R=R_"\"""_$P($T(T12),U,2)_"""\3\\K?.N!(""-""[K)" D R0 G S4Z:K="-"
S4B I WK?.N S WK=WK_"-"_WK
S4C F I=$P(WK,"-",1):1:$P(WK,"-",2) S $P(B,D,I+2)=K D S5
S4Z Q
 ;
S5 S X=I\13*20+13,FP=I#13 S:'FP FP=13,X=X-20 S FP=FP+6*100+X W @F,$J($S($L(K):K,1:100),3)
S5Z Q
 ;
1 S U=";",K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 F I=1,2 S K=$P($T(@("T"_I)),U,2),FP=3+I*100+15 W @F,@F5,":" S FP=3+I*100+2 W @F,@F6,K,@F5
13 S I=0
15 S I=I+1 G 2:I=53 S X=I\13*20+10,FP=I#13 S:'FP FP=13,X=X-20 S FP=FP+6*100+X W @F,@F5,":"
17 S FP=FP-8 W @F,@F6,$P($T(T3),U,2),$J(I,3),@F5 G 15
 ;
2 S R="K\22\3\"_$P($T(T1),U,2)_"\"""_$P($T(T4),U,2)_"""\5" D R0 G YZ:K="-" I K="" D S1 G 2:K="-"
21 L @("^"_Q_"PPP(K)"):2 E  S KKK=$P($T(T5),U,2)_" "_K X ^cTXT(0,"N",142) W @F5,@F2 R K K KKK G 2
23 S PKD=K,B="",$P(B,D,54)=D I '$D(@("^"_Q_"PPP(K)")) S $P(B,D,1)=K,FP=418 W @F,@F2,K D S2 G 2:K="-",27
25 S B=^(K) F I=1,2 S FP=3+I*100+18 W @F,$P(B,D,I)
27 F I=1:1:52 S K=$P(B,D,I+2) D S5
 ;
3 S R="WK\22\3\"_$P($T(T6),U,2)_"\C1\5\K1" D R0 I K="-" S @("^"_Q_"PPP(PKD)")=B D S3 G 2
31 I K="V" S R="K\22\3\"_$P($T(T9),U,2)_"\\1\\""-,V""[K" D R0 G 3:K'="V" K @("^"_Q_"PPP(PKD)") D S3 G 2
33 I K="O" D S2 G 3
35 G 5:K'="K" 
 ;
4 S R="K\22\3\"_$P($T(T1),U,2)_"\\5\\$L(K)" D R0 G 3:K="-"
41 G 3:K=$P(B,D,1) I $D(@("^"_Q_"PPP(K)")) X ^cTXT(0,"N",153) R K G 4
43 L @("^"_Q_"PPP(K)"):2 E  S KKK=$P($T(T5),U,2)_" "_K X ^cTXT(0,"N",142) W @F5,@F2 R K K KKK G 4
45 K ^(PKD) S PKD=K,$P(B,D,1)=K,FP=418 W @F,@F2,K G 3
 ;
5 I K'="A" D S4 G 3
51 F WK=1:1:52 D S4 I K="-" S WK=WK-2 Q:WK<0
53 G 3
 ;
YZ Q
 ;
K1 ;K?.N&K&(K<53)!(K?1N1"-"1N!(K?1N1"-"2N)!(K?2N1"-"2N)&($P(K,"-",2)>$P(K,"-",1))&($P(K,"-",2)<53)&$P(K,"-",1))!("-AKOV"[K&($L(K)=1))
 ;
Z X ^cZ Q
ZZ ; 11.03.88 - 10 u 10