source: cprs/branches/tmg-cprs/m_files/TMGPRNTR.m@ 838

Last change on this file since 838 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 16.5 KB
Line 
1TMGPRNTR ;TMG/kst/Printer API Fns ;03/25/06
2 ;;1.0;TMG-LIB;**1**;04/25/04
3
4 ;"TMG PRINTER API FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7
8 ;"=======================================================================
9 ;" API -- Public Functions.
10 ;"=======================================================================
11
12 ;"MatchPrt(Printers)
13
14 ;"=======================================================================
15 ;" Functions Used During Printing Process
16 ;"=======================================================================
17 ;"SETJOB(Filename)
18 ;"FINISH(Printer)
19
20
21 ;"Dependancies
22 ;" TMGXDLG.m
23 ;"=======================================================================
24 ;"Private Functions
25 ;"=======================================================================
26 ;"GetPrinters^TMGPRNTR(Printers)
27 ;"GetPrtDefs(PrtDefs)
28 ;"PickPrtDef(LinuxPrt,PrtDefs,Output)
29
30
31
32GetPrinters(Printers)
33 ;"Purpose: To interact with Redhat 9 Linux printer system and get a list
34 ;" of defined printers
35 ;"Input: (Printers is an OUT variable. MUST PASS BY REFERENCE
36 ;"Output: Printers variable will be filled like this:
37 ;" Printers(0,"COUNT")=2
38 ;" Printers(1)="Deskjet1"
39 ;" Printers(2)="Laser1"
40 ;"result: 1=OkToCont 0=Abort
41
42 ;"Notes: Here is a simple way to get the available printers from the CUPS system
43 ;"#lpstat -p >/tmp/DefinedPrinters.txt
44 ;"#cat DefinedPrinters.txt
45 ;"printer Laser is idle. enabled since Jan 01 00:00
46 ;"--notice that in this case "Laser" is the name of the printer. There is only 1 printer.
47 ;"This printer could be used like this:
48 ;"lp -d Laser MyFile.txt
49
50
51 new Cmd,HookCmd
52 new FileHandle
53 new CmdResult
54 new lpReport
55 new index,PrtIndex
56 new PrinterCount set PrinterCount=0
57 new cOKToCont set cOKToCont=1
58 new cAbort set cAbort=0
59 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
60
61 new result set result=cOKToCont
62
63 if TMGDEBUG>0 do Entry^TMGDEBUG(.DBIndent,"GetPrinters")
64
65 new CommFPath set CommFPath="/tmp/"
66 new CommFName set CommFName="M_Printer_comm_"_$J_".tmp"
67 new CommFile set CommFile=CommFPath_CommFName
68
69 set HookCmd="lpstat -p>"_CommFile
70 ;"write "Here is hook command",!,!,HookCmd,!,!
71 zsystem HookCmd
72
73 set CmdResult=$ZSYSTEM&255 ;"get result of execution. (low byte only)
74 ;"write "CmdResult=",CmdResult,! ;"1=error
75 if CmdResult=0 set result=cOKToCont else set result=cAbort goto GPDone
76
77 ;"Read output info Results
78 set FileHandle=$$FTG^%ZISH(CommFPath,CommFName,$name(lpReport("LIST")),3)
79 ;"zwr lpReport(*)
80
81 ;"Now kill the communication file... no longer needed.
82 new FileSpec
83 set FileSpec(CommFile)=""
84 set result=$$DEL^%ZISH(CommFPath,$name(FileSpec))
85
86 set index=""
87 for do quit:(index="")
88 . new s
89 . set s=$get(lpReport("LIST",index))
90 . if s="" quit
91 . new Prt set Prt=$piece(s," ",2)
92 . if Prt'="" do
93 . . set PrinterCount=PrinterCount+1
94 . . set Printers(PrinterCount)=Prt
95 . set index=$order(lpReport("LIST",index))
96
97 ;"if $data(Printers) zwr Printers(*)
98 ;"w "done"
99
100GPDone
101 set Printers(0,"COUNT")=PrinterCount
102 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrinters")
103
104 quit result
105
106
107GetPrtDefs(PrtDefs)
108 ;"Purpose: To get a list of printer definitions (i.e. TERMINAL TYPES)
109 ;"Input: PrtDefs -- SHOULD BE PASSED BY REFERENCE to receive results.
110 ;"Output: (PrtDefs is changed)
111 ;" PrtDefs(0,"COUNT")=12
112 ;" PrtDefs(1,"NAME")="P-ANADEX"
113 ;" PrtDefs(1,"DESCRIPTION")="ANADEX PRINTER 10P"
114 ;" PrtDefs(2,"NAME")="P-CENT"
115 ;" PrtDefs(2,"DESCRIPTION")="Centronix printer"
116 ;" ... etc.
117 ;"Result: 1=OKToCont 0=Abort
118
119 ;"TERMINAL TYPE if file 3.2
120
121 new cOKToCont set cOKToCont=1
122 new cAbort set cAbort=0
123 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
124
125 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"GetPrtDefs")
126
127 new Matches,Msg
128 if $data(PriorErrorFound)=0 new PriorErrorFound
129 if $data(DBIndent)=0 new DBIndent set DBIndent=0
130 new NumMatches,index
131 new PrtCount set PrtCount=0
132 new result set result=cOKToCont
133 new MatchValue set MatchValue="P-"
134
135 ;"======================================================
136 ;"Call FIND^DIC
137 ;"======================================================
138 ;"Params:
139 ;"FILE,IENS,FIELDS,FLAGS,VALUE,NUMBER,INDEXES,SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOTS
140 if TMGDEBUG>0 do DebugEntry^TMGDEBUG(.DBIndent,"FIND^DIC")
141 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent," MatchValue=",MatchValue)
142 do FIND^DIC("3.2","","@;.01","",MatchValue,"*",,"",,"Matches","Msg")
143 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"FIND^DIC")
144 ;"======================================================
145 ;"======================================================
146
147 if $data(Msg("DIERR"))'=0 do goto GPDDone
148 . do ShowDIERR^TMGDEBUG(.Msg,.PriorErrorFound)
149 . set result=cAbort
150
151 if $data(Matches) do
152 . if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries")
153 . if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches")
154
155 if $data(Matches("DILIST"))=0 goto GPDDone
156
157 set NumMatches=$piece(Matches("DILIST",0),"^",1)
158 kill PrtDefs
159 set PrtDefs(0,"COUNT")=NumMatches
160 if NumMatches=0 goto GPDDone ;"keep RecNumIEN default of 0
161 if TMGDEBUG>0 do DebugMsg^TMGDEBUG(.DBIndent,"Here are Matches entries")
162 if TMGDEBUG>0 do ArrayDump^TMGDEBUG("Matches")
163
164 for index=1:1:NumMatches do
165 . kill OneMatch
166 . new Name,Descr
167 . set Name=$get(Matches("DILIST","ID",index,.01))
168 . set Descr=$get(^%ZIS(2,index,9))
169 . set PrtDefs(index,"NAME")=Name
170 . set PrtDefs(index,"DESCRIPTION")=Descr
171
172GPDDone
173 if TMGDEBUG>0 do DebugExit^TMGDEBUG(.DBIndent,"GetPrtDefs")
174 quit result
175
176
177PickPrtDef(LinuxPrt,PrtDefs,Output)
178 ;"Purpose: To show all the printer types (TERMINAL TYPES), and have user pick one
179 ;"Input: LinuxPrt -- name of Linux printer, as retrieved from GetPrinters()
180 ;" PrtDefs -- Array of printer defs, as returned from GetPrtDefs(PrtDefs)
181 ;" Array will not be changed, even if passed by reference.
182 ;" Output -- MUST BE PASSED BY REFERENCE. Will be formated like this:
183 ;" Output(0,"COUNT")=1
184 ;" Output(1,"LINUX")="Laser1" <----- Prior results
185 ;" Output(1,"TYPE")="P-ANADEX"
186 ;"Output: Output -- MUST BE PASSED BY REFERENCE. Output will be formated like this:
187 ;" Output(0,"COUNT")=2
188 ;" Output(1,"LINUX")="Laser1" <----- Prior results
189 ;" Output(1,"TYPE")="P-ANADEX"
190 ;" Output(2,"LINUX")="Printer2" <----- Added results
191 ;" Output(2,"TYPE")="P-CENT"
192 ;"Result: 1=OKToCont 0=Abort, OR Cancel pressed.
193
194 new cOKToCont set cOKToCont=1
195 new cAbort set cAbort=0
196 new result set result=cAbort
197 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
198 new tPrtDefs
199 new DefCount,OutCount
200 new index
201 new UserPick
202
203 set DefCount=$get(PrtDefs(0,"COUNT"),0)
204 if DefCount=0 do goto PPDefDone
205 . write "No printer defs! Quitting!",!
206 set OutCount=$get(Output(0,"COUNT"),0)
207 Set Output(0,"COUNT")=OutCount ;"Ensure this is set before any need to abort
208
209 for index=1:1:DefCount do
210 . new s,Name,Descr
211 . set s=index_"; "
212 . set Name=$get(PrtDefs(index,"NAME"))
213 . ;"write "converted: ",Name," to "
214 . set Name=$extract(Name,3,128)
215 . ;"write Name,!
216 . set Descr=$get(PrtDefs(index,"DESCRIPTION"))
217 . set s=s_Name
218 . if Descr'="" set s=s_Name_" -- "_Descr
219 . set tPrtDefs(index)=s
220
221 new s set s="---- Pick VistA driver for printer '"_LinuxPrt_"' ----\n\n"
222 set s=s_"(Note: If you can not find an corresponding driver for your\n"
223 set s=s_"printer, then see your installer regarding adding an\n"
224 set s=s_"appropriate entry to the TERMINAL TYPE file, then retry.)"
225 set UserPick=$$Combo^TMGXDLG(s,80,15,.tPrtDefs)
226 if UserPick="" goto PPDefDone
227 set index=+$piece(UserPick,";",1)
228 if index=0 goto PPDefDone
229 set OutCount=OutCount+1
230
231 set Output(OutCount,"LINUX")=LinuxPrt
232 set Output(OutCount,"TYPE")=PrtDefs(index,"NAME")
233 Set Output(0,"COUNT")=OutCount
234
235 set result=cOKToCont
236PPDefDone
237 quit result
238
239
240
241MatchPrt(Output)
242 ;"Purpose: To create match between Linux printers, and definitions
243 ;"Input: Output -- and out parameter. MUST BE PASSED BY REFERENCE
244 ;"Output: (Output is changed) as follows
245 ;" Output(0,"COUNT")=2
246 ;" Output(1,"LINUX")="Deskjet1" <-- suitable name for linux: lp -p PRINTER
247 ;" Output(1,"TYPE")="P-ANADEX"
248 ;" Output(2,"LINUX")="Laser1" <-- suitable name for linux: lp -p PRINTER
249 ;" Output(2,"TYPE")="P-CENT"
250
251 new cOKToCont set cOKToCont=1
252 new cAbort set cAbort=0
253 if $data(TMGDEBUG)#10=0 new TMGDEBUG set TMGDEBUG=0
254 if $data(DispMode)#10=0 new DispMode set DispMode=1 ;"1=GUI, 3=Roll-n-Scroll
255 new result set result=cOKToCont
256 new PrtDefs,Printers
257 new PrtCount set PrtCount=0
258 kill Output ;"clear any prior entries.
259
260 if DispMode'=1 do goto SUPDone
261 . write "Currently unable to set up printers in 'Roll-and-Scroll' mode. Quitting.",!
262
263 set result=$$GetPrinters(.Printers)
264 if result=cAbort do goto SUPDone
265 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printers.")
266
267 set result=$$GetPrtDefs(.PrtDefs)
268 if result=cAbort do goto SUPDone
269 . do ShowError^TMGDEBUG(.PriorErrorFound,"Unable to get Printer definitions.")
270
271 new tPrts
272 new Selected set Selected=""
273 merge tPrts=Printers
274 kill tPrts(0)
275 ;"set tPrts(2)="TestPrinter" ;"temp!!!!!
276 ;"set tPrts(3)="TestPrinter2" ;"temp!!!!!
277 for do quit:Selected=""
278 . ;"write "loop1, selected=",Selected,!
279 . set Selected=$$Combo^TMGXDLG("Select Printer to Setup",,,.tPrts)
280 . if Selected="" quit
281 . ;"write "OK, now to set up printer: ",Selected,!
282 . new tResult set tResult=$$PickPrtDef(Selected,.PrtDefs,.Output)
283 . ;"Note: I am not doing anything if user cancels pick of printer type.
284 . ;"Now remove that printer from list of printers to install.
285 . new index set index=$order(tPrts(""))
286 . new NextIndex set NextIndex=""
287 . for do quit:(index="")
288 . . ;"write "loop2, index=",index,!
289 . . set NextIndex=1
290 . . if index="" quit
291 . . if $get(tPrts(index))=Selected do quit
292 . . . set NextIndex=$order(tPrts(index))
293 . . . kill tPrts(index)
294 . . . set index=""
295 . . set index=$order(tPrts(index))
296 . if $data(tPrts)=0 do quit
297 . . set Selected="" ;"force quit
298 . ;"Now move all entries below this one UP
299 . set index=NextIndex
300 . for do quit:index=""
301 . . ;"write "loop3, index=",index,!
302 . . if index="" quit
303 . . set tPrts(index-1)=tPrts(index)
304 . . new PriorIndex set PriorIndex=index
305 . . set index=$order(tPrts(index))
306 . . kill tPrts(PriorIndex)
307 . . if $data(tPrts)=0 do
308 . . . set Selected=""
309 . . . set index=""
310
311SUPDone
312 quit result
313
314
315SetupPrt
316 ;"To query linux printer system, and create VistA entries for these.
317
318
319 new cFile set cFile="FILE"
320 new cEntries set cEntries="Entries"
321
322 ; new Data
323 ; set Data(0,cFile)="3.5"
324 ; set Data(0,cEntries)=1
325 ; set Data
326 ;
327 ; 1 0;1 .01 NAME [RFX]
328 ; 2 1;1 .02 LOCATION OF TERMINAL [RF]
329 ; MN;0 .03 MNEMONIC <-Mult [3.501]
330 ; 3 -0;1 .01 -MNEMONIC [MFX]
331 ; 4 1;4 .04 LOCAL SYNONYM [F]
332 ; 5 0;2 1 $I [RFX]
333 ; 6 0;9 1.9 VOLUME SET(CPU) [FX]
334 ; 7 0;11 1.95 SIGN-ON/SYSTEM DEVICE [SX]
335 ; 8 TYPE;1 2 TYPE [RS]
336 ; 9 SUBTYPE;1 3 SUBTYPE <-Pntr [RP3.2]
337 ; 10 0;3 4 ASK DEVICE [S]
338 ; 11 0;4 5 ASK PARAMETERS [S]
339 ; 12 1;5 5.1 ASK HOST FILE [S]
340 ; 13 1;6 5.2 ASK HFS I/O OPERATION [S]
341 ; 14 0;12 5.5 QUEUING [S]
342 ; 15 90;1 6 OUT-OF-SERVICE DATE [D]
343 ; 17 90;3 8 KEY OPERATOR [F]
344 ;18 91;1 9 MARGIN WIDTH [NJ3,0]
345 ; 19 91;3 11 PAGE LENGTH [NJ5,0]
346 ; 20 1;11 11.2 SUPPRESS FORM FEED AT CLOSE [S]
347 ; 27 POX;E1,245 19.7 PRE-OPEN EXECUTE [K]
348 ; 28 PCX;E1,245 19.8 POST-CLOSE EXECUTE [K]
349 ;
350 ;
351 ;NAME: TEST-LINUX-PRINTER $I: <To be set in PRE-OPEN EXECUTE>
352 ; ASK DEVICE: NO ASK PARAMETERS: NO
353 ; SIGN-ON/SYSTEM DEVICE: NO LOCATION OF TERMINAL: Laughlin_Office
354 ; ASK HOST FILE: NO ASK HFS I/O OPERATION: NO
355 ; NEAREST PHONE: 787-7000 PAGE LENGTH: 80
356 ; FORM CURRENTLY MOUNTED: Plain paper
357 ; POST-CLOSE EXECUTE: DO FINISH^TMGPRNTR("laughlin_laser")
358 ; PRE-OPEN EXECUTE: DO SETJOB^TMGPRNTR(.IO) ;Note: Change IO (output file)
359 ; SUBTYPE: P-OTH80 TYPE: TERMINAL
360 ; ASK DEVICE TYPE AT SIGN-ON: YES, ASK
361
362 quit
363
364
365 ;"=======================================================================
366 ;"=======================================================================
367
368
369GETJOBNM()
370 ;"Purpose: To create a unique printer job name. This will be used during a printing process
371 ;" that writes the printer file to the host file system, then passes file to Linux
372 ;" printing system.
373 ;"Output: Returns name of file to put output into
374
375 ;"UNIQUE will generate a filename based on time and job number
376 ;" i.e. 'Print-Job-628233034.tmp
377
378 ;"write !,"here in GETJOBNM^TMGPRNTR",!
379 new cJobs set cJobs="PRINT JOBS"
380 new Filename set Filename=$$UNIQUE^%ZISUTL("/tmp/Print-Job.tmp")
381
382 ;"Now store Filename for later transfer to Linux lpr
383 new index set index=$order(^TMP("TMG",cJobs,$J,""))
384 if index="" set index=1
385 set ^TMP("TMG",cJobs,$J,index)=Filename
386
387 ;"write !,"Print job name will be:",Filename,!
388 quit Filename ;"result returned by altering Filename
389
390
391
392FINISH(Printer)
393 ;"Purpose: to complete the printing process by sending the now-created file
394 ;" to Linux CUPS (the printing system).
395 ;"Note: The lpr system itself will delete this print file when done (option -r)
396 ;"Input: Printer OPTIONAL -- the name of the linux printer to send the job to.
397
398 new cJobs set cJobs="PRINT JOBS"
399 new index set index=$order(^TMP("TMG",cJobs,$J,""))
400 new Filename set Filename=$get(^TMP("TMG",cJobs,$J,index))
401
402 close IO
403 kill IO(1,IO)
404
405 kill ^TMP("TMG",cJobs,$J,index)
406
407 if Filename'="" do
408 . new CmdStr
409 . set CmdStr="lpr "
410 . if $get(Printer)'="" set CmdStr=CmdStr_"-P "_Printer_" "
411 . set CmdStr=CmdStr_"-r " ;"option -r --> lpr deletes file after printing done.
412 . set CmdStr=CmdStr_Filename_" &"
413 . zsystem CmdStr
414
415 quit
416
417
418
419
420
Note: See TracBrowser for help on using the repository browser.