TRANSPL ;Verwerking expediteur (afdruk etiket) [ 03/28/2003  10:53 AM ]
 ; Beheer range barcodes ABX Link, (oude) afdruk ABX Link labels, delegatie naar Bartender ABX Link labels.
 ; Ook enkele utility methods
 
 #include vhLib.Macro
 #define BarTenderPrintersInstalled 1
 ;
 ; RePrint : 1 = herdrukken zonder nieuwe barcode
 ;           2 = herdrukken met nieuwe barcode
LABEL(VervRef,GroepNr,RePrint,PrinterKeuze) 
 New R,bl,TranspNr,Dev,Print,Prog,IsTerugname
 Set PrinterKeuze=$G(PrinterKeuze,1)
 Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D),IsTerugname=$P(R,D,5)="T"
 Do:'IsTerugname
 .Set R=$G(^TRANSP("T",TranspNr)),Prog=$P(R,D,7)
 .If '$$ISPRINT(VervRef,$G(GroepNr))!$G(RePrint) Do
 ..If Prog="" Do
 ...If $$$BarTenderPrintersInstalled!($$$Server="CACHE02") Do
 ....Set bl=##class(BL.Flow.Cons.TransportLabel).Instantiate()
 ....Do bl.Init($G(GroepNr))
 ....if '$length($G(Printer)) set Printer=##class(CHUI.Printer.Printer).KiesPrinterVoorLayout("TRANSP_DI1")
 ....Quit:Printer=""
 ....Do bl.PrintLabelGLS(Printer,VervRef,$G(GroepNr),$G(RePrint))
 ...Else  Do
 ....If PrinterKeuze Do  Quit:0[Dev  ; Met printerkeuze
 .....Do INIT^vhPRINTER("","","UB")
 .....Set Dev=$G(Print("DEV"))
 ....Else  Set Dev=0
 ....Do PRINT(VervRef,$G(GroepNr),$G(RePrint),Dev)  ;oude afdrukmethode
 ....Quit:0'[Dev
 ..Else  Do @Prog
 Quit
  
SelPrinter() ;selectie van de labelprinter
 Quit "\\BARTENDER\INPAK_GLS"
 Do bl.qLabelPrinters(.PrinterLijst)
 If '$D(PrinterLijst) Do
 . Set Printer=""
 Else  If PrinterLijst=1 Do
 . Set Printer=$Piece(PrinterLijst(1),"`") ;als er maar één printer is dan wordt deze printer automatisch geselecteerd
 Else  Do
 . Set Printer=$$WILD^vhPOPUP("C;C","KO1-","Selecteer een printer",.PrinterLijst)
 If Printer="" Do
 . Set from=$$$Server
 . ;Set to=$lb("pve")
 . Set to=$lb("ICT")
 . set subject=$$Format^vhLib("dd/mm hh:nn",$H)_"   geen printer geselecteerd=>palletlabels niet afgedrukt"
 . set body="programma ^TRANSPL"_$C(13)_"Er zijn geen transportlabels afgedrukt want er is geen printer geselecteerd!"
 . set sc=$$SendMiniMail^vhLib(from,to,subject,body)
 Quit Printer
 
PRINT(VervRef,GroepNr,RePrint,Dev) 
 New C,Collie,Aantal,MaxCol,ColNum,ColTyp,OneGroep,BarCode,Count
 Set GroepNr=$G(GroepNr),RePrint=$G(RePrint),OneGroep=''$L(GroepNr)
 Do STORE^vhTERMINA()
 Set FP=2001
 Write @F,@F1,!?2,"Printing ..."
 Open:0'[Dev Dev
 Use:0'[Dev Dev
 For  Set GroepNr=$S('OneGroep:$O(^TRANSP("D",VervRef,"D",GroepNr)),1:GroepNr) Quit:GroepNr=""  Do  Quit:OneGroep
 .If $D(^TRANSP("D",VervRef,"D",GroepNr,"C")),'RePrint Quit
 .Set ColTyp="",MaxCol=0
 .Kill Collie
 .For  Set ColTyp=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)) Quit:ColTyp=""  Do
 ..Set R=^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp),Aantal=$P(R,D)
 ..Quit:'Aantal
 ..Set MaxCol=MaxCol+Aantal
 ..Set R=^RES("EWBON","PI","COLLIETYPE","D",ColTyp),ColNum=$P(R,"`"),Collie(ColNum)=ColTyp_D_Aantal
 .If RePrint'=1 Kill ^TRANSP("D",VervRef,"D",GroepNr,"C")
 .Else  Do
 ..Set BarCode="",Count=0
 ..For  Set BarCode=$O(^TRANSP("D",VervRef,"D",GroepNr,"C",BarCode)) Quit:BarCode=""  Do
 ...Set Count=Count+1,BarCode(Count)=BarCode
 .Set ColNum="",(Collie,Count)=0
 .For  Set ColNum=$O(Collie(ColNum)) Quit:ColNum=""  Do
 ..Set R=Collie(ColNum),ColTyp=$P(R,D),Aantal=$P(R,D,2)
 ..Do FETCHCOL(VervRef,GroepNr,.C)
 ..Set C("COLLIETYPE")=$P(^RES("EWBON","PI","COLLIETYPE","D",ColTyp),"`",2)
 ..For Aantal=1:1:Aantal Do
 ...Set Collie=Collie+1,C("COLLIE")=Collie_"/"_MaxCol
 ...If RePrint=1 Set Count=Count+1,C("BARCODE")=BarCode(Count)
 ...Else  Do
 ....Set C("BARCODE")=$$BARCODE(VervRef,GroepNr)
 ....Set ^TRANSP("D",VervRef,"D",GroepNr,"C",C("BARCODE"))=""
 ....Set ^TRANSP("L",C("BARCODE")_" ")=ColTyp_D_VervRef_D_GroepNr_D_$H
 ...Set C("LABELSIZE")="10x10"
 ...Set C("LBLGROEP")="TRANSP"
 ...Set C("LABELTYP")="COLLIE"
 ...Do:0'[Dev WLABEL^vhPRINTER(-1,.C,) ; Continues printing device already opened
 Close:0'[Dev Dev
 If $$ISPRINT(VervRef) Set R=^TRANSP("D",VervRef) Set:$P(R,D,2)="" $P(R,D,2)="P",^TRANSP("D",VervRef)=R
 Do REFRESH^vhTERMINA()
 Quit
 ;
