#include BL.Derde.KlantSpecifiek
#include Prod.Product
#include vhLib.Macro
EWSTAT ;EWMS Statistieken [ 12/16/2003  8:23 AM ]
 Do ORDW
 Quit
 
 ; Definitie van de tijden Qty;Tijd in sec
GVP ;999999;150\10;110\8;100\6;90\4;80\2;70\1;60
NVP ;999999;130\10;100\9;90\8;80\6;70\4;60\2;50
STUK ;999999;120\500;100\100;90\50;80\20;70\10;60\5;50
WEGZET ;100
  
ORDW 
 New %SC,R,LD,Input,DatVan,DatTot,CONSNr,DatBon,Date,Display,Dir
 Do INIT,DISPLAY^vhScherm("EWORDSTAT"),FIELD^vhScherm("EWORDSTAT","DISPLAY")
 If $L(Display) Do
 .If Display="T"!(Display="P") Do EDIT^vhScherm("EWORDSTAT") Quit:'%SC
 .Set FP=201
 .Write @F,@F1
 .If Display="F" Do 
 ..Do FORCAST
 .Else  If Display="H" Do
 ..Do HISTORD
 .Else  If Display="P" Do
 ..Do TRANSUUR
 .Else  If Display="M" Do
 ..Do ExportPicker
 .Else  Do
 ..Do TRANSORD
 Kill ^HULP(%J)
 Quit
 
DISP ; Lichtkrant magazijn
	New CONSNr,ORDNr,OLUNr,SOLNr,Rec,Cnt,Dev,MagNr,PRNr,Kleur,BonErr,Ident,TeDoen,Opslag,PalId
 
 Set D="\"
 Kill Cnt
 Set Kleur(0)=$$HEX^vhRtn1("1C,38") ;Geel - geen afhaling
 Set Kleur(1)=$$HEX^vhRtn1("1C,37") ;Oranje - dringend
 Set Kleur(2)=$$HEX^vhRtn1("1C,31") ;Rood - afhaling
 Set Kleur(3)=$$HEX^vhRtn1("1C,31") ;Rood - superspoed
 Set Kleur(9)=$$HEX^vhRtn1("1C,35") ;Dim green
 Quit:$$FETCHSOM()  ; somatie en stoppen indien niets veranderd
 
 
 Set $ZTrap="DISPTRAP^EWSTAT"
 Merge Cnt=^EWREC("DISP","W")
 
 Do DISPONE("192.168.7.251")
 Do DISPONE("192.168.15.184")
 Quit
 
