KF32CC G 1 ;REGISTRATIE UITLEVERINGEN (DRUKKEN ORDERS CASH & CARRY) ;Do naar %F32 - Quit naar %F10 [ 04/09/2001  3:18 PM ]
 ;
M1 S MSG=UOU_" NIET GESLOTEN" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K
MZ K MSG Q
 ;
1 N KN,KN2,KA,KS,KP,KW,KT,KB
 S X=@("^"_Q_UGL_"(KC,US,UR,1)") I '$P(X,D,22) D M1 S K="-" G YZ
2 S Q20="@(UGL_""(UR)"")",URSV=UR,(FUR,LUR)=UR I $D(OD) S FUR=$O(OD("")),LUR=$O(OD(""),-1)
3 K UTA,UTB S SW13=""
 K @("^HBOU"_$J)
5 S SW37=0 S:$D(@("^"_Q_"BA(37)")) SW37=^(37) I 'SW37 F I=1:1:12 I $D(@("^"_Q_"BA(99,I)")) S @(Q_"BA(99,I)")=^(I)
11 D INIT^vhPRINTER(80) G 17:'$D(Print) F UR=FUR:1:LUR D SETBON,@(@("^"_Q_"UL(0,US,""UDOU"")"))
13 D CLOSE^vhPRINTER
17 F UR=FUR:1:LUR D KILLBON
 S UR=-1
19 S UR=$N(@("^HBOU"_$J_"(UR)")) G 21:UR=-1 K @("^"_Q_UGB_"(UR,US)") G 19
21 K @("^HBOU"_$J)
23 S UR=URSV
25 K UG,UC,UA,UE,UO,UEP,UK,UB,UN,UH,UGK,UF,UBE,UM,USP,UMC,URD,ULT,UZ,U26,U27,U28,U29,U30,U31,U32,U33,U34,U35
27 X @("^"_Q_"OD(0,US,1)"),^("UT"),^("UF") D ^KF12
 ;
YK K Q20,URSV,KK,KKT,KKTA,KLV,KX,KXA,KXWA,PCO,PNR,SW37,U2,UI,UJ,X,Y,TOP,KT1,HG,GR,SG,PCC,PDP
YK1 K U0,U1,U2,UO,KBN,KWL,TL,FUR,LUR,Q20,Z,@(Q_"BA(99)")
YZ Q
 ;
SETBON 
 S @("^"_Q_"U1(UR,US)")=KC_D,R=@("^"_Q_"OD(KC,US,URSV,1)"),R=UR_" - "_$P(R,D,2)_" - "_$P(R,D,3),R="\\\\"_R
 S $P(R,D,35)=D,$P(R,D,17)="KF5",@("^"_Q_"UL(KC,US,UR,101)")=R,I=""
 F  S I=$O(@("^"_Q_"OD(KC,US,URSV,I)")) Q:I=""  S R=^(I),@("^"_Q_"UL(KC,US,UR,I+(I>100))")=R
 Q
 ;
KILLBON 
 K @("^"_Q_"U1(UR,US)"),@("^"_Q_"UL(KC,US,UR)")
 Q
 ;
R0 S R7=1 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,$E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,K'[D&(K'?.E1C.E),@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V5 02.01.86
 ;