PVEWSTAT ;EWMS Statistieken [ 11/08/2003   8:27 PM ]
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr,KLNr,R,ORDNr,OLUNr,SOLUNr
 Do BLDCONTR^KPOSW
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"OLLOC.TXT","W")
 Use Dev
 Set MPRNr=""
 For  Set MPRNr=$O(^PRLINK("D",MPRNr)) Quit:MPRNr=""  Do
 .Quit:'$$ISORGAL^ORGALUX(MPRNr)
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",MPRNr,KPRNr)) Quit:KPRNr=""  Do
 ..Quit:$D(Mem(KPRNr)) 
 ..Set Mem(KPRNr)=""
 ..Set PalId=""
 ..For  Set PalId=$O(^EWPAL("D",KPRNr,PalId)) Quit:PalId=""  Do
 ...Write MPRNr,$C(9),$P(^KPR(MPRNr,0),D,1),$C(9),KPRNr,$C(9),$P(^KPR(KPRNr,0),D,1),$C(9),PalId,!
 Close:0'[Dev Dev
 Q
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr,KLNr,R,ORDNr,OLUNr,SOLUNr
 Do BLDCONTR^KPOSW
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"OLCHK.TXT","W")
 Use Dev
 Set CONSNr=""
 For  Set CONSNr=$O(^ORDW("D",CONSNr)) Quit:CONSNr=""  Do
 .Set R=^ORDW("D",CONSNr)
 .Quit:$P(R,D,20)'="B"
 .Set KLNr=$P(R,D),DatBon=+$P(R,D,24) ; Einde consolidatie
 .Set:'DatBon DatBon=+$P(R,D,22) ; Begin picking
 .Set ORDNr=""
 .For  Set ORDNr=$O(^ORDW("D",CONSNr,"D",ORDNr)) Quit:ORDNr=""  Do
 ..Set OLUNr=""
 ..For  Set OLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ...Set PRNr=$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,1)
 ...Set Typ="BS"
 ...Set:$P($G(^KPR(PRNr,2)),D,15)=3 Typ="LG"
 ...Set:$P($G(^KPR(PRNr,2)),D,15)=2 Typ="UG"
 ...Set:$G(ContrInd(PRNr))[KLNr Typ="CONTR"
 ...Set:$$ISORGAL^ORGALUX(PRNr) Typ="OL"
 ...Set:$$ISHALUX^PRODUKT2(PRNr) Typ="HAL"
 ...Set SOLUNr=""
 ...For  Set SOLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)) Quit:SOLUNr=""  Do
 ....Set R=^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)
 ....Set PRNr=$P(R,D,1)
 ....Quit:$P($G(^KPR(PRNr,2)),D,15)=7 ; werkvloer product
 ....Quit:'$P($G(^KPR(PRNr,2)),D,15) ; manueel product
 ....Quit:'$P(R,D,5) ; geen pallet info
 ....Set Pick="D"
 ....Set:$P(R,D,5)>15000000 Pick="A" ;Auto pick
 ....Set:$P(R,D,5)>20000000 Pick="U" ;Ugly
 ....Set Dat=$P($P(R,D,6),",")
 ....Set Uur=$P($P(R,D,6),",",2)
 ....Write KLNr,$C(9),CONSNr,$C(9),PRNr,$C(9),$P($G(^KPR(PRNr,0)),D,1),$C(9),Pick,$C(9),Typ,$C(9)
 ....Write $TR($$EXTDATE^vhDTyp(DatBon,"DK"),".","-"),! ; Begin picking
 Close:0'[Dev Dev
 Quit
 
