vhPRINTER ;PRINTER INSTELLINGEN [ 11/29/2003  12:32 PM ]
 ;
GIVELIST(Device,Types,PapListe) 
 New PrNrs,PrNm,PrTyp,I,PrT,RecDev,PrNr
 Set (PrNrs,PrNm,PrTyp)=U
 Set Types=U_$G(Types)_U
 Do:Types[";UB;"
 .Set I=""
 .For  Set I=$O(^DATA(0,"SYS.CP",I)) Quit:I=""  Do
 ..Set RecDev=^DATA(0,"SYS.CP",I,0)
 ..Quit:$P(RecDev,D,30)  Quit:'$P(RecDev,D)  Quit:$P(RecDev,D,4)'="UB"
 ..Set I($P(RecDev,D))=RecDev
 Set I=""
 For  Set I=$O(^cPRINT(boot,$J,I)) Quit:I=""  Do
 .Set RecDev=^cPRINT(boot,$J,I,0)
 .Quit:'$P(RecDev,D)
 .Set I($P(RecDev,D))=RecDev
 Set I=""
 For  Set I=$O(I(I)) Quit:I=""  Do
 .Set RecDev=I(I)
 .Set PrNr=$P(RecDev,D,3)
 .Set PrT=$P($G(^cLOG(boot,"DEV",$$UPTRIMAN^vhRtn1(PrNr))),D,2)
 .Set:PrT="" PrT="BR"
 .Quit:Types'[PrT&(Types'=(U_U))
 .Set PrTyp=PrTyp_PrT_U
 .Set PrNrs=PrNrs_PrNr_U
 .Set PrNm=PrNm_$P(RecDev,D,2)_U
 Quit:PrTyp=U ""
 Quit PrTyp_D_PrNrs_D_PrNm
 
 ; Devices: Lijst van BR;CA;BO;BL;M;P;T;TA;TH;S;F;FOP
 ;          Indien enkelvoudig karakters dan mag het zonder ";"         
 ;          M : afdruk op Mac
 ;          P : alle soorten printers BRother;CAnon;BrotherOld;BrotherLaser
 ;          T : alle soorten transfers TAscii & THostfile 
 ;          S : scherm,video.
 ;          F : Fax
 ; Optie : N : Van Tot bladzijde ev. opvragen
 ;         F : Opvragen fax nummer       
 ; Optie kan doorgegeven worden via .Local.
 ; Optie("AUTOSEL") : Te kiezen device zonder vraagstelling
 ; Optie("FAXNR") : Default faxnr
 
INIT(PapList,LijstBr,PrintTyp,Optie,Titel) 
 ; Opmer
 New Device,PapAsk,AutoSel,DevPref,DevExec,DevFOP,SelectedPrinter
 New OpenParams set OpenParams = ""
 Kill Print
 Set PapList=$G(PapList),LijstBr=$G(LijstBr)
 Set PrintTyp=$G(PrintTyp),Optie=$G(Optie)
 Do:PrintTyp="UB" UBI("Optie")
 Set AutoSel=$D(Optie("AUTOSEL")) Set:AutoSel PrintTyp=Optie("AUTOSEL")
 Set:PrintTyp="" PrintTyp="P"
 Do:'AutoSel STORE^vhTERMINA()
 ; Voor oude compatibiltiet
 Set:PrintTyp="MC" PrintTyp="M" Set:PrintTyp="VI" PrintTyp="S" Set:PrintTyp="TR" PrintTyp="TA" Set:PrintTyp="HF" PrintTyp="TH" Set:Optie=1 PrintTyp=PrintTyp_";F"
 Set Device=$$SELECT(PrintTyp,AutoSel,$G(Titel)) Goto:'$L(Device) INIT2
 Set DevNm=$P(Device,"`",2)
 Set DevOms=$P(Device,"`",4)
 Set DevExec=$P(Device,"`",6)
 Set DevFOP=$P(Device,"`",7)
 Set Device=$P(Device,"`")
 Set DevPref=$P($$DEV(DevOms),$TR(Device,"/",D))
 If Device=$I,DevNm="MP" Do MACPRINT(PapList,LijstBr) Goto INIT2
 If Device="S" Do VIDEO(PapList,LijstBr) Goto INIT2
 If Device="T" Do TRANS($G(PapList),$G(LijstBr)) Goto INIT2
 If Device="H" Do HFS($G(PapList),$G(LijstBr)) Goto INIT2
 ; Verder alleen printers en fax
 Do PAPIER(PapList,$G(LijstBr),AutoSel)
 If DevNm="BZ" {
	 set DevPref=""
	 set Device = $select($data(Optie("BESTAND")):Optie("BESTAND"),1:$$BepaalBestandNaam()),OpenParams="WNS",DevFOP="FOP;Bestand"
 }
 If DevNm="UB" Do:'AutoSel REFRESH^vhTERMINA() Do UBI("Print") Goto INIT2
 Do OPEN:DevNm'="TK",FAX:DevNm="TK"
INIT2 If $D(Print) Do
 .Set:$D(Print("DEV")) Print("DEV")=$G(Print("DEV","PREFIX"))_Print("DEV")
 .Xecute:$L(DevExec) DevExec
 Else  Do CLOSE