DISPONE(IPaddr)
 ; Via TCP-socket
 Set Dev="|TCP|4"
 OPEN Dev:(IPaddr:3001::$CHAR(3,4)):5
 ; Via seriele com-poort
 ; Set Dev=3 ;COM1 van de server
 ; Open Dev:(:"SI"::" 0722X00":9600)
 
 Use Dev
 If '$P($G(Cnt),D,2) Do  ; Klok juist zetten
 .Write $$HEX^vhRtn1("0,0,0,0,0,01,5A,30,30,02,45,20"),$TR($$EXTTIME^vhLib.DataTypes($H),":",""),$$HEX^vhRtn1("04")
 .Write $$HEX^vhRtn1("0,0,0,0,0,01,5A,30,30,02,45,27,4D,04") ;24-uur
 .Set Date=$$EXTDATE^vhLib.DataTypes($H,"DKP")
 .Write $$HEX^vhRtn1("0,0,0,0,0,01,5A,30,30,02,45,3B"),$P(Date,".",2),$P(Date,"."),$P(Date,".",3),$$HEX^vhRtn1("04") ;Datum
 Write $$HEX^vhRtn1("0,0,0,0,0,01,5A,30,30,02") ; Broadcast naar alle displays
 Write $$HEX^vhRtn1("41,41") ; Write tot file "A"
 Write $$HEX^vhRtn1("1B,20")
 
 ;If SuperSpoed Do  ; Superspoed
 . Write "T"_"[SUPERSPOED] " ; De eerste karakter 'T' wordt niet getoond op het display
 
 If $D(^EWREC("P","DISPTXT")) Do  ; Vaste tekst
 . Write "T"_$G(^EWREC("P","DISPTXT")) ; De eerste karakter 'T' wordt niet getoond op het display
 Else  If $P($G(Cnt),D,2) Do  ;Te verwerken lijnen
 . Write $$HEX^vhRtn1("15") ; slow speed als er meer tekst is dan op het scherm kan
 . Set Mag=""
 . For  Set Mag=$O(Cnt(Mag)) Quit:Mag=""  Do
 .. Write $$HEX^vhRtn1(7),"0" ; Knipperen af
 .. Write Kleur(9),$S(Mag="E":"A",Mag="A":"T",1:Mag) ;,":"
 .. Write $$HEX^vhRtn1(7),$S($P($G(Cnt(Mag)),D,4)!$P($G(Cnt),D,4):"1",1:"0") ; Knipperen
 .. Write Kleur(+$P($G(Cnt(Mag)),D,3))
 .. Write +$P($G(Cnt(Mag)),D,2),$S($P($G(Cnt(Mag)),D,3)=2:"!",1:""),$S($O(Cnt(Mag))="":"",1:"  ")
 
 Else  Do  ; Datum en tijd
 . Write $S($P($G(Cnt),D,4):$$HEX^vhRtn1("63"),1:$$HEX^vhRtn1("62"))
 . Write $$HEX^vhRtn1("1D,30,31") ; dubbelstroke
 . Write Kleur(9),$$HEX^vhRtn1("0B,31,20,13")
 Write $$HEX^vhRtn1("04")
 Close:Dev'=0 Dev
 Quit
 
DISPTRAP
	Quit
 
FORCAST New Def,Cnt,Txt,X
 Merge Cnt=^EWREC("DISP")
 Set Txt=0
 Set Txt=Txt+1,Txt(Txt)="              "
 Set Txt=Txt+1,Txt(Txt)="Orders      : "
 Set Txt=Txt+1,Txt(Txt)="Orderlijnen : "
 For Mag="E","H","L","O","U","A" Set Txt=Txt+1,Txt(Txt)="   "_$P("Auto   ;Ugly   ;Transf.;Lang   ;Halux  ;Orgalux",";",$F("EUALHO",Mag)-1)_"  : "
 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($P($G(Cnt(Mode)),D,1),4)_" : "
 .Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$J($P($G(Cnt(Mode)),D,2),4)_" : "
 .For Mag="E","H","L","O","U","A" Set Txt=Txt+1,Txt(Txt)=Txt(Txt)_$J($P($G(Cnt(Mode,Mag)),D,2),4)_" : "
 Set Txt=Txt+1,Txt(Txt)=""
 Set Tijd=$P($G(Cnt("W","E")),D,5)
 Set Qty=$P($G(Cnt("W")),D,2)
 Set:Qty Txt=Txt+1,Txt(Txt)="Tijdsraming Auto (bij 2 PP) : "_$$EXTTIME^vhLib.DataTypes(Tijd/2)
 Set:Qty Txt=Txt+1,Txt(Txt)="Gemiddeld : "_$J(Tijd/Qty,0,0)_" sec."
 ; Controle op bons in de fout
 Set:$P($G(Cnt("W")),D,4) Txt=Txt+1,Txt(Txt)="Probleem : "_$P($G(Cnt("W")),D,4)
 Set:$P($G(Cnt("SUPERSPOED")),D,4) Txt=Txt+1,Txt(Txt)="Superspoed : "_$P($G(Cnt("SUPERSPOED")),D,4)
 Set X=$$WILD^vhTXTPOP("C;C","Tijdsraming","Txt")
 Quit
 
