HADETIK ;Afdrukken Halux deuretiketten [ 11/13/2003  2:38 PM ]
 Do PRINT(103,"P","","",181039,1) 
 Q
 ;
ORDER(ORDNr,OLNr,Print,Order) 
 Goto ORDERNew
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant
 Set ORDNr=$G(ORDNr),OLNr=$G(OLNr)
 If 'ORDNr Do
 .Do DISPLAY^vhScherm("HADETIKO")
 .For  Do FIELD^vhScherm("HADETIKO","ORDNR") Quit:ORDNr="-"  Do
 ..Quit:'$$ISHALUX^FLOW("O",ORDNr)
 ..Do ORDER(ORDNr,,.Print)
 Else  If 'OLNr Do
 .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 OLNr=""
 .For  Set OLNr=$O(Order(OLNr)) Quit:OLNr=""  Do
 ..Set R=Order(OLNr),PRNr=$P(R,D),Aantal=$P(R,D,2)
 ..Do PRINT(Dev,"O",ORDNr,OLNr,PRNr,Aantal)
 Else  Do
 .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,"J6332"))
 .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) Set Order(OLNr)=PRNr_D_Aantal
 ..Else  Do PRINT(Dev,"O",ORDNr,OLNr,PRNr,Aantal)
 Quit
 ;
ORDERNew
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant,SortKey
 Set ORDNr=$G(ORDNr),OLNr=$G(OLNr)
 If 'ORDNr Do
 .Do DISPLAY^vhScherm("HADETIKO")
 .For  Do FIELD^vhScherm("HADETIKO","ORDNR") Quit:ORDNr="-"  Do
 ..Quit:'$$ISHALUX^FLOW("O",ORDNr)
 ..Do ORDER(ORDNr,,.Print)
 Else  If 'OLNr Do
 .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
 .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,"J6332"))
 .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)
 Quit
 ;
TOE(TOENr,TLNr,Print,Order) 
 ; TOENr verplicht, TLNr optioneel
 Goto TOENew
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant
 Set LEVNr=6332
 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 TLNr=""
 .For  Set TLNr=$O(Order(TLNr)) Quit:TLNr=""  Do
 ..Set R=Order(TLNr),PRNr=$P(R,D),Aantal=$P(R,D,2)
 ..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,"J6332"))
 .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) Set Order(TLNr)=PRNr_D_Aantal
 ..Else  Do PRINT(Dev,"T",TOENr,TLNr,PRNr,Aantal)
 Quit
 ;