FETCH(DatVan,DatTot) 
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr
 Set DatTot=$G(DatTot)
 Kill ^HULP(%J)
 Set CONSNr=""
 ;Set Dev=$$OPEN^vhDEV(,"TEST.TXT","W")
 ;Use Dev
 For  Set CONSNr=$O(^ORDW("D",CONSNr)) Quit:CONSNr=""  Do
 .Set R=^ORDW("D",CONSNr)
 .Quit:$P(R,D,20)'="B"
 .Set KLNr=$P(R,D),DatBon=+$P(R,D,24) ; Einde consolidatie
 .Set:'DatBon DatBon=+$P(R,D,22) ; Begin picking
 .Quit:DatBon<DatVan
 .If DatTot,DatBon>DatTot Quit
 .Set ^HULP(%J,"F",DatBon,"K",KLNr)=""
 .Set LevAdr=$G(^ORDW("D",CONSNr,"A"))
 .Set LevAdr=$E(LevAdr,1,50)_KLNr
 .Set ^HULP(%J,"F",DatBon,"A",LevAdr)=""
 .Kill DatRec
 .Merge DatRec=^HULP(%J,"F",DatBon,"D")
 .Set MemMol=$G(DatRec("MOL"))
 .Set ORDNr=""
 .For  Set ORDNr=$O(^ORDW("D",CONSNr,"D",ORDNr)) Quit:ORDNr=""  Do
 ..Set OLUNr=""
 ..For  Set OLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ...Set PRNr=$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,1)
 ...Quit:$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,4)<0
 ...Set:'$P($G(^KPR(PRNr,2)),D,15) DatRec("MOL")=$G(DatRec("MOL"))+1 ; OL Manueel
 ...Quit:'$P($G(^KPR(PRNr,2)),D,15)  ; OL Manueel
 ...Set DatRec("WOL")=$G(DatRec("WOL"))+1 ; OL WMS
 ...Set R=^ORDW("D",CONSNr,"D",ORDNr,OLUNr)
 ...If $L($P(R,D,3)) Do
 ....If $P(R,D,3)="Q"!($P(R,D,3)="K")!($P(R,D,3)="E") Set DatRec("WOLQ")=$G(DatRec("WOLQ"))+1 ; OL fout in aantal
 ....Else  Set DatRec("WOLe")=$G(DatRec("WOLe"))+1 ; OL systeem error
 ...Set SOLUNr=""
 ...For  Set SOLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)) Quit:SOLUNr=""  Do
 ....Set R=^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)
 ....Set PRNr=$P(R,D,1)
 ....If '(SOLUNr#100) Do  ; Master SOL
 .....Set DatRec("WOLK")=$G(DatRec("WOLK"))+1
 .....Set ^HULP(%J,"F",DatBon,"P",CONSNr,PRNr)=$G(^HULP(%J,"F",DatBon,"P",CONSNr,PRNr))+1
 ....Quit:'$P(R,D,5)
 ....Set DatRec("SOL")=$G(DatRec("SOL"))+1 ; SOL
 ....;Write CONSNr,$C(9),ORDNr,$C(9),OLUNr,$C(9),SOLUNr,$C(9),$P(R,D,5),$C(9),$D(^KPR(PRNr,"J6332")),$C(9),$P($G(^KPR(PRNr,2)),D,15),!
 ....If $D(^KPR(PRNr,"J6332")) Set DatRec("SOLH")=$G(DatRec("SOLH"))+1 ; Halux
 ....Else  If $P(R,D,5)<15000000 Set DatRec("SOLD")=$G(DatRec("SOLD"))+1 ; SOL Directe uitvoer
 ....Else  If $P(R,D,5)<(15500000+$S(58899>+DatBon:0,1:100000)) Set DatRec("SOLP1")=$G(DatRec("SOLP1"))+1 ; Pickpost 1
 ....Else  If $P(R,D,5)<(15600000+$S(58899>+DatBon:0,1:100000)) Set DatRec("SOLP2")=$G(DatRec("SOLP2"))+1 ; Pickpost2
 ....Else  Do
 .....If $P($G(^KPR(PRNr,2)),D,15)=3 Set DatRec("SOLL")=$G(DatRec("SOLL"))+1 ; SOL LANGGOED
 .....Else  Set DatRec("SOLU")=$G(DatRec("SOLU"))+1 ; SOL UGLY
 .If MemMol'=$G(DatRec("MOL")) Set DatRec("MBON")=$G(DatRec("MBON"))+1
 .Else  Set DatRec("WBON")=$G(DatRec("WBON"))+1
 .Set DatRec("SOLP")=$G(DatRec("SOL"))-$G(DatRec("SOLD"))-$G(DatRec("SOLU"))-$G(DatRec("SOLL"))-$G(DatRec("SOLH"))
 .Kill ^HULP(%J,"F",DatBon,"D")
 .Merge ^HULP(%J,"F",DatBon,"D")=DatRec
 ;
 ; Aantal klanten, leveringsadres, en dubbele produkten
 Set DatBon=""
 For  Set DatBon=$O(^HULP(%J,"F",DatBon)) Quit:DatBon=""  Do
 .Kill DatRec
 .Merge DatRec=^HULP(%J,"F",DatBon,"D")
 .Set KLNr=""
 .For  Set KLNr=$O(^HULP(%J,"F",DatBon,"K",KLNr)) Quit:KLNr=""  Set DatRec("KL")=$G(DatRec("KL"))+1 ; Aantal klanten
 .Set LevAdr=""
 .For  Set LevAdr=$O(^HULP(%J,"F",DatBon,"A",LevAdr)) Quit:LevAdr=""  Set DatRec("KLA")=$G(DatRec("KLA"))+1 ; Aantal leveringsadressen
 .Set CONSNr=""
 .For  Set CONSNr=$O(^HULP(%J,"F",DatBon,"P",CONSNr)) Quit:CONSNr=""  Do
 ..Set PRNr=""
 ..For  Set PRNr=$O(^HULP(%J,"F",DatBon,"P",CONSNr,PRNr)) Quit:PRNr=""  Do
 ...Set R=^HULP(%J,"F",DatBon,"P",CONSNr,PRNr),DatRec("WOLP")=$G(DatRec("WOLP"))+R-1 ; Aantal zelfde producten in een consolidatie
 .Kill ^HULP(%J,"F",DatBon)
 .Merge ^HULP(%J,"F",DatBon,"D")=DatRec
 ;C:0'[Dev Dev
 Quit
 ;