FETCHSOM(Def) ; ophalen van gegevens voor DISP en FORCAST, deze gegevens worden opgeslagen in ^EWREC("DISP")
 New Cnt,CONSNr,ORDNr,OLUNr,SOLNr,Rec,KLNr,TeDoen,Error,BonErr,VzwAf,Mag,MagLijst,pv,Qty,PRNr
 ; Opbouw van EWREC("DISP")
 ; Controleert of een bon volledig is afgewerkt en forceert dan op status C
 ; Return TRUE indien verschillend van vorige resultaat
 Do:'$D(Def) DEF(.Def)
 Set (CONSNr,ORDNr,OLUNr,SOLNr)=""
 Merge BonErr=^EWREC("BONERR") Kill ^EWREC("BONERR")
 Set BonErr=0
 For  Set CONSNr=$O(^ORDW("D",CONSNr)) Quit:CONSNr=""  Do
 . Set Rec=^ORDW("D",CONSNr)
 . Set KLNr=$P(Rec,D)
 . ;Quit:KLNr=1000  ; Testklant
 . Set TeDoen=0 ; Bons waarvan nog moet gepickt worden?
 . Quit:$P(Rec,D,20)="B"  ; Afgewerkte consolidaties, 'A' en 'C' toelaten voor error detectie
 . Set Error=$P(Rec,D,21)'="" ; Error status ingevuld?
 
 . Set VzwAf=$S(($$DIFFTIME^vhLib.DataTypes($P(Rec,D,3),$H)>0)&&(KLNr=$$$KlantKeller):1,$P(Rec,D,2)["AF":2,$$DIFFTIME^vhLib.DataTypes($P(Rec,D,2),$H)>0:1,1:0) ; Afhaling of DueOut verstreken
 . ;Set:($$DIFFTIME^vhLib.DataTypes($P(Rec,D,2),$H)>0) VzwAf=3 ; Keller en DueOut verstreken
 . Set Mode=$P(Rec,D,20)
 . Set Mode=$S(Mode="":"V",Mode="K":"K",1:"W")
 . Set MagLijst=""
 . Set lbBevat=$$Bevat^EWORDSW(CONSNr)
 . For  Set ORDNr=$O(^ORDW("D",CONSNr,"D",ORDNr)) Quit:ORDNr=""  Do
 .. For  Set OLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 ... Set Rec=^(OLUNr)
 ... Quit:$P(Rec,D,3)="z" ; zonder stockaanpassing
 ... Quit:$P(Rec,D,3)="t" ; terugname
 ... Set:'Error Error=$P(Rec,D,3)'="" ; Error status ingevuld?
 ... For  Set SOLNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLNr)) Quit:SOLNr=""  Do
 .... Set Rec=^(SOLNr)
 .... Set PRNr=$P(Rec,D,1)
 .... Set Qty=$P(Rec,D,3)
 .... Quit:Qty<0 ;Geen terugnames
 .... Quit:($P(Rec,D,2)'="")&&($P(Rec,D,2)'="W")&&($P(Rec,D,2)'="K")
 .... Set:$P(Rec,D,2)="W" TeDoen=1 ; Nog niet of niet meer in WMS
 .... ;W:$P(Rec,D,2)="W" CONSNr,!
 .... Set Mag=$P(Rec,D,13)
 .... Set:Mag?1N Mag="E" ; Indien gegroepeerd dan "E"
 .... If Mag="" Do  ; SoftVerwerking niet ingevuld, daarom default invullen als het nog op blanko staat
 ..... Set Mag=$$SOFTV^EWORDSW(PRNr,KLNr,Qty,lbBevat,1)
 ..... Set:Mode'="W" $P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLNr),D,13)=Mag ;Bij nog niet doorgestuurde consolidatie het berekend magazijn onthouden
 .... ;Lijn telling
 .... Set $P(Cnt(Mode),D,2)=$P($G(Cnt(Mode)),D,2)+1
 .... Set:'$D(Cnt(Mode,Mag)) Cnt(Mode,Mag)=D_D_0 ; Default
 .... Set $P(Cnt(Mode,Mag),D,2)=$P(Cnt(Mode,Mag),D,2)+1 ; Aantal lijnen
 .... Set:$P(Cnt(Mode,Mag),D,3)<VzwAf $P(Cnt(Mode,Mag),D,3)=VzwAf ; Normaal=0, Dringend=1, Afhaling=2 of SuperSpoed=3
 .... Set Tijd=$$SELDEF(PRNr,Qty,Mag,.Def) ; Picktijd
 .... Set $P(Cnt(Mode),D,5)=$P(Cnt(Mode),D,5)+Tijd ; Tijd globaal
 .... Set $P(Cnt(Mode,Mag),D,5)=$P(Cnt(Mode,Mag),D,5)+Tijd ; Tijd per magazijn
 .... Set:MagLijst'[Mag MagLijst=MagLijst_Mag
 . ; BON telling
 . Set:$L(MagLijst) $P(Cnt(Mode),D,1)=$P(Cnt(Mode),D,1)+1 ; Aantal bon's
 . For I=1:1:$L(MagLijst) Do
 .. Set Mag=$E(MagLijst,I)
 .. Set $P(Cnt(Mode,Mag),D,1)=$P(Cnt(Mode,Mag),D,1)+1 ; Aantal order per magazijn
 .. Set Tijd=$P($T(WEGZET),";",2) ; Wegzetten order
 .. Set $P(Cnt(Mode),D,5)=$P(Cnt(Mode),D,5)+Tijd ; Tijd globaal
 .. Set $P(Cnt(Mode,Mag),D,5)=$P(Cnt(Mode,Mag),D,5)+Tijd ; Tijd per magazijn
 .
 . Set:$G(VzwAf)=3 $P(Cnt("SUPERSPOED"),D,4)=$P($G(Cnt("SUPERSPOED")),D,4)_$S($L($P($G(Cnt("SUPERSPOED")),D,4))>10:"",1:$S($L($P($G(Cnt("SUPERSPOED")),D,4)):";",1:"")_CONSNr)
 .
 . ;Control: volledig afgewerkt maar de finale feedback ontbreekt
 . If Mode="W",'TeDoen!Error Do  ; De bon is volledig gepickt maar nog niet op bon gezet
 .. If $D(BonErr(CONSNr)) Do  ; Vorige keer ook al in de fout
 ... ;Na 15 min. of 1 min. bij status fout
 ... If $$DIFFTIME^vhLib.DataTypes(BonErr(CONSNr),$H)>($S(Error:1,1:15)*60) Do
 .... Set $P(Cnt("W"),D,4)=$P($G(Cnt("W")),D,4)_$S($L($P($G(Cnt("W")),D,4)):";",1:"")_CONSNr
 ... Set ^EWREC("BONERR",CONSNr)=BonErr(CONSNr) ; Zoals vorige keer
 ... If 'TeDoen,$$DIFFTIME^vhLib.DataTypes(BonErr(CONSNr),$H)>(5*60) Do  ; Er is niet meer te doen alle lijnen staan op "A" en er is 5 minuten verstreken 
 .... Lock +^ORDW("D",CONSNr):0 Else  Quit
 .... Do COMPLETE^EWORDF2(CONSNr) ; Forceren op Compleet
 .... Lock -^ORDW("D",CONSNr)
 .. Else  Set ^EWREC("BONERR",CONSNr)=$H ; Eerste keer
 .. Set $P(Cnt("W"),D,4)=$P($P($G(Cnt("W")),D,4),";",1,20) ; Beperken tot een twintigtal, anders misschien MAXSTR error
 If $D(Cnt("W","E")),$O(^EWREC("ECNT",1)) Do  ; Er is voor het EWMS nog andere picklocaties dan in het automatisch mag.
 . Set $P(Cnt("W","E"),D,4)=1
 
 Set:$L($G(^EWREC("P","DISPTXT"))) $P(Cnt("W"),D,10)=^EWREC("P","DISPTXT")
 
 ; Nakijken of het display is verander
 Set Ident=$G(Cnt("W"))=$G(^EWREC("DISP","W")) ; Identiek Totaal
 For Mag="E","O","L","U","H","A" Quit:'Ident  Do
 .Set Ident=$G(Cnt("W",Mag))=$G(^EWREC("DISP","W",Mag)) ; Identiek per Mag
 Kill ^EWREC("DISP") Merge ^EWREC("DISP")=Cnt
 Quit Ident  ; niets veranderd
 
TRANSORD New DatRec,I,Key,Label,Dev
 Do FETCH(DatVan,DatTot)
 Quit:'$D(^HULP(%J,"F"))
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,$$ASKFILE^vhDEV("PICKSTAT.TXT"),"W")
 Use Dev
 Set Date="",Count=0
 Write "Jaar",$C(9),"Maand",$C(9),"Datum",$C(9),"Dag",$C(9)
 For I=1:1:99 Set Label=$T(@("LORD"_I)) Quit:Label=""  Do
 .Quit:'$L($P(Label,";",4))
 .Write:I'=1 $C(9)
 .Write $P(Label,";",4)
 Write !
 For  Set Date=$O(^HULP(%J,"F",Date)) Quit:Date=""  Do
 .Kill DatRec
 .Merge DatRec=^HULP(%J,"F",Date,"D")
 .Write $$EXTDATE^vhLib.DataTypes(Date,"J4"),$C(9)
 .Write $$EXTDATE^vhLib.DataTypes(Date,"MC"),$C(9)
 .Write $$EXTDATE^vhLib.DataTypes(Date,"DK"),$C(9)
 .Write $$EXTDATE^vhLib.DataTypes(Date,"DC"),$C(9)
 .For I=1:1:99 Set Label=$T(@("LORD"_I)) Quit:Label=""  Do
 ..Quit:'$L($P(Label,";",4))
 ..Set Key=$P(Label,";",2)
 ..For  Quit:$E(Key,$L(Key))'=" "  Set $E(Key,$L(Key))=""
 ..Quit:Key=""
 ..Write:I'=1 $C(9)
 ..Write $G(DatRec(Key))
 .Write !
 Close:0'[Dev Dev
 Quit
 
