KPPIP3 G 1 ;INTERNE PREVISIES ;(VOLGENS KLASSIFIKATIE);KPPIP1;Go van KPPIP1 - Do naar KPSELS [ 11/29/2003   1:16 PM ]
 ;
T1 ;BLZ:
T2 ;:---------------------------------------------------------------------------:
T3 ;:
T4 ;:------------------:------------------:------------------:------------------:
T6 ;IDENTNUMMER : 
T7 ;PRODUKTKODE : 
T8 ; -
 ;
S1 F I2=I2,I2+.1 S $P(A(I2),D,26)=D I $D(^("P"_I2)) S A(I2)=^("P"_I2)
S1Z Q
 ;
R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D,1),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
R3A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) G R3B:R6'>R5 S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
R3B W ?$P(R,D,3),$J(R0,R1),R4,R3
R3Z K R0,R1,R2,R3,R4,R5,R6 Q  ;V1 26.11.84
 ;
1 S BLZ=0,R=72 D ^KFOLE S I=100 G 19:$N(B(I))=-1 D HD,^KPSELS
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)"
21 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 160
27 D HD S GRS=GR I GR'=0 S X=$D(@Q2) G 31:X
29 S GRS=$N(@Q2) I GRS=-1!(GRS]GRX) W # 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 LT=0,LN=LN+3+(AWK+3\4) I LN>59 W # D HD G 111
112 W !?3,$P($T(T3),U,2),?5,$P($T(T6),U,2),$P(A(2),D,25),?79,$P($T(T3),U,2)
113 W !?3,$P($T(T3),U,2),?5,$P($T(T7),U,2),$P(A(0),D,1),?79,$P($T(T3),U,2),!?3,$P($T(T4),U,2)
115 K A S I2=BJR D S1 F I=BWK:1:BWK+AWK-1 S A(I)=$P(A(BJR)_A(BJR+.1),D,I) Q:I=52
117 I BWK+AWK>53 S I2=BJR+1 D S1 F I=1:1:AWK-(53-BWK) S A(I)=$P(A(BJR+1)_A(BJR+1.1),D,I)
119 S LT=LT+1 G 150:LT=14 S I=0
121 S A=BWK+LT+(I*13)-1,K=$E(BJR,3,4) S:A>52 A=A-52,K=K+1 I '$D(A(A)),I=0 G 150
123 W:'I ! W ?3+(I*19),$P($T(T3),U,2) I $D(A(A)) W " ",K,$J(A,3),$P($T(T8),U,2) S R=A(A)_D_9_D_(12+(I*19)) D:+R R3
125 S I=I+1 G 121:I<4 W ?79,$P($T(T3),U,2) G 119
150 W !?3,$P($T(T4),U,2) G 37
160 S R=$P(^cLOG(boot,"DEV",$$DEV^vhPRINTER($I,1)),D,11) S:'R R=66 D ^KFOLE D CLOSE^vhPRINTER
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0 W !?3,QN,?72,$P($T(T1),U,2),$J(BLZ,4),!?3,NM2 F X=1:1:3 W $C(13),?38,$P($T(+1),U,2)
HDA W ?72,DT,!?3,NM3,?73,TD,!!
HDB I BLZ>1!($N(B(100))=-1) W ?3,$E(HG,EXH,99) W:GR=GRX "- ",$E(GR,EXG,99) W:SG=SGX "- ",$E(SG,EXS,99) W !!?3,$P($T(T2),U,2)
HDZ Q
 ;