KPBAB2 G 1 ;OPMAKEN BESTELSUGGESTIES ;KPBAB2; Quit naar KPBAB1 [ 11/06/2001  9:47 AM ]
 ;
S2 S @S=$$ROUND^KPRIJS(@S) Q
 ;
1 S AGV=0 S:$D(@("^"_Q_"STPR(0,0,6)")) AGV=+^(6) S Y=@("^"_Q_"PR(0,0)"),Y="A",VNR=0,FP=401 W @F,@F1 K TAB
3 S Y=$N(^(Y)) I Y'=-1 S @Y=^(Y) G 3
5 S SWP=1 D ^cPE81 G 43:K="-",9:'$D(@("^"_Q_"WBAT(0)"))
7 S R="K\22\3\DE EERDER OPGEMAAKTE BESTELSUGGESTIES WORDEN VERWIJDERD\""O[] = opmaken nieuwe bestelsuggesties   -[] = hernemen""\1\\""-O""[K&$L(K)" D R0 G 43:K="-"
9 K @("^"_Q_"WBAT") S FP=501 W @F,@F1 S FP=2403 W @F,@F4,"OPMAKEN BESTELSUGGESTIES ",@F5
11 I $L(H) S HX=H G 15
13 S (H,HX)=$N(@("^"_Q_"PH(H)")) G 45:H=-1!($L(HH)&(H]HH)),17
15 I $L(G) S GX=G G 19
17 S (G,GX)=$N(@("^"_Q_"PH(H,G)")) G 21:'(G=-1!($L(GG)&(G]GG))),13
19 I $L(S) S SX=S G 23
21 S (S,SX)=$N(@("^"_Q_"PH(H,G,S)")) G 17:S=-1!($L(SS)&(S]SS)),25
23 I $L(M) S MX=M G 27
25 S (M,MX)=$N(@("^"_Q_"PH(H,G,S,M)")) G 21:M=-1!($L(MM)&(M]MM)),27
27 S P=$N(@("^"_Q_"PH(H,G,S,M,P)")) G 25:P=-1
29 S PR=+^(P),X=@("^"_Q_"PR(PR,1)"),PBW=$P(X,D,17),PSN=$P(X,D,20),PGW=+$P(X,D,21) G 27:'PSN
31 S X=^(0),PC=$P(X,D,1),PST=$P(X,D,14),PY=$P(X,D,17),PQ=$P(X,D,22),X=^(2),PRE=$P(X,D,9),PNR=$P(X,D,25),PSUG=0
33 S X=" \ \ " S:$E($N(^("J")),1)="J" X=^($N(^("J"))) S LEV=$P(X,D,1),(PLQ,PSUG)=$P(X,D,6),PLL=$P(X,D,7),PGV=$P(X,D,16)
35 S PCPL=$P(X,D,23),PHBP=PBW+PLL*PGW,AGVS=AGV S:$E(PQ,1)="#" AGVS=$P(PQ,"#",2) S:PHBP<(AGVS*PGV) PHBP=AGVS*PGV
36 G 27:PHBP<(PST+PY-PRE) S VNR=VNR+1,PTST=PST+$P(PY,"#",2)-$P(PRE,"#",2),FP=2303 W @F,@F2,PNR,"   ",PC
37 S SR="PCPL" D S2 I PSUG<(PQ+PHBP-PTST) S PSUG=PQ+PHBP-PTST I PGV,PSUG#PGV S PSUG=PSUG+(PGV-(PSUG#PGV))
 ;S SR="PCPL" D S2 S:PQ>PSUG PSUG=PQ
38 ;I (PSUG+PTST)'>PHBP S PSUG=PSUG+PGV G 38:PGV
39 S @("^"_Q_"WBAT(VNR)")=PSUG_"#"_PSUG_D_PGV_D_PLQ_D_PTST_D_PHBP_D_PLL_D_PBW_D_PGW_D_PC_D_PNR_D_LEV_D_H_D_G_D_S_D_P_D_PR_D_PCPL_D_PQ_D
41 G 27
43 S FP=501 W @F,@F1
45 I $N(@("^"_Q_"WBAT(0)"))'=-1 S ^(0)=DT_D_TD_D
 ;
YZ K Y,VNR,SWP,H,HH,HX,G,GG,GX,S,SS,SX,M,MM,MX,P,PR,PBW,PSN,PGW,X,PC,PST,PY,PRE,PNR,PSUG,LEV,PQ,PLQ,PLL,PGV,PCPLPHBP,SR Q
 ;
R0 S R7="K'[D&(K'?.E1C.E)" 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 W $E("........................................",1,R6),@F,@F0
R0D R K S:$P(R,D,7)="DCTR" RD=$P(K,".",1),RM=$P(K,".",2),RJ=$P(K,".",3) W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K G R0F
R0E G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$E("                                        ",1,R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7,RD,RM,RJ Q
 ;
 Q
Z X ^cZ Q
ZZ ; 08.06.88 - 10 u 10