HISTORD 
 Set DatVan=$H-($P($H,",",2)<43200),Dir=1,Input=""
 For  Do  Quit:Input="O"
 .Do FETCH(DatVan)
 .Set Date=+DatVan
 .Kill DatRec
 .Merge DatRec=^HULP(%J,"F",Date,"D")
 .If '$D(DatRec) Do  Quit
 ..If Dir>0 Do  Quit
 ...If DatVan<$H Set DatVan=DatVan+1
 ...Else  Set DatVan=DatVan-1,Dir=-1
 ..Else  Set DatVan=DatVan-1
 .Kill ^HULP(%J,"D")
 .For I=1:1:99 Set Label=$T(@("LORD"_I)) Quit:Label=""  Do
 ..Set Key=$P(Label,";",2)
 ..For  Quit:$E(Key,$L(Key))'=" "  Set $E(Key,$L(Key))=""
 ..Quit:Key=""
 ..Set ^HULP(%J,"D",I)=$P(Label,";",3)_D_$G(DatRec(Key))
 .Do INIT^vhLIST("EWSTAT","ORDW",.LD)
 .Do WRITE^vhLIST(.LD)
 .For  Set Input=$$SCROLL^vhLIST(.LD) Do  Quit:$L(Input)
 ..If Input="(" Do
 ...Set CONSNr=$O(^ORDW("D",""))
 ...If CONSNr="" Write *7 Set Input="" Quit
 ...Set DatBon=$H-100 ;$P(^ORDW("D",CONSNr),D,24)
 ...If DatVan>DatBon Set DatVan=DatVan-1,Dir=-1
 ...Else  Write *7 Set Input=""
 ..If Input=")" Do
 ...If DatVan<$H Set DatVan=DatVan+1,Dir=1
 ...Else  Write *7 Set Input=""
 Quit
 