PICKLOG(PalId,Datum) 
 Quit
 
FORCAST New Def,Cnt,Txt,X
 Do DEF(.Def) ; Ophalen default picktijden
 Do FETCHFC(.Cnt,.Def) ; Ophalen orderlijnen
 Set Txt=0
 Set Txt=Txt+1,Txt(Txt)="              "
 Set Txt=Txt+1,Txt(Txt)="Orders      : "
 Set Txt=Txt+1,Txt(Txt)="Orderlijnen : "
 For MagNr=1:1:4 Set Txt=Txt+1,Txt(Txt)="   "_$P("Auto ;Ugly ;Lang ;Halux",";",MagNr)_"    : "
 For Mode="W","V","K" Do
 .Set Txt=0
 .Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$S(Mode="W":" WMS",Mode="V":"VOLG",1:"KODE")_" : "
 .Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$J($G(Cnt(Mode,"BON")),4)_" : "
 .Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$J($G(Cnt(Mode,"OL")),4)_" : "
 .For MagNr=1:1:4 Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$J($G(Cnt(Mode,"OL",MagNr)),4)_" : "
 Set Txt=Txt+1,Txt(Txt)=""
 Set:$G(Cnt("W","OL")) Txt=Txt+1,Txt(Txt)="Tijdsraming : "_$$EXTTIME^vhDTyp($G(Cnt("W","TIJD")))
 Set:$G(Cnt("W","OL")) Txt=Txt+1,Txt(Txt)="Gemiddeld : "_$J($G(Cnt("W","TIJD"))/Cnt("W","OL"),0,0)_" sec."
 Set X=$$WILD^vhTXTPOP("C;C","Tijdsraming","Txt")
 Quit
 ;
