KPVE4 G 1 ;VOORRAADEVOLUTIE ;(VOLGENS LEVERANCIER);KPVE1;Go van KPVE1 - Do naar KPSELS, KPVE5 [ 08/05/2002  10:26 AM ]
 ;
S1 F I2=I2,I2+.1 S $P(A(I2),D,26)=D I $D(^("P"_I2)) S A(I2)=^("P"_I2)
S1Z Q
 ;
1 I KPS="P" S BLZ=0,LN=99,R=72 D:AWK<18 ^KFOLE S I=100 G 19:$N(B(I))=-1 D HD,^KPSELS G 19
11 W @F11,@F1 S SF=F,VHD=100
13 I AWK>17 W *27,"[?3h" S SF=$P(F,"\100",1)_"\1000"_$P(F,"\100",2),SF=$P(SF,"#100",1)_"#1000"_$P(SF,"#100",2),VHD=1000
19 S Q0="^"_Q_"PR(PR,0)",Q1="^"_Q_"LE(LE)",Q2="^"_Q_"PL(LES)",Q3="^"_Q_"HULP($J,PRCS)"
23 I LE'=0 S X=$D(@Q1) G 27:X
25 S LE=$N(@Q1) I LE=-1!(LE]LEX) G 151
27 S LES=$P(LE," ",2)_" ",LNM=$P(^(LE,0),D,2),X=$D(@Q2) G 25:'X D S9
29 S PRCS=PRC I PRC'=0 S X=$D(@Q3) G 100:X
31 S PRCS=$N(@Q3) I PRCS=-1!(PRCS]PRCX) G 25
100 S PR=+^(PRCS) D ^KPCHKPR G 31:'OK
111 S PST=$P(A(0),D,14),PC=$P(A(0),D,1),PID=$P(A(2),D,25),PBW=$P(A(1),D,17),POL=$P(A(2),D,24),PLT=$P(A("J"),D,7)
115 K A S (PBL,X)=0,I2=DJ D S1 F I=WK:1:WK+AWK-1 S A(I)=-$P(A(DJ)_A(DJ+.1),D,I),X=X+1 S:X'>PSP PBL=PBL-A(I) Q:I=52
117 I WK+AWK>53 S I2=DJ+1 D S1 F I=1:1:AWK-(53-WK) S A(I)=-$P(A(DJ+1)_A(DJ+1.1),D,I),X=X+1 S:X'>PSP PBL=PBL-A(I)
119 S I2="W"
121 S I2=$N(^(I2)) G 129:$E(I2,1)'="W" S K=^(I2) I $E(I2,9)="T" S K=$P(K,D,5,6)
123 S I=$TR($$CONVDATE^vhDTyp($P(K,D,2),"DW","DW4"),"/","")
 G 121:I'<LWK S:I<BWK I=BWK S I=$E(I,5,6) I $E(I2,9)="T" S A(I)=A(I)+K
125 E  S A(I)=A(I)-K
127 G 121
129 S TOT=PST,(MAX,MIN)=0 F I=WK:1:WK+AWK-1 S (A(I),TOT)=A(I)+TOT S:TOT>MAX MAX=TOT S:TOT<MIN MIN=TOT Q:I=52
131 I WK+AWK>53 F I=1:1:AWK-(53-WK) S (A(I),TOT)=A(I)+TOT S:TOT>MAX MAX=TOT S:TOT<MIN MIN=TOT
132 I KEX,MAX<PBL,MIN>POL G 31
133 S:MAX<10&(MIN=0) MAX=10 K C F I=0:1:20 S K=MAX-MIN/20,C(I+1)=MIN+(K*I)
134 S R=0 G 141:MAX=0,141:MIN=0,137:MAX<-MIN F K=1:2 Q:C(K)'<0
135 F I=K:1:21 S C(K+R)=MAX/(21-K)+.99999\1*R,C(K-R)=-MAX/(21-K)-.99999\1*R,R=R+1
136 G 141
137 F K=21:-2 Q:C(K)<0
139 F I=K:-1:1 S C(K-R)=MIN/(K-1)-.99999\1*R,C(K+R)=-MIN/(K-1)+.99999\1*R,R=R+1
 ;
141 I $L(KPS) S LN=LN+1+KOZ I LN>2 W:BLZ # D HD G 141
143 D ^KPVE5 I '$L(KPS),K="E" G 151
145 G 31
 ;
151 I KPS="P" S R=66 D:AWK<18 ^KFOLE D CLOSE^vhPRINTER K @("^"_Q_"HULP($J)")
153 I KPS="",AWK>17 W *27,"[?3l"
 ;
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0 W !,QN,?72+(AWK>17*53),$P($T(T2),U,2),$J(BLZ,4)
HDA W !,NM2,?30 W:AWK>17 @F82 W $P($T(+1),U,2) W:AWK>17 @F83,$C(13),?63 W $P($T(+1),U,3),?72+(AWK>17*53),DT
HDB W !,NM3,?73+(AWK>17*53),TD,!! I BLZ>1!($N(B(100))=-1) W LNM
HDZ Q
 ;
S9 K @("^"_Q_"HULP($J)") S SL=LES,SM=0,S1="^"_Q_"PL(SL,SM)",S2="^"_Q_"PL(SL,SM,SR)",S3="^"_Q_"PL(SL,SM,SR,SP)"
S9A S SM=$N(@S1) G S9Z:SM=-1 S SR=0
S9B S SR=$N(@S2) G S9A:SR=-1 S SP=0
S9C S SP=$N(@S3) G S9B:SP=-1 S R=+^(SP),@("^"_Q_"HULP($J,SP)")=R G S9C
S9Z K SL,SM,SR,SP,S1,S2,S3,R Q
 ;