HADETIK ;Afdrukken Halux deuretiketten [ 11/13/2003  2:38 PM ]
 #include BL.Derde.KlantSpecifiek
 #include BL.Derde.LevSpecifiek
 #include Prod.Product
 #include vhLib.Macro
 ;#define BartenderPath "\\FOP\DROPFOLDER\HALPROD01\"
 #define BartenderPath "\\BARTENDER\DROPFOLDER\"
 ;#define BartenderPath "\\notes01\shared\p v\"
 
 
 Do ORDER(168916,"") 
 
 ;Do PRINT(103,"P","","",181039,1) 
 Q
 ;
ORDER(ORDNr,OLNr,Print,Order) 
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant,SortKey
 Kill %Print2File
 ;Set:$zcvt($io,"U")["PV_XP" 
 Set %Print2File=1
 Set ORDNr=$G(ORDNr),OLNr=$G(OLNr)
 If 'ORDNr Do ;Order opvragen en via recursie verwerken
 .Do DISPLAY^vhScherm("HADETIKBO")
 .For  Do FIELD^vhScherm("HADETIKO","ORDNR") Quit:ORDNr="-"  Do
 ..Quit:'$$ISHALUX^FLOW("O",ORDNr)
 ..Do ORDER(ORDNr,,.Print)
 Else  If 'OLNr Do ; Elke lijn van het order via recursie verwerken
 .Do INIT
 .Quit:'$D(Print)
 .Set Dev=$G(Print("DEV"))
 .Quit:0[Dev
 .Set R=^KO1(ORDNr,"F"),KLNr=$P(R,D)
 .Set Order=1,OLNr=100
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 ..Quit:'$$ISHALUX^FLOW("O",ORDNr,OLNr)
 ..Do ORDER(ORDNr,OLNr,.Print,.Order)
 .Set SortKey=""
 .For  Set SortKey=$O(Order(SortKey)) Quit:SortKey=""  Do
 ..Set R=Order(SortKey),PRNr=$P(R,D),Aantal=$P(R,D,2),OLNr=$P(R,D,3)
 ..Do PRINT(Dev,"O",ORDNr,OLNr,PRNr,Aantal)
 Else  Do ; per lijn
 .Set Dev=$G(Print("DEV"))
 .Do:0[Dev INIT
 .Set Dev=$G(Print("DEV"))
 .Quit:0[Dev
 .Set R=^KO1(ORDNr,"F"),KLNr=$P(R,D)
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr,"J"_$$$LevHalux))
 .Quit:($$ISTBX^PRODUKT2(PRNr))&&($LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"VERPAK"))?1(1"A",1"B")) ; Geen etiket vragen voor VHOSS
 .Set Aantal=$P(R,D,3)
 .Quit:Aantal'>0
 .Set DefAant=$$DEFAANT(PRNr)
 .If DefAant,DefAant<Aantal Set Aantal=DefAant
 .Do STORE^vhTERMINA()
 .Set FP=1801
 .Write @F,@F1
 .Do DISPLAY^vhScherm("HADETIKO","","","","ORDNR;PRNR")
 .Do FIELD^vhScherm("HADETIKO","AANTAL")
 .Do REFRESH^vhTERMINA()
 .If %SC,Aantal Do
 ..If $G(Order) Do
 ...Set SortKey=$$SortKey(PRNr) Set:$L(SortKey) SortKey=SortKey_"-" Set SortKey=SortKey_OLNr
 ...Set Order(SortKey)=PRNr_D_Aantal_D_OLNr
 ..Else  Do PRINT(Dev,"O",ORDNr,OLNr,PRNr,Aantal)
 If $D(%Print2File)>1 Do
 . Do Print2File("HAD",Dev)
 Quit
 ;
TOE(TOENr,TLNr,Print,Order) 
 ; TOENr verplicht, TLNr optioneel
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant,SortKey
 Set LEVNr=$$$LevHalux
 Kill %Print2File
 Set %Print2File=1
 Set TLNr=$G(TLNr)
 If 'TLNr Do
 .Do INIT
 .Quit:'$D(Print)
 .Set Dev=$G(Print("DEV"))
 .Quit:0[Dev
 .Set Order=1,TLNr=100
 .For  Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr=""  Do
 ..Quit:'$$ISHALUX^FLOW("T",TOENr)
 ..Do TOE(TOENr,TLNr,.Print,.Order)
 .Set SortKey=""
 .For  Set SortKey=$O(Order(SortKey)) Quit:SortKey=""  Do
 ..Set R=Order(SortKey),PRNr=$P(R,D),Aantal=$P(R,D,2),TLNr=$P(R,D,3)
 ..Do PRINT(Dev,"T",TOENr,TLNr,PRNr,Aantal)
 Else  Do
 .Set Dev=$G(Print("DEV"))
 .Do:0[Dev INIT
 .Set Dev=$G(Print("DEV"))
 .Quit:0[Dev
 .Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr,"J"_$$$LevHalux))
 .Quit:($$ISTBX^PRODUKT2(PRNr))&&($LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"VERPAK"))?1(1"A",1"B")) ; Geen etiket vragen voor VHOSS
 .Set Aantal=$P(R,D,3)
 .Do:Aantal>0
 ..New ORDNr
 ..Set DefAant=$$DEFAANT(PRNr)
 ..If DefAant,DefAant<Aantal Set Aantal=DefAant
 ..Do STORE^vhTERMINA()
 ..Set FP=1801
 ..Write @F,@F1
 ..Set ORDNr=TOENr
 ..Do DISPLAY^vhScherm("HADETIKO","","","","ORDNR;PRNR")
 ..Do FIELD^vhScherm("HADETIKO","AANTAL")
 ..Do REFRESH^vhTERMINA()
 ..Set:'%SC Aantal=0
 .If Aantal>0 Do
 ..If $G(Order) Do
 ...Set SortKey=$$SortKey(PRNr) Set:$L(SortKey) SortKey=SortKey_"-" Set SortKey=SortKey_TLNr
 ...Set Order(SortKey)=PRNr_D_Aantal_D_TLNr
 ..Else  Do PRINT(Dev,"T",TOENr,TLNr,PRNr,Aantal)
 If $D(%Print2File)>1 Do
 . Do Print2File("HAD",Dev)