FETCHCOL(VervRef,GroepNr,C) 
 New R,TranspNr,TranspNm,AfzId,AfzNaam,AfzAdres,AfzWPl,KLNr,KreaDat,Rembours,Gewicht,CollieNr,Land,PostKode,Munt
 Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 Set R=^TRANSP("T",TranspNr),TranspNm=$P(R,D),AfzId=$P(R,D,2)
 Set C("TR","NAAM")=TranspNm
 Set AfzNaam=^KBA(99,1),AfzAdres=^KBA(99,2),AfzWPl=^KBA(99,3)
 Set C("AFZ","ID")=AfzId
 Set C("AFZ","NAAM")=AfzNaam
 Set C("AFZ","ADRES")=AfzAdres
 Set C("AFZ","WOONPL")=AfzWPl
 Set R=^TRANSP("D",VervRef,"D",GroepNr),KLNr=$P(R,D),KreaDat=$P(R,D,10)
 Set R=$$LEVADR(VervRef,GroepNr),PostKode=$P(R,D,6),Land=$$LAND^vhRtn1($P(R,D,8))
 Set C("KL","NAAM")=$P(R,D,2)
 Set C("KL","TOENM")=$P(R,D,3)
 Set C("KL","ADRES")=$P(R,D,5)
 Set C("KL","POSTKODE")=PostKode
 Set C("KL","WOONPL")=$P(R,D,7)
 Set C("TAAL")=$P(^KKL(^KK1(KLNr),0),D,9)
 Set Munt=$P(^KKL(^KK1(KLNr),0),D,11) Set:Munt="MTL" Munt=$P(^KUL(KLNr,"F",GroepNr,1),D,18)
 Set R=^TRANSP("D",VervRef,"D",GroepNr),Rembours=$P(R,D,2),Gewicht=$J($P(R,D,3),0,1)
 Set C("GEWICHT")=$S(Gewicht:$$EXTNUM^vhLib.DataTypes(Gewicht,0,".",1)_" kg",1:"")
 Set C("REMBOURS")=$S(Rembours:$$EXTNUM^vhLib.DataTypes(Rembours,0,".",$$MUNT^vhRtn1(Munt,4))_" "_Munt,1:"")
 Set C("DATUM")=$$EXTDATE^vhLib.DataTypes(KreaDat)
 Set C("REFAFZ")=$$EXTNUM^vhLib.DataTypes(GroepNr,0,".",0)
 Set CollieNr=$O(^TRANSP("D",VervRef,"D",GroepNr,""))
 Set C("PRODUCT")=$$PRODUCT(VervRef,GroepNr)
 If Land="NL" Do
 . Set C("DEPOT")=""
 . Quit:'$D(^TRANSP("D",VervRef,"D",GroepNr,"Q","L"))
 . If $O(^TRANSP("D",VervRef,"D",GroepNr,"Q","L"))="",$O(^TRANSP("D",VervRef,"D",GroepNr,"Q","L"),-1)="" Quit
 . Set C("DEPOT")="FR8"
 Else  Do
 . If Land'="BE",$L($P(PostKode,"-",2)) Set PostKode=$P(PostKode,"-",2)
 . Set C("DEPOT")=$G(^ABX(Land,PostKode))
 Quit
 ;