TRANSUUR New GroupBy,Dev,Date,Uur,Cnt,Min,Max
 Set GroupBy=$G(GroupBy,15)*60 ; Default 15 min.
 Do FETCHUUR(DatVan,DatTot,GroupBy)
 Set Dev=$$OPEN^vhDEV($$DIRUSER^vhDEV,$$ASKFILE^vhDEV("PICKPERF.TXT"),"W")
 Use Dev
 Set Date="",Uur=0
 Write $TR("Datum;Uur;Aantal;PerTwee;PerVier",";",$C(9)),!
 For  Set Date=$O(^HULP(%J,Date)) Quit:Date=""  Do
 .Set Cnt=0
 .For Uur=Min:(GroupBy):Max  Do
 ..Write $$EXTDATE^vhLib.DataTypes(Date),$C(9),$$EXTTIME^vhLib.DataTypes(Uur),$C(9),$G(^HULP(%J,Date,Uur))
 ..Set Cnt=Cnt+1
 ..Write $C(9)
 ..Write:Cnt>1 $G(^HULP(%J,Date,Uur))+$G(^HULP(%J,Date,Uur-GroupBy))
 ..Write $C(9)
 ..Write:Cnt>3 $G(^HULP(%J,Date,Uur))+$G(^HULP(%J,Date,Uur-GroupBy))+$G(^HULP(%J,Date,Uur-(2*GroupBy)))+$G(^HULP(%J,Date,Uur-(3*GroupBy)))
 ..Write !
 Close:0'[Dev Dev
 Quit
 
