KPWS1 G 1 ;TRANSFERT PRODUKTEN WEEKOMZET ;Go naar KPWS2, KPWS3, KPWS4 [ 08/05/2002  10:25 AM ]
 ;
T1 ;OK VOOR BEGIN TRANSFERT
T2 ;[] = ok   ,[] = hernemen
T3 ;VANAF WEEK :
T4 ;TOT WEEK   :
T5 ;EERSTE TE TRANSFEREREN WEEK
T6 ;LAATSTE TE TRANSFEREREN WEEK
T7 ;onder de vorm jjjj.ww
T8 ;onder de vorm jjjj.mm   I[[] = idem als vorige   .[] = tot het einde
T9 ;VANAF HET BEGIN
T10 ;TOT HET EINDE
T11 ;OK VOOR EINDE TRANSFERT
T12 ;[] = ok
 ;
1 S K=$P($T(+1),";",2)_QN_" " S FP=203+$L(K) W @F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 S DOC=$P($T(+1),";",2),LSTX="KLPB"
13 S SELK=1 D PP^KPSEL I K="-" K @("^"_Q_"PSEL($J)") G YZ
15 S %WK=$$EXTDATE^vhDTyp(,"W")
 ;
2 S FP=2001 W @F,$C(13),?2,$P($T(T3),U,2),!?2,$P($T(T4),U,2)
21 S R="BWK\23\3\"_$P($T(T5),U,2)_"\"""_$P($T(T7),U,2)_"""\7\\""-""[K&($L(K)=1)!(K?4N1"".""2N&($P(K,""."",2)<54))"
23 D R0 G 11:K="-" S FP=2016 W @F,@F2,K
25 S R="EWK\23\3\"_$P($T(T6),U,2)_"\"""_$P($T(T8),U,2)_"""\7\\"".-I""[K&($L(K)=1)!(K?4N1"".""2N&($P(K,""."",2)<54))"
27 D R0 G 21:K="-" I K="I" G 25:BWK=1000.01 S (EWK,K)=BWK
28 S:K="." (EWK,K)=DJ_"."_%WK G 25:BWK>EWK S FP=2116 W @F,@F2,K
29 S R="K\23\3\"_$P($T(T1),U,2)_"\"""_$P($T(T2),U,2)_"""\1\\""-,""[K\\\" D R0 G 13:K=",",25:K="-"
 ;
3 S BWK=$J(BWK-.01,0,2)_" ",EWK=EWK_" " K DOC,LSTX,SELK D @("^KPWS"_$F("PKLB",LST))
 ;
4 S R="K\23\3\"_$P($T(T11),U,2)_"\"""_$P($T(T12),U,2)_"""\1\\K=""""" D R0
 ;
YZ Q
 ;
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))," ",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 S:$P(R,D,7)="DCTR" RD=$P(K,".",1),RM=$P(K,".",2),RJ=$P(K,".",3) W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K G R0F
R0E G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$E("                                        ",1,R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,RD,RM,RJ Q
 ;
 Q
Z X ^cZ Q
ZZ ; 02.08.88 -  8 u 15