source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXMEVN.m@ 1801

Last change on this file since 1801 was 1147, checked in by Sam Habiel, 14 years ago

Mumps Routines 4 BMX4
File size: 7.2 KB
Line 
1BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
2 ;;4.1000;BMX;;Apr 17, 2011
3 ;
4 Q
5 ;
6REGET ;EP
7 ;Error trap from REGEVNT, RAISEVNT, and UNREG
8 ;
9 I '$D(BMXI) N BMXI S BMXI=999
10 S BMXI=BMXI+1
11 D REGERR(BMXI,99)
12 Q
13 ;
14REGERR(BMXI,BMXERID) ;Error processing
15 S BMXI=BMXI+1
16 S ^TMP("BMX",$J,BMXI)=BMXERID_$C(30)
17 S BMXI=BMXI+1
18 S ^TMP("BMX",$J,BMXI)=$C(31)
19 Q
20 ;
21REGEVNT(BMXY,BMXEVENT) ;EP
22 ;RPC Called by BMX REGISTER EVENT to inform RPMS server
23 ;of client's interest in BMXEVENT
24 ;Returns RECORDSET with field ERRORID.
25 ;If everything ok then ERRORID = 0;
26 ;
27 N BMXI
28 S BMXI=0
29 S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
30 S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
31 S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
32 S ^TMP("BMX EVENT",$J,BMXEVENT)=$G(DUZ)
33 ;
34 S BMXI=BMXI+1
35 S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
36 Q
37 ;
38RAISEVNT(BMXY,BMXEVENT,BMXPARAM,BMXBACK,BMXKEY) ;EP
39 ;RPC Called to raise event BMXEVENT with parameter BMXPARAM
40 ;If BMXBACK = 'TRUE' then event will be raised back to originator
41 ;Calls EVENT
42 ;Returns a RECORDSET wit the field ERRORID.
43 ;If everything ok then ERRORID = 0;
44 ;
45 N BMXI,BMXORIG
46 S BMXI=0
47 S BMXORIG=$S($G(BMXBACK)="TRUE":"",1:$J)
48 S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
49 S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
50 S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
51 ;
52 D EVENT(BMXEVENT,BMXPARAM,BMXORIG,$G(BMXKEY))
53 ;
54 S BMXI=BMXI+1
55 S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
56 Q
57 ;
58EVENT(BMXEVENT,BMXPARAM,BMXORIG,BMXKEY) ;PEP - Raise event to interested clients
59 ;Clients are listed in ^TMP("BMX EVENT",BMXEVENT,BMXSESS)=DUZ
60 ;BMXORIG represents the event originator's session
61 ;The event will not be raised back to the originator if BMXORIG is the session of the originator
62 ;BMXKEY is a ~-delimited list of security keys. Only holders of one of these keys
63 ;will receive event notification. If BMXKEY is "" then all registered sessions
64 ;will be notified.
65 ;
66 L +^TMP("BMX EVENT RAISED"):30
67 N BMXSESS,BMXINC
68 S BMXSESS=0 F S BMXSESS=$O(^TMP("BMX EVENT",BMXSESS)) Q:'+BMXSESS D
69 . I BMXSESS=$G(BMXORIG) Q
70 . I '$D(^TMP("BMX EVENT",BMXSESS,BMXEVENT)) Q
71 . ;S BMXDUZ=^TMP("BMX EVENT",BMXEVENT,BMXSESS)
72 . S BMXDUZ=^TMP("BMX EVENT",BMXSESS,BMXEVENT)
73 . ;TODO: Test if DUZ holds at least one of the keys in BMXKEY
74 . S BMXINC=$O(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,99999999),-1)
75 . S:BMXINC="" BMXINC=0
76 . ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Set "_$NA(^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1))_"="_$G(BMXPARAM)
77 . S ^TMP("BMX EVENT RAISED",BMXSESS,BMXEVENT,BMXINC+1)=$G(BMXPARAM) ;IHS/OIT/HMW SAC Exemption Applied For
78 . Q
79 L -^TMP("BMX EVENT RAISED")
80 Q
81 ;
82POLLD(BMXY) ;EP
83 ;Debug Entry Point
84 ;D DEBUG^%Serenji("POLLD^BMXMEVN(.BMXY)")
85 Q
86 ;
87POLL(BMXY) ;EP
88 ;Check event queue for events of interest to current session
89 ;Return DataSet of events and parameters
90 ;Called by BMX EVENT POLL
91 ;
92 N BMXI,BMXEVENT
93 S BMXI=0
94 S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
95 S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
96 S ^TMP("BMX",$J,0)="T00030EVENT"_U_"T00030PARAM"_$C(30)
97 L +^TMP("BMX EVENT RAISED"):1 G:'$T POLLEND
98 ;
99 G:'$D(^TMP("BMX EVENT RAISED",$J)) POLLEND
100 S BMXEVENT=0 F S BMXEVENT=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT)) Q:BMXEVENT']"" D
101 . N BMXINC
102 . S BMXINC=0
103 . F S BMXINC=$O(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC)) Q:'+BMXINC D
104 . . ;Set output array node
105 . . S BMXPARAM=$G(^TMP("BMX EVENT RAISED",$J,BMXEVENT,BMXINC))
106 . . S BMXI=BMXI+1
107 . . S ^TMP("BMX",$J,BMXI)=BMXEVENT_U_BMXPARAM_$C(30)
108 . . Q
109 . Q
110 ;S ^TMP("BMXTRACK",$P($H,",",2))="Job "_$J_" Killed "_$NA(^TMP("BMX EVENT RAISED",$J))
111 K ^TMP("BMX EVENT RAISED",$J)
112 ;
113POLLEND S BMXI=BMXI+1
114 S ^TMP("BMX",$J,BMXI)=$C(31)
115 L -^TMP("BMX EVENT RAISED")
116 Q
117 ;
118TTESTD(BMXY,BMXTIME) ;Debug entry point
119 ;
120 ;D DEBUG^%Serenji("TTEST^BMXMEVN(.BMXY,BMXTIME)")
121 Q
122 ;
123TTEST(BMXY,BMXTIME) ;EP Timer Test
124 ;
125 S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
126 S BMXY=$NA(^BMXTMP("BMX",$J)) K @BMXY
127 S ^BMXTMP("BMX",$J,0)="I00020HANGTIME"_$C(30)
128 I +BMXTIME H BMXTIME
129 ;
130 S BMXI=1
131 S BMXI=BMXI+1
132 S ^BMXTMP("BMX",$J,BMXI)=BMXTIME_$C(30)_$C(31)
133 ;
134 Q
135 ;
136UNREGALL ;EP
137 ;Unregister all events for current session
138 ;Called on exit of each session
139 ;
140 N BMXEVENT
141 S BMXEVENT=""
142 K ^TMP("BMX EVENT",$J)
143 Q
144 ;
145UNREG(BMXY,BMXEVENT) ;EP
146 ;RPC Called by client to Unregister client's interest in BMXEVENT
147 ;Returns RECORDSET with field ERRORID.
148 ;If everything ok then ERRORID = 0;
149 ;
150 N BMXI
151 S BMXI=0
152 S X="REGET^BMXMEVN",@^%ZOSF("TRAP")
153 S BMXY=$NA(^TMP("BMX",$J)) K @BMXY
154 S ^TMP("BMX",$J,0)="I00020ERRORID"_$C(30)
155 K ^TMP("BMX EVENT",$J,BMXEVENT)
156 ;
157 S BMXI=BMXI+1
158 S ^TMP("BMX",$J,BMXI)="0"_$C(30)_$C(31)
159 Q
160 ;
161POLLET ;EP
162 ;Error trap from REGEVNT, RAISEVNT, ASYNCQUE and UNREG
163 ;
164 I '$D(BMXI) N BMXI S BMXI=999
165 S BMXI=BMXI+1
166 D POLLERR(BMXI,99)
167 Q
168 ;
169POLLERR(BMXI,BMXERID) ;Error processing
170 S BMXI=BMXI+1
171 S ^TMP("BMX",$J,BMXI)=BMXERID_U_$C(30)
172 S BMXI=BMXI+1
173 S ^TMP("BMX",$J,BMXI)=$C(31)
174 Q
175 ;
176ASYNCQUD(BMXY,BMXRPC,BMXEVN) ;EP
177 ;D DEBUG^%Serenji("ASYNCQUD^BMXMEVN(.BMXY,BMXRPC,BMXEVN)")
178 Q
179 ;
180ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP
181 ;RPC Queues taskman to job wrapper ASYNCZTM
182 N BMXRPCX
183 S BMXRPCX=$P(BMXRPC,$C(30))
184 ;RETURNS EVENT NAME, ZTSK in PARAM
185 S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
186 S BMXY=$NA(^TMP("BMX ASYNC QUEUE",$J)) K @BMXY
187 S ^TMP("BMX ASYNC QUEUE",$J,0)="I00030ERRORID"_U_"I00030PARAM"_$C(30)
188 ;
189 K BMXSEC
190 S BMXSEC=""
191 D CHKPRMIT^BMXMSEC(BMXRPCX) ;checks if RPC allowed to run
192 N OLDCTXT
193 I $L($G(BMXSEC)) D
194 . S OLDCTXT=""
195 . F S OLDCTXT=$O(XWBSTATE("ALLCTX",OLDCTXT)) Q:'$L($G(OLDCTXT)) D I '$L($G(BMXSEC)) Q
196 . . D ADDCTXT^BMXMSEC(DUZ,OLDCTXT)
197 . . D CHKPRMIT^BMXMSEC(BMXRPCX)
198 . . Q
199 . Q
200 I $L($G(BMXSEC)) D Q
201 . S ^TMP("BMX ASYNC QUEUE",$J,1)=2_U_$G(BMXSEC)_$C(30) ;IHS/OIT/HMW SAC Exemption Applied For
202 . S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31) ;IHS/OIT/HMW SAC Exemption Applied For
203 . Q
204 ;K ZTSK
205CHKOLDOK N ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
206 S ZTRTN="ASYNCZTM^BMXMEVN"
207 S BMXRPC=$TR(BMXRPC,"~",$C(30))
208 S ZTSAVE("BMXRPC")=""
209 S ZTSAVE("BMXEVN")=""
210 S ZTDESC="BMX ASYNC JOB"
211 S ZTIO="",ZTDTH=DT
212 D ^%ZTLOAD
213 ;D @ZTRTN ;Debugging call
214 ;
215 S ^TMP("BMX ASYNC QUEUE",$J,1)=1_U_$G(ZTSK)_$C(30)
216 S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31)
217 ;
218 Q
219 ;
220ASYNCZTM ;EP
221 ;Called by Taskman with BMXRPC and BMXEVN defined to
222 ; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN)
223 ; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM
224 ;
225 N BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY
226 N BMXT S BMXT=$C(30)
227 I $E(BMXRPC,1,6)="SELECT" S BMXRPC="BMX SQL"_$C(30)_BMXRPC
228 S BMXRPCD=$O(^XWB(8994,"B",$P(BMXRPC,BMXT),0))
229 S BMXNOD=^XWB(8994,BMXRPCD,0)
230 S BMXRTN=$P(BMXNOD,U,3)
231 S BMXTAG=$P(BMXNOD,U,2)
232 S BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY,"
233 F BMXJ=2:1:$L(BMXRPC,BMXT) D
234 . S BMXCALL=BMXCALL_$C(34)_$P(BMXRPC,BMXT,BMXJ)_$C(34)
235 . S:BMXJ<$L(BMXRPC,BMXT) BMXCALL=BMXCALL_","
236 . Q
237 S BMXCALL=BMXCALL_")"
238 X BMXCALL
239 D EVENT(BMXEVN,$G(ZTSK)_"~"_$P($G(BMXY),U,2),$J,"")
240 Q
241 ;
242 ;
243 ;Windows event handler:
244 ;Catches event with ZTSK^DataLocation parameter
245 ;Matches ZTSK to process that called event
246 ;Calls ASYNCGET rpc with DATALOCATION parameter
247 ;
248ASYNCGET(BMXY,BMXDATA) ;EP
249 ;RPC Retrieves data queued by ASYNCZTM
250 ;by setting BMXY to BMXDATA
251 ;
252 S BMXY="^"_BMXDATA
253 Q
254 ;
255ASYNCET ;EP
256 ;Error trap from ASYNCQUE
257 ;
258 I '$D(BMXI) N BMXI S BMXI=999
259 S BMXI=BMXI+1
260 D ASYNCERR(BMXI,0)
261 Q
262 ;
263ASYNCERR(BMXI,BMXERID) ;Error processing
264 S BMXI=BMXI+1
265 S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=BMXERID_U_$C(30)
266 S BMXI=BMXI+1
267 S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=$C(31)
268 Q
Note: See TracBrowser for help on using the repository browser.