KPBHV2 G 1 ;BESTELHOEVEELHEID ;Go naar KPBHV1 [ 08/05/2002  11:56 AM ]
 ;
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
 ;
1 I KID D HD S (TWHP,TWTS,TWHM,TWAT)=0
3 I $L(H) S HX=H G 7
5 S (H,HX)=$N(@("^"_Q_"PH(H)")) G 45:H=-1!($L(HH)&(H]HH)),9
7 I $L(G) S GX=G G 11
9 S (G,GX)=$N(@("^"_Q_"PH(H,G)")) G 13:'(G=-1!($L(GG)&(G]GG))) G 5
11 I $L(S) S SX=S G 15
13 S (S,SX)=$N(@("^"_Q_"PH(H,G,S)")) G 9:S=-1!($L(SS)&(S]SS)),17
15 I $L(M) S MX=M G 19
17 S SWP=0,(M,MX)=$N(@("^"_Q_"PH(H,G,S,M)")) G 13:M=-1!($L(MM)&(M]MM)),19
19 S P=$N(@("^"_Q_"PH(H,G,S,M,P)")) I P=-1 G 17:'SWP,17:'KID S LN=LN+1 W !,$P($T(T2),U,2) G 17
21 S PR=+^(P),X=@("^"_Q_"PR(PR,1)") G 19:'$P(X,D,20) S PGW=$P(X,D,21)
22 S X=^(0),PC=$P(X,D,1),PQR=$P(X,D,22),X=^(2),PNR=$P(X,D,25)
23 S (PLQ,PGV)=0,X=$N(^("J")) S:$E(X,1)="J" X=^(X) S PLQ=$P(X,D,6),PGV=$P(X,D,16)
25 S PQ=PGW*PQW
33 I 'KID G 19:$E(PQR,$L(PQR))="*"!(PQ=PQR)!($E(PQR,1)="#"),43
35 S LN=LN+2 I LN>50 W:SWP !,$P($T(T2),U,2) W # D HD G 35
37 W !,$P($T(T3),U,2),$C(13),?2,$J($E(PNR,1,11),11),?16,PC S R=PQ_"\7\43\0" D:+R&(+R'=PQR) R3 S R=+PQR_"\7\52\0" D:+R R3
38 W:$E(PQR,$L(PQR))="*" $C(13),?59,"*" I $L(PGW) S R=PGW_"\7\61\0" D:PGW'="-0"&(PGW'="-@") R3 W:PGW="-0"!(PGW="-@") $C(13),?67,$E(PGW,2),"-"
39 W:$E(PGW,$L(PGW))="*" $C(13),?68,"*" S R=(PGW*PQW)_"\7\70\0" D:+R R3
40 S R=PLQ_"\7\79\0" D:+R R3 S R=PGV_"\6\88\0" D:+R R3 W:$E(PQR,1)="#" $C(13),?94,"#"
41 W !,$P($T(T3),U,2) S SWP=1 G 19
43 S FP=2303 W @F,@F2,PNR,"   ",PC S X=@("^"_Q_"PR(PR,0)"),X=$P(X,D,1,21)_D_PQ_D_$P(X,D,23,99),^(0)=X G 19
45 G 47:'KID W # D CLOSE^vhPRINTER
47 G 1^KPBHV1
YZ Q
 ;
HD S BLZ=BLZ+1,LN=0 W !,NM1,?88,"BLZ:",$J(BLZ,4),!,NM2,?28,@F82,$P($T(KPBHV2),";",2),@F83,$C(13),?65,"(INGEVULD : ",IDT,")",?88,DT
HD1 W !,NM3,?28,"OP BASIS VAN ",PQW," X PRAKTISCHE WEEKVERKOOP"
HD2 W ?89,TD,!!,$P($T(T2),U,2),!,$P($T(T1),U,2),PQW,$P($T(T1),U,3),!,$P($T(T2),U,2)
HDZ Q
 ;
T1 ;: IDENTNUMMER : PRODUKTNAAM               : TEO-BH : PRA-BH : PRA-WV : MAAL ; : MIN-BH : GR-VP :
T2 ;:-------------:---------------------------:--------:--------:--------:--------:--------:-------:
T3 ;:             :                           :        :        :        :        :        :       :
 ;