source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXMON.m@ 1561

Last change on this file since 1561 was 1192, checked in by Sam Habiel, 13 years ago

BMXMON now gets the port number for GT.M in BMX CONNECT STATUS RPC
BMXRPC3 now correctly deals with zero divisions in
VISTA and fixes HTG bug in getting the last selected division from DISV
File size: 15.1 KB
Line 
1BMXMON ; IHS/OIT/HMW - BMXNet MONITOR ; 5/22/11 3:35pm
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;
4 ; Changes for *1000 by WV/SMH (Feb 2 2011) to support GT.M
5 ; - XINETD entry point for GT.M
6 ; - Replacement of all W *-3 to W !
7 ; - Addition of logging capabilities for analysis using XWBDLOG
8 ; - In SESSRES
9 ; -- Broker Timeout set from Kernel System Parameter Broker Timeout Field
10 ; -- Process Name now gets Set to show in %SS or ZSY
11 ; - Error Handling does not log Network Errors to the Error Trap.
12 ; - Major refactoring to Writing to the TCP Network Stream.
13 ; --> All writes are buffered up to 32767 characters (max string on Cache)
14 ; --> Then sent...
15 ; --> See EP's WRITE and WBF
16 ; --> This avoids the side effects of the Nagle Algorithm on the Linux TCP Stack
17 ; - BMXERR renamed to BMXERROR in EP ETRAP so that it can be sent via SNDERR.
18 ; --> This reduces the need for custom error trap handling which is very difficult to do
19 ; --> in Mumps for new programmers. Mumps errors now are thrown on the client.
20 ; - CHSTAT now has code to get the port for GT.M when using xinetd
21 ;
22 ;IHS/OIT/HMW Patch 1 added validity check for passed-in namespace
23 ;
24STRT(BMXPORT,NS,IS,VB) ;EP
25 ;Interactive monitor start
26 ;Optional NS = namespace. If undefined, start in current ns
27 ;Optional IS = Integrated Security. Default is 1
28 ;Optional VB = Verbose. Default is 1
29 ;
30 N Y,BMXNS,BMXWIN
31 ;
32 ;Verbose
33 S BMXVB=$G(VB,1)
34 ;
35 ;Check if port already running
36 I '$$SEMAPHOR(BMXPORT,"LOCK") W:BMXVB "BMXNet Monitor on port "_BMXPORT_" appears to be running already.",! Q
37 S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
38 ;
39 D MARKER(BMXPORT,1) ;record problem marker
40 ; -- start the monitor
41 ;
42 ;Namespace
43 X ^%ZOSF("UCI")
44 S BMXNS=$G(NS,$P(Y,","))
45 ;
46 ;Integrated security
47 S BMXWIN=$G(IS,1)
48 ;
49 ;J DEBUG^%Serenji("MON^BMXMON("_BMXPORT_","_BMXNS_","_BMXWIN_")")
50 J MON^BMXMON(BMXPORT,BMXNS,BMXWIN)::5 I '$T W:BMXVB "Unable to run BMXNet Monitor in background.",! Q ;IHS/OIT/HMW SAC Exemption Applied For
51 F %=1:1:5 D Q:%=0
52 . W:BMXVB "Checking if BMXNet Monitor has started...",!
53 . H 1
54 . S:'$$MARKER(BMXPORT,0) %=0
55 I $$MARKER(BMXPORT,0) D
56 . W:BMXVB !,"BMXNet Monitor could not be started!",!
57 . W:BMXVB "Check if port "_BMXPORT_" is busy on this CPU.",!
58 . D MARKER(BMXPORT,-1) ;clear marker
59 E W:BMXVB "BMXNet Monitor started successfully."
60 ;
61 Q
62 ;
63RESTART ;EP
64 ;Stop and Start all monitors in BMX MONITOR file
65 ;Called by option BMX MONITOR START
66 ;
67 D STOPALL
68 D STRTALL
69 Q
70 ;
71STRTALL ;EP
72 ;Start all monitors in BMX MONITOR file
73 ;
74 N BMXIEN
75 S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
76 . S BMXNOD=$G(^BMXMON(BMXIEN,0))
77 . Q:'+BMXNOD
78 . Q:'+$P(BMXNOD,U,2)
79 . S BMXWIN=$P(BMXNOD,U,3)
80 . S BMXNS=$P(BMXNOD,U,4)
81 . D STRT($P(BMXNOD,U),BMXNS,BMXWIN,0)
82 . Q
83 Q
84 ;
85STOPALL ;EP
86 ;Stop all monitors in BMXNET MONITOR file
87 ;
88 N BMXIEN,BMXPORT
89 S BMXIEN=0 F S BMXIEN=$O(^BMXMON(BMXIEN)) Q:'+BMXIEN D
90 . S BMXNOD=$G(^BMXMON(BMXIEN,0))
91 . Q:'+BMXNOD
92 . S BMXPORT=+BMXNOD
93 . D STOP(BMXPORT,0)
94 Q
95 ;
96STOP(BMXPORT,VB) ;EP Stop monitor on BMXPORT
97 ;Open a channel to monitor on BMXPORT and send shutdown request
98 ;Optional VB = Verbose. Default is 1
99 ;
100 N IP,REF,X,DEV
101 S U="^" D HOME^%ZIS
102 ;
103 ;Verbose
104 S BMXVB=$G(VB,1)
105 ;
106 D:BMXVB EN^DDIOL("Stop BMXNet Monitor...")
107 X ^%ZOSF("UCI") S REF=Y
108 S IP="0.0.0.0" ;get server IP
109 IF $G(BMXPORT)="" S BMXPORT=9200
110 ; -- make sure the listener is running
111 I $$SEMAPHOR(BMXPORT,"LOCK") D Q
112 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
113 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
114 ; -- send the shutdown message to the TCP Listener process
115 D CALL^%ZISTCP("127.0.0.1",BMXPORT) I POP D Q
116 . S %=$$SEMAPHOR(BMXPORT,"UNLOCK")
117 . D:BMXVB EN^DDIOL("BMXNet Monitor does not appear to be running.")
118 U IO
119 S X=$T(+2),X=$P(X,";;",2),X=$P(X,";")
120 IF X="" S X=0
121 S X=$C($L(X))_X
122 W "{BMX}00011TCPshutdown",!
123 R X#3:5 ;IHS/OIT/HMW SAC Exemption Applied For
124 D CLOSE^%ZISTCP
125 I X="ack" D:BMXVB EN^DDIOL("BMXNet Monitor has been shutdown.")
126 E D:BMXVB EN^DDIOL("Shutdown Failed!")
127 ;change process name
128 D CHPRN($J)
129 Q
130 ;
131MON(BMXPORT,NS,IS) ;Monitor port for connection & shutdown requests
132 ;NS = Namespace to Start monitor
133 ;IS = 1: Enable integrated security
134 ;
135 N BMXDEV,BMXQUIT,BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
136 S BMXQUIT=0,BMXDTIME=999999
137 ;
138 ;Set lock
139 Q:'$$SEMAPHOR(BMXPORT,"LOCK")
140 ;Clear problem marker
141 D MARKER(BMXPORT,-1)
142 ;H 1
143 ;
144 ;Namespace
145 X ^%ZOSF("UCI")
146 I $G(NS)="" S BMXNS=$P(Y,",")
147 E S BMXNS=NS
148 ;
149 ;Integrated security
150 S BMXWIN=$G(IS,1)
151 ;
152 ;Open server port;
153 S BMXDEV="|TCP|"_BMXPORT
154 C BMXDEV ;IHS/OIT/HMW SAC Exemption Applied For
155 O BMXDEV:(:BMXPORT:"S"):5 I '$T Q ;IHS/OIT/HMW SAC Exemption Applied For
156 ;
157 ;S BMXDTIME(1)=BMXDTIME ; TODO: Set timeouts
158 S BMXDTIME(1)=.5 ;HMW 20050120
159 U BMXDEV
160 F D Q:BMXQUIT
161 . R BMXACT#5:BMXDTIME ;Read first 5 chars from TCP buffer, timeout=BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
162 . I BMXACT'="{BMX}" S BMXQUIT=1 Q
163 . R BMXACT#5:BMXDTIME ;Read next 5 chars - message length ;IHS/OIT/HMW SAC Exemption Applied For
164 . S BMXLEN=+BMXACT
165 . R BMXACT#BMXLEN:BMXDTIME ;IHS/OIT/HMW SAC Exemption Applied For
166 . I $P(BMXACT,"^")="TCPconnect" D Q
167 . . N BMXNSJ,X,Y,ZCHILD,%
168 . . S BMXNSJ=$P(BMXACT,"^",2) ;Namespace
169 . . S BMXNSJ=$P(BMXNSJ,",")
170 . . I BMXNSJ="" S BMXNSJ=BMXNS
171 . . S X=BMXNSJ
172 . . X ^%ZOSF("UCICHECK") I Y=0 S BMXNSJ=BMXNS
173 . . S STATUS=$S(Y'=0:"CONNECTION OK",1:"CONNECTION FAILED, INVALID NAMESPACE") ; SET CONNECTION STATUS BASED ON NAMESPACE VALIDITY
174 . . J SESSION^BMXMON(BMXWIN)[BMXNSJ]:(:5:BMXDEV:BMXDEV):5 ;IHS/OIT/HMW SAC Exemption Applied For
175 . . X ("S ZCHILD="_$C(36,90)_"CHILD")
176 . . I ZCHILD S ^BMXTMP("CONNECT STATUS",ZCHILD)=STATUS
177 . . Q
178 . I $P(BMXACT,"^")="TCPshutdown" S BMXQUIT=1 W "ack",!
179 S %=$$SEMAPHOR(BMXPORT,"UNLOCK") ; destroy 'running flag'
180 Q
181 ;
182XINETD ;PEP Directly from xinetd or inetd for GT.M
183 ;
184 N XWBDEBUG S XWBDEBUG=$$GET^XPAR("SYS","XWBDEBUG") ; 0 1 2 or 3; depending on the level of verbosity desired.
185 D:XWBDEBUG LOGSTART^XWBDLOG("XINETD^BMXMON") ; Start Log only if logging
186 ;
187 N BMXDEV
188 S U="^",$ETRAP="D ^%ZTER H" ;Set up the error trap
189 S $ZT="" ;Clear old trap
190 ;
191 ; GT.M specific error and device code; get remove ip address
192 S @("$ZINTERRUPT=""I $$JOBEXAM^ZU($ZPOSITION)""")
193 S BMXDEV=$P X "U BMXDEV:(nowrap:nodelimiter:ioerror=""^%ZTER H"")"
194 S %="",@("%=$ZTRNLNM(""REMOTE_HOST"")") S:$L(%) IO("GTM-IP")=%
195 ;
196 ; Read message type
197 N BMXACT,BMXDTIME
198 S BMXDTIME=10 ; change in 2.2 instead of 9999999 - initial conn timout
199 R BMXACT#5:BMXDTIME
200 ;
201 D LOG("Read: "_BMXACT)
202 ;
203 Q:BMXACT'="{BMX}" ; Not a BMX message - quit.
204 ; Fall through to below...
205GTMLNX ;EP from XWBTCPM for GT.M
206 ; not implementing NS and integrated authentication
207 ; Vars: Read timeout, msg len, msg, windows auth, Namespace
208 N BMXDTIME,BMXLEN,BMXACT,BMXWIN,BMXNS
209 S BMXNSJ="",BMXWIN=0 ; No NS on GT.M, no Windows Authentication
210 S BMXDTIME(1)=.5,BMXDTIME=180 ; sign on timeout
211 R BMXACT#5:BMXDTIME ;Read next 5 chars - message length
212 ;
213 D LOG("Read: "_BMXACT)
214 ;
215 S BMXLEN=+BMXACT
216 R BMXACT#BMXLEN:BMXDTIME
217 ;
218 D LOG("Read: "_BMXACT)
219 ;
220 I $P(BMXACT,"^")="TCPconnect" S ^BMXTMP("CONNECT STATUS",$JOB)="CONNECTION OK" G SESSRES ; <--WARNING: A GOTO
221 I $P(BMXACT,"^")="TCPshutdown" W "ack",! Q
222 QUIT ; Should't hit this quit, but just in case
223 ;
224SESSION(BMXWIN) ;EP
225 ;Start session monitor
226 ;BMXWIN = 1: Enable integrated security
227SESSRES ;EP - reentry point from trap
228 ; new in 2.2: Use kernel rpc timeout instead of 9999999
229 S BMXDTIME(1)=.5,BMXDTIME=$$BAT^XUPARAM
230 ;
231 ; Change Process Name (new in 2.2 and 2.3)
232 ; (GT.M doesn't store the IP in $P, but Cache does. We get GT.M
233 ; remote process IP from linux env var $REMOTE_HOST)
234 D:+$G(IO("GTM-IP")) CHPRN("BMX:ip"_$P(IO("GTM-IP"),".",3,4)) ; GT.M
235 D:+$P CHPRN("BMX:ip_"_$P($P,".",3,4)) ; Cache
236 ;
237 ;IHS/OIT/HMW SAC Exemption Applied For
238 N $ESTACK S $ETRAP="D ETRAP^BMXMON"
239 S DIQUIET=1,U="^" D DT^DICRW
240 D UNREGALL^BMXMEVN ;Unregister all events for this session
241 U $P D SESSMAIN
242 ;Turn off the error trap for the exit
243 S $ETRAP=""
244 I $G(DUZ) D LOGOUT^XUSRB
245 K BMXR,BMXARY
246 C $P ;IHS/OIT/HMW SAC Exemption Applied For
247 Q
248 ;
249SESSMAIN ; MAIN LOOP!!!!!!
250 N BMXTBUF ; BMX Read Buffer
251 N BMXWBUF S BMXWBUF="" ; BMX Write Buffer
252 D SETUP^BMXMSEC(.RET) ;Setup required system vars
253 S U="^"
254 U $P
255 F D Q:BMXTBUF="#BYE#"
256 . R BMXTBUF#11:BMXDTIME IF '$T D TIMEOUT S BMXTBUF="#BYE#" Q ;IHS/OIT/HMW SAC Exemption Applied For
257 . ;
258 . D LOG("Read: "_BMXTBUF)
259 . ;
260 . I BMXTBUF="#BYE#" QUIT ;**QUITTING HERE**
261 . S BMXHTYPE=$S($E(BMXTBUF,1,5)="{BMX}":1,1:0) ;check HDR
262 . I 'BMXHTYPE S BMXTBUF="#BYE#" D QUIT ;;***QUITTING HERE***
263 . . D SNDERR
264 . . D WRITE(BMXTBUF_$C(4)),WBF
265 . S BMXTLEN=$E(BMXTBUF,6,10),L=$E(BMXTBUF,11,11)
266 . R BMXTBUF#4:BMXDTIME(1)
267 . ;
268 . D LOG("Read: "_BMXTBUF)
269 . ;
270 . S BMXTBUF=L_BMXTBUF ;IHS/OIT/HMW SAC Exemption Applied For
271 . S BMXPLEN=BMXTBUF
272 . R BMXTBUF#BMXPLEN:BMXDTIME(1) ;IHS/OIT/HMW SAC Exemption Applied For
273 . ;
274 . D LOG("Read: "_BMXTBUF)
275 . ;
276 . I $P(BMXTBUF,U)="TCPconnect" D QUIT ;;***QUIT HERE***
277 . . D SNDERR
278 . . D WRITE("accept"_$C(4)),WBF ;Ack
279 . IF BMXHTYPE D
280 . . K BMXR,BMXARY
281 . . IF BMXTBUF="#BYE#" D QUIT
282 . . . D SNDERR
283 . . . D WRITE("#BYE#"_$C(4))
284 . . . D WBF
285 . . S BMXTLEN=BMXTLEN-15
286 . . D CALLP^BMXMBRK(.BMXR,BMXTBUF)
287 . . S BMXPTYPE=$S('$D(BMXPTYPE):1,BMXPTYPE<1:1,BMXPTYPE>6:1,1:BMXPTYPE)
288 . IF BMXTBUF="#BYE#" Q
289 . U $P
290 . D SNDERR ;Clears SNDERR parameters
291 . D SND
292 . D WRITE($C(4)) ;send eot
293 . D WBF ; Flush Buffer
294 D UNREGALL^BMXMEVN ;Unregister all events for this session
295 Q ;End Of Main
296 ;
297SNDERR ;send error information
298 ;BMXSEC is the security packet, BMXERROR is application packet
299 N X
300 S X=$E($G(BMXSEC),1,255)
301 D WRITE($C($L(X))_X)
302 S X=$E($G(BMXERROR),1,255)
303 D WRITE($C($L(X))_X)
304 S BMXERROR="",BMXSEC="" ;clears parameters
305 Q
306 ;
307WRITE(BMXSTR) ;Write a data string to the output buffer
308 F Q:'$L(BMXSTR) D
309 . I $L(BMXWBUF)+$L(BMXSTR)>32767 D WBF ; Maximum String Length on Cache
310 . S BMXWBUF=BMXWBUF_$E(BMXSTR,1,255),BMXSTR=$E(BMXSTR,256,999999)
311 QUIT
312 ;
313WBF ;Write Buffer to Network Stream then flush
314 Q:'$L(BMXWBUF)
315 I $G(XWBDEBUG)>2,$L(BMXWBUF) D LOG^XWBDLOG("wrt ("_$L(BMXWBUF)_"): "_BMXWBUF)
316 W BMXWBUF,!
317 S BMXWBUF=""
318 QUIT
319
320SND ; -- send data for all, Let WRITE sort it out
321 N I,T
322 ;
323 ; -- error or abort occurred, send null
324 IF $L(BMXSEC)>0 D WRITE("") QUIT
325 ;
326 ; -- single value
327 IF BMXPTYPE=1 S BMXR=$G(BMXR) D WRITE(BMXR) QUIT
328 ;
329 ; -- table delimited by CR+LF
330 IF BMXPTYPE=2 D QUIT
331 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10))
332 ;
333 ; -- word processing
334 IF BMXPTYPE=3 D QUIT
335 . S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE(BMXR(I)),WRITE($C(13,10)):BMXWRAP
336 ;
337 ; -- global array
338 IF BMXPTYPE=4 D QUIT
339 . S I=$G(BMXR) Q:I="" S T=$E(I,1,$L(I)-1) D:$D(@I)>10 WRITE(@I)
340 . F S I=$Q(@I) Q:I=""!(I'[T) D WRITE(@I),WRITE($C(13,10)):(BMXWRAP&(@I'=$C(13,10)))
341 . IF $D(@BMXR) K @BMXR
342 ;
343 ; -- global instance
344 IF BMXPTYPE=5 S BMXR=$G(@BMXR) D WRITE(BMXR) QUIT
345 ;
346 ; -- variable length records only good upto 255 char)
347 IF BMXPTYPE=6 S I="" F S I=$O(BMXR(I)) Q:I="" D WRITE($C($L(BMXR(I)))),WRITE(BMXR(I))
348 QUIT
349 ;
350TIMEOUT ;Do this on MAIN loop timeout
351 I $G(DUZ)>0 D SNDERR,WRITE("#BYE#"_$C(4)),WBF QUIT
352 ;Sign-on timeout
353 S BMXR(0)=0,BMXR(1)=1,BMXR(2)="",BMXR(3)="TIME-OUT",BMXPTYPE=2
354 D SNDERR,SND,WRITE($C(4)),WBF QUIT
355 ;
356SEMAPHOR(BMXTSKT,BMXACT) ;Lock/Unlock BMXMON semaphore
357 N RESULT
358 S U="^",RESULT=1
359 D GETENV^%ZOSV ;get Y=UCI^VOL^NODE^BOXLOOKUP of current system
360 I BMXACT="LOCK" D
361 . L +^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT):1
362 . S RESULT=$T
363 E L -^BMXMON("BMXMON",$P(Y,U,2),$P(Y,U),$P(Y,U,4),BMXTSKT)
364 Q RESULT
365 ;
366CHPRN(N) ;Change process name to N.
367 D SETNM^%ZOSV($E(N,1,15))
368 Q
369 ;
370CKSTAT(OUT,IN) ; EP - RPC: BMX CONNECT STATUS ; CONFIRMS THAT THAT A VALID PROCESS HAS BEEN SPAWNED BY BMXMON
371 ; On GT.M on xinetd, get port from ZSHOW "D":^SAM -- thanks to Wally Fort in VistaLink for the Idea
372 ;^SAM("D",1)="/dev/null OPEN "
373 ;^SAM("D",2)="0 OPEN SOCKET TOTAL=1 CURRENT=0 "
374 ;^SAM("D",3)=" SOCKET[0]=h13060671680 DESC=0 CONNECTED ACTIVE TRAP REMOTE=172.16.16.56@54531 LOCAL=172.16.16.142@9260 "
375 ;^SAM("D",4)=" ZDELAY ZBFSIZE=1024 ZIBFSIZE=0 NODELIMITER "
376 ;
377 N PORT,STATUS,JOBID
378 S PORT=+$P($P,"|",3) ; On Cache, port would be the 3rd piece of $Principle
379 I PORT=0,^%ZOSF("OS")["GT.M" DO ; if port is blank and we are on GT.M, then we must be using Xinetd
380 . N BMXTMP ; holds device data
381 . X "ZSHOW ""D"":BMXTMP" ; dump data
382 . N % S %="" ; loop var
383 . F S %=$O(BMXTMP("D",%)) Q:'% Q:BMXTMP("D",%)["LOCAL" ; Cycle % to the right value
384 . S PORT=+$P($P(BMXTMP("D",%),"LOCAL=",2),"@",2) ; Get port
385 S JOBID=$P($J,":",1)
386 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1 ;Wait for job to spawn ZCHILD to be set in MON^
387 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
388 I $G(^BMXTMP("CONNECT STATUS",JOBID))="" HANG 1
389 S STATUS=$G(^BMXTMP("CONNECT STATUS",JOBID))
390 K ^BMXTMP("CONNECT STATUS",JOBID)
391 I STATUS="" S STATUS="CONNECTION STATUS UNKNOWN"
392 S OUT=PORT_"|"_STATUS_"|"_JOBID
393 Q
394 ;
395MARKER(BMXPORT,BMXMODE) ;Set/Test/Clear Problem Marker, BMXMODE=0 is a function
396 N IP,Y,%,REF X ^%ZOSF("UCI") S REF=Y,IP="0.0.0.0",%=0
397 L +^BMX(IP,REF,BMXPORT,"PROBLEM MARKER"):1
398 I BMXMODE=1 S ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")=1
399 I BMXMODE=0 S:$D(^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")) %=1
400 I BMXMODE=-1 K ^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
401 L -^BMX(IP,REF,BMXPORT,"PROBLEM MARKER")
402 Q:BMXMODE=0 % Q
403 ;
404ETRAP ; -- on trapped error, send error info to client
405 ; Error Trap Vars: Code, Error, Last Global Reference
406 N BMXERC,BMXERROR,BMXLGR
407 ;
408 ;Change trapping during trap.
409 S $ETRAP="D ^%ZTER HALT" ;IHS/OIT/HMW SAC Exemption Applied For
410 ;
411 ; If the error is simply that we can't write to the TCP device
412 ; clear and log out
413 ; GT.M Error Code.
414 I $ECODE=",Z150376602," S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
415 ; Cache Error Codes:
416 I ($EC["READ")!($EC["WRITE")!($EC["SYSTEM-F") S $ECODE="" D:$G(DUZ) LOGOUT^XUSRB HALT
417 ;
418 ; Otherwise, log error and send to client
419 S BMXERC=$$EC^%ZOSV
420 S BMXERROR="M ERROR="_BMXERC_$C(13,10)_"LAST REF="
421 S BMXLGR=$$LGR^%ZOSV_$C(4)
422 S BMXERROR=BMXERROR_BMXLGR
423 ;
424 D ^%ZTER ;%ZTER clears $ZE and $ECODE
425 ;
426 U $P
427 ;
428 D SNDERR,WRITE(BMXERROR),WBF
429 ;
430 S $ETRAP="Q:($ESTACK&'$QUIT) Q:$ESTACK -9 S $ECODE="""" G SESSRES^BMXMON",$ECODE=",U99," ;IHS/OIT/HMW SAC Exemption Applied For
431 QUIT
432 ;
433LOG(STR) ; EP - Log stuff in Broker log only if XWBDLOG is defined
434 D:XWBDEBUG LOG^XWBDLOG(STR)
435 QUIT
436 ;
437MENU ;EP - ENTRY ACTION FROM BMXMENU OPTION
438 ;
439 N BMX,BMXVER
440 ;VERSION
441 D
442 . S BMXN="BMXNET ADO.NET DATA PROVIDER" I $D(^DIC(9.4,"B",BMXN)) Q
443 . S BMXN="BMXNET RPMS .NET UTILITIES" I $D(^DIC(9.4,"B",BMXN)) Q
444 . S BMXN=""
445 . Q
446 ;
447 S BMXVER=""
448 I BMXN]"",$D(^DIC(9.4,"B",BMXN)) D
449 . S BMX=$O(^DIC(9.4,"B",BMXN,0))
450 . I $D(^DIC(9.4,BMX,"VERSION")) S BMXVER=$P(^DIC(9.4,BMX,"VERSION"),"^")
451 . E S BMXVER="VERSION NOT FOUND"
452 S:BMXVER="" BMXVER="VERSION NOT FOUND"
453 ;
454 ;LOCATION
455 N BMXLOC
456 S BMXLOC=""
457 I $G(DUZ(2)),$D(^DIC(4,DUZ(2),0)) S BMXLOC=$P(^DIC(4,DUZ(2),0),"^")
458 S:BMXLOC="" BMXLOC="LOCATION NOT FOUND"
459 ;
460 ;WRITE
461 W !
462 W !,"BMXNet Version: ",BMXVER
463 W !,"Location: ",BMXLOC
464 Q
Note: See TracBrowser for help on using the repository browser.