EndInit 
 New Info Set Info = $$ArrayToText^vhLib("Print")_$char(13,10)_
 					 "PapList :"_$get(PapList)_$char(13,10)_
 					 "PrintTyp : "_$get(PrintTyp)_$char(13,10)_
 					 "LijstBr : "_$get(LijstBr)_$char(13,10)_
 					 "Device : "_$get(Device)_$char(13,10)_
 					 "Optie : "_$$ArrayToText^vhLib("Optie")
 do ##class(vhLib.Logger).%New().Info("INIT",Info)
 quit
 
BepaalBestandNaam()
 New BestandNaam,BestandLocatie
 if ##class(TECH.Config.ConfigMgr).Instance().GeefBoolean("vhPRINTER_BestandNaam_DoorverwijzingActief") {
	set BestandLocatie = ##class(TECH.Config.ConfigMgr).Instance().GeefString("PrintFileDropFolder")
	Set BestandNaam = ##class(TECH.Context).Instance().GeefFileAPI().GeefFileNameGenerator().GenerateFileName("prn","txt")
 } else {
	set BestandLocatie = $$DIRUSER^vhDEV()
	if '$length(BestandLocatie) {
		set BestandLocatie = ##class(TECH.Config.ConfigMgr).Instance().GeefString("DefaultExportDirectory")
	}
	set BestandNaam ="prn"_$translate($zdatetime($horolog,8)," :","")_" "_$piece($ztimestamp,".",2)_".txt"
 }
 quit ##class(TECH.Files).AppendFile(BestandLocatie,BestandNaam)
 
