KPVE3 G 1 ;VOORRAADEVOLUTIE ;(VOLGENS KLASSIFIKATIE);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_"PH(HG)",Q2="^"_Q_"PH(HG,GRS)",Q3="^"_Q_"PH(HG,GRS,SGS)",Q4="^"_Q_"PH(HG,GRS,SGS,MK,PRCS)"
22 F I="HG","GR","SG" S @("EX"_$E(I,1))=$P(@("^"_Q_"PR(0,I)"),D,5)
23 I HG'=0 S X=$D(@Q1) G 27:X
25 S HG=$N(@Q1) I HG=-1!(HG]HGX) G 151
27 S GRS=GR I GR'=0 S X=$D(@Q2) G 31:X
29 S GRS=$N(@Q2) I GRS=-1!(GRS]GRX) G 25
31 S SGS=SG I SG'=0 S X=$D(@Q3) G 35:X
33 S SGS=$N(@Q3) I SGS=-1!(SGS]SGX) G 29
35 S PRCS=PRC I PRC'=0 S X=$D(@Q4) G 100:X
37 S PRCS=$N(@Q4) I PRCS=-1!(PRCS]PRCX) G 33
100 S PR=+^(PRCS) D ^KPCHKPR G 37:'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^vhLib.DataTypes($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 37
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 37
 ;
151 I KPS="P" S R=66 D:AWK<18 ^KFOLE D CLOSE^vhPRINTER
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 $E(HG,EXH,99) W:GR=GRX "- ",$E(GR,EXG,99) W:SG=SGX "- ",$E(SG,EXS,99)
HDZ Q
 ;