Quit
 
FETCHO(ORDNr,OLNr,PRNr,Aantal,C)  ; ophalen order en klant gegevens
 New R,KLNr,Adres,Taal,GNode,GenPRNr,KlRef,PAKNr,GenTyp,DosNr,ToeNr,TLNr,BONNr,ProjectRef,RitRef, ProductOrderLijn
 Set C("ORDNR")=ORDNr
 Set R=^KO1(ORDNr,"F"),KLNr=$P(R,D),BONNr=$P(R,D,2)
 Quit:KLNr=""
 Do ORDREF(ORDNr,1,.C)
 If KLNr=1239 Do 
 . Set RitRef=$S('OLNr:"",PRNr'?4.7N:"",1:$P($S(BONNr:^KUL(KLNr,"F",BONNr,OLNr),1:^KOD(KLNr,"F",ORDNr,OLNr)),D,45)) ; ritnr
 . Set:$L(RitRef) C("ORDREF")=C("ORDREF")_" - "_RitRef
 Else  Do
 . Set ProjectRef=$S('OLNr:"",PRNr'?4.7N:"",1:$P($S(BONNr:^KUL(KLNr,"F",BONNr,OLNr),1:^KOD(KLNr,"F",ORDNr,OLNr)),D,5))
 . Set:$L(ProjectRef) C("ORDREF")=ProjectRef ; Projectreferentie is belangrijker dan de orderreferentie
 Do ADRES(ORDNr,KLNr,.C)
 Do VerzendWijze(KLNr,ORDNr,.C)
 If (KLNr=$$$KlantHein)||(KLNr=$$$KlantOptimaPack) Set C("KLNMBIG")=$$UPTRIMAN^vhRtn1(C("ORDREF")) ; Voor Hein en Optima
 Set C("TOENR")=$S(BONNr:"",1:$S('OLNr:"",1:$P(^KOD(KLNr,"F",ORDNr,OLNr),D,27)))
 Set C("PRODWK")=$TR($S('OLNr:"",1:$P($S(BONNr:^KUL(KLNr,"F",BONNr,OLNr),1:^KOD(KLNr,"F",ORDNr,OLNr)),D,25)),"/","")
 ; Indien contract dan leverweek van toelevering
 Set ToeNr=$S(BONNr:"",1:$P(^KOD(KLNr,"F",ORDNr,OLNr),D,27))
 Set TLNr=$S(BONNr:"",1:$P(^KOD(KLNr,"F",ORDNr,OLNr),D,28))
 If ToeNr,TLNr,$D(^KTO($$$LevHalux,ToeNr,TLNr)) Do
 .Set C("PRODWK")=$TR($P(^KTO($$$LevHalux,ToeNr,TLNr),D,25),"/","")
 Set Taal=$P(^KKL(^KK1(KLNr),0),D,9)
 If Taal'="F",Taal'="D" Set Taal="N"
 Set C("TAAL")=Taal
 If KLNr=$$$KlantNeves,C("ORDREF")?1N1E1.N Set C("REFBARCODE")=C("ORDREF")  ; Neves
 If KLNr=$$$KlantSFS Do
 .  Set C("KLNMBIG")=C("ORDREF")
 .  Set C("ORDREF")=$$ZoekSFSRef(KLNr,ORDNr)
 .  Set:$L($G(C("COMMREF"))) C("KLREF")=$G(C("COMMREF"))
 If KLNr=$$$KlantFranssen Do
 . Set:$ZCVT($TR(C("KLNM"),"- "),"U")["DMLINE" C("KLNR")=$$$KlantDMLine
 . Set:$ZCVT($TR(C("KLNM"),"- "),"U")["KASTID" C("KLNR")=$$$KlantKastID
 . Set:$P($$GENTYP^HAD(PRNr),"\")="TBX" C("KLNMBIG")=$G(C("COMMREF"))
 Set ProductOrderLijn = ##class(DOM.DomeinContext).Instance().GeefOrderAPI().GeefOrder(ORDNr).GeefOrderLijn(OLNr)
 Set C("KLANTBARCODE") = ProductOrderLijn.GeefKlantBarcode()
 Quit
 
VerzendWijze(KLNr,ORDNr,C)
	Set VerzendW=$P($P($P($G(^KOD(KLNr,"F",ORDNr,1)),"\",7),"`"),";")
	Set C("VERZENDW")=VerzendW
	Quit
 
 
ZoekSFSRef(KLNr,ORDNr)
	New OLNr,Ref
	Set OLNr=99
	Set Ref=""
	For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:Ref'=""
	. Quit:$P($P(^KOD(KLNr,"F",ORDNr,OLNr),"\",17),"#")'="KF11"
	. Quit:$P($P(^KOD(KLNr,"F",ORDNr,OLNr),"\",18),";",4)'="OBF"
	. Set Ref=$P(^KOD(KLNr,"F",ORDNr,OLNr),"\",5)
	Quit Ref
 ;
FETCHT(TOENr,TLNr,PRNr,Aantal,C)  ; Ophalen toeleveringsgegevens
 New R,KLNr,Adres,Taal,GNode,GenPRNr,KlRef,PAKNr,GenTyp,DosNr,ORDNr,OLNr,LEVNr
 Set LEVNr=$P(^KTO1(TOENr),D)
 Set LijnR=^KTO(LEVNr,TOENr,TLNr)
 Set ORDNr=$P(LijnR,D,27)
 Set OLNr=$P(LijnR,D,28)
 ; Indien KOM-link ingevuld dan via Order
 If ORDNr,OLNr Do FETCHO(ORDNr,OLNr,PRNr,Aantal,.C) Quit
 ;
 Set R=^KTO(LEVNr,TOENr,1),KLNr=$P(R,D,8)
 ;If 'KLNr Do  ; Opzoeken in statistiek bestand
 ;.Set KLNr=$O(^KSTPR(PRNr,0))
 Set:ORDNr="" ORDNr=$P(R,D,7)
 Set C("ORDNR")=ORDNr
 Do ORDREF(ORDNr,1,.C)
 Do ADRES(ORDNr,KLNr,.C)
 If (KLNr=$$$KlantHein)||(KLNr=$$$KlantOptimaPack) Set C("KLNMBIG")=$$UPTRIMAN^vhRtn1(C("ORDREF")) ; Voor Hein en Optima
 If (KLNr=$$$KlantHein) Set C("ORDREF")=$G(C("COMMREF")) ; Voor Hein en Optima
 Set C("TOENR")=TOENr
 Set C("PRODWK")=$TR($P(LijnR,D,25),"/","")
 Set Taal="N"
 Set:KLNr Taal=$P(^KKL(^KK1(KLNr),0),D,9)
 If Taal'="F",Taal'="D" Set Taal="N"
 Set C("TAAL")=Taal
 Quit
 
FETCHP(PRNr,Aantal,C) 
 New R,KLNr,Adres,Taal,GNode,GenPRNr,KlRef,PAKNr,GenTyp,DosNr
 Set C("LABELSIZE")="10x10"
 Set Taal=$G(C("TAAL"))
 Set C("AANTAL")=Aantal
 Set C("PRNR")=PRNr
 Set C("TAAL")=$G(C("TAAL"),"N")
 Set GNode=$G(^KPR(PRNr,"G"))
 Set DosNr=$P(GNode,D,1)
 Set C("DOSSIER")=$S($L($G(C("TOENR"))):C("TOENR")_".",1:"")_DosNr
 Set C("FABR")=$S($L($G(C("TOENR"))):C("TOENR")_".",1:"")_$G(C("PRODWK"))
 Set C("DOSNR")=$$BARCODE^HAD(PRNr,"F")
 Set C("BARCODE")=$TR(C("DOSNR"),".","")
 Set R=^KPR(PRNr,0),C("KORTT")=$P(R,D)
 Set R=$$GETOMSCH^PRODUKT2(PRNr,C("TAAL")),C("LT1")=$P(R,D),C("LT2")=$P(R,D,2),C("LT3")=$P(R,D,3)
 Set C("KLEURCODE")=$E(C("KORTT"),22,25)
 Set C("KLEUR")=$G(^KCOL(C("KLEURCODE")_" ",Taal))
 Set R=^KPR(PRNr,0),GenPRNr=$P(R,D,3)
 Set C("LABELTYP")=$S($L($G(C("DOSNR"))):"ALGBARC",1:"ALG") ; Default voor niet kaderdeur en tandembox
 Set GenTyp=$$GENTYP^HAD(PRNr)
 Set C("GENTYP")=GenTyp
 
 If $P(GenTyp,D,1)="KAD"||($P(GenTyp,D,1)="PRF") Do 
 . Set C("PROFIEL")=$P(GNode,D,2)
 . Set:$L(C("PROFIEL")) C("PROFOMS")=$G(^RES("HAD","PI","PROFIEL","D",C("PROFIEL"),Taal))
 . Set C("HOOGTE")=$P(GNode,D,8)
 . Set C("BREEDTE")=$P(GNode,D,9)
 . Set C("TOEP")=$P(GNode,D,5)
 . Set:$L(C("TOEP")) C("TOEPOMS")=$G(^RES("HAD","PI","TOEPAS","D",C("TOEP"),Taal))
 . If $P(GNode,D,5)="KD" Do
 . . Set C("DRAAI")=$P(GNode,D,4)
 . . Set:$L(C("DRAAI")) C("DRAAIOMS")=$G(^RES("HAD","PI","DRAAI","D",C("DRAAI"),Taal))
 . Set C("VULLING")=$P(GNode,D,10)
 . Set:$L(C("VULLING")) C("VULOMS")=$G(^RES("HAD","PI","VULLING","D",C("VULLING"),Taal))
 . Set C("MONTAGE")=$S($P(GNode,D,11):$S(C("TAAL")="F":"Monté",1:"Gemonteerd"),1:"")	 
 . If $P(GenTyp,D,1)="KAD",$P(GenTyp,D,2)'="MDS" Set C("LABELTYP")="KAD"
 . If $P(GenTyp,D,1)="PRF" Set C("LABELTYP")="KAD",C("TOEPOMS")=$S(Taal="N":"Los profiel",1:"Profil")
 
 Else  If $P(GenTyp,D,1,2)="DIV\GRP",##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"GRP") Do  ; Greep
 . Set C("LABELTYP")="ALGBARC"
 
 Else  If $P(GenTyp,D,1,2)="DIV\TLM",##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"TLM") Do  ; Verlichting
 . Set C("TITEL")="TL-LAMP"
 
 Else  If $P(GenTyp,D,1,1)="BAN" Do  ; Banco
 . Set C("TITEL")="BANCO"
 
 Else  If C("KORTT")?1"TB8SI".E Do ; Assenti Sifonlade
 . Set C("LABELTYP")="ALG5x10"
 . Set C("LABELSIZE")="5x10"
 
 Else  If $P(GenTyp,D)="TBX" Do  ; Tandembox
 . Quit:'##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"TBX")
 . Set C("LABELTYP")=$S($L($G(C("REFBARCODE"))):"TBXBAR",1:"TBX")
 . Set C("KLEUR")=$E(C("KORTT"),22,23)_"/"_$E(C("KORTT"),24,25)
 . For Key="IB","LD","KB","KL","LC","BS","NMBS","CB","WD","VERPAK","DC" Set C(Key)=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,Key))
 . Set:C("VERPAK")?1(1"C",1"O",1"A",1"I",1"B") C("LABELTYP")="TBXCOM",C("LABELSIZE")="5x10" ; Commissie etiket 5x10
 . Set:C("VERPAK")?1(1"X",1"Y") C("LABELTYP")="TBXCOM",C("LABELSIZE")="5x10" ; Probox Etiket -> zelfde layout als commissie etiket
 . Set C("ORDNR")=$G(C("ORDNR"))_$S($L($G(C("ORDNR"))):":"_C("VERPAK"),1:"")
 . Set:C("BS")="BD"&C("NMBS") C("BS")="ER"
 . ;Set C("PICT")=##CLASS(BL.Prod.ImageLink).TBXImageCode(PRNr)
 . Set C("PICT")=##class(BL.Prod.ImageLink).%New().GetProductImageURL(PRNr,"LABEL")
 . Set C("FSC")=##class(DOM.PR.FSC).GetImageLink(##class(DOM.PR.FSC).CalcFSCCode(PRNr))
 
 Else  If $P(GenTyp,D,1,2)="DIV\ASM" Do  ; Antislipmat
 . Quit:'##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"ASM")
 . Set C("LABELTYP")="ASM"
 . Set C("LABELSIZE")="5x10"
 . For Key="ASM","LD","WD","CB","NB","ND" Set C(Key)=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("ASM",PRNr,Key))
 . Set C("MULTIPLICANT")=C("AANTAL")
 . Set C("AANTAL")=1
 
 Else  If $P(GenTyp,D,1,2)="DIV\SDM" Do ; ServoDrive
 . Quit:'##class(BL.ProdHist.ChargeTrace).HasChargeHalfFabr(PRNr)
 . Set C("HASCHARGE")=1
 . Set C("LABELTYP")="CHARGE"
 . Set C("LABELSIZE")="10x10"
 
 Set KLNr=$G(C("KLNR"))
 Set:KLNr=2967&&(C("LABELTYP")="KAD") C("LABELTYP")="KADBURB"
 Set (KlRef,PAKNr,KlRefOms)=""
 If KLNr'="" For  Set PAKNr=$O(^PAKKET("IP",PRNr,KLNr,PAKNr)) Quit:PAKNr=""  Do
 . Quit:$P($G(^PAKKET("D",PAKNr),D_D_"D"),D,3)="D"
 . Set KlRef=KlRef_" & "_$P(^PAKKET("D",PAKNr),D,2)
 . Set:$L($P(^PAKKET("D",PAKNr),D,4)) KlRefOms=KlRefOms_" & "_$P(^PAKKET("D",PAKNr),D,4)
 Set:KLNr'=$$$KlantSFS||($G(C("KLREF"))="") C("KLREF")=$E($G(KlRef),4,80)
 Set C("KLREFOMS")=$E($G(KlRefOms),4,80)
 Quit
 
CHARGEID(C) ; Unique voor elk product ook voor elk stuk
 ; param C via .Local
  Set C("CHARGEID")=##class(BL.ProdHist.ChargeTrace).GetUniqueComposite(C("PRNR"))
  Quit
  
  ; Herafdrukken Haluxetiketten bij doorsturen naar WMS
CONSNR(CONSNr,SendWMS) 
 New R,KLNr,ORDNr,OLUNr,OLNr,PRNr,GenPRNr,Aantal,Dev,WMSStat
 Set SendWMS=$G(SendWMS),R=^ORDW("D",CONSNr),KLNr=$P(R,D),WMSStat=$P(R,D,20)
 If ("\"_$$$KlantBruynzeel_"\"_$$$KlantKeller_"\")[(D_KLNr_D) Do  ; Alleen voor Bruynzeel en KELLER
 .If WMSStat="B" Do BONNR(CONSNr,SendWMS) Quit  ; Reeds op bon
 .;Set Dev="|PRN|\\NOTES01\WMSUITV_TXT_LABEL" ; Receptie/Uitvoer conv. via parallelconvertor
 .Set Dev="|PRN|\\NOTES01\MAG_HALUX" ; Magazijn Halux
 .;Set Dev="|PRN|\\NOTES01\OVHALUX_TXT_LABEL" ; OV Halux
 .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 R=^ORDW("D",CONSNr,"D",ORDNr,OLUNr),PRNr=$P(R,D),Aantal=$P(R,D,4)
 ...Quit:Aantal'>0
 ...If '$D(^KPBI("D",KLNr,PRNr)) Quit:KLNr'=$$$KlantBruynzeel  ; Er is geen bestelimpuls
 ...Set R=^KPR(PRNr,0),GenPRNr=$P(R,D,3)
 ...Quit:GenPRNr'=57791  ; GEN.HALKAD4
 ...Set OLNr=$G(^ORD("IU",ORDNr,OLUNr))
 ...If SendWMS,OLNr,$L($P($G(^KOD(KLNr,"F",ORDNr,OLNr)),D,27)) Quit  ; Niet afdrukken indien KOM
 ...If KLNr=11708,SendWMS,OLNr,$L($P($G(^KOD(KLNr,"F",ORDNr,OLNr)),D,28)) Quit  ; Niet afdrukken indien Bruynzeel en het was KOM
 ...Do PRINT(Dev,"O",ORDNr,OLNr,PRNr,Aantal)
 Quit
 ;
 ; Herafdrukken Haluxetiketten indien reeds op bon
BONNR(BONNr,SendWMS) 
 New R,KLNr,BLNr,ORDNr,PRNr,Aantal
 Set SendWMS=$G(SendWMS),KLNr=$P(^KU1(BONNr,"F"),D)
 If ("\"_$$$KlantBruynzeel_"\"_$$$KlantKeller_"\")[(D_KLNr_D) Do  ; Alleen voor Bruynzeel en KELLER
 .;Set Dev="|PRN|\\NOTES01\WMSUITV_TXT_LABEL" ; Receptie/Uitvoer conv. via parallelconvertor
 .Set Dev="|PRN|\\NOTES01\MAG_HALUX" ; Magazijn Halux
 .;Set Dev="|PRN|\\NOTES01\OVHALUX_TXT_LABEL" ; OV Halux
 .Set BLNr=100,ORDNr=""
 .For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do
 ..Set R=^KUL(KLNr,"F",BONNr,BLNr) Set:$P(R,D,17)="KF5" ORDNr=$P($P(R,D,5)," - ")
 ..Quit:'ORDNr
 ..Set PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 ..Quit:'PRNr  Quit:Aantal'>0
 ..If '$D(^KPBI("D",KLNr,PRNr)) Quit:KLNr'=$$$KlantBruynzeel  ; Er is geen bestelimpuls
 ..Set R=^KPR(PRNr,0),GenPRNr=$P(R,D,3)
 ..Quit:GenPRNr'=57791  ; GEN.HALKAD4
 ..If SendWMS,$L($P(^KUL(KLNr,"F",BONNr,BLNr),D,28)) Quit  ; Niet afdrukken indien KOM
 ..Do PRINT(Dev,"O",ORDNr,BLNr,PRNr,Aantal)
 Quit
 ;
ORDREF(ORDNr,StripDatum,C) ; Referentie opzoeken in leveringsbon indien order reeds op bon gezet
 New R,KLNr,OrdRef,BONNr,BLNr
 If 'ORDNr Set C("ORDREF")="VOORRAAD" Quit
 Set (CommRef,OrdRef)="",R=$G(^KO1(ORDNr,"F")),KLNr=$P(R,D),BONNr=$P(R,D,2)
 If BONNr Do
 .Set BLNr=100
 .For  Set BLNr=$O(^KUL(KLNr,"F",BONNr,BLNr)) Quit:'BLNr  Do  Quit:$L(OrdRef)
 ..Set R=^KUL(KLNr,"F",BONNr,BLNr)
 ..If $P(R,D,17)="KF5",$P($P(R,D,5)," - ")=ORDNr Set OrdRef=$P($P(R,D,5)," - ",3),CommRef=$P(R,D,20)
 Else  If KLNr Set OrdRef=$P($G(^KOD(KLNr,"F",ORDNr,1)),D,3),CommRef=$P($G(^KOD(KLNr,"F",ORDNr,1)),D,19)
 If $E(OrdRef,1,3)="EDI" Set $E(OrdRef,1,3)="",OrdRef=$TR(OrdRef," ","")
 If $G(StripDatum),OrdRef?1.2N1"."1.2N1"."2N1" ".E!(OrdRef?1.2N1"/"1.2N1"/"2N1" ".E)!(OrdRef?1.2N1"-"1.2N1"-"2N1" ".E) Set OrdRef=$P(OrdRef," ",2,99)
 
 Set C("ORDREF")=OrdRef
 Set:$L(CommRef) C("COMMREF")=CommRef
 Quit OrdRef
 
ADRES(ORDNr,KLNr,C) 
 New R,OrdRef,BONNr,BLNr,Adres
 Set Adres=""
 If ORDNr Do
 .Set R=$G(^KO1(ORDNr,"F")),KLNr=$P(R,D),BONNr=$P(R,D,2)
 .If BONNr Set Adres=$G(^KUL(KLNr,"F",BONNr,3))
 .Else  If KLNr Set Adres=$G(^KOD(KLNr,"F",ORDNr,3))
 If $L($TR(Adres,"\",""))<5 Do  ; Geen of onvoldoende adres
 .Set:KLNr Adres=^KKL(^KK1(KLNr),0)
 Set C("KLNM")=$P(Adres,D,2)
 Set C("KLNR")=KLNr
 Set C("KLNMBIG")=$$TRIMNAAM^vhRtn1(C("KLNM"),1)
 Set:(KLNr=8545) C("KLNMBIG")="I.SCHREURS" ; Speciaal toegevoegd om verwarring te vermijden met 3760 - PV - 13-09-05
 Set:(KLNr=$$$KlantAssenti) C("KLNM")="@4451",C("KLNMBIG")="4451" ; Assenti
 Set:(KLNr=1300) C("KLNMBIG")="OSTE K" ; Speciaal toegevoegd op vraag van klant - PV - 21-04-08
 Set C("TOENM")=$P(Adres,D,3)
 Set C("STRAAT")=$P(Adres,D,5)
 Set C("POSTKODE")=$S($E($P(Adres,D,6),1,2)="NL":"NL",$P(Adres,D,6)?4N:"",1:$P(Adres,D,6))
 Set C("GEMEENTE")=$E($P(Adres,D,7),1,18)
 Quit
 
 ; ******************
 ;     PRINTING      
 ; ******************
TESTPV 
 Set C("LABELTYP")="ASM"
 Set C("LABELSIZE")="5x10"
 Set C("ASM")="R"
 Set C("LD")=500
 Set C("WD")=16
 Set C("CB")=1200
 Set C("NB")= C("CB")-85-32
 Set C("ND")=C("LD")-24
 Set C("KLNR")=1000
 SEt C("KLNM")="Testklant VAN HOECKE"
 SEt C("ORDNR")="154837"
 Set C("TOENR")="252408"
 Set C("DOSNR")="M.AZE.9"
 Set C("BARCODE")="MAZE9"
 Set C("ORDREF")="MEYLEMANS"
 Set C("TAAL")="N"
 Set C("AANTAL")=1
 Set C("MULTIPLICANT")=5
 set C("PRODWK")="0527"
 D WLABEL^vhPRINTER("|PRN|\\NOTES01\OVHALUX_TXT_LABEL_5X10",.C)
 q
 
PRINT(Dev,ObjTyp,ObjRef,ObjLNr,PRNr,Aantal) 
 New C,GenTyp,ProdGrp
 ;Do:0'[Dev STORE^vhTERMINA()
 Set FP=2001
 Write @F,@F1,!?2,"Printing ..."
 
 Set C("TAAL")="N"
 Do:ObjTyp="T" FETCHT(ObjRef,ObjLNr,PRNr,$G(Aantal),.C)
 Do:ObjTyp="O" FETCHO(ObjRef,ObjLNr,PRNr,$G(Aantal),.C)
 
 If $E($$$PRGet($$$KortTekst),1,3)="Z37" Do  Quit ; Glazen boxside op maat
 . Do ##class(CHUI.Prod.ProductLabel).PrintVHMaatwerk(PRNr,$G(C("KLNMBIG")),$G(C("TOENR")),$G(C("ORDNR")),Aantal)
 
 Set ProdGrp=##class(BL.PPS.TBX.LeanBatch).ProdGrp(PRNr,$G(C("KLNR")))
 Quit:ProdGrp?1(1"A",1"B") ; VHoss - wordt afgedrukt NA de optimalisatie
 Quit:ProdGrp="+" ; Keller - geen etiket nodig
 
 Do FETCHP(PRNr,$G(Aantal),.C)
 Set C("LABELTYP")=$G(C("LABELTYP"),$S($L($G(C("DOSNR"))):"ALGBARC",1:"ALG"))
 
 Set C("LOGO")=$G(^IPCom("CS","LOGO4682",0))
 Set:$D(^IPCom("CS","LOGO"_C("KLNR"))) C("LOGO")=$G(^IPCom("CS","LOGO"_C("KLNR"),0))
  For Loop=1:1:$G(C("AANTAL"),Aantal) Do
 . If $G(C("HASCHARGE")) Do CHARGEID(.C) ; aanpassen ChargeID per product
 . Merge %Print2File($G(C("LABELSIZE"),"10x10"),C("LABELTYP"),%Print2File)=C ; onthouden vn de definities
 . Set %Print2File=%Print2File+1
 
 Quit
 
Print2File(LblGroep,Dev) ; data is opgeslagen in %Print2File
	Set LabelSize=""
	For  Set LabelSize=$O(%Print2File(LabelSize)) Quit:LabelSize=""  Do
	. Set LabelType=""
	. For  Set LabelType=$O(%Print2File(LabelSize,LabelType)) Quit:LabelType=""  Do
	. . Set VolgNr=""
	. . Set File=$$CreateFile(Dev,LblGroep,LabelSize,LabelType)
	. . For  Set VolgNr=$O(%Print2File(LabelSize,LabelType,VolgNr)) Quit:VolgNr=""  Do
	. . . Kill C
	. . . Merge C=%Print2File(LabelSize,LabelType,VolgNr)
	. . . Do WriteRow(LblGroep,LabelType,.C)
	. . Close:File'=0 File
	. . Write:File=0 !
	Quit
	
CreateFile(Dev,LblGroep,LabelSize,LabelType)
	Set File=0
	New BartenderPath Set BartenderPath = ##class(TECH.Config.ConfigMgr).Instance().GetString("PrintFileDropFolder")
	Set File=$$OPEN^vhDEV(BartenderPath,"Lbl"_$TR($ZH,".","_")_".TXT","W","M")
	Use File
	Set BartenderPrinter="EasyCoderPD41"
	;Set BartenderPrinter="//FOP/HALUX 10x10"
	;Set:LabelSize="5x10" BartenderPrinter="//FOP/PD41 HALUX 5x10"
	Set BartenderPrinter="OVHALUX2" ; 8x11
	Set:LabelSize="5x10" BartenderPrinter="OVHALUX1" ; 5x10
	
	If (##class(TECH.Config.ConfigMgr).Instance().GetBoolean("HADETIK_SelecteerPrinter"))
	{
		Set BartenderPrinter = $Piece(Dev,"|",3)
	}
	
	Set BartenderPrinter=$TR(BartenderPrinter,"/","\")
	Set BartenderLabelType=LabelType
	Set:LabelType="ALG" BartenderLabelType="KlantGEN10x10"
	Set:LabelType="CHARGE" BartenderLabelType="KlantGENBARCHARGE10x10"
	Set:LabelType="ALGBARC" BartenderLabelType="KlantGENBAR10x10"
	Set:LabelType="ALG5x10" BartenderLabelType="KlantGEN5x10"
	Set:LabelType="ASM" BartenderLabelType="KlantASM5x10"
	Set:LabelType="KAD" BartenderLabelType="KlantKAD10x10"
	Set:LabelType="KADBURB" BartenderLabelType="BurbKAD10x10"
	Set:LabelType="TBX" BartenderLabelType="KlantTBX10x10"
	Set:LabelType="TBXCOM" BartenderLabelType="KlantTBX5x10"
	Set:LabelType="TBXBAR" BartenderLabelType="KlantTBXBAR10x10"
	Set:LabelType="OLPRODUCT" BartenderLabelType="OLProduct6x10"
	Set:LabelType="OLDOOS" BartenderLabelType="OLDoos6X10"
 
	If (BartenderLabelType["10x10") Do
	. ;Set BartenderPrinter="//FOP/ICT TEST"
	. Set BartenderLabelType=$$REPLACE^vhRtn1(BartenderLabelType,"10x10","8x11")
	
	Write "%BTW% /AF=""C:\Bartender\Templates\"_BartenderLabelType_".btw"" /PRN="""_BartenderPrinter_""" /R=3 /P  /D=<Trigger File Name> /CLOSE",$C(13,10)
	Write "%END%",$C(13,10)
	;Do WriteLbl(LblGroep,LabelType)
	Quit File
	
WriteLbl(LblGroep,LabelType)
	New Delim,VolgNr,Rec,Lbl,Last
	Set Delim=$C(9)
	Set Last=$O(^RES(LblGroep,"LBLK",LabelType,""),-1)
	Set VolgNr=""
	For  Set VolgNr=$O(^RES(LblGroep,"LBLK",LabelType,VolgNr)) Quit:VolgNr=""  Do
	. Set Rec=^RES(LblGroep,"LBLK",LabelType,VolgNr)
	. Set Lbl=$P(Rec,"`")
	. Write Lbl
	. Write:VolgNr<Last Delim
	Write $C(13,10)
	Quit 	
 
WriteRow(LblGroep,LabelType,C)
	New Delim,VolgNr,Rec,Check,Last,Print
	Set Delim=$C(9)
	Set Last=$O(^RES(LblGroep,"LBLK",LabelType,""),-1)
	Set VolgNr=""
 	Set %Groep=LblGroep
 	Set %Taal=C("TAAL")
	For  Set VolgNr=$O(^RES(LblGroep,"LBLK",LabelType,VolgNr)) Quit:VolgNr=""  Do
 	. Set Rec=^RES(LblGroep,"LBLK",LabelType,VolgNr)
 	. Set Check=1
	 .If $L($P(Rec,"`",3)) Set Check=0 If @$P(Rec,"`",3) Set Check=1  ; Conditioneel
 	. If Check Do
 	. . Set Print=$P(Rec,"`",2)
 	. . ;do WLIP^vhDBG(15,LblGroep_"="_%Groep)
 	. . ;do WLIP^vhDBG(15,"Before:"_Print)
 	. . Set:Print["{" Print=$$REPLACE5^vhRtn1(Print,"{","$$Label^vhPRINTER(""","}",""")") ; label vervangen door $$Label^vhPRINTER("label")
 	. . ;do WLIP^vhDBG(15,"After:"_Print)
 	. . Write @(Print)
 	. Write:VolgNr<Last Delim
	Write $C(13,10)
	Quit
 
 
 ;
INIT 
 Do INIT^vhPRINTER("","","UB",,"Selectie output voor etiketten")
 Quit
 ;
 
DEFAANT(PRNr) 
 New DefAant,GenTyp
 Set DefAant="",GenTyp=$$GENTYP^HAD(PRNr)
 If $P(GenTyp,D)="DIV","\GRP\POM\"[(D_$P(GenTyp,D,2)_D) Set DefAant=1
 Else  If $P(GenTyp,D)="KAD",$P($G(^KPR(PRNr,"G")),D,14)="B" Set DefAant=2
 Quit DefAant
 
 
 
 
 ; CONVERSIE oude versie naar ^RES 
 
TOGLOB
	k ^RES("ORGALUX","LBL")
	For Lbl="L;PRODUCT","LV;ADRES" Do
	. For Taal="N" Do
	.. Set Cnt=0
	.. w !
	.. For I=1:1:30 Set Lijn=$T(@($P(Lbl,";")_Taal_I)) Do:Lijn'="" 
	... Set Cnt=Cnt+10
	... w "."
 	... Set ^RES("ORGALUX","LBL",$P(Lbl,";",2),Cnt)=$P(Lijn,";",2)
 	Q
CONVGLOB
 
	For Lbl="COLLIE" Do
	. w "***"
	. SEt Cnt=""
	. For  Set Cnt=$O(^RES("TRANSP","LBL",Lbl,Cnt)) Quit:Cnt=""  Do
	. . Set String=^RES("TRANSP","LBL",Lbl,Cnt)
	. . If $E(String,1,2)="""A" Do
	. . .  Write String,!
	. . .  Set X=$E($P(String,",",1),3,99)
	. . .  Set Y=$P(String,",",2)
	. . .  Set X2=Y-50
	. . .  Set Y2=765-X
	. . .  Set String="""A"_X2_","_Y2_","_$P(String,",",3,99)
	. . .  ; Draaiing
	. . .  Set $P(String,",",3)=0
	. . .  ; Swap enlarge
	. . .  Set H=$P(String,",",5)
	. . .  Set V=$P(String,",",6)
	. . .  Set $P(String,",",5)=V
	. . .  Set $P(String,",",6)=H
	. . .  Write String,!!
	. . .  Set ^RES("TRANSP","LBL",Lbl,Cnt)=String
	Q
 
 ; Sorteren
SortKey(PRNr)
 Quit ##class(BL.PPS.TBX.Sequencer).SequenceKey(PRNr)
 
 New SortKey
 Set SortKey=""
 If PRNr?4.7N,$$ISTBX^PRODUKT2(PRNr) Do
 . Set IB=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"IB"))
 . Set RH=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"RH"))
 . Set LD=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,"LD"))
 . Quit:IB="" ; geen breedte
 . Set SortKey=LD_"-"_$CASE(RH,"N":1,"M":2,"K":1,"B":3,"C":4,"D":5,:9)_"-"_$J(IB,4)_"-"_PRNr
 Quit SortKey