KPBAB5 G 1 ;OPMAKEN DEFINITIEVE BESTELLINGEN ;KPBAB5; Quit naar KPBAB1 [ 08/05/2002  11:52 AM ]
 ;
1 S FP=403 W @F,@F1 K TAB
3 I '$D(@("^"_Q_"WBAT(0)")) S FP=2403 W @F,@F2,@F4,"BESTELSUGGESTIES NIET OPGEMAAKT  [] = ok ",@F5,@F0 R K G YZ
4 S X=^(0),ODT=$P(X,D,1),OTD=$P(X,D,2) W @F,"BESTELSUGGESTIES OPGEMAAKT : ",ODT,"   ",OTD
5 S R="K\22\3\TOELEVERINGEN OPMAKEN\C1\1\\""-T""[K&$L(K)\\\" D R0 G YZ:K="-" S %WK=$$EXTDATE^vhDTyp(,"W")
7 S VNR=0,FP=501 W @F,@F1 S FP=2403 W @F,@F4,"RANGSCHIKKEN BESTELSUGGESTIES ",@F5 K @("^"_Q_"WBAT1")
9 S VNR=$N(@("^"_Q_"WBAT(VNR)")) G 13:VNR=-1 S X=^(VNR),PSUG=+X,PC=$P(X,D,9),PNR=$P(X,D,10),FP=2303 W @F,@F2,PNR,"   ",PC
11 S LEV=$P(X,D,11),HG=$P(X,D,12),GR=$P(X,D,13),SG=$P(X,D,14),PCC=$P(X,D,15),PR=$P(X,D,16)
12 S @("^"_Q_"WBAT1(LEV,HG,GR,SG,PCC)")=PSUG_D_PR_D_PNR_D_PC_D G 9
13 S LEV=0,FP=2001 W @F,@F1,$C(13),?2,"TOELEVERING :",!?2,"LEVERANCIER :",!?2,"PRODUKT     :"
14 S FP=2403 W @F,@F2,@F4,"OPMAKEN TOELEVERINGEN ",@F5
15 S LEV=$N(@("^"_Q_"WBAT1(LEV)")) G 55:LEV=-1 S HG="" L (@("^"_Q_"WBAT"),@("^"_Q_"TO(0,""TR"")"))
 S TR=$$GETNUM^FLOW("KTO","KTO1")
17 S TZ=101,UVM="",FP=2017 W @F,@F2,TR
18 S LN=$P(@("^"_Q_"LE(@(""^""_Q_""L1(LEV)""),0)"),D,2),FP=2117 W @F,@F2,LEV,"   ",LN S TAB(TR)=LEV_D_LN
19 S HG=$N(@("^"_Q_"WBAT1(LEV,HG)")) G 51:HG=-1 S GR=""
21 S GR=$N(@("^"_Q_"WBAT1(LEV,HG,GR)")) G 19:GR=-1 S SG=""
23 S SG=$N(@("^"_Q_"WBAT1(LEV,HG,GR,SG)")) G 21:SG=-1 S PCC=""
25 S PCC=$N(@("^"_Q_"WBAT1(LEV,HG,GR,SG,PCC)")) G 23:PCC=-1 S X=^(PCC),PSUG=$P(X,D,1),PR=$P(X,D,2)
27 S PNR=$P(X,D,3),PC=$P(X,D,4),FP=2217 W @F,@F2,PNR,"   ",PC
29 L (@("^"_Q_"PR1(PCC)"),@("^"_Q_"PR(PR)"),@("^"_Q_"WBAT"),@("^"_Q_"TO(LEV,TR)"))
31 S X=@("^"_Q_"PR(PR,0)"),PY=$P(X,D,17),PY=($P(PY,"#",1)+PSUG)_"#"_($P(PY,"#",2)+PSUG)_"#"_$P(PY,"#",3)
33 S X=$P(X,D,1,16)_D_PY_D_$P(X,D,18,99),^(0)=X,X=^(1),PEH=$P(X,D,12),X=$N(^("J")) S:$E(X,1)'="J" X="" S:$E(X,1)="J" X=^(X)
35 S ULT=$$INTDATE^vhDTyp(%WK,"DW")+($P(X,D,7)*7) S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
39 S ^("W    0.0T"_DJ_DM_DD_$J(TR,6)_$J((TZ-100),3))=DT_D_LEV_"\STOCK AUTOM.\"_PSUG_D_PSUG_D_ULT_D,^("W")=""
41 S PK1=$P(X,D,9),PK2="",UVM=$P(X,D,17),UEP=$J($P(X,D,19),0,2),PEA=$P(X,D,28) S:'$L(PEA) PEA="E"
43 S PAP=UEP-(UEP*PK1/100),PAP=PAP-(PAP*PK2/100)
45 S UBE=$J(UEP*PSUG/$P("1\100\1000",D,$F("EHM",PEA)-1),1,2),UN=$J(PAP*PSUG/$P("1\100\1000",D,$F("EHM",PEA)-1),1,2)
47 S X=D_PR_D_PSUG_D_PEH_D_D_UEP_D_PK1_"#"_PK2_D_D_UN_D_UN_"\\L\\\\"_UBE_"\KTRPL\\\\"_PEA_D_UVM_"\\\"_ULT_"\\\\\\\\\\\"
49 S @("^"_Q_"TO(LEV,TR,TZ)")=X,TZ=TZ+1 G 25
51 S @("^"_Q_"TO2(LEV,TR)")="",(@("^"_Q_"TO1(TR)"),@("^"_Q_"TOB(TR)"))=LEV_D
53 S @("^"_Q_"TO(LEV,TR,0)")=TZ,^(1)=D_DT_D_"STOCK AUTOM.\\\"_LEV_"\\\\\\\\\\\\"_UVM_"\\\\\\\\" G 15
55 S LTR=TR,TR="",FP=403 W @F,@F1,"VOLGENDE TOELEVERINGEN OPGEMAAKT" S FP=503
57 S TR=$N(TAB(TR)) G 59:TR=-1 S FP=FP+100 W @F,TR,"   ",$P(TAB(TR),D,1),"   ",$P(TAB(TR),D,2) G 57:FP<2000
59 S R="K\22\3\DRUKKEN TOELEVERINGEN\C2\1\\""-D""[K" D R0 G 63:K="-" I K="" S FP=503 W @F,@F1 G 57
61 S TR="",FTR=$N(TAB(TR)),TOU=@("^"_Q_"TO(0,""TOU"")"),UGL="TO",UG1="TO1",UGB="TOB",SW13=1
62 S Q20="@(""^""_Q_UGB_""(TR)"")" D 22^KTO32
63 S FP=401 W @F,@F1 K @("^"_Q_"WBAT"),@("^"_Q_"WBAT1")
65 L @("^"_Q_"WBAT")
YZ K VNR,LEV,HG,GR,SG,PCC,PC,PR,X,LN,TR,TZ,UVM,%WK,LA,LC,LLL,LLT,LLTA,LLV,LX,LXA,LXWA,PAP,PEA,PK1,PK2,PLF,PNR,PSUG,PXN,PY,SW37,TAB,TOU,U26,UBE,UEP,UG1,UGB,UGL,UK,ULT,UN,USP,UVN,UZ,ODT,OTD 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
 ;
C1 W !?2,"T[] = toeleveringen definitief opmaken   -[] = hernemen" Q
C2 W !?2 W:TR'=-1&($N(TAB(TR))'=-1) "[] = vervolg   " W "D[] = drukken toeleveringen" Q
 ;
 Q
Z X ^cZ Q
ZZ ; 21.04.88 - 12 u 32