FETCHUUR(DatVan,DatTot,GroupBy) 
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr,KLNr,R,ORDNr,OLUNr,SOLUNr
 Set DatTot=$G(DatTot)
 Kill ^HULP(%J)
 Set CONSNr=""
 Set Max=-1,Min=99999999
 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 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 SOLUNr=""
 ...For  Set SOLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)) Quit:SOLUNr=""  Do
 ....Set R=^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)
 ....Quit:'$P(R,D,5)
 ....Quit:$P(R,D,5)<17000000  ; Direct uitvoer
 ....Quit:$P(R,D,5)>22000000  ;Ugly
 ....Set Dat=$P($P(R,D,6),",")
 ....Set Uur=$P($P(R,D,6),",",2)
 ....Set Uur=Uur\(GroupBy)*GroupBy ; Per x minuten
 ....Set ^HULP(%J,Dat,Uur)=$G(^HULP(%J,Dat,Uur))+1
 ....Set:Uur>Max Max=Uur
 ....Set:Uur<Min Min=Uur
 Quit

ExportPicker(DatVan,DatTot) 
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr,KLNr,R,ORDNr,OLUNr,SOLUNr

 Set Dev=$$OPEN^vhDEV(,"WMS Picking "_$$EXTDATE^vhLib.DataTypes($H)_".TXT","W","T")
 Use Dev
 Write "BONNr	ORDNr	OLUNr	SOLUNr	ExtraVeld	MPRNr	MKortTekst	MQty	GenTyp	ProdGrp	PRNr	KortTekst	Qty	Picker	Datum	Tijd	SoftMag	PickMag	Pallet",!
 Set DatVan=$G(DatVan,$H-60)
 Set DatTot=$G(DatTot,$H-1)
 Set CONSNr=""
 Set Max=-1,Min=99999999
 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 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 MPRNr=$P($G(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)),"\")
 ...Set MQty=$P($G(^ORDW("D",CONSNr,"D",ORDNr,OLUNr)),"\",4)
 ...Set GenTyp=$P($$GENTYP^HAD(MPRNr,1),"\")
 ...Set ProdGrp=$$PRODGRP^PRODUKT(MPRNr,1) 
 ...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 Dat=$P($P(R,D,6),",")
 ....Set Uur=$P($P(R,D,6),",",2)
 ....Set Pallet=$P(R,D,10)
 ....Set Picker=$P(R,D,12)
 ....Quit:Picker=""
 ....Set SoftMag=$P(R,D,13)
 ....Set PickMag=$P(R,D,14)
 ....Set PRNr=$P(R,D,1)
 ....Set Qty=$P(R,D,4)
 .... Write CONSNr,*9,ORDNr,*9,OLUNr,*9,SOLUNr,*9,CONSNr,";",ORDNr,";",OLUNr,*9,MPRNr,*9,$$$ProductGet(MPRNr,$$$KortTekst),*9,MQty,*9,GenTyp,*9,ProdGrp,*9,PRNr,*9,$$$PRGet($$$KortTekst),*9,$$$ExcelNum(Qty),*9,Picker,*9,$$$ExcelDat(Dat),*9,$$$ExcelTime(Uur),*9,SoftMag,*9,PickMag,*9,Pallet,!
 Do CLOSE^vhDEV(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,23) ; Einde consolidatie
 .Set:'DatBon DatBon=+$P(R,D,19) ; Op bon gezet
 .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:'$D(^KPR(PRNr))
 ...Set IsOrgal=$$ISORGAL^PRODUKT2(PRNr)
 ...Quit:$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,4)<0
 ...Set Status=$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr),D,3)
 ...Quit:Status="t" ; terugname
 ...Quit:Status="z" ; zonder stockaanpassing
 ...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)
 ....Set SoftV=$P(R,D,13)
 ....Set:SoftV?1N SoftV="E" ; Groepering van automatisch mag.
 ....Quit:'$L(SoftV)
 ....Quit:'$L($P(R,D,10))&'$L($P(R,D,5)) ; Bronpallet
 ....Set:IsOrgal DatRec("ORGAOL")=$G(DatRec("ORGAOL"))+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
 ....;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),$C(9),SoftV,$C(9),$P(R,D,10)
 ....Set DatRec("SOL")=$G(DatRec("SOL"))+1 ; SOL
 ....If SoftV="E" Do
 ..... Set DatRec("SOLE")=$G(DatRec("SOLE"))+1 ; EWMS pickpost
 ..... If $P(R,D,5)<15000000 Set DatRec("SOLED")=$G(DatRec("SOLED"))+1 ; SOL Directe uitvoer
 ..... Else  Do
 ...... Set DatRec("SOLEP")=$G(DatRec("SOLEP"))+1 ; EWMS pickpost
 ...... If $P(R,D,5)<(15800000) Set DatRec("SOLEP1")=$G(DatRec("SOLEP1"))+1 ; Pickpost 1
 ...... Else  If $P(R,D,5)<(16990000) Set DatRec("SOLEP2")=$G(DatRec("SOLEP2"))+1 ; Pickpost2
 ...... Else  Set DatRec("SOLEU")=$G(DatRec("SOLEU"))+1 ; EWMS uglypick
 ..... Set:IsOrgal DatRec("SOLEO")=$G(DatRec("SOLEO"))+1 ; Dubbeltelling orgalux
 ....Else  Do  ;SoftV=Uglypick
 ..... Set DatRec("SOLU")=$G(DatRec("SOLU"))+1 ; SOL UGLY
 ..... Set:(SoftV="A")&&$$IsAventos^PRODUKT2(PRNr) SoftV="K" ; klepbeslag apart van Tandem
 ..... Set DatRec("SOLU"_SoftV)=$G(DatRec("SOLU"_SoftV))+1 ; SOL UGLY Softv
 .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
 Quit
 ;