WLABEL(Dev,C) 
 For I=1:1 Set Lijn=$T(@("B"_$G(C("TAAL"),"N")_I)) Quit:Lijn=""  Write @$P(Lijn,";",2),!
 Quit
 ;
 ; Nieuw barcodenummer
BARCODE(VervRef,GroepNr) 
 New R,BarCode,KLNr,PostKode,Land,EasyPack
 Set R=^TRANSP("D",VervRef,"D",GroepNr),KLNr=$P(R,D)
 Set R=$$LEVADR(VervRef,GroepNr)
 Set PostKode=$P(R,D,6),Land=$$LAND^vhRtn1($P(R,D,8)) Set:Land'="BE" PostKode=$P(PostKode,"-",2)
 Set EasyPack=$$PRODUCT(VervRef,GroepNr)="E"
 Set BarCode=$$RANGE(EasyPack)_$S(EasyPack:PostKode,1:99),BarCode=BarCode_((BarCode#7)+1)
 Quit BarCode
 ;
RANGE(EasyPack) 
 New AbxRec,AbxRange,AbxRef,AbxVan,AbxTot,AbxCount
 Set EasyPack=$G(EasyPack)
 Set AbxRec=^TRANSP("T",5036),AbxRange=$P(AbxRec,D,5+EasyPack),AbxRef=$P(AbxRange,"#")
 If $L(AbxRef) Do
 .Set AbxVan=$P(AbxRange,"#",2),AbxTot=$P(AbxRange,"#",3),AbxCount=$P(AbxRange,"#",4)
 .Set AbxCount=AbxCount+1
 .If AbxCount>AbxVan,AbxCount<AbxTot
 .Else  Set AbxCount=AbxVan
 .Set $P(AbxRange,"#",4)=AbxCount,$P(AbxRec,D,5+EasyPack)=AbxRange,^TRANSP("T",5036)=AbxRec
 .Set R=AbxRef_$TR($J(AbxCount,9-$L(AbxRef))," ",0)
 Else  Set R=$$RANGE('EasyPack)
 Quit R
 ;
ISPRINT(VervRef,GroepNr) 
 New IsPrint
 Set GroepNr=$G(GroepNr)
 If $L(GroepNr) Set IsPrint=$D(^TRANSP("D",VervRef,"D",GroepNr,"C"))
 Else  Do
 .Set IsPrint=1
 .For  Set GroepNr=$O(^TRANSP("D",VervRef,"D",GroepNr)) Quit:GroepNr=""  Set IsPrint=$$ISPRINT(VervRef,GroepNr) Quit:'IsPrint
 Quit IsPrint
 ;
PRODUCT(VervRef,GroepNr) 
 New R,Product,Land,Rembours,Gewicht,OneCol
 Set R=^TRANSP("D",VervRef,"D",GroepNr),Rembours=$P(R,D,2),Gewicht=$P(R,D,3)
 Set R=$$LEVADR(VervRef,GroepNr),Land=$$LAND^vhRtn1($P(R,D,8))
 Set OneCol=$P($G(^TRANSP("D",VervRef,"D",GroepNr,"Q","C")),D)=1
 Set:OneCol OneCol=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q","C"),-1)=""
 Set:OneCol OneCol=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q","C"))=""
 Set Product=$S("\BE\LU\"[(D_Land_D):"A",1:"I")
 ; Easypack niet toegelaten
 ;If Product="A",Gewicht'>30,OneCol,'Rembours Set Product="E"
 ; "G" niet meer gebruikt
 ;If Product="I",Gewicht'>50,OneCol,'Rembours Set Product="G"
 Quit Product
 ;
LEVADR(VervRef,GroepNr) 
 New R,ContactType,ContactRef
 Set R=^TRANSP("D",VervRef,"D",GroepNr),ContactRef=$P(R,"\",1),ContactType=$P(R,"\",6)
 Set:ContactType="" ContactType="K"
 Set R=$G(^TRANSP("D",VervRef,"D",GroepNr,"A"))
 If $L($TR(R,"0\",""))
 Else  If ContactType="K" Do
 . Set R=$G(^KUL(ContactRef,"F",GroepNr,3))
 . Set:$L($TR(R,"\",""))<5 R=$G(^KUL(ContactRef,"G",GroepNr,3))
 . Set:$L($TR(R,"\",""))<5 R=^KKL(^KK1(ContactRef),0)
 Else  If ContactType="L" Set R=^KLE(^KL1(ContactRef),0)
 Else  If ContactType="D" Set R=ContactRef
 Quit R
 ;