FETCHFC(Cnt,Def) New CONSNr,ORDNr,OLUNr,SOLNr,Rec
 Kill Cnt
 Set (CONSNr,ORDNr,OLUNr,SOLNr)=""
 For  Set CONSNr=$O(^ORDW("D",CONSNr)) Quit:CONSNr=""  Do
 .Set Rec=^ORDW("D",CONSNr)
 .Set Mode=$P(Rec,D,20)
 .Quit:Mode'="W"&(Mode'="P")&(Mode'="")&(Mode'="K")
 .Set:Mode="P" Mode="W"
 .Set:Mode="" Mode="V"
 .Set Cnt(Mode,"BON")=$G(Cnt(Mode,"BON"))+1
 .Set Cnt(Mode,"TIJD")=$G(Cnt(Mode,"TIJD"))+$P($T(WEGZET),";",2)
 .For  Set ORDNr=$O(^ORDW("D",CONSNr,ORDNr)) Quit:ORDNr=""  Do
 ..For  Set OLUNr=$O(^ORDW("D",CONSNr,ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ...For  Set SOLNr=$O(^ORDW("D",CONSNr,ORDNr,OLUNr,SOLNr)) Quit:SOLNr=""  Do
 ....Set Rec=^(SOLNr)
 ....Quit:$P(Rec,D,2)'="W"&($P(Rec,D,2)'="")  ; Nog niet of niet meer in WMS
 ....Set PRNr=$P(Rec,D)
 ....Set Qty=$P(Rec,D,4)
 ....Set MagNr=$P(^KPR(PRNr,2),D,15)
 ....Set:'(MagNr>0&(MagNr<4)) MagNr=2 ; 1:Auto, 2:Ugly en 3:Langgoed
 ....Set:$D(^KPR(PRNr,"J6332")) MagNr=4
 ....Set Cnt(Mode,"TIJD")=$G(Cnt(Mode,"TIJD"))+$$SELDEF(PRNr,Qty,.Def)
 ....Set Cnt(Mode,"OL")=$G(Cnt(Mode,"OL"))+1
 ....Set Cnt(Mode,"OL",MagNr)=$G(Cnt(Mode,"OL",MagNr))+1
 Quit
 ;
DEF(Def) New Node,Key,I
 For Key="GVP","NVP","STUK" Do
 .Set Node=$P($T(@Key),";",2,99)
 .For I=1:1:$L(Node,"\") Set Def(Key,$P($P(Node,"\",I),";"))=$P($P(Node,"\",I),";",2)
 Quit
 ;
SELDEF(PRNr,Qty,Def) 
 New RecJ,GVP,NVP,GVPQty,NVPQty,Tijd
 Set RecJ=^KPR(PRNr,$O(^KPR(PRNr,"J")))
 ;Write !,PRNr," ",$P(^KPR(PRNr,0),D)," ",Qty," GVP:",GVP," NVP:",NVP
 Set GVP=$P(RecJ,D,16)
 Set NVP=$P(RecJ,D,15)
 Set (GVPQty,NVPQty)=0
 Set:GVP GVPQty=Qty\GVP
 Set Qty=Qty-(GVPQty*GVP)
 Set:NVP NVPQty=Qty\NVP
 Set Qty=Qty-(NVPQty*NVP)
 Set Tijd=0
 Set:GVPQty Tijd=Tijd+Def("GVP",$O(Def("GVP",GVPQty-1)))
 Set:NVPQty Tijd=Tijd+Def("NVP",$O(Def("NVP",NVPQty-1)))
 Set:Qty Tijd=Tijd+Def("STUK",$O(Def("STUK",Qty-1)))
 ;Write:GVPQty !,"GVP:",GVP," aantal:",GVPQty," tijd:",Def("GVP",$O(Def("GVP",GVPQty-1)))
 ;Write:NVPQty !,"NVP:",NVP," aantal:",NVPQty," tijd:",Def("NVP",$O(Def("NVP",NVPQty-1)))
 ;Write:Qty !,"Stuk aantal:",Qty," tijd:",Def("STUK",$O(Def("STUK",Qty-1)))
 Quit Tijd
 ;
INIT 
 Do INIT^vhTERMINA
 Set %J=$G(%J,$$%J^vhRtn1())
 Kill ^HULP(%J)
 Set (Display,DatVan,DatTot)=""
 Quit
 ;
LORDdef ;ProgrLabel;DisplayLabel;TransferLabel
LORD1 ;KL  ;Klanten;#KL
LORD2 ;KLA ;Leveringsadressen;LevAdr
LORD3 ;WBON;WMS Leveringsbons;Bons WMS
LORD4 ;WOL ;   Orderlijnen;OL WMS
LORD5 ;WOLQ;      Status Q,K of E;OLQ
LORD6 ;WOLe;      Status e of m;OLe
LORD7 ;WOLK;   Orderlijnen (incl. kind);OLKind
LORD8 ;WOLP;      Zelfde produkt;OLIdemProd
LORD9 ;SOL ;   Sub orderlijnen;SubOL
LORD10 ;SOLP;      Pickpost;SubOLPick
LORD11 ;SOLP1;         PP1  ;SubOLPick1
LORD12 ;SOLP2;         PP2  ;SubOLPick1
LORD13 ;SOLD;      Directe uitvoer(A+U);SubOLDirUitv
LORD14 ;SOLU;      UGLY;SubOLUgly
LORD15 ;SOLL;      Langgoed;SubOLLang
LORD16 ;SOLH;      Halux   ;SubOLHal
LORD17 ;MBON;Manueel leveringsbons;Bons Manueel
LORD18 ;MOL ;   Orderlijnen;OL Manueel