TOENew 
 ; TOENr verplicht, TLNr optioneel
 New C,R,%SC,KLNr,PRNr,Dev,Aantal,DefAant,SortKey
 Set LEVNr=6332
 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,"J6332"))
 .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)
 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
 Set C("ORDNR")=ORDNr
 Set R=^KO1(ORDNr,"F"),KLNr=$P(R,D),BONNr=$P(R,D,2)
 Quit:KLNr=""
 Set C("ORDREF")=$$ORDREF(ORDNr,1)
 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)
 If (KLNr=7833)||(KLNr=6279) 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(6332,ToeNr,TLNr)) Do
 .Set C("PRODWK")=$TR($P(^KTO(6332,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=4855 Set C("REFBARCODE")=C("ORDREF")  ; Neves
 Quit
 ;
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
 Set C("ORDREF")=$$ORDREF(ORDNr,1)
 Do ADRES(ORDNr,KLNr,.C)
 If (KLNr=7833)||(KLNr=6279) Set C("KLNMBIG")=$$UPTRIMAN^vhRtn1(C("ORDREF")) ; 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("TAAL")=$G(C("TAAL"),"N")
 Set GNode=$G(^KPR(PRNr,"G"))
 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:"")
 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 GenTyp=$$GENTYP^HAD(PRNr)
 Set C("GENTYP")=GenTyp
 Set C("LABELTYP")=$S($L($G(C("DOSNR"))):"ALGBARC",1:"ALG") ; Default voor niet kaderdeur en tandembox
 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")
 If $P(GenTyp,D,1,2)="DIV\GRP",##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"GRP") Do  ; Greep
 . Set C("LABELTYP")="ALGBARC"
 If $P(GenTyp,D,1,2)="DIV\TLM",##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"TLM") Do  ; Verlichting
 . Set C("TITEL")="TL-LAMP"
 If $P(GenTyp,D,1,1)="BAN" Do  ; Banco
 . Set C("TITEL")="BANCO"
 If C("KORTT")?1"TB8SI".E Do ; Assenti Sifonlade
 . Set C("LABELTYP")="ALG5x10"
 . Set C("LABELSIZE")="5x10"
 If $P(GenTyp,D)="TBX" Do  ; Tandembox
 . Quit:'##class(Prod.Kenmerk.DataDefinitie).Exists(PRNr,"TBX")
 . Set C("LABELTYP")="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" Set C(Key)=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TBX",PRNr,Key))
 . Set:C("VERPAK")?1(1"C",1"O",1"A",1"K") C("LABELTYP")="TBXCOM",C("LABELSIZE")="5x10" ; Commissie etiket 5x10
 . Set:C("BS")="BD"&C("NMBS") C("BS")="ER"
 . Set C("PICT")=$TR(C("LC"),"2I\/","")_$S(C("BS")="BC":"BD",C("BS")="BZ":"BD",C("BS")="BF":"BD",1:C("BS")) ; Glazen boxside dan etiket voor dubbelwandige boxside
 . Set:C("PICT")="CZER" C("PICT")="BZER" ; C-binnenlade
 . Set:C("PICT")="KZZR" C("PICT")="MZZR" ; K-binnenlade
 . Set:C("PICT")="MBZR" C("PICT")="MZR" ; Burolade
 . ;Set:C("PICT")["DS2" C("PICT")="DSBD" ; Spoelbaklade type 2
 . ;Set:C("PICT")["BS2" C("PICT")="DSBD" ; Spoelbaklade type 2
 . ;Set:C("PICT")["MS2" C("PICT")="DSBD" ; Spoelbaklade type 2
 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
 Set KLNr=$G(C("KLNR"))
 Set:KLNr=2967&&(C("LABELTYP")="KAD") C("LABELTYP")="KADBURB"
 Set (KlRef,PAKNr)=""
 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 C("KLREF")=$E(KlRef,4,80)
 ;i $io["PV_XP" zw C r k
 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 "\11708\1239\"[(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'=11708  ; 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 "\11708\1239\"[(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'=11708  ; 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) ; Referentie opzoeken in leveringsbon indien order reeds op bon gezet
 New R,KLNr,OrdRef,BONNr,BLNr
 Quit:'ORDNr "VOORRAAD"
 Set 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)
 Else  If KLNr Set OrdRef=$P($G(^KOD(KLNr,"F",ORDNr,1)),D,3)
 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) 
 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($P(Adres,D,2),1)
 Set:KLNr=8545 C("KLNMBIG")="I.SCHREURS" ; Speciaal toegevoegd om verwarring te vermijden met 3760 - PV - 13-09-05
 Set:(KLNr=4451) C("KLNM")="@4451",C("KLNMBIG")="4451" ; Assenti
 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
 ;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)
 Do FETCHP(PRNr,$G(Aantal),.C)
 Do WLABEL^vhPRINTER(Dev,.C,1)
 ;Do:0'[Dev REFRESH^vhTERMINA()
 Quit
 ;
INIT 
 Do INIT^vhPRINTER("","","UB")
 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
 
 
	
 ; *****************************************
 ;     DOORSTUREN LOGO EN AFBEELDINGEN      
 ; *****************************************
 
 
 ; Alle PCX bestanden worden opgenomen in een LABELCOPY.BAT bestand deze dient naderhand worden uitgevoerd voor het doorsturen naar de printer
 ; De printer dient local gekoppeld te worden vermits er 
SENDALLViaDOS() 
 New Label,Files,File,First,Dev,BatDev,Som,Count,Size
 Set NetworkPad="\\NOTES01\SHARED\P V\LABEL"
 ;Set NetworkPad="\\PV_XP\c$\LABEL"
 Set Printer="\\PV_XP\TXT_LABEL"
 Set DOSPrinter ="LPT1"
 Set Dev="|PRN|"_Printer
 ;Set Dev=0 
 Kill ^IPCom("CS")
 Set Label=""
 Set (Count,Som)=0
 Hang:0'[Dev 2
 Do SCANDIR^vhDEV(NetworkPad,"*.PCX",$NA(Files),"","")
 Set File=""
 Set First=1
 Set BatDev=$$OPEN^vhDEV(NetworkPad,"LABELCOPY.BAT","W","M")
 For  Set File=$O(Files(File)) Quit:File=""  Do  
 . Set Count=Count+1
 . Set Label=$$UPTRIMAN^vhRtn1($P(File,".",1,$L(File,".")-1))
 . Set Size=$P(Files(File),D)
 . Set Som=Som+Size
 . Use 0
 . Write Label," : ",Size," bytes",!
 . Set ^IPCom("CS",Label,0)=Size
 . Do SENDONE(BatDev,File,Label,Size,NetworkPad,Printer,DOSPrinter,First)
 . Set First=0
 . ;Hang:0'[Dev 1
 . ;D TEST(Dev,1)
 Close:0'[Dev BatDev
 Write !,"Aantal=",Count," Graf.geheugen=",Som," bytes",!
 Do TESTUSAGE(Dev)
 Quit
 
SENDONE(BatDev,File,Label,Size,NetworkPad,Printer,DOSPrinter,First)
 New Dev
 ; Prepareren van de printer
 Set Dev=$$OPEN^vhDEV(NetworkPad,Label_".TXT","W","M")
 use Dev
 Open:0'[Dev Dev Use Dev
 Write ! 
 Write:$G(First) "M90,5,700",! ;(met 1MByte flash)
 ;Write:$G(First) "M90,5,399",!
 Write:$G(First) "GK""*""",!
 Write "GM"""_Label,"""",Size,!
 Close:0'[Dev Dev
 ; Opbouw BAT FILE
 If 0'[BatDev Do
 . use BatDev
 . Write "COPY """_NetworkPad_"\"_Label_".TXT"" "_DOSPrinter,!
 . Write "COPY """_NetworkPad_"\"_File_""" "_DOSPrinter_" /b",!
 Use 0
 Quit
 
 ; Rechtstreeks doorsturen via CACHE
 ; Obsolete zie SENDALLViaDOS - PV -27-04-05
SENDPICT(Dev,C) 
 ;Via .local
 Use Dev:(::::4096)
 Write "M90,5,15",! ; zonder geheugen uitbreiding
 ;Write "M90,5,399",! ; met geheugen uitbreiding van 386kB
 Write "GK""*""",!
 Quit:'$D(C("PICT"))
 Quit:'$G(^IPCom("CS","TBX"_C("PICT"),0))
 Write "GM""TBX"_C("PICT")_"""",^IPCom("CS","TBX"_C("PICT"),0),!
 Do:0'[Dev WPICT($NAME(^IPCom("CS","TBX"_C("PICT"))))
 If C("KLNR")=7833 Do  ;Klant HEIN logo
 .Write "GM"""_"LOGO7833"_"""",^IPCom("CS","LOGO"_C("KLNR"),0),!
 .Do:0'[Dev WPICT($NAME(^IPCom("CS","LOGO"_C("KLNR")))) ; Logo HEIN
 Write !
 Quit
  
WPICT(Ref) 
 New I
 Set I=0
 For  Set I=$O(@Ref@(I)) Quit:I=""  Do
 .Write @Ref@(I)
 Quit
 
TESTUSAGE(Dev,Short)
 If '$D(Dev) Set Dev="|PRN|\\PV_XP\TXT_LABEL" Open Dev
 Open:0'[Dev Dev
 U Dev
 W:'$G(Short) !,"U"
 Write !,"GI"
 C:0'[Dev Dev
 q
 
 ; 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)
 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