vhPRINTER ;PRINTER INSTELLINGEN [ 12/10/2001  3:58 PM ]
 ;
GIVELIST(Device,Types,PapListe) 
 New PrNrs,PrNm,PrTyp,I,PrT,RecDev,PrNr
 Set (PrNrs,PrNm,PrTyp)=U
 Set Types=U_$G(Types)_U
 For I=1:1:^cLOG(boot,"CP",0) Do
 .Set RecDev=$G(^cLOG(boot,"CP",I))
 .Quit:'$L(RecDev)
 .If $P(RecDev,D,3)'=(U_"."_U),$P(RecDev,D,3)'[(U_Device_U) Quit
 .Set PrNr=$P(^(I),D,1)
 .Set PrT=$P($G(^cLOG(boot,"DEV",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
 ;          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) 
 ; Opmer
 New Device,PapAsk,AutoSel
 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) Goto:'$L(Device) INIT2
 Set DevNm=$P(Device,"`",2)
 Set DevOms=$P(Device,"`",4)
 Set Device=$P(Device,"`")
 
 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="UB" Do:'AutoSel REFRESH^vhTERMINA() Do UBI("Print") Goto INIT2
 Do OPEN:DevNm'="TK",FAX:DevNm="TK"
INIT2 Do:'$D(Print) CLOSE
 Quit
 
FAX If Optie["F" Do  Quit:'$D(Print)  ; Opvragen faxnummer
 .Set Print("FAX","NR")=$$ASK^vhINP("Faxnummer : ",20,$G(Optie("FAXNR")),"Ingave faxnummer")
 .Do REFRESH^vhTERMINA() Set sScr("PAGE")=sScr("PAGE")+1
 .If $L(Print("FAX","NR"))<5 Kill Print
 If $D(Optie("MPC")) Set R=Optie("MPC")
 Else  Set R=$$PI^vhPOPUP("C;C","1OM-","","vhPRINTER","FAX","","",1)
 If zb="CANC" Kill Print Do TXTL^vhINP("PRINTER","FAXNOTSEND") Quit:'$D(Print)
 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"
 Set FP=2401 Write @F,"Voorbereiden fax ..."
 X F70
 D INIT^vhFAX
 Quit
 
OPEN ; Alleen voor printer
 New X
 Quit:'$D(Print)
 ;zw Print R K:20
 B 0
 Set AutoSel=$G(AutoSel)
OPEN2 Set X=1
 Open Device::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 Device::3600 S:$T X=1 Kill:'$T Print Quit
 .B 0
 Do GETF70
 If 'AutoSel Set FP=2401 Write @F,"Printing ..."
 Set:Print("DEV")'=$P $P(^cLOG(boot,"DEV",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 $D(Print("LADE")) Write @(@("FLA"_Print("LADE"))) ; Lade selectie
 If Print("FONTSIZE")=12 Do
 .Write *27,":"
 .Set F83=F83_",*27,"":"""
 Quit
 
CLOSE If $D(Print) Write:$D(Print("LADE")) @FLA1 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=^cLOG(boot,"DEV",Device)
 If DevNm="TK" Set PapTyp="S"
 Else  Do:'AutoSel SELPAP
 Set:AutoSel 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")=Device,Print("DEV","AUTOSEL")=AutoSel
 Set Print("PRINTER")="P;"_DevNm
 Do @(DevNm)
 Set Print("MAXLIJN")=Print("LEN")-Print("TOP")-Print("BOT")
 Quit
 
BL ; Brother laser
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) 
 New DevRec,I,T,P,PRec,Rec,Y,X,Extra
 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;"'[(";"_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;",$P($G(^cLOG(boot,"CP",99)),D,3)[(";"_$$IO^cQ5_";")!($P($G(^cLOG(boot,"CP",99)),D,3)=".") Set Y=Y+1,Y(Y)="F`Fax`",Z("F")=$P(^cLOG(boot,"CP",99),D,1)_"`TK`"_Y(Y),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;"
 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
 ; 
 Set ProcID=$J
 Set I=1000
 For  Set I=$O(^cPRINT(boot,ProcID,I)) Quit:I=""  Do
 .Set Rec=$G(^cPRINT(boot,ProcID,I))
 .Quit:'$P(PRec,D,9)
 .Quit:Devices'[(";"_$P(PRec,D,2)_";")
 .Set Y=Y+1,Y(Y)=P_"`"_$P(Rec,D,2)_"`",Z(P)=$P(Rec,D)_"`"_$P(PRec,D,2)_"`"_Y(Y),Extra=1
 ; 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 Set P=$P(Y(1),"`") Quit $G(Z(P),P_"`"_P)
 ;If Extra Do
 .Do FILL^vhTERMINA(sScr("ROW")-1,1,sScr("ROW"),sScr("KOL"))
 .Set FP=2304 Write @F,@FMTI,"Voor extra instellingen ivm. printers,",!,"   gelieve te selekteren met '+' ipv. de spatiebalk",@FMTi
 Set P=$$EDIT^vhPOPUP("C;C","W","Y",$P(DevRec,D,14),"I","BOK2-","Selectie output","","",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)
 Quit P
 
AUTOSEL(Device) 
 New I,Rec
 Set Device=$$UPTRIMAN^vhRtn1(Device)
 If Device="FAX" Do
 .Set Rec=^cLOG(boot,"CP",99)
 .Set Device=$P(Rec,D)_"`TK`99`"_$P(Rec,D,2)_"`"
 Else  For I=1:1:$G(^cLOG(boot,"CP",0)) Do  Quit:$L(Device,"`")>1
 .Set Rec=$G(^cLOG(boot,"CP",I))
 .If Device'=I,Device'=$P(Rec,D),Device'=$$UPTRIMAN^vhRtn1($P(Rec,D,2)) Quit
 .Set Device=$P(Rec,D)_"`"_$P($G(^cLOG(boot,"DEV",$P(Rec,D))),D,2)_"`"_I_"`"_$P(Rec,D,2)_"`"
 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
 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
 .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
 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")=$H
 Set Print("LF")=$C(13)_$C(10)
 Set Print("CR")=$C(13)
 Set Print("FF")=$C(12)
 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=Device
 S %LNMAX=$P(^cLOG(boot,"DEV",K),D,11)
 ;
 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:Device ^DEVSAVE($I,"PRINT","UB")=Device
 Else  If Local="Optie" Set Device=$G(^DEVSAVE($I,"PRINT","UB")) Set: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
 ;