FAX
 New MPC
 Set MPC=$G(Optie("MPC"),"MPCB\1")
 If Optie["F" Do  Quit:'$D(Print)  ; Opvragen faxnummer
 .Set Print("FAX","NR")=$$ASK^vhINP("Faxnummer : ",20,$G(Optie("FAXNR")),"Ingave faxnummer")
 .If 'AutoSel Do REFRESH^vhTERMINA() Set sScr("PAGE")=sScr("PAGE")+1
 .If $L(Print("FAX","NR"))<5 Kill Print
 If '$P(MPC,D,2) Set R=$P(MPC,D)
 Else  Set R=$$PI^vhPOPUP("C;C","1OM-","","vhPRINTER","FAX","","",1)
 If $G(zb)="CANC" Kill Print Do TXTL^vhINP("PRINTER","FAXNOTSEND") Quit:'$D(Print)
 If 'AutoSel Do REFRESH^vhTERMINA() Set sScr("PAGE")=sScr("PAGE")+1
 Set Print("FAX","COPYINT")=R["C",Print("FAX","MAIL")=R["M",Print("FAX","PRINT")=R["P",Print("FAX","COPYBV")=R["B"
 S F70="S %S1="""_DevNm_""" D ^cA605",F71="D ^cA606"
 If 'AutoSel Set FP=2401 Write @F,"Voorbereiden fax ..."
 X F70
 D INIT^vhFAX
 Quit
 
OPEN ; Alleen voor printer
 New X,ODevice
 Quit:'$D(Print)
 B 0
 Set AutoSel=$G(AutoSel)
OPEN2 Set X=1,ODevice=$G(DevPref)_$TR(Device,"/",D)
 if $get(OpenParams)="WNS" do ##class(TECH.Context).Instance().GeefFileAPI().GeefDirectoryUtils().CreateIfNotExists(##class(TECH.File).GetDirectory(ODevice))
 Open ODevice:$G(OpenParams):1 Else  Do
 .Set X=$S(AutoSel:"H",1:$$^vhTXTPOP("vhPRINTER","DEVINUSE",1,Device,DevOms))
 .Quit:AutoSel
 .Do REFRESH^vhTERMINA()
 .Set sScr("PAGE")=sScr("PAGE")+1
 If X="" Kill Print Quit
 If X="H" Goto OPEN2
 If X="W" Do  If 'X Kill Print Quit
 .B 1
 .Set FP=2401 Write @F,"Wachten ..."
 .Open ODevice:$G(OpenParams):3600 S:$T X=1 Kill:'$T Print Quit
 .B 0
 Do GETF70
 Set:Print("DEV")'=$P $P(^cLOG(boot,"DEV",$$UPTRIMAN^vhRtn1(Print("DEV"))),"\",13)=$G(Print("PAPIER"))

 X F70 I $L($G(^cLOG(boot,"TERMINAL",$I))) X ^($I)
 W @F80
 If $E(Print("PRINTER"))="P" Set FP=Print("LEN") W @F32
 If Print("FONTSIZE")=12 Do
 .Write $C(27),":"
 .Set F83=F83_",$C(27),"":"""
 Quit
 
CLOSE(PrinterType)
 If $D(Print) Xecute F71
 If '$G(Print("DEV","AUTOSEL")),'$G(AutoSel) Do REFRESH^vhTERMINA()
 Kill Print
 Quit
 
SELPAP ; Selecteren uit meerdere papiertypes
 New I,RecPap,Y,I,Vorig,Oms
 ;Defaulting
 If PapList="" Set PapList=$S(DevNm="UB":"E",1:"S;B")
 I PapList?2.3N Set:'LijstBr LijstBr=PapList Set PapList=$S(PapList<96:"S;B",1:"B")
 ; Opkuis voor Brother Matrix: Smal wordt Logo
 For I=1:1:$L(PapList,";") I $P(PapList,";",I)="S",DevNm="BR"!(DevNm="BO") Set $P(PapList,";",I)=$S(PapList["L":"",1:"L") 
 Set:$E(PapList)=";" $E(PapList)=""
 ; Nakijken of eerste papiertype OK is
 Set PapTyp=$P(PapList,";")
 Set RecPap=$G(^cLOG(boot,"PAP",DevNm,PapTyp))
 If '$G(PapAsk),PapTyp=$P(RecDev,D,12),(PapTyp=$P(RecDev,D,13)) Quit  ;Default papier
 ; Vragen naar het goede papiertype
 Set Oms=$P(RecPap,D) Set:Oms="" Oms="Onbekend"
 Set Vorig=$P(RecDev,D,13) Set:$L(Vorig) Vorig=$P($G(^cLOG(boot,"PAP",DevNm,Vorig)),D)
 Set Y=""
 For I=1:1:$L(PapList,";") Do
 .Set PapTyp=$P(PapList,";",I) Quit:'$L(PapTyp)
 .Quit:'$D(^cLOG(boot,"PAP",DevNm,PapTyp))
 .Set RecPap=^(PapTyp)
 .Set Y=Y+1,Y(Y)=PapTyp_"`"_$P(RecPap,D)
 Do FILL^vhTERMINA(sScr("ROW")-1,1,sScr("ROW"),sScr("KOL"))
 Set FP=2304 Write @F,@FMTI,"Gelieve papier "_Oms_" op de printer te plaatsen"
 Write:$L(Vorig) !,"   De vorige papierkeuze was : "_Vorig Write @FMTi
 Set PapTyp=$$EDIT^vhPOPUP("C;C","W","Y",$P(PapList,";"),"I","BOK2-","Selectie papier","","",1)
 Do REFRESH^vhTERMINA() Set sScr("PAGE")=sScr("PAGE")+1
 If PapTyp="-" Set PapTyp="" Quit
 Quit
 
PAPIER(PapList,LijstBr,AutoSel)   
 New PapBr Set RecDev=$g(^cLOG(boot,"DEV",$$UPTRIMAN^vhRtn1(Device)))
 If (DevNm="TK") { Set PapTyp="S" }
 ElseIf (DevNm="BZ") { set PapTyp="S" }
 Else { Do:'AutoSel SELPAP }
 if (($G(PapTyp) = "") && AutoSel ) set PapTyp="L"
 If PapTyp="" Kill Print Quit
 Set:'LijstBr LijstBr=$S(PapTyp="B":132,1:$S(DevNm="TK":96,1:80))
 Do SETPRINT
 Set Print("PAPIER")=PapTyp
 Set Print("DEV")=$TR(Device,"/",D),Print("DEV","PREFIX")=$G(DevPref),Print("DEV","AUTOSEL")=AutoSel
 Set Print("PRINTER")="P;"_DevNm
 If $L($TR(DevNm," ","")) Do
 . If $L($T(@(DevNm))) Do @(DevNm)
 . Else  Do AllTyp
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")-4
 Quit
 
AllTyp ; Alle types
L1
L2
L3
AB
BL ; Brother laser
BZ ; Printen naar bestand
CA ; Canon inkjet, los papier
 ;Selectie van het papierlade
 New I
 If $P(RecDev,D,14)[PapTyp For I=1:1:$L($P(RecDev,D,14),";") Quit:$P($P(RecDev,D,14),";",I)=PapTyp
 Set:$G(I) Print("LADE")=I
 Set PapBr=$S(PapTyp="B":132,1:80)
 If PapTyp="B",132<(LijstBr*12/10) Do  ;Eventueel niet condensed
 .Set Print("FONTSIZE")=12
 .Set PapBr=112
 If PapTyp="S"!(PapTyp="L"),LijstBr<96,LijstBr>80 Do  ;Eventueel wel condensed
 .Set Print("FONTSIZE")=12
 .Set PapBr=96
 Set:'Print("LMARG") Print("LMARG")=$S(PapBr-LijstBr>4:4,PapBr>LijstBr:PapBr-LijstBr,1:0)
 Set Print("KOL")=PapBr
 Set:PapTyp="L" Print("KOLLOGO")=15
 Quit
 
 ;Brother matrix, ketting papier
BO ; Brother old
BR Set:PapTyp="L" Print("KOLLOGO")=25
 If PapTyp="S",LijstBr<96,LijstBr>80 Do  ;Eventueel wel condensed
 .Set Print("FONTSIZE")=12
 .Set PRINT("KOL")=96
 If PapTyp="B",LijstBr<159,LijstBr>132 Do  ;Eventueel wel condensed
 .Set Print("FONTSIZE")=12
 .Set Print("KOL")=159
 Quit
 
 ; Fax
TK Set PapBr=$S(PapTyp="B":132,1:96)
 If PapTyp="B",132<(LijstBr*12/10) Do  ;Eventueel niet condensed
 .Set Print("FONTSIZE")=12
 .Set PapBr=112
 If PapTyp="S"!(PapTyp="L"),LijstBr<96,LijstBr>80 Do  ;Eventueel wel condensed
 .Set Print("FONTSIZE")=12
 .Set PapBr=96
 Set:'Print("LMARG") Print("LMARG")=$S(PapBr-LijstBr>4:4,PapBr>LijstBr:PapBr-LijstBr,1:0)
 Set Print("KOL")=PapBr
 Set:PapTyp="L" Print("KOLLOGO")=15
 Quit
 ;
 ; UBI Etiketprinter
UB 
 Quit
 ;
SELECT(Devices,AutoSel,Titel) 
 New DevRec,I,T,P,PRec,Rec,Y,X,Extra,Device
 If $G(AutoSel) Quit $$AUTOSEL(Devices)
 Set DevRec=$G(^cLOG(boot,"DEV",$$IO^cQ5))
 Set:Devices="" Devices="P"
 If Devices'[";",";TA;TH;CA;BR;BO;UB;BL;FOP;BZ;"'[(";"_Devices_";")  Set T=Devices,Devices="" For I=1:1:$L(T) Set Devices=Devices_";"_$E(T,I)
 Set Devices=";"_Devices_";"
 For I=1:1 Quit:$E(Devices,I)=""  I $E(Devices,I)=";",$E(Devices,I+1)=";" Set $E(Devices,I)=""
 Set Y=0
 Set Extra=0
 ; Scherm & Fax
 If Devices[";S;" Set Y=Y+1,Y(Y)="S`Scherm`"
 If Devices[";F;" Do
 .Set P=$$AUTOSEL("Fax")
 .Quit:P=""
 .Set $P(P,"`",3)="F",Y=Y+1,Y(Y)=$P(P,"`",3,5),Z("F")=P,Extra=1
 Set:Y Y=Y+1,Y(Y)="&S"
 ; Direct geconnecteerd of printer gekoppeld aan MAC
 If Devices[";P;" Set Devices=Devices_";CA;BR;BO;BL;BZ;"
 If $P(DevRec,D,9),$P(DevRec,D,2)="MP"&(Devices[";M;")!(Devices[(";"_$P(DevRec,D,2)_";")) Set Y=Y+1,Y(Y)="0`"_$S($L($P(DevRec,D,5)):$P(DevRec,D,5),$P(DevRec,D,2)="MP":"LaserWriter",1:"Terminal printer"),Z(0)=$$IO^cQ5_"`"_$P(DevRec,D,2)_"`"_Y(Y)
 ; Centrale printers
 Do:Devices[";UB;"
 .Set P=""
 .For  Set P=$O(^DATA(0,"SYS.CP",P)) Quit:P=""  Do
 ..Set Rec=^DATA(0,"SYS.CP",P,0)
 ..Quit:$P(Rec,D,30)  Quit:'$P(Rec,D)  Quit:$P(Rec,D,4)'="UB"
 ..Set P($P(Rec,D))=Rec
 Set P=""
 For  Set P=$O(^cPRINT(boot,$J,P)) Quit:P=""  Do
 .Set Rec=^cPRINT(boot,$J,P,0)
 .Quit:'$P(Rec,D)
 .Set P($P(Rec,D))=Rec
 Set P=""
 For  Set P=$O(P(P)) Quit:P=""  Do
 .Set Rec=P(P),Device=$$UPTRIMAN^vhRtn1($P(Rec,D,3))
 .Quit:Device=""  ; Geen device naam
 .If '$D(^cLOG(boot,"DEV",Device)) Do
 ..Set PRec="VI"_D_$P(Rec,D,4)_"\\\\\\\1\0\"_$P(Rec,D,5)
 ..Set $P(PRec,D,12)=$S($P(Rec,D,4)="UB":"E",$P(Rec,D,4)="BR":"B",1:"S")
 ..Set $P(PRec,D,13)=$S($P(Rec,D,4)="UB":"E",$P(Rec,D,4)="BR":"B",1:"S")
 ..Set $P(PRec,D,14)=$S($P(Rec,D,4)="CA":"S;L",$P(Rec,D,4)="BL":"S;L",1:"")
 ..Set ^cLOG(boot,"DEV",Device)=PRec
 .Else  Set PRec=^cLOG(boot,"DEV",Device)
 .Quit:'$P(PRec,D,9)
 .If Devices'=";FOP;" Quit:Devices'[(";"_$P(PRec,D,2)_";")
 .If Devices=";FOP;",$P($P(PRec,D,15),";")'="FOP" Quit
 .If Devices'=";FOP;",$P(PRec,D,16)="AlleenFOP" Quit
 .Set Y=Y+1,Y(Y)=$P(Rec,D)_"`"_$P(Rec,D,2)_"`",Z($P(Rec,D))=$P(Rec,D,3)_"`"_$P(Rec,D,4)_"`"_Y(Y)_"`"_$P(Rec,D,24)_"`"_$P(PRec,D,15),Extra=1
 
 new GebruikerBeheerder,GebruikerID,Gebruiker
#dim GebruikerBeheerder As DOM.common.VanHoeckeGebruikerBeheerder = ##class(DOM.DomeinContext).Instance().GeefGebruikerAPI().GeefVanHoeckeGebruikerBeheerder()
#dim GebruikerID As %String = $$USERID^vhUSER(QU)
#dim Gebruiker As DOM.common.VanHoeckeGebruiker = GebruikerBeheerder.GeefGebruiker(GebruikerID)
 if Gebruiker.GeefRollen().Find(##class(APPS.common.Authorizatie.enu.Rol).ICTmedewerker()) {
 	Set Rec = ^DATA(0,"SYS.CP",1043,0) ; Print naar bestand
 	Set Y=Y+1,Y(Y)=$P(Rec,D)_"`"_$P(Rec,D,2)_"`",Z($P(Rec,D))=$P(Rec,D,3)_"`"_$P(Rec,D,4)_"`"_Y(Y)_"`"_$P(Rec,D,24)
 }
 
 ; File Transfer
 If Devices[";T;" Set Devices=Devices_";TA;TH;"
 If Y,Y(Y)'="&S" Set Y=Y+1,Y(Y)="&S"
 If Devices[";TA;",$P(DevRec,D)="MC" Set Y=Y+1,Y(Y)="T`Transfer ASCII`"
 If Devices[";TH;" Set Y=Y+1,Y(Y)="H`HostFileSystem`"
 If Y,Y(Y)="&S" Kill Y(Y) Set Y=Y-1
 Quit:'Y ""
 If Y=1,'##class(TECH.Config.ConfigMgr).%New().GetBoolean("vhPRINTER_AlwaysSelect") Set P=$P(Y(1),"`") Quit $G(Z(P),P_"`"_P)
 Set Titel=$G(Titel) Set:Titel="" Titel="Selectie output"
 Set P=$$EDIT^vhPOPUP("C;C","W","Y",$P(DevRec,D,14),"I","BOK2-",Titel,"","",1)
 If zb="CANC",Devices[";F;" Do TXTL^vhINP("PRINTER","FAXNOTSEND")
 Do REFRESH^vhTERMINA() Set sScr("PAGE")=sScr("PAGE")+1
 Quit:'$L(P) P
 Set P=$G(Z(P),P_"`"_P)
 Set $P(P,"`")=$TR($P(P,"`"),"/",D)
 Quit P
 
AUTOSEL(Device) 
 New I,Rec,NextPr,PrNr,PRec
 Set Device=$ZCVT(Device,"U") ; hier bewust geen uptrim an want anders werken de printers met '.' in nr niet meer
 Set NextPr=999
 For  Set NextPr=$O(^DATA(0,"SYS.CP",NextPr)) Quit:NextPr=""  Do  Quit:$L(Device,"`")>1
 .Set Rec=^DATA(0,"SYS.CP",NextPr,0)
 .Quit:$P(Rec,D,30)
 .If Device'=$P(Rec,D),$$UPTRIMAN^vhRtn1(Device)'[$$UPTRIMAN^vhRtn1($TR($P(Rec,D,3),"/",D)),$$UPTRIMAN^vhRtn1(Device)'=$$UPTRIMAN^vhRtn1($P(Rec,D,2)) Quit
 .Set PRec="",PrNr=$$UPTRIMAN^vhRtn1($P(Rec,D,3))
 .Set:$L(PrNr) PRec=$G(^cLOG(boot,"DEV",PrNr))
 .Set Device=$TR($P(Rec,D,3),"/",D)_"`"_$S(Device="FAX":"TK",1:$P(Rec,D,4))_"`"_$P(Rec,D)_"`"_$P(Rec,D,2)_"``"_$P(Rec,D,24)_"`"_$P(PRec,D,15)
 Set:$L(Device,"`")=1 Device=""
 Quit Device
 
MACPRINT(PapList,LijstBr)  ; Laserprinter van de Macintosh
 New Key
 Set PapTyp=$P(PapList,";")
 Do SETPRINT
 Set Print("LEN")=$S(Print("KOL")>80:46,1:72)
 Set Print("PRINTER")="M;BR"
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Set Key="MP"
 For  Set Key=$O(^vhDEV(Key)) Quit:Key=""!($E(Key,1,2)'="MP")  Set @$E(Key,3,99)=^vhDEV(Key)
 W *27,"[5i" ; Opzetten printer
 S F71="W *27,""[4i"" D ^cA606"
 Quit
 
VIDEO(PapList,LijstBr) ; Screen afdruk
 Set PapTyp=$P(PapList,";")
 Do SETPRINT
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Set Print("PRINTER")="S;VT"
 If Print("KOL")>80 W @FS132
 If Print("KOL")<81 W @FS80
 S (F82,F83,F32)="""""" ; Initialisatie printer kenmerken
 Set F71="D ^cA606 W @FS80" 
 Quit
 
TRANS(PapList,LijstBr) ; Transfert Mac
 Set PapTyp=$P(PapList,";")
 Do SETPRINT
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Set Print("PRINTER")="T;VT"
 If Print("KOL")=999
 S (F82,F83,F32)="""""" ; Initialisatie printer kenmerken
 Quit
 
HFS(PapList,LijstBr) ; Host file server
 Set PapTyp=$P(PapList,";")
 Do SETPRINT
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Set Print("PRINTER")="H;VT"
 If Print("KOL")=999
 S (F82,F83,F32)="""""" ; Initialisatie printer kenmerken
 Quit
 
SETPRINT ;Init van Print local
 New PapBr,LaatsteGlobalRef
 If $L($G(DevNm)),$L($G(PapTyp)),$D(^cLOG(boot,"PAP",DevNm,PapTyp)) Do
 .Set PapBr=^(PapTyp)
 .Set Print("TOP")=$P(PapBr,D,4)
 .Set Print("BOT")=$P(PapBr,D,5)
 .Set Print("KOL")=$P(PapBr,D,3)
 .Set Print("LEN")=$P(PapBr,D,2)
 .Set Print("LMARG")=$P(PapBr,D,6)
 Else  Do
 .Set LaatsteGlobalRef = $ZR
 .Do ##class(vhLib.Logger).%New().Warning("SETPRINT","Niet gedefiniëerd papier : "_LaatsteGlobalRef)
 .I PapTyp?2.N Set:'LijstBr LijstBr=PapTyp Set PapTyp=$S(PapTyp<96:PapTyp="S",1:"B")
 .Set PapBr=$S(PapTyp="B":132,1:80)
 .Set:'LijstBr LijstBr=$S(PapTyp="B":132,1:80)
 .Set Print("BOT")=0
 .Set Print("TOP")=0
 .Set Print("KOL")=PapBr
 .Set Print("LEN")=99999
 .Set Print("LMARG")=0
 .Do ##class(vhLib.Logger).%New().Warning("SETPRINT","Niet gedefiniëerd papier : Set "_LaatsteGlobalRef_" = ""\"_Print("LEN")_"\"_Print("KOL")_"\"_Print("TOP")_"\"_Print("BOT")_"\"_Print("LMARG")_"""")
 Set Print("NAAM")=$G(DevOms)
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Set Print("FONTSIZE")=10
 Set Print("PAPIER")=PapList
 Set Print("DEV")=$P
 Set Print("BLZ")=0
 Set Print("LIJN")=0
 Set Print("TITEL")=5
 Set Print("HEAD")=3
 Set Print("FOOT")=1
 Set Print("$H")=##class(TECH.Context).Instance().GeefDateTimeAPI().CurrentHorolog()
 Set Print("LF")=$C(13,10)
 Set Print("CR")=$C(13)
 Set Print("FF")=$C(12)
 Set:$P($G(DevFOP),";")="FOP" Print("FOPNAME")=$P(DevFOP,";",2)
 Quit
 
 ; Centrale printer ADM 81 - DEV 11 -> 3 of 13
JOBBOVEN(Device) 
 Open 11,Device
 For  Use 11 Read *Char Quit:Char=255  Use Device Write $C(Char)
 Close 11,Device
 Quit
 
 ; Selekteer printer vanuit ADM naar DEV
SELBOVEN(Q) 
 New (Q)
 Set Device=$I
 Use 0
 Do
 .New Device
 .Do ^cA604,INIT^vhTERMINA
 Set Printer(1)="3`Canon",Printer(2)="13`Brother"
 Set Printer=$$WILD^vhPOPUP("11;34","O1-","Printer boven",.Printer)
 Use Device
 Quit Printer
 
GETF70 
 New RR,K,%LNMAX
 Set K=$TR(Device,"/",D)
 S %LNMAX=$P($G(^cLOG(boot,"DEV",$$UPTRIMAN^vhRtn1(K))),D,11)
 if %LNMAX="" set %LNMAX=70
 Set K=$G(DevPref)_K
 ;
 S F70="O """_K_""" U """_K_""""
 S:%LNMAX F70=F70_" S %LNMAX="""_%LNMAX_""""
 S F70=F70_" S %S1="""_DevNm_""" D ^cA605"
 ;
 S F71="S FP="""_%LNMAX_""" W:FP&$D(F32) @F32 C """_K_""""
 S F71=F71_" D ^cA606"
 Quit
 
UBI(Local) 
 New Rec,Device
 Set Local=$G(Local)
 If Local="Print" Set Device=$G(@Local@("DEV")) Set:$L(Device) ^DEVSAVE($I,"PRINT","UB")=Device
 Else  If Local="Optie" Set Device=$G(^DEVSAVE($I,"PRINT","UB")) Set:$L(Device) @Local@("AUTOSEL")=Device
 Else  Kill ^DEVSAVE($I,"PRINT","UB")
 Quit
 
USERS ; Afdrukken overzicht printergebruikers
 Do INITUSER,DISPLAY^vhScherm("PRINTER"),FIELD^vhScherm("PRINTER","SORT")
 If %SC Do
 .Do DISPLAY^vhScherm("PRINTER",,,,"SORT"),INIT^PROC("PRINTER"_Sort,"LD")
 .Set LD(11)=LD(11)_"\Printers : "_^cLOG(master,"CP",0)
 .Do FETCHUSR,LISTUSER,CLEANUSR
 Quit
 ;
INITUSER 
 Kill
 Do INIT^vhTERMINA
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set Sort="P"
 Quit
 ;
FETCHUSR 
 Set (NextPr,Count)=0
 For  Set NextPr=$O(^cLOG("ADM","CP",NextPr)) Quit:NextPr=""  Do
 .If Count,Sort'="G" Set Count=Count+1,^HULP(%J,Count)=1
 .Set R=^cLOG("ADM","CP",NextPr),PrDev=$P(R,D),PrName=$P(R,D,2),UserDevs=$$SORTUSER($P(R,D,3))
 .For  Quit:$E(PrName,$L(PrName))'=" "  Set $E(PrName,$L(PrName))=""
 .Set R=D_PrName_D_PrDev_D
 .For  Set UserDev=$P(UserDevs,U),UserDevs=$P(UserDevs,U,2,999) Do  Quit:UserDevs=""
 ..If UserDev="",$L(UserDevs) Quit
 ..Set R=R_UserDev_D_$$USERNAME(UserDev)_D_NextPr
 ..Set Count=Count+1,^HULP(%J,Count)=R
 ..Set $P(R,D,4,99)="" Set:Sort'="G" R="\\\"
 If Sort="G" Do
 .For Count=1:1:Count Do
 ..Set R=^HULP(%J,Count),PrName=$P(R,D,2),UserDev=$P(R,D,4),UserName=$P(R,D,5),NextPr=$P(R,D,6)
 ..Set ^HULP(%J,0,UserName,UserDev,NextPr)=PrName
 ..Kill ^HULP(%J,Count)
 .Set Count=0,(UserName,R)=""
 .For  Set UserName=$O(^HULP(%J,0,UserName)) Quit:UserName=""  Do
 ..If Count Set Count=Count+1,^HULP(%J,Count)=1
 ..Set $P(R,D,5)=UserName,UserDev=""
 ..For  Set UserDev=$O(^HULP(%J,0,UserName,UserDev)) Quit:UserDev=""  Do
 ...Set $P(R,D,2)="",$P(R,D,4)=UserDev,NextPr=""
 ...For  Set NextPr=$O(^HULP(%J,0,UserName,UserDev,NextPr)) Quit:NextPr=""  Do
 ....Set PrName=^HULP(%J,0,UserName,UserDev,NextPr)
 ....Set:$L($P(R,D,2)) $P(R,D,2)=$P(R,D,2)_", " Set $P(R,D,2)=$P(R,D,2)_PrName
 ...Set PrName=$P(R,D,2)
 ...For  Do  Quit:PrName=""
 ....Set $P(R,D,2)=""
 ....For  Quit:$L($P(R,D,2))+$L($P(PrName,","))>79  Do  Quit:PrName=""
 .....Set:$L($P(R,D,2)) $P(R,D,2)=$P(R,D,2)_","
 .....Set $P(R,D,2)=$P(R,D,2)_$P(PrName,","),PrName=$P(PrName,",",2,99)
 ....For  Quit:$E($P(R,D,2))'=" "  Set $P(R,D,2)=$E($P(R,D,2),2,999)
 ....Set Count=Count+1,^HULP(%J,Count)=R,($P(R,D,4),$P(R,D,5))=""
 .Kill ^HULP(%J,0)
 Quit
 ;
SORTUSER(UserDevs) 
 New UserDev
 If UserDevs="." Do
 .Set UserDevs="",UserDev=0
 .For  Set UserDev=$O(^vhUSER("ID",UserDev)) Quit:UserDev=""  Set UserDevs=UserDevs_";"_UserDev
 Else  Do
 .For  Set UserDev=$P(UserDevs,U) Do  Quit:UserDevs=""
 ..Set:UserDev UserDevs(UserDev)="" Set UserDevs=$P(UserDevs,U,2,99)
 .Set (UserDevs,UserDev)=""
 .For  Set UserDev=$O(UserDevs(UserDev)) Quit:UserDev=""  Set UserDevs=UserDevs_U_UserDev
 Quit UserDevs
 ;
USERNAME(UserDev) 
 New UserName,DfltConf
 Set UserName=$$USERNAME^vhUSER($$DEVUSER^vhUSER(UserDev))
 If UserName="",$L(UserDev) Do
 .Set DfltConf=$P($G(^|"MGR"|SYS("CONFIG","DFLT")),U)
 .Set UserName=$G(^|"MGR"|SYS(DfltConf,"DDB",UserDev))
 .Quit:$L(UserName)
 .Set UserName=$G(^|"MGR"|QSYS(DfltConf,"DDB",UserDev))
 .Quit:$L(UserName)
 .Set UserName="???"
 Quit UserName
 ;
LISTUSER 
 If $D(^HULP(%J)) Do
 .Set FP=2101
 .Write @F,@F1
 .Do ^OUTPUT("SP")
 Quit
 ;
CLEANUSR 
 Kill ^HULP(%J)
 Break 1
 Quit
 ;
CBUSER(Ref) 
 New R,Aktie
 Set Aktie=""
 If Ref'?1A Set R=@Ref Set:$P(R,D,1) Aktie=$S(Sort="G":"BR",1:"PB")
 Quit Aktie
 ;
 ; Call back voor het opnemen van de elementen 'FAX'
PopUpInclElement(Element)
 New D,Include
 Set D="\"
 Set:$P(Element,"`",3)="" $P(Element,"`",3)=1
 Xecute "Set Include="_$P(Element,"`",3)
 Quit Include
 ;
DEV(Name,UpTrim) 
 New R,NextPr,Dev
 Set Name=$P(Name,"|PRN|")_$P(Name,"|PRN|",2),Name=$$UPTRIMAN^vhRtn1($G(Name)),(NextPr,Dev)=""
 For  Set NextPr=$O(^DATA(0,"SYS.CP",NextPr)) Quit:NextPr=""  Do  Quit:$L(Dev)
 .Set R=^DATA(0,"SYS.CP",NextPr,0)
 .If Name'=$$UPTRIMAN^vhRtn1($P(R,D,2)),Name'=$$UPTRIMAN^vhRtn1($P(R,D,3)) Quit
 .Set Dev=$TR($P(R,D,3),"/",D)
 .If '$G(UpTrim) Set Dev="|PRN|"_Dev
 .Else  Set Dev=$$UPTRIMAN^vhRtn1(Dev)
 Quit Dev
 
 
 ;LABEL PRINTER - INTERMEC C4
WLABEL(Dev,C,LogoKlantAfh,Initial)
 ; Indien Dev=-1 dan werd het print device reeds geopend
 ; Indien LogoKlantAfh=-1 dan GEEN LOGO
 ; Speciale data in C
 ; C("LBLGROEP") = "PRINTER", "HAD", ... zie ^RES(LblGroep,"LBL")
 ; C("LABELTYP") = zie ^RES(LblGroep,"LBL",LabelTyp)
 ; C("TAAL") = N, F, D of E
 ; C("KLNR") = voor keuze logo
 ; C("LABELSIZE") = 5x10, ...
 
 New I,%Groep,%Taal
 ;Set Dev=0
 If Dev'=-1 Do
 . ;If 0'[Dev,$G(C("LABELSIZE"))="5x10" Set Dev="|PRN|\\JDB_XP\HALUX_TXT_LABEL_5X10" ; slechts 1 printer met blanko 5X10 etiketten
 . If 0'[Dev,$G(C("LABELSIZE"))="5x10" Set Dev="|PRN|\\NOTES01\OVHALUX_TXT_LABEL_5X10" ; slechts 1 printer met blanko 5X10 etiketten
 . Set Dev=$P(Dev,"|PRN|")_$P(Dev,"|PRN|",2)
 . Set Dev="|PRN|"_Dev
 . Open:0'[Dev Dev
 . Use Dev
 
 Set Groep=$G(C("LBLGROEP"),"HAD")
 Set %Taal=C("TAAL")
 
 Set I=$$SetIO^%NLS("C850")
 Set Logo="LOGO4682" ; Van Hoecke Logo
 If $G(LogoKlantAfh),$G(C("KLNR")),$D(^IPCom("CS","LOGO"_C("KLNR"))) Set Logo="LOGO"_C("KLNR")
 
 Do WRES("PRINTER",$S($G(Initial,1):$S(Dev["5x10":"INITSLOW",1:"INITFAST"),1:"INIT")) ; initialisatie
 Do WRES(Groep,$G(C("LABELTYP"),$S($L($G(C("DOSNR"))):"ALGBARC",1:"ALG"))) ; gegevens
 Do:$G(LogoKlantAfh)'=-1 WRES("PRINTER","LOGO") ; firma logo
 Do WRES("PRINTER","FINISH") ; afsluiten
	
 If Dev'=-1 Close:0'[Dev Dev
 Quit
 
WRES(LblGroep,ID)
 New I,Check
 Set I=""
 Set %Groep=LblGroep
 For  Set I=$O(^RES(LblGroep,"LBL",ID,I)) Quit:I=""  Do
 . Set Rec=^RES(LblGroep,"LBL",ID,I)
 . Set Check=1
 . If $L($P(Rec,"`",2)) Set Check=0 If @$P(Rec,"`",2) Set Check=1  ; Conditioneel
 . Quit:'Check
 . Set Print=$P(Rec,"`",1)
 . Set:Print["{" Print=$$REPLACE5^vhRtn1(Print,"{","$$Label^vhPRINTER(""","}",""")") ; label vervangen door $$Label^vhPRINTER("label")
 . Write @(Print),!
 Quit
 
Label(ID)
	Set Lbl=$G(^RES(%Groep,"PI","LBL","D",ID,%Taal))
	Set:Lbl="" Lbl="{"_$G(^RES(%Groep,"PI","LBL","D",ID,"N"))_"}"
	Set:Lbl="{}" Lbl="?"_ID_"?"
	Quit Lbl