TMGPRNTR ;TMG/kst/Printer API Fns ;03/25/06 ;;1.0;TMG-LIB;**1**;04/25/04 ;"TMG PRINTER API FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"MatchPrt(Printers) ;"======================================================================= ;" Functions Used During Printing Process ;"======================================================================= ;"SETJOB(Filename) ;"FINISH(Printer) ;"Dependancies ;" TMGXDLG.m ;"======================================================================= ;"Private Functions ;"======================================================================= ;"GetPrinters^TMGPRNTR(Printers) ;"GetPrtDefs(PrtDefs) ;"PickPrtDef(LinuxPrt,PrtDefs,Output) GetPrinters(Printers) ;"Purpose: To interact with Redhat 9 Linux printer system and get a list ;" of defined printers ;"Input: (Printers is an OUT variable. MUST PASS BY REFERENCE ;"Output: Printers variable will be filled like this: ;" Printers(0,"COUNT")=2 ;" Printers(1)="Deskjet1" ;" Printers(2)="Laser1" ;"result: 1=OkToCont 0=Abort ;"Notes: Here is a simple way to get the available printers from the CUPS system ;"#lpstat -p >/tmp/DefinedPrinters.txt ;"#cat DefinedPrinters.txt ;"printer Laser is idle. enabled since Jan 01 00:00 ;"--notice that in this case "Laser" is the name of the printer. There is only 1 printer. ;"This printer could be used like this: ;"lp -d Laser MyFile.txt new Cmd,HookCmd new FileHandle new CmdResult new lpReport new index,PrtIndex new PrinterCount set PrinterCount=0 new cOKToCont set cOKToCont=1 new cAbort set cAbort=0 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 new result set result=cOKToCont if TMGDEBUG>0 do Entry^TMGDEBUG(.DBIndent,"GetPrinters") new CommFPath set CommFPath="/tmp/" new CommFName set CommFName="M_Printer_comm_"_$J_".tmp" new CommFile set CommFile=CommFPath_CommFName set HookCmd="lpstat -p>"_CommFile ;"write "Here is hook command",!,!,HookCmd,!,! zsystem HookCmd set CmdResult=$ZSYSTEM&255 ;"get result of execution. (low byte only) ;"write "CmdResult=",CmdResult,! ;"1=error if CmdResult=0 set result=cOKToCont else set result=cAbort goto GPDone ;"Read output info Results set FileHandle=$$FTG^%ZISH(CommFPath,CommFName,$name(lpReport("LIST")),3) ;"zwr lpReport(*) ;"Now kill the communication file... no longer needed. new FileSpec set FileSpec(CommFile)="" set result=$$DEL^%ZISH(CommFPath,$name(FileSpec)) set index="" for do quit:(index="") . new s . set s=$get(lpReport("LIST",index)) . if s="" quit . new Prt set Prt=$piece(s," ",2) . if Prt'="" do . . set PrinterCount=PrinterCount+1 . . set Printers(PrinterCount)=Prt . set index=$order(lpReport("LIST",index)) ;"if $data(Printers) zwr Printers(*) ;"w "done" GPDone set Printers(0,"COUNT")=PrinterCount if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrinters") quit result GetPrtDefs(PrtDefs) ;"Purpose: To get a list of printer definitions (i.e. TERMINAL TYPES) ;"Input: PrtDefs -- SHOULD BE PASSED BY REFERENCE to receive results. ;"Output: (PrtDefs is changed) ;" PrtDefs(0,"COUNT")=12 ;" PrtDefs(1,"NAME")="P-ANADEX" ;" PrtDefs(1,"DESCRIPTION")="ANADEX PRINTER 10P" ;" PrtDefs(2,"NAME")="P-CENT" ;" PrtDefs(2,"DESCRIPTION")="Centronix printer" ;" ... etc. ;"Result: 1=OKToCont 0=Abort ;"TERMINAL TYPE if file 3.2 new cOKToCont set cOKToCont=1 new cAbort set cAbort=0 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetPrtDefs") new Matches,Msg if $data(PriorErrorFound)=0 new PriorErrorFound if $data(DBIndent)=0 new DBIndent set DBIndent=0 new NumMatches,index new PrtCount set PrtCount=0 new result set result=cOKToCont new MatchValue set MatchValue="P-" ;"====================================================== ;"Call FIND^DIC ;"====================================================== ;"Params: ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC") if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent," MatchValue=",MatchValue) do FIND^DIC("3.2","","@;.01","",MatchValue,"*",,"",,"Matches","Msg") if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC") ;"====================================================== ;"====================================================== if $data(Msg("DIERR"))'=0 do goto GPDDone . do ShowDIERR^TMGDEBUG(.Msg,.PriorErrorFound) . set result=cAbort if $data(Matches) do . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries") . if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches") if $data(Matches("DILIST"))=0 goto GPDDone set NumMatches=$piece(Matches("DILIST",0),"^",1) kill PrtDefs set PrtDefs(0,"COUNT")=NumMatches if NumMatches=0 goto GPDDone ;"keep RecNumIEN default of 0 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries") if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches") for index=1:1:NumMatches do . kill OneMatch . new Name,Descr . set Name=$get(Matches("DILIST","ID",index,.01)) . set Descr=$get(^%ZIS(2,index,9)) . set PrtDefs(index,"NAME")=Name . set PrtDefs(index,"DESCRIPTION")=Descr GPDDone if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrtDefs") quit result PickPrtDef(LinuxPrt,PrtDefs,Output) ;"Purpose: To show all the printer types (TERMINAL TYPES), and have user pick one ;"Input: LinuxPrt -- name of Linux printer, as retrieved from GetPrinters() ;" PrtDefs -- Array of printer defs, as returned from GetPrtDefs(PrtDefs) ;" Array will not be changed, even if passed by reference. ;" Output -- MUST BE PASSED BY REFERENCE. Will be formated like this: ;" Output(0,"COUNT")=1 ;" Output(1,"LINUX")="Laser1" <----- Prior results ;" Output(1,"TYPE")="P-ANADEX" ;"Output: Output -- MUST BE PASSED BY REFERENCE. Output will be formated like this: ;" Output(0,"COUNT")=2 ;" Output(1,"LINUX")="Laser1" <----- Prior results ;" Output(1,"TYPE")="P-ANADEX" ;" Output(2,"LINUX")="Printer2" <----- Added results ;" Output(2,"TYPE")="P-CENT" ;"Result: 1=OKToCont 0=Abort, OR Cancel pressed. new cOKToCont set cOKToCont=1 new cAbort set cAbort=0 new result set result=cAbort if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 new tPrtDefs new DefCount,OutCount new index new UserPick set DefCount=$get(PrtDefs(0,"COUNT"),0) if DefCount=0 do goto PPDefDone . write "No printer defs! Quitting!",! set OutCount=$get(Output(0,"COUNT"),0) Set Output(0,"COUNT")=OutCount ;"Ensure this is set before any need to abort for index=1:1:DefCount do . new s,Name,Descr . set s=index_"; " . set Name=$get(PrtDefs(index,"NAME")) . ;"write "converted: ",Name," to " . set Name=$extract(Name,3,128) . ;"write Name,! . set Descr=$get(PrtDefs(index,"DESCRIPTION")) . set s=s_Name . if Descr'="" set s=s_Name_" -- "_Descr . set tPrtDefs(index)=s new s set s="---- Pick VistA driver for printer '"_LinuxPrt_"' ----\n\n" set s=s_"(Note: If you can not find an corresponding driver for your\n" set s=s_"printer, then see your installer regarding adding an\n" set s=s_"appropriate entry to the TERMINAL TYPE file, then retry.)" set UserPick=$$Combo^TMGXDLG(s,80,15,.tPrtDefs) if UserPick="" goto PPDefDone set index=+$piece(UserPick,";",1) if index=0 goto PPDefDone set OutCount=OutCount+1 set Output(OutCount,"LINUX")=LinuxPrt set Output(OutCount,"TYPE")=PrtDefs(index,"NAME") Set Output(0,"COUNT")=OutCount set result=cOKToCont PPDefDone quit result MatchPrt(Output) ;"Purpose: To create match between Linux printers, and definitions ;"Input: Output -- and out parameter. MUST BE PASSED BY REFERENCE ;"Output: (Output is changed) as follows ;" Output(0,"COUNT")=2 ;" Output(1,"LINUX")="Deskjet1" <-- suitable name for linux: lp -p PRINTER ;" Output(1,"TYPE")="P-ANADEX" ;" Output(2,"LINUX")="Laser1" <-- suitable name for linux: lp -p PRINTER ;" Output(2,"TYPE")="P-CENT" new cOKToCont set cOKToCont=1 new cAbort set cAbort=0 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0 if $data(DispMode)#10=0 new DispMode set DispMode=1 ;"1=GUI, 3=Roll-n-Scroll new result set result=cOKToCont new PrtDefs,Printers new PrtCount set PrtCount=0 kill Output ;"clear any prior entries. if DispMode'=1 do goto SUPDone . write "Currently unable to set up printers in 'Roll-and-Scroll' mode. Quitting.",! set result=$$GetPrinters(.Printers) if result=cAbort do goto SUPDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printers.") set result=$$GetPrtDefs(.PrtDefs) if result=cAbort do goto SUPDone . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printer definitions.") new tPrts new Selected set Selected="" merge tPrts=Printers kill tPrts(0) ;"set tPrts(2)="TestPrinter" ;"temp!!!!! ;"set tPrts(3)="TestPrinter2" ;"temp!!!!! for do quit:Selected="" . ;"write "loop1, selected=",Selected,! . set Selected=$$Combo^TMGXDLG("Select Printer to Setup",,,.tPrts) . if Selected="" quit . ;"write "OK, now to set up printer: ",Selected,! . new tResult set tResult=$$PickPrtDef(Selected,.PrtDefs,.Output) . ;"Note: I am not doing anything if user cancels pick of printer type. . ;"Now remove that printer from list of printers to install. . new index set index=$order(tPrts("")) . new NextIndex set NextIndex="" . for do quit:(index="") . . ;"write "loop2, index=",index,! . . set NextIndex=1 . . if index="" quit . . if $get(tPrts(index))=Selected do quit . . . set NextIndex=$order(tPrts(index)) . . . kill tPrts(index) . . . set index="" . . set index=$order(tPrts(index)) . if $data(tPrts)=0 do quit . . set Selected="" ;"force quit . ;"Now move all entries below this one UP . set index=NextIndex . for do quit:index="" . . ;"write "loop3, index=",index,! . . if index="" quit . . set tPrts(index-1)=tPrts(index) . . new PriorIndex set PriorIndex=index . . set index=$order(tPrts(index)) . . kill tPrts(PriorIndex) . . if $data(tPrts)=0 do . . . set Selected="" . . . set index="" SUPDone quit result SetupPrt ;"To query linux printer system, and create VistA entries for these. new cFile set cFile="FILE" new cEntries set cEntries="Entries" ; new Data ; set Data(0,cFile)="3.5" ; set Data(0,cEntries)=1 ; set Data ; ; 1 0;1 .01 NAME [RFX] ; 2 1;1 .02 LOCATION OF TERMINAL [RF] ; MN;0 .03 MNEMONIC <-Mult [3.501] ; 3 -0;1 .01 -MNEMONIC [MFX] ; 4 1;4 .04 LOCAL SYNONYM [F] ; 5 0;2 1 $I [RFX] ; 6 0;9 1.9 VOLUME SET(CPU) [FX] ; 7 0;11 1.95 SIGN-ON/SYSTEM DEVICE [SX] ; 8 TYPE;1 2 TYPE [RS] ; 9 SUBTYPE;1 3 SUBTYPE <-Pntr [RP3.2] ; 10 0;3 4 ASK DEVICE [S] ; 11 0;4 5 ASK PARAMETERS [S] ; 12 1;5 5.1 ASK HOST FILE [S] ; 13 1;6 5.2 ASK HFS I/O OPERATION [S] ; 14 0;12 5.5 QUEUING [S] ; 15 90;1 6 OUT-OF-SERVICE DATE [D] ; 17 90;3 8 KEY OPERATOR [F] ;18 91;1 9 MARGIN WIDTH [NJ3,0] ; 19 91;3 11 PAGE LENGTH [NJ5,0] ; 20 1;11 11.2 SUPPRESS FORM FEED AT CLOSE [S] ; 27 POX;E1,245 19.7 PRE-OPEN EXECUTE [K] ; 28 PCX;E1,245 19.8 POST-CLOSE EXECUTE [K] ; ; ;NAME: TEST-LINUX-PRINTER $I: ; ASK DEVICE: NO ASK PARAMETERS: NO ; SIGN-ON/SYSTEM DEVICE: NO LOCATION OF TERMINAL: Laughlin_Office ; ASK HOST FILE: NO ASK HFS I/O OPERATION: NO ; NEAREST PHONE: 787-7000 PAGE LENGTH: 80 ; FORM CURRENTLY MOUNTED: Plain paper ; POST-CLOSE EXECUTE: DO FINISH^TMGPRNTR("laughlin_laser") ; PRE-OPEN EXECUTE: DO SETJOB^TMGPRNTR(.IO) ;Note: Change IO (output file) ; SUBTYPE: P-OTH80 TYPE: TERMINAL ; ASK DEVICE TYPE AT SIGN-ON: YES, ASK quit ;"======================================================================= ;"======================================================================= GETJOBNM() ;"Purpose: To create a unique printer job name. This will be used during a printing process ;" that writes the printer file to the host file system, then passes file to Linux ;" printing system. ;"Output: Returns name of file to put output into ;"UNIQUE will generate a filename based on time and job number ;" i.e. 'Print-Job-628233034.tmp ;"write !,"here in GETJOBNM^TMGPRNTR",! new cJobs set cJobs="PRINT JOBS" new Filename set Filename=$$UNIQUE^%ZISUTL("/tmp/Print-Job.tmp") ;"Now store Filename for later transfer to Linux lpr new index set index=$order(^TMP("TMG",cJobs,$J,"")) if index="" set index=1 set ^TMP("TMG",cJobs,$J,index)=Filename ;"write !,"Print job name will be:",Filename,! quit Filename ;"result returned by altering Filename FINISH(Printer) ;"Purpose: to complete the printing process by sending the now-created file ;" to Linux CUPS (the printing system). ;"Note: The lpr system itself will delete this print file when done (option -r) ;"Input: Printer OPTIONAL -- the name of the linux printer to send the job to. new cJobs set cJobs="PRINT JOBS" new index set index=$order(^TMP("TMG",cJobs,$J,"")) new Filename set Filename=$get(^TMP("TMG",cJobs,$J,index)) close IO kill IO(1,IO) kill ^TMP("TMG",cJobs,$J,index) if Filename'="" do . new CmdStr . set CmdStr="lpr " . if $get(Printer)'="" set CmdStr=CmdStr_"-P "_Printer_" " . set CmdStr=CmdStr_"-r " ;"option -r --> lpr deletes file after printing done. . set CmdStr=CmdStr_Filename_" &" . zsystem CmdStr quit