PICKLOG(PalId,Datum) 
 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,SoftV,Def) 
 New RecJ,GVP,NVP,GVPQty,NVPQty,Tijd
 Quit:$E($O(^KPR(PRNr,"J")))'="J" 0
 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;
LORD6 ;WOLe  ;      Status e of m;
LORD7 ;WOLK  ;   Orderlijnen (incl. kind);OLKind
LORD8 ;WOLP  ;      Zelfde produkt;OLIdemProd
LORD9 ;SOL   ;   Suborderlijnen;SubOL
LORD10 ;SOLE  ;   EWMS;
LORD11 ;SOLEP ;      Pickpost;SubOLEPick
LORD12 ;SOLEP1;         PP1  ;SubOLEPick1
LORD13 ;SOLEP2;         PP2  ;SubOLEPick2
LORD14 ;SOLED ;      Directe uitvoer;SubOLDirUitv
LORD15 ;SOLEU ;      Ugly pick;SubOLEUglyPick
LORD16 ;SOLEO ;      Orgalux dubbeltelling;SubOLEOrgalux dubtel
LORD17 ;SOLU  ;   UGLY;
LORD18 ;SOLUH ;      Halux   ;SubOLHalux
LORD19 ;SOLUL ;      Langgoed;SubOLLanggoed
LORD20 ;SOLUO ;      Orgalux ;SubOLOrgalux
LORD21 ;SOLUU ;      Ugly    ;SubOLUgly
LORD22 ;SOLUA ;      Tandem  ;SubOLTandem
LORD23 ;SOLUK ;      Aventos ;SubOLAventos
LORD24 ;MBON  ;Manueel leveringsbons;Bons Manueel
LORD25 ;MOL   ;   Orderlijnen;OL Manueel
 
Lijst 
 New R,CONSNr,DatBon,PRNr,DatRec,KLNr,PRNr
 Set CONSNr=""
 Set Dev=0
 Set Dev=$$OPEN^vhDEV(,"TEST.TXT","W")
 Use Dev
 Write $TR("KLNr,KLNaam,Regio,BonNr,Datum,Tijd,PRNr,KortTekst,SortKey,SrcPal,Qty,IsOrgal,PickTyp",",",$C(9)),!
 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,23) ; Einde consolidatie
 .Set Dat=$TR($$EXTDATE^vhLib.DataTypes(DatBon,"DKP"),".","/")
 .Set Tijd=$$EXTTIME^vhLib.DataTypes($P($P(R,D,23),",",2))
 .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:'$D(^KPR(PRNr))
 ...Set IsOrgal=##class(DOM.DomeinContext).Instance().GeefProductTypeAPI().IsOrgaluxProduct(PRNr)
 ...Set RecOL=^ORDW("D",CONSNr,"D",ORDNr,OLUNr)
 ...Quit:$P(RecOL,D,4)<0 
 ...Quit:'$P($G(^KPR(PRNr,2)),D,15)  ; OL Manueel
 ...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:'$D(^KPR(PRNr))
 ....Set Qty=$P(R,D,4)
 ....;Quit:'$P(R,D,5)  ; geen cons pallet
 ....Set PickTyp=$P(R,D,13)
 ....;If $D(^KPR(PRNr,"J6332")) Set PickTyp="H" ; Halux
 ....;Else  If $P(R,D,5)<15000000 Set PicKTyp="D" ; Directe uitvoer
 ....;Else  If $P(R,D,5)<(15400000++$S(60576<+DatBon:0,1:200000)) Set PickTyp="P1" ; Pickpost 1
 ....;Else  If $P(R,D,5)<(15600000++$S(60576<+DatBon:0,1:100000)) Set PickTyp="P2" ; Pickpost 2
 ....;Else  Do
 .....;If $P($G(^KPR(PRNr,2)),D,15)=3 Set PickTyp="L" ; Langgoed
 .....;Else  Set PickTyp="U" ; SOL UGLY
 ....Set SortKey=$$SORTKEY^PRODUKT(PRNr)
 ....Set KortT=$P(^KPR(PRNr,0),D,1)
 ....Set BXTyp=""
 ....If SortKey["BX" Do
 .....If KortT["TA+ZRE" Set BXTyp="TO"
 .....If KortT["TAN-BOX V1" Set BXTyp="TO"
 .....If KortT["ZA R+L" Set BXTyp="TN"
 .....If KortT["RWH R+L" Set BXTyp="TN"
 .....If KortT["KO R+L" Set BXTyp="TN"
 .....If KortT["ICREL-SET 2" Set BXTyp="TN"
 ....Set lbVerpak=$$lbVerpak^PRODUKT(PRNr)
 ....Write KLNr,$C(9),$P(^KKL(^KK1(KLNr),0),D,2),$C(9),$P(^KKL(^KK1(KLNr),0),D,20),$C(9),CONSNr,$C(9),Dat,$C(9),Tijd,$C(9),PRNr,$C(9),KortT,$C(9),SortKey,$C(9),$P(R,D,10),$C(9),Qty,$C(9),IsOrgal,$C(9),PickTyp,$C(9),BXTyp,*9,$LG(lbVerpak),!
 Close:0'[Dev Dev
 Quit
 ;