#include Prod.Product
#include BL.Derde.LevSpecifiek
#include vhLib.Macro
EWPR ;E'WMS Produkten [ 12/04/2003  4:37 PM ]
 
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  Quit:PRNr>70000
 .Quit:'$$CHKSEND(PRNr) 
 .Set Status=$$CHKAFGL(PRNr)
 .Write PRNr,$C(9),$P(^KPR(PRNr,0),D,1),$C(9),$S(Status:"",1:Status),!
 Quit
 ;
 
ZendFromExcel(PRNr)
	Set Q="K",D="\",U=";",QU="PV"
    Do BUILD(PRNr),ZEND^EWRECS("C")
    Set $P(^KPR(PRNr,2),D,17)="A;"_$H
	Q "Send"
 
 
 ; ##class(TECH.Config.ConfigMgr).Instance().SetBoolean("EWMSProductSyncViaSQL",$$$false)
 ; ##class(TECH.Config.ConfigMgr).Instance().SetBoolean("EWMSProductSyncViaEWMS2003",$$$false)
 
ZEND(PRNr,Forced) 
 New C, EWMSProductSyncViaSQL,EWMSViaEWMS2003
 Set EWMSViaSQL = ##class(TECH.Config.ConfigMgr).Instance().GetBoolean("EWMSProductSyncViaSQL",$$$false)
 Set EWMSViaEWMS2003 = ##class(TECH.Config.ConfigMgr).Instance().GetBoolean("EWMSProductSyncViaEWMS2003",$$$True)
 ;Q ; Tijdelijk geen produkt info doorsturen
 If ($$CHKSEND(PRNr)&&("1D"[$$CHKAFGL(PRNr)))||$G(Forced) Do
 . Do BUILD(PRNr)
 . Do:(EWMSViaEWMS2003) ZEND^EWRECS("C")
 . Do:(EWMSViaSQL) ##class(BL.Legacy.EWPR).ZendSQL("C")
 . Set $P(^KPR(PRNr,2),D,17)="A;"_$H
 Quit
 
ZENDALL 
 New PRNr,EndPRNr,Cnt,MemCnt,DH,C
 Read !,"Dit Programma duurt ongeveer een uur (Doorgaan=[] of start PRNr[]) : ",C
 Quit:C'=""&(C'?4.7N)
 Set PRNr=$S(C?4.7N:C-1,1:0)
 Set MemCnt=0,Cnt=0
 Set EndPRNr=$O(^KPR(""),-1)
 For  Do  Quit:PRNr=""
 .Set DH=""
 .Set StartPRNr=PRNr
 .For  Set PRNr=$O(^KPR(PRNr)) Quit:'PRNr  Do  Quit:Cnt'=MemCnt&(Cnt#500=0)
 .. ;Quit:'$$CHKSEND(PRNr)
 .. ;Quit:'$$CHKAFGL(PRNr)
 .. Quit:$$$PRGet($$$OpslagZone)'=3
 .. Set Cnt=Cnt+1
 .. W $$$ProductGet(PRNr,$$$KortTekst)," - ",$$$PRGet($$$OpslagZone),!
 .. Set:'DH DH=$$OPEN^EWRECS
 .. Do BUILD(PRNr),PUT^EWRECS(DH,"C")
 .. Set $P(^KPR(PRNr,2),D,17)="A;"_$H
 .Do:DH CLOSE^EWRECS(DH,1) ; met NoStore
 .Set MemCnt=Cnt
 .Write !,Cnt," : ",StartPRNr," -> ",PRNr," Max:",EndPRNr
 .Hang 20
 Quit
 
SYNCAFGL ; Alle generisch afgeleide producten weghalen die gedurende 1 maand niet meer bewogen zijn en waarvoor er geen "W" node bestaat  
 ; Alle producten waarvoor er terug een "W" node bestaat moeten terug doorgestuurd worden
 Set PRNr=0
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do  Quit:PRNr>50000
 .Set ChkSend=$$CHKSEND(PRNr)
 .Set ChkAfgl=$$CHKAFGL(PRNr)
 .If $P($P(^KPR(PRNr,2),D,17),";")="D" Do  ; Reeds verwijderd, maar het moet terug geactiveerd worden
 ..Do:ChkAfgl ZEND(PRNr)
 .Else  If 'ChkSend!'ChkAfgl Do  ; Reeds doorsgestuurd, eventueel verwijderen
 .. Q:'$D(^KPR(PRNr,"J6332"))
 ..;Write PRNr,$C(9),$P(^KPR(PRNr,0),D,1),$C(9),ChkSend,$C(9),ChkAfgl,!
 ..;r K
 ..Set:'ChkSend!'ChkAfgl Status=$$CHKDEL(PRNr)
 ..Write PRNr,$C(9),$P(^KPR(PRNr,0),D,1),$C(9),ChkSend,$C(9),ChkAfgl,$C(9),Status,!
 Quit
 
CHKDEL(PRNr)  ; OUDE ROUTINE, zie DeleteProd^EWPR
 Quit:$P(^KPR(PRNr,2),D,15)=0 1 ; Opslagzone Manueel
 Quit:$E($P(^KPR(PRNr,0),D),1,6)="EGEMIN" 1
 New C,W,WH
 Set C="P02"
 Set C("PRNR")=PRNr
 Set C("DATUM")=$H
 Set W="P03"
 Set W("PRNR")=PRNr
 Set WH=$$ZENDWAIT^EWRECW("C","W")
 Do GET^EWRECW(WH,"W")
 Set:$G(W("STATUS"))="OK" $P(^KPR(PRNr,2),D,17)="D;"_+$H
 Quit $G(W("STATUS"))="OK"
 
CHKSEND(PRNr) ; Nakijken of een product mag verstuurd worden naar E'WMS
 Quit:$P(^KPR(PRNr,1),D,25)=1 0 ; Non-aktief
 Quit:$P(^KPR(PRNr,0),D,3)?1A1.E 0 ; Generisch product NIET overdragen naar het WMS (wel de afgeleide)
 Quit:$P(^KPR(PRNr,2),D,15)=0 0 ; Opslagzone Manueel
 ;Quit:+$$$PRGet($$$CifPPLEUR)>0 0
 Quit 1
 
CHKAFGL(PRNr,Dagen) ; Controle of afgeleid product nog moet verstuurd worden
 ; Status = 1 -> moet verstuurd worden
 ; Status = H -> historiek ouder dan x dagen
 ; Status = A -> verstuurd naar WMS ouder dan x dagen
 ; Status = D -> reeds verwijderd mag verwijderd blijven
 New Key,Rec,Node,Datum,Status
 Set Dagen=$S($D(^KPR(PRNr,"J6332")):60,1:360) ; Halux op 30 dagen de andere op 360
 Set Status=1 ; Moet verstuurd worden
 If '$P(^KPR(PRNr,0),D,3) Quit Status ; Geen Afgeleid product
 If $E($O(^KPR(PRNr,"W")))="W"  Quit Status ; Er zijn orders of toeleveringen
 If PRNr+100>^KPR(0,1) Quit Status ; Recent product
 Set Key="H"
 Set Key=$O(^KPR(PRNr,"I"),-1)
 If Key?1"H"4N Do  ; Er is historiek
 .Set Rec=^(Key)
 .Set Node=""
 .Set:($L(Rec,D)>0) Node=$P(Rec,D,$L(Rec,D))
 .Set:Node=""&($L(Rec,D)>1) Node=$P(Rec,D,$L(Rec,D)-1)
 .Quit:Node=""
 .Set Datum=$$INTDATE^vhLib.DataTypes($E(Node,5,6)_"/"_$E(Node,3,4)_"/"_$E(Node,1,2),"DK")
 .Set:Datum<($H-Dagen) Status="H"
 Else  If $P($P($G(^KPR(PRNr,2)),D,17),";")="A" Do  ; Geen historiek dus kijken naar de verzend datum WMS
 .Set:$P($P(^KPR(PRNr,2),D,17),";",2)<($H-Dagen) Status="A"
 Else  If $P($P($G(^KPR(PRNr,2)),D,17),";")="D" Do  ; Reeds verwijderd mag dus verwijderd blijven
 .Set Status="D"
 Quit Status
 
BUILD(PRNr) ; Opvullend van de cache met de produktgegevens
 New P,KleurC,KleurO
 Do FETCHPR^UTILI(PRNr,"P")
 Kill C
 Set C="P01" ; Produkt record
 Set C("PRNR")=PRNr
 Set C("IDNR")=$$KortAfIdentNrTotMaxLengteVoorEgemin($P(P(2),D,25))
 Set C("KORTTEKST")=$P(P(0),D,1)
 Set C("OMSCHRIJFNED")=$$TEKST(45,"0.2;0.11;6.1;6.2;6.3;6.4")
 Set KleurC=$E($P(P(0),D,1),22,25)
 Set KleurO=$G(^KCOL(KleurC_" ","N"))
 Set:$L(KleurO) $E(C("OMSCHRIJFNED"),45-$L(KleurO)+1,45)=KleurO
 Set C("OMSCHRIJFFRANS")=$$GeefItemIDForAX(PRNr) ;$$TEKST(45,"1.22;3.21;8.1;8.2;8.3;8.4")
 ;Set KleurO=$G(^KCOL(KleurC_" ","F"))
 ;Set:$L(KleurO) $E(C("OMSCHRIJFFRANS"),45-$L(KleurO)+1,45)=KleurO
 ;Set KleurO=$G(^KCOL(KleurC_" "),"N")
 Set C("LEVNR")=$P(P("J"),D,1)
 Set C("LEVNM")=$P(^KLE(^KL1(C("LEVNR")),0),D,2)
 Set C("LEVREF")=$P(P("J"),D,3)
 Set C("LEVREFOMS")=$$TEKST(45,"4.1;4.2;4.3;4.4;4.5;4.6;4.7;4.8;4.9;4.10")
 Set C("TELBAAR")=+$P(P(1),D,7)
 Set C("AKP")=$$AankoopPrijs(PRNr)
 
 If +C("LEVNR")=5005 Do  ; Blum
 . Set C("AANTALGVP")=$P(P("J"),D,16)
 . Set C("AANTALKVP")=$P(P("J"),D,15)
 . Set:'C("AANTALKVP") C("AANTALKVP")=$P(P("J"),D,14) ; Indien norm niet is ingevuld dan kleinverpakking
 Else  Do ; Alle andere dan BLU, geen verpakkings gegeven meesturen
 . Set C("AANTALGVP")=""
 . Set C("AANTALKVP")=""
 
 Set C("SNS")=$P(P(1),D,20)
 Set C("MKBTYPE")=$S($P(P(0),D,23)="K":"K",$D(^PRLINK("D",PRNr)):"M",1:"")
 Set C("MOEDERPRNR")=$D(^PRLINK("IKM",PRNr))>0 ; vermits een kind meerdere moeders kan hebben alleen maar markering of dat het een moeder heeft
 Set C("PRODUKTGROEP")=$P(P(1),D)
 Set:+C("PRODUKTGROEP")=0 C("PRODUKTGROEP")=1
 Set C("CYCLECOUNTTYPE")=$P(P(1),D,2)
 Set:+C("CYCLECOUNTTYPE")=0 C("CYCLECOUNTTYPE")=4
 Set C("ABCKLAS")=+$CASE($P($P(P(0),D,8),"#"),"A":1,"B":2,:3)
 Set C("BARCODE")=$P(P(2),D,14)
 Set C("SORTKEY")=$$SORTKEY^PRODUKT(PRNr)
 Set C("GEWICHT")=$P(P(1),D,13)*1000 ; in mg, moet nauwkeuriger ingegeven kunnen worden
 Set C("SAMPLETYPE")="" ;$P(P(2),D,12)
 Set C("HOOGTE")=$P(P(1),D,4)
 Set C("BREEDTE")=$P(P(1),D,5)
 Set C("LENGTE")=$P(P(1),D,6)
 Set C("DATUMFIFO")=$P(P(1),D,8)
 Set C("OPSLAGZONE")=$P(P(2),D,15)
 Set C("TELWIJZE")="" ;$P(P(2),D,11)
 Set C("PALLETAANTAL")=$P(P(2),D,16)
 Set C("IMAGE")=##class(BL.Prod.ImageLink).%New().GetProductImageURL(PRNr,"WMS")
 Set:C("IMAGE")'="" C("IMAGE")=$$REPLACE^vhRtn1(C("IMAGE"),"Notes01","EWMS2003")
 ;Wijzig accenten in std. ascii
 ;Do VANNAAR^vhTERMINA("ASCII")
 ;Set C("OMSCHRIJFNED")=$TR(C("OMSCHRIJFNED"),FVAN,FNAAR)
 ;Set C("OMSCHRIJFFRANS")=$TR(C("OMSCHRIJFFRANS"),FVAN,FNAAR)
 ;Set C("LEVREFOMS")=$TR(C("LEVREFOMS"),FVAN,FNAAR)
 Quit
 
AankoopPrijs(PRNr)
	New CifPPL,BLID,lbPRNrs,CifPPLSom,CifPPL2,Cnt,PRNr2
	Set CifPPL=+$$$PRGet($$$CifPPLEUR)
	Set (CifPPLSom,Cnt)=0
	If (+CifPPL=0)&&($$$PRGet($$$LeveranciersNr)=$$$LevBlum) Do ; zonder prijs
	. Set BLID=$$GetBlumID^BLPROD(PRNr)
    . Set lbPRNrs=$$GetVHProds^BLPROD(BLID)
    . For I=1:1:$LL(lbPRNrs) Do
    . . Set PRNr2=$LG(lbPRNrs,I)
    . . Quit:PRNr2=""
    . . Quit:PRNr=PRNr2
    . . Set CifPPL2=$$$ProductGet(PRNr2,$$$CifPPLEUR)
    . . ;W $$$ProductGet(PRNr2,$$$KortTekst)," ",CifPPL2,!
    . . Quit:+CifPPL2=0
    . . Set Cnt=Cnt+1
    . . Set CifPPLSom=CifPPLSom+CifPPL2
    . Set:Cnt CifPPL=CifPPLSom/Cnt
	Quit CifPPL


Image(PRNr)
	Set StartPad=##class(TECH.Config.ConfigMgr).Instance().GeefString("ImagesDirectory","\\Notes01\Images") _ "\"
	Set rsImg=##Class(%ResultSet).%New("Res.ImageLink:GetViaFunctieTypes")
	Do rsImg.Execute("PR",PRNr,$LB("PB"),"N") ; Haalt alle objecten waarvang de functietype is PB en AG (ook dubbels worden getoond)
	Set TFile=""
	For  Quit:'rsImg.Next()  Do
	. Set TFile=##class(Res.ImageLink).GetFile(StartPad,rsImg.Data("%ID"),"W","\")
	Quit TFile

GeefItemIDForAX(PRNr)
	New Translator,ItemID
 	Set Translator=##class(AX.Uitgaand.EC.DataAX.impl.Translator).%New()
 	Set ItemID=Translator.GeefItemIDForAX(PRNr)
 	Quit ItemID
 	
KortAfIdentNrTotMaxLengteVoorEgemin(Identnr)
 New KortIdentnr
 Set KortIdentnr = $S($L(Identnr)>11:$Reverse($P($Reverse(Identnr),".")_$P($Reverse(Identnr),".",2,9)),1:Identnr)
 Quit KortIdentnr
 
ZENDEMPTY ; Opvullend van de cache met de produktgegevens
 New P,KleurC,KleurO
 Kill C
 Set C="P01" ; Produkt record
 Set C("PRNR")="EMPTY"
 Set C("IDNR")="1.234.567.8"
 Set C("KORTTEKST")="DUMMY PRODUCT"
 Set C("OMSCHRIJFNED")="DUMMY PRODUCT EMPTY"
 Set KleurC=""
 Set KleurO=""
 Set C("OMSCHRIJFFRANS")=""
 Set KleurO=""
 Set C("LEVNR")="5005"
 Set C("LEVNM")="BLUM"
 Set C("LEVREF")=""
 Set C("LEVREFOMS")=""
 Set C("TELBAAR")=0
 Set C("AKP")=9999
 Set C("AANTALGVP")=1
 Set C("AANTALKVP")=1
 Set C("SNS")=1
 Set C("MKBTYPE")=""
 Set C("MOEDERPRNR")=""
 Set C("PRODUKTGROEP")=""
 Set C("CYCLECOUNTTYPE")=""
 Set C("ABCKLAS")=""
 Set C("ABCKLAS")=""
 Set C("BARCODE")=""
 Set C("SORTKEY")=""
 Set C("GEWICHT")=""
 Set C("SAMPLETYPE")=""
 Set C("HOOGTE")=""
 Set C("BREEDTE")=""
 Set C("LENGTE")=""
 Set C("DATUMFIFO")=""
 Set C("OPSLAGZONE")="1"
 Set C("TELWIJZE")=""
 Set C("PALLETAANTAL")=""
 Do ZEND^EWRECS("C")
 Quit
TEKST(Len,Refs) 
 New Txt,T
 Set Txt=""
 For I=1:1:$L(Refs,";") Do
 .Set T=$P($G(P($P($P(Refs,";",I),"."))),D,$P($P(Refs,";",I),".",2))
 .Quit:T=""
 .Set T=T_$J("",Len-$L(T))
 .Set Txt=Txt_T
 Quit Txt
 
CheckProdInUse(ProdNr)
	New OrderNr,Status,LocID
	Set Status=""
	
	; ====== To_Receive ======
	&sql(DECLARE crTR CURSOR FOR SELECT OrderNr INTO :OrderNr FROM EWMS.ToReceive WHERE (Product=:ProdNr) AND (QtyToReceive <> QtyTransported))	
	&sql(OPEN crTR)
 	For  &sql(FETCH crTR) Quit:SQLCODE  Do  Quit:Status["R"
	. Quit:$G(OrderNr)=""
	. Quit:'$D(^RCP("D",OrderNr)) ; bestaat niet meer in RCP
	. Quit:$P(^RCP("D",OrderNr),"\",20)="I" ; ingeboekt
	. Set Status=Status_"R"
	&sql(CLOSE crTR)
	
	; ====== To_Pick ======
	k OrderNr
	&sql(DECLARE crTP CURSOR FOR SELECT order_nr INTO :OrderNr FROM EWMS_Pick.ToPick WHERE (product=:ProdNr) AND (qty_to_pick <> qty_picked))	
	&sql(OPEN crTP)
 	For  &sql(FETCH crTP) Quit:SQLCODE  Do  Quit:Status["P"
	. Quit:$G(OrderNr)=""
	. Quit:'$D(^ORDW("D",OrderNr)) ; bestaat niet meer in RCP
	. Quit:$P(^ORDW("D",OrderNr),"\",20)="B" ; op bon
	. Set Status=Status_"P"
	&sql(CLOSE crTP)
	
	; ====== Inventory ======
	&sql(DECLARE crI CURSOR FOR SELECT loc_id INTO :LocID FROM EWMS.Inventory WHERE (product=:ProdNr) AND (loc_m<5))	
	&sql(OPEN crI)
	&sql(FETCH crI)
	Set:($D(LocID)) Status=Status_"I"
	&sql(CLOSE crI)	
	
	Quit Status
	
DeleteProd(ProdNr)
	k %msg
	&sql(DELETE FROM EWMS.Product WHERE (product=:ProdNr))
	Quit:($D(%msg)) "SQLCode #"_$G(SQLCODE,"?")_": "_%msg
 
	k %msg
	&sql(DELETE FROM EWMS.VHProductGegevens WHERE (product=:ProdNr))
	Quit:($D(%msg)) "SQLCode #"_$G(SQLCODE,"?")_": "_%msg
	
	k %msg
	Set:$D(^KPR(ProdNr,2)) $P(^KPR(ProdNr,2),"\",17)="D;"_+$H ; Markeren dat het product verwijderd werd uit het EWMS
	Quit ""