source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXMEVN.m@ 645

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

Initial Import of BMX.net code
File size: 6.7 KB
Line 
1BMXMEVN ; IHS/OIT/HMW - BMXNet MONITOR ;
2 ;;2.1;BMX;;Jul 26, 2009
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("POLL^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 ;
176ASYNCQUE(BMXY,BMXRPC,BMXEVN) ;EP
177 ;RPC Queues taskman to job wrapper ASYNCZTM
178 ;
179 ;RETURNS EVENT NAME, ZTSK in PARAM
180 S X="POLLET^BMXMEVN",@^%ZOSF("TRAP")
181 S BMXY=$NA(^TMP("BMX ASYNC QUEUE",$J)) K @BMXY
182 S ^TMP("BMX ASYNC QUEUE",$J,0)="I00030ERRORID"_U_"I00030PARAM"_$C(30)
183 ;
184 ;K ZTSK
185 N ZTSK,ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH
186 ;S ZTRTN="ASYNCZTD^BMXMEVN" ;Debugging call
187 S ZTRTN="ASYNCZTM^BMXMEVN"
188 S BMXRPC=$TR(BMXRPC,"~",$C(30))
189 S ZTSAVE("BMXRPC")=""
190 S ZTSAVE("BMXEVN")=""
191 S ZTDESC="BMX ASYNC JOB"
192 S ZTIO="",ZTDTH=DT
193 D ^%ZTLOAD
194 ;D @ZTRTN ;Debugging call
195 ;
196 S ^TMP("BMX ASYNC QUEUE",$J,1)=1_U_$G(ZTSK)_$C(30)
197 S ^TMP("BMX ASYNC QUEUE",$J,2)=$C(31)
198 Q
199 ;
200ASYNCZTD ;EP Debug entry point
201 D DEBUG^%Serenji("ASYNCZTM^BMXMEVN")
202 Q
203 ;
204ASYNCZTM ;EP
205 ;Called by Taskman with BMXRPC and BMXEVN defined to
206 ; 1) invoke the BMXRPC (RPC NAME^PARAM1^...^PARAMN)
207 ; 2) when done, raises event BMXEVN with ZTSK^$J in BMXPARAM
208 ;
209 N BMXRTN,BMXTAG,BMXRPCD,BMXCALL,BMXJ,BMXY,BMXNOD,BMXY
210 N BMXT S BMXT=$C(30)
211 I $E(BMXRPC,1,6)="SELECT" S BMXRPC="BMX SQL"_$C(30)_BMXRPC
212 S BMXRPCD=$O(^XWB(8994,"B",$P(BMXRPC,BMXT),0))
213 S BMXNOD=^XWB(8994,BMXRPCD,0)
214 S BMXRTN=$P(BMXNOD,U,3)
215 S BMXTAG=$P(BMXNOD,U,2)
216 S BMXCALL="D "_BMXTAG_"^"_BMXRTN_"(.BMXY,"
217 F BMXJ=2:1:$L(BMXRPC,BMXT) D
218 . S BMXCALL=BMXCALL_$C(34)_$P(BMXRPC,BMXT,BMXJ)_$C(34)
219 . S:BMXJ<$L(BMXRPC,BMXT) BMXCALL=BMXCALL_","
220 . Q
221 S BMXCALL=BMXCALL_")"
222 X BMXCALL
223 D EVENT(BMXEVN,$G(ZTSK)_"~"_$P($G(BMXY),U,2),$J,"")
224 Q
225 ;
226 ;
227 ;Windows event handler:
228 ;Catches event with ZTSK^DataLocation parameter
229 ;Matches ZTSK to process that called event
230 ;Calls ASYNCGET rpc with DATALOCATION parameter
231 ;
232ASYNCGET(BMXY,BMXDATA) ;EP
233 ;RPC Retrieves data queued by ASYNCZTM
234 ;by setting BMXY to BMXDATA
235 ;
236 S BMXY="^"_BMXDATA
237 Q
238 ;
239ASYNCET ;EP
240 ;Error trap from ASYNCQUE
241 ;
242 I '$D(BMXI) N BMXI S BMXI=999
243 S BMXI=BMXI+1
244 D ASYNCERR(BMXI,0)
245 Q
246 ;
247ASYNCERR(BMXI,BMXERID) ;Error processing
248 S BMXI=BMXI+1
249 S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=BMXERID_U_$C(30)
250 S BMXI=BMXI+1
251 S ^TMP("BMX ASYNC QUEUE",$J,BMXI)=$C(31)
252 Q
Note: See TracBrowser for help on using the repository browser.