source: cprs/branches/tmg-cprs/m_files/TMGKERN2.m@ 1620

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

replacing soft links with actual files
File size: 19.2 KB
RevLine 
[896]1TMGKERN2 ;TMG/kst/OS Specific functions ;11/21/09
2 ;;1.0;TMG-LIB;**1**;11/21/09
3 ;
4 ;"TMG KERNEL FUNCTIONS -- 2
5 ;"This module is primarly for functions to support a SOCKET
6 ;" connection between two different VistA instances. One running
7 ;" as a server, and the other as a client.
8 ;"I.e. functions that are OS specific.
9 ;"Kevin Toppenberg MD
10 ;"GNU General Public License (GPL) applies
11 ;"11/21/09
12 ;
13 ;"=======================================================================
14 ;" API -- Public Functions.
15 ;"=======================================================================
16 ;"RUNSERVER(PORT,TMGMSGFN,TMGVERBOSE) --open up a socket that will listen to requests from a client.
17 ;"SEND(MSG) -- funnel all writing back to the client through this, so checksums can be calc'd
18 ;"ASK(MSG) -- funnel all writing to server through this function, so that checksums can calc'd
19 ;"DEBUGMSG(NOTE) ;
20 ;"RUNCLIENT(HOST,PORT) --Establish a connection with specified server. Then maintain connection, sending queries to server, and returning results.
21 ;"MSGCLIENT(JNUM,TMGQUERY,REPLY,ERROR,TIMEOUT) -- send messages to background client.
22 ;"CLEARBUF(JNUM,ERROR) -- remove all messages from message buffer.
23 ;"RUNMONITOR --Show DEBUG messages as they are added.
24 ;"=======================================================================
25 ;"Dependancies
26 ;"=======================================================================
27 ;"TMGUSRIF
28 ;"=======================================================================
29 ;
30RUNSERVER(PORT,TMGMSGFN,TMGVERBOSE) ;
31 ;"Purpose: To open up a socket that will listen to requests from a client.
32 ;"Input: Port -- the port to listen on
33 ;" TMGMSGFN -- the NAME of a function that will handle incoming
34 ;" messages. E.g. 'HANDLMSG^MOD1'
35 ;" This function will be called as follows:
36 ;" xecute "DO "_TMGMSGFN_"(TMGCLIENT)"
37 ;" So the function must accept at least 1 parameter.
38 ;" NOTE: Any output that the handler function wants to go back
39 ;" to the client should be sent to SEND^TMGKERN2(MSG), so
40 ;" that error checking and self-correction can urr.
41 ;" TMGVERBOSE -- If 1 then some output will be show to console.
42 ;"Results: 1 if successful, -1^Error Message if failed.
43 ;"NOTE: This will be messaging protocol.
44 ;" #HELLO# will be sent on startup (possibly preceeded by 2 blank lines)
45 ;" #BYE# will be sent when server is quitting
46 ;" Server will respond to query of #BYE# by quitting.
47 ;" Server will turn control over to the message-handler-fn, allowing it to write
48 ;" out as many lines as it wants.
49 ;" After message-handler-fn returns, the server will send #DONE# to signal done.
50 ;"
51 NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
52 NEW TMGCLIENT,TMGANSWR,TMGCODE
53 KILL ^TMG("TMP","LOG","TCP")
54 ;
55 SET RESULT=1 ;"Default of success
56 IF +$GET(PORT)'>0 DO GOTO RSVRDN
57 . SET RESULT="-1^Invalid port number passed. Received: "_$GET(PORT)
58 IF $GET(TMGMSGFN)="" DO GOTO RSVRDN
59 . SET RESULT="-1^No Message handling function passed."
60 IF $TEXT(@TMGMSGFN)="" DO GOTO RSVRDN
61 . SET RESULT="-1^Message handler ["_TMGMSGFN_"] appears invalid"
62 SET PORT=+$GET(PORT)
63 SET TMGDELIM=$CHAR(13)
64 SET TMGTCPDEV="server$"_$JOB
65 SET TMGTIMEOUT=60
66 SET TMGCODE="DO "_TMGMSGFN_"(TMGCLIENT)"
67 SET TMGVERBOSE=+$GET(TMGVERBOSE)
68 ;
69 IF TMGVERBOSE DO
70 . WRITE "Starting server. Trying to connect to client..."
71 OPEN TMGTCPDEV:(ZLISTEN=PORT_":TCP":attach="server":DELIMITER=TMGDELIM:NOWRAP):TMGTIMEOUT:"SOCKET"
72 IF $TEST=0 DO GOTO RSVRDN
73 . SET RESULT="-1^Attempts to open server failed (timedout)"
74 USE TMGTCPDEV
75 WRITE /listen(1)
76 WRITE /wait(TMGTIMEOUT)
77 DO SEND("#HELLO#")
78 ;
79 IF TMGVERBOSE DO
80 . USE $P
81 . WRITE " Connected!",!
82 . WRITE "Press [ESC] multiple times to abort (and wait up to 60 sec).",!
83 . WRITE "Press '?' to see server output.",!
84 . WRITE "RUNNING SERVER..."
85 . USE TMGTCPDEV
86L1 ;"Main Listen-Reply loop
87 NEW TMGCLIENT,TMGI,TMGDONE,TMGLEN
88 SET TMGDONE=-1,TMGI=1
89 NEW TMGSHOWOUT SET TMGSHOWOUT=0
90 DO DEBUGMSG("Starting main listen-reply loop")
91 FOR DO QUIT:(TMGDONE>0)!(TMGCLIENT="#BYE#")
92 . USE $P
93 . NEW USERKEY
94 . READ *USERKEY:0
95 . SET TMGDONE=(USERKEY=27)
96 . IF TMGDONE DO QUIT
97 . . DO SEND("#BYE#")
98 . . USE TMGTCPDEV
99 . SET:(USERKEY=63) TMGSHOWOUT=1 ;"63='?' Turn on showing ouput on console.
100 . SET:(USERKEY=33) TMGSHOWOUT=0 ;"33='!' Turn off showing ouput on console.
101 . USE TMGTCPDEV
102 . READ TMGCLIENT:TMGTIMEOUT
103 . IF ($TEST=0)!(TMGCLIENT="") DO QUIT
104 . . DO DEBUGMSG("$TEST=0 or TMGCLIENT='', so quitting")
105 . . SET TMGDONE=TMGDONE+1
106 . . DO SEND("#BYE#")
107 . . SET TMGCLIENT="#BYE#"
108 . ;"Check for valud query from client.
109 . SET TMGLEN=+$PIECE(TMGCLIENT,$CHAR(255),2)
110 . SET TMGCLIENT=$PIECE(TMGCLIENT,$CHAR(255),1)
111 . IF TMGLEN'=$LENGTH(TMGCLIENT) DO QUIT
112 . . DO DEBUGMSG("Length doesn't match checksup, so asking for resend")
113 . . DO SEND("#RESEND#")
114 . DO DEBUGMSG("TMGCLIENT="_TMGCLIENT)
115 . IF TMGCLIENT="#ENQ#" DO SEND("#ACK#") QUIT
116 . IF TMGCLIENT="#BYE#" DO SEND("#BYE#") QUIT
117 . ELSE DO SEND("#GOTQUERY#")
118 . SET TMGI=TMGI+1
119 . DO
120 . . NEW $ETRAP
121 . . SET $ETRAP="W ""<Error in message handler>"",!,$ZSTATUS,!,""#BYE"",! set $etrap="""",$ecode="""""
122 . . SET TMGMSGSUM=0
123 . . ;"DO DEBUGMSG("About to execute handler code")
124 . . XECUTE TMGCODE
125 . . ;"DO DEBUGMSG("Back from handler code")
126 . USE TMGTCPDEV ;"Ensure handler didn't redirect $IO
127 . ;"Send message to indicate done sending reply (will allow multi line responses)
128 . ;"Also append a count of total number of characters that have been sent, for error checking.
129 . DO DEBUGMSG("Sending back a DONE and total for amount sent: "_TMGMSGSUM)
130 . DO SEND("#DONE#^"_TMGMSGSUM)
131 . IF (TMGDONE>0) DO DEBUGMSG("NOTE: TMGDONE is > 0")
132 . IF (TMGCLIENT="#BYE#") DO DEBUGMSG("NOTE: TMGCLIENT = '#BYE#'")
133 ;
134 DO DEBUGMSG("Closing socket")
135 CLOSE TMGTCPDEV
136 ;
137RSVRDN USE $P
138 DO DEBUGMSG("Quitting RUNSERVER")
139 IF TMGVERBOSE DO
140 . WRITE "Quitting ",$SELECT((RESULT=1):"normally",1:"with errors"),!
141 QUIT RESULT
142 ;
143 ;
144SEND(MSG) ;
145 ;"Purpose: To funnel all writing back to the client through this function, so that
146 ;" checksums can be calculated for error checking...
147 ;"Input: MSG -- The message to write out
148 ;"NOTE: Will use globally scoped variable (on server side) TMGMSGSUM
149 ;" It is expected that RUNSERVER will set this to 0 before passing control
150 ;" over to a message handler.
151 ;
152 IF 1=0 DO
153 . NEW NUM SET NUM=+$GET(^TMG("TMP","LOG","TCP",0))
154 . SET NUM=NUM+1
155 . SET ^TMG("TMP","LOG","TCP",NUM,"NB")=$H_" SENDING; "_MSG
156 . SET ^TMG("TMP","LOG","TCP",0)=NUM
157 ;
158 WRITE MSG,!
159 SET TMGMSGSUM=+$GET(TMGMSGSUM)+$LENGTH(MSG)
160 IF $GET(TMGSHOWOUT)=1 DO
161 . USE $P
162 . WRITE "('!' to hide) ",MSG,!
163 . NEW USERKEY
164 . READ *USERKEY:0
165 . SET TMGDONE=(USERKEY=27)
166 . SET:(USERKEY=33) TMGSHOWOUT=0 ;"33='!' Turn off showing ouput on console.
167 . USE TMGTCPDEV
168 QUIT
169 ;
170 ;
171ASK(MSG) ;
172 ;"Purpose: To funnel all writing to server through this function, so that
173 ;" checksums can be maintained for error checking...
174 ;"Input: MSG -- The message to write out
175 IF 1=0 DO
176 . NEW NUM SET NUM=+$GET(^TMG("TMP","LOG","TCP",0))
177 . SET NUM=NUM+1
178 . SET ^TMG("TMP","LOG","TCP",NUM,"ASK")=$H_"; "_MSG
179 . SET ^TMG("TMP","LOG","TCP",0)=NUM
180 ;
181 WRITE MSG_$CHAR(255)_$LENGTH(MSG),!
182 QUIT
183 ;
184 ;
185DEBUGMSG(NOTE) ;f
186 IF 1=0 DO
187 . NEW NUM SET NUM=+$GET(^TMG("TMP","LOG","TCP",0))
188 . SET NUM=NUM+1
189 . SET ^TMG("TMP","LOG","TCP",NUM,"NB")=$H_"; "_NOTE
190 . SET ^TMG("TMP","LOG","TCP",0)=NUM
191 quit
192 ;
193 ;
194RUNCLIENT(HOST,PORT) ;"NOTE: meant to be run as a background process
195 ;"Purpose: Establish a connection with specified server. Then maintain connection,
196 ;" sending queries to server, and returning results. Will take as input
197 ;" a messaging global ^TMG("TMP","TCP",$J,"TS",<index>)=<query> TS=ToServer
198 ;" And replies will be stored in ^TMG("TMP","TCP",$J,"FS",<index>)=<query> FS=FromServer
199 ;"Input: HOST -- the IP address, (or name for DNS lookup) of the server.
200 ;" PORT -- the port that the server is listening on.
201 ;"Result: none
202 ;"Output: Results will be stored in ^TMG("TMP","TCP",$J,"RESULT")=<result>
203 ;" 1 -- if successful, -1^Error Message if failed.
204 ;"!!NOTICE!! -- This can't be used to transfer binary files, because $char(255) is used
205 ;" as a signalling character for error checking.
206 ;"
207 NEW RESULT,TMGDELIM,TMGTCPDEV,TMGTIMEOUT
208 ;"Setup vars
209 SET TMGTCPDEV="client$"_$JOB
210 SET TMGTIMEOUT=30
211 KILL ^TMG("TMP","TCP",$J,"RESULT")
212 KILL ^TMG("TMP","LOG","TCP")
213 SET RESULT=1
214 ;"Validate input
215 IF +$GET(PORT)'>0 DO GOTO RCLDN
216 . SET RESULT="-1^Valid port number passed. Received: "_$GET(PORT)
217 IF $GET(HOST)="" DO GOTO RCLDN
218 . SET RESULT="-1^No Host passed."
219 SET PORT=+$GET(PORT)
220 IF PORT'>0 DO GOTO RCLDN
221 . SET RESULT="-1^Invalid port: ["_PORT_"]"
222 ;"Open up the TCP/IP connection
223 DO DEBUGMSG("NOTE: Job number="_$JOB)
224 DO DEBUGMSG("Starting to open connection with server")
225 OPEN TMGTCPDEV:(CONNECT=HOST_":"_PORT_":TCP":ATTACH="client":DELIMITER=$CHAR(13):NOWRAP):TMGTIMEOUT:"SOCKET"
226 IF $TEST=0 DO GOTO RCLDN
227 . SET RESULT="-1^Error on OPEN of SOCKET"
228 DO DEBUGMSG("Open succeeded.")
229 USE TMGTCPDEV
230 ;"Make sure server is ready to send information.
231 NEW TMGI,SRVREPLY
232 DO DEBUGMSG("Starting read (up to 3 tries), waiting for #HELLO#")
233 FOR TMGI=1:1:3 DO QUIT:(SRVREPLY="#HELLO#")
234 . READ SRVREPLY:TMGTIMEOUT
235 IF SRVREPLY'="#HELLO#" DO GOTO RCLDN
236 . SET RESULT="-1^Failed to get a '#HELLO#' from server"
237 DO DEBUGMSG("We got a #HELLO# alright. Great!")
238 SET ^TMG("TMP","TCP",$J,"RESULT")=$GET(RESULT)
239 ;
240 ;"Now process messaging.
241RC1 NEW TSREF SET TSREF=$NAME(^TMG("TMP","TCP",$J,"TS"))
242 NEW FSREF SET FSREF=$NAME(^TMG("TMP","TCP",$J,"FS"))
243 NEW NTIME,STIME SET STIME=$PIECE($H,",",2)
244 NEW TMGQUERY SET TMGQUERY=""
245 NEW TMGIDLE SET TMGIDLE=0
246 NEW TMGABORT SET TMGABORT=0
247 DO DEBUGMSG("About to start main loop for messaging")
248 FOR DO QUIT:(TMGQUERY="#BYE#")!(SRVREPLY="#BYE#")!(TMGABORT=1)
249 . IF SRVREPLY'="#RESEND#" DO
250 . . SET TMGI=$ORDER(@TSREF@(""))
251 . . IF TMGI="" DO ;"Start idle handling
252 . . . SET TMGQUERY=""
253 . . . SET NTIME=$PIECE($H,",",2)
254 . . . IF (NTIME-STIME)<15 DO QUIT
255 . . . . IF TMGIDLE HANG 0.5 ;"This loop was taking 90+% of CPU othewise.
256 . . . SET TMGQUERY="#ENQ#" ;"send an ENQ every 15 seconds of idleness.
257 . . . SET STIME=$PIECE($H,",",2) ;"Reset idle counter
258 . . . SET TMGIDLE=1 ;"If idle for 15 seconds, then turn on idle mode. Will take 0.5 sec to turn off
259 . . ELSE DO
260 . . . SET TMGIDLE=0
261 . . . SET TMGQUERY=$get(@TSREF@(TMGI)) ;"Get query from user
262 . . . KILL @TSREF@(TMGI)
263 . . . SET STIME=$PIECE($H,",",2) ;"Reset idle counter
264 . . . IF $DATA(@TSREF)'=0 DO
265 . . . . NEW I SET I=""
266 . . . . FOR SET I=$order(@TSREF@(I)) QUIT:(I="") DO
267 . . . . . DO DEBUGMSG("Left over messages found!: "_$get(@TSREF@(I)))
268 . IF TMGQUERY="" QUIT
269 . USE TMGTCPDEV
270 . DO ASK(TMGQUERY) ;"Send out query to server.
271 . ;"Check for acknowledgement from server of query.
272 . READ SRVREPLY:TMGTIMEOUT ;"read reply.
273 . ;"IF ($TEST=0)!(SRVREPLY="")!(SRVREPLY="#BYE#") DO QUIT
274 . IF ($TEST=0)!(SRVREPLY="#BYE#") DO QUIT
275 . . SET TMGABORT=1
276 . . DO DEBUGMSG("1: Got bad or #BYE# reply, so quitting (Setting TMGABORT=1)")
277 . IF SRVREPLY="#ACK#" DO QUIT
278 . ;"Now process server reply to query.
279 . IF SRVREPLY="#RESEND" QUIT ;"Server replied with RESEND, so will ask query again
280 . IF SRVREPLY="#GOTQUERY#" FOR DO QUIT:(SRVREPLY="#BYE#")!(SRVREPLY="#DONE#")!(TMGABORT=1)
281 . . READ SRVREPLY:TMGTIMEOUT ;"read reply.
282 . . ;"IF ($TEST=0)!(SRVREPLY="")!(SRVREPLY="#BYE#") DO QUIT
283 . . IF ($TEST=0)!(SRVREPLY="#BYE#") DO QUIT
284 . . . DO DEBUGMSG("2: Got bad or #BYE# reply, so quitting (Setting TMGABORT=1)")
285 . . . SET TMGABORT=1 ;"Got NULL or bad or #BYE# reply, so setting quitting "
286 . . IF SRVREPLY="" QUIT ;"Ignore null replies (i.e. server sent a blank line) ?? good idea ??
287 . . IF SRVREPLY["#DONE#" DO ;"Cut off checksum, but DO store #DONE#
288 . . . DO DEBUGMSG("Got an #DONE#. Later I should check on checksum")
289 . . . ;"Later check on checksum
290 . . . SET SRVREPLY="#DONE#"
291 . . SET TMGI=+$ORDER(@FSREF@(""),-1)
292 . . SET @FSREF@(TMGI+1)=SRVREPLY
293 DO DEBUGMSG("Done with loop, so sending #BYE#")
294 DO DEBUGMSG("TMGQUERY="_TMGQUERY)
295 DO DEBUGMSG("SRVREPLY="_SRVREPLY)
296 DO DEBUGMSG("TMGABORT="_TMGABORT)
297 DO ASK("#BYE#") ;"Done with loop and exiting, so sending #BYE#"
298 CLOSE TMGTCPDEV
299 ;
300RCLDN USE $P
301 KILL ^TMG("TMP","TCP",$J)
302 HALT ;"(quit background process)
303 ;
304 ;
305MSGCLIENT(JNUM,TMGQUERY,REPLY,ERROR,TIMEOUT) ;
306 ;"Purpose: To send messages to background client. So this will be one function
307 ;" that the programmer may interact with. The reason for having the client
308 ;" run as a separate job is so that the server and the client can talk back
309 ;" and forth with ENQ<-->ACK upon either timing out, to keep the connection
310 ;" alive.
311 ;"Input: JNUM -- The job number of the background client process
312 ;" TMGQUERY -- The message to send to the server.
313 ;" REPLY -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
314 ;" REPLY(1)=<a reply line from server>
315 ;" REPLY(2)=<a reply line from server>
316 ;" REPLY(3)=<a reply line from server>
317 ;" ERROR -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
318 ;" If error, filled with -1^Message.
319 ;" TIMEOUT -- OPTIONAL. Default=1 (in seconds)
320 ;"Result: none
321 ;"Will set globally-scoped variable TMGABORT=1 if timeout or other error
322 ;
323 KILL ERROR,REPLY
324 NEW RESULT SET RESULT=""
325 SET JNUM=+$GET(JNUM)
326 IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO MSGDN
327 SET TMGQUERY=$GET(TMGQUERY)
328 IF TMGQUERY="" SET ERROR="-1^NO QUERY PROVIDED" GOTO MSGDN
329 SET TIMEOUT=+$GET(TIMEOUT,1)
330 NEW SHOWPROG SET SHOWPROG=0
331 NEW NTIME,STIME SET STIME=$PIECE($H,",",2)
332 KILL ^TMG("TMP","TCP",JNUM,"FS") ;"Clear message buffer before communication
333 NEW TMGI SET TMGI=+$ORDER(^TMG("TMP","TCP",JNUM,"TS",""),-1)
334 SET ^TMG("TMP","TCP",JNUM,"TS",TMGI+1)=TMGQUERY
335 IF TMGQUERY="#BYE#" GOTO MSGDN
336 NEW LINECT SET LINECT=1
337 NEW TMGCT SET TMGCT=0
338 NEW REPLYI SET REPLYI=1
339 NEW STIME SET STIME=$PIECE($H,",",2)
340 NEW USERKEY
341 NEW TMGSHOWOUT SET TMGSHOWOUT=0
342 NEW ONELINE SET ONELINE=""
343 FOR DO QUIT:(ONELINE="#DONE#")
344 . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
345 . READ *USERKEY:0
346 . ;"SET TMGDONE=(USERKEY=27) QUIT:TMGDONE
347 . SET:(USERKEY=63) TMGSHOWOUT=1 ;"63='?' Turn on showing ouput on console.
348 . SET:(USERKEY=33) TMGSHOWOUT=0 ;"33='!' Turn off showing ouput on console.
349 . IF TMGI="" DO QUIT
350 . . SET NTIME=$PIECE($H,",",2)
351 . . IF (NTIME-STIME)'<TIMEOUT DO
352 . . . SET ERROR="-1^TIMED OUT WAITING FOR CLIENT TO GET REPLY FROM SERVER"
353 . . . SET ONELINE="#DONE#"
354 . . . SET TMGABORT=1
355 . SET ONELINE=$GET(^TMG("TMP","TCP",JNUM,"FS",TMGI))
356 . SET TMGCT=TMGCT+1
357 . IF TMGSHOWOUT=1 WRITE "('!' to hide) ",ONELINE,!
358 . IF (ONELINE'["#ERROR TRAPPED#") DO
359 . . IF (ONELINE["#THINKING#") DO QUIT
360 . . . NEW MSG SET MSG=$PIECE(ONELINE,"|",2)
361 . . . IF MSG="" SET MSG="(Server is working...)"
362 . . . WRITE MSG,!
363 . . . SET STIME=$PIECE($H,",",2) ;"Ignore server message to avoid timeout.
364 . . IF (ONELINE'="#DONE#") DO
365 . . . SET REPLY(REPLYI)=ONELINE
366 . . . SET REPLYI=REPLYI+1
367 . . . SET LINECT=LINECT+1
368 . ELSE DO
369 . . SET ERROR="-1^Error trapped on server side"
370 . . SET ERROR=ERROR_": "_$PIECE(ONELINE,"#ERROR TRAPPED#",2)
371 . . SET ONELINE="#DONE#"
372 . . SET TMGABORT=1
373 . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
374 . IF (SHOWPROG=0),($$HDIFF^XLFDT($H,STIME,2)>15) DO ;"Turn on progress bar after 15 seconds.
375 . . SET SHOWPROG=1
376 . IF (SHOWPROG=1),(TMGCT>1000) DO
377 . . DO ProgressBar^TMGUSRIF(100,"Receiving Data ('?' to monitor): "_LINECT,-1,-1,70)
378 . . SET TMGCT=0
379MSGDN ;
380 KILL ^TMG("TMP","TCP",JNUM,"FS") ;"Clear message buffer after communication
381 QUIT
382 ;
383 ;
384CLEARBUF(JNUM,ERROR) ;
385 ;"Purpose: To remove all messages from message buffer.
386 ;"Input: JNUM -- The job number of the background client process
387 ;" ERROR -- PASS BY REFERENCE, AN OUT PARAMETER. Prior data killed.
388 ;" If error, filled with -1^Message.
389 ;"Result: None
390 ;
391 KILL ERROR
392 SET JNUM=+$GET(JNUM)
393 IF JNUM'>0 SET ERROR="-1^BAD JOB NUMBER" GOTO CLBFDN
394 NEW TMGI
395 FOR DO QUIT:(TMGI="")
396 . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"TS",""))
397 . IF TMGI="" QUIT
398 . KILL ^TMG("TMP","TCP",JNUM,"TS",TMGI)
399 FOR DO QUIT:(TMGI="")
400 . SET TMGI=$ORDER(^TMG("TMP","TCP",JNUM,"FS",""))
401 . IF TMGI="" QUIT
402 . KILL ^TMG("TMP","TCP",JNUM,"FS",TMGI)
403 ;
404CLBFDN QUIT
405 ;
406 ;
407RUNMONITOR ;
408 ;"Purpose: This is a debugging routine. If run in a separate process, it will
409 ;" show DEBUG messages as they are added.
410 NEW NUM,TMGDONE,MSG,MAX
411 SET TMGDONE=0
412 FOR NUM=1:1 DO QUIT:(TMGDONE>0)
413 . READ *TMGDONE:0
414 . SET MAX=+$GET(^TMG("TMP","LOG","TCP",0))
415 . IF NUM>MAX SET NUM=MAX QUIT
416 . NEW NODE SET NODE=$ORDER(^TMG("TMP","LOG","TCP",NUM,""))
417 . WRITE NODE,": ",$GET(^TMG("TMP","LOG","TCP",NUM,NODE)),!
418 QUIT
419 ;
Note: See TracBrowser for help on using the repository browser.