source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVAPI.m@ 1310

Last change on this file since 1310 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 8.6 KB
Line 
1HLEVAPI ;O-OIFO/LJA - Event Monitor APIs ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4 ; Routine Supported APIs...
5 ; -----------------------------------------------------------------
6 ; HLEVAPI START(VAR)
7 ; HLEVAPI CHECKIN
8 ; HLEVAPI CHECKOUT
9 ; HLEVAPI ABORT(STATUS,APPLSTAT)
10 ; HLEVAPI MAILIT
11 ; HLEVAPI VARIABLE
12 ; -----------------------------------------------------------------
13 ; HLEVAPI0 ONOFFM(HLEVIENE)
14 ; -----------------------------------------------------------------
15 ; HLEVAPI1 APPSTAT(STATUS)
16 ; HLEVAPI1 MSGTEXT(GBL)
17 ; HLEVAPI1 RUNDIARY(GBL)
18 ;
19 ;
20 ; Test server code with TEST^HLEVSRV1 (Also HLEVMNU)
21 ; Test monitor code with TEST^HLEVUTI1 (Also HLEVMNU)
22 ;
23 ;
24 ; EVENT CODE
25 ;
26VARIABLE(HLEVIENJ,HLVAR) ; Store passed in variables...
27 ; HLVAR can be the name of a variable, like "CT", or it can be
28 ; a list of variables passed by reference.
29 N VAL,VAR
30 ;
31 D DEBUG^HLEVAPI2("VARIABLE") ; Debug data created conditionally
32 ;
33 ; Stop all event monitoring to enable on-site debugging...
34 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
35 ;
36 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" ;->
37 ;
38 ; Loop thru array...
39 S VAR=""
40 F S VAR=$O(HLVAR(VAR)) Q:VAR']"" D
41 . I $E(VAR,$L(VAR))="*" D QUIT ;->
42 . . QUIT:VAR="*" ;->
43 . . D VARSTAR(HLEVIENJ,VAR)
44 . D STOREIT(HLEVIENJ,VAR,$S($D(@VAR):@VAR,1:"---"),$G(HLVAR(VAR)))
45 ;
46 Q
47 ;
48VARSTAR(HLEVIENJ,VAR) ; Store VAR* variables...
49 N GBL,LP,REF,ROOT,X,X1
50 ;
51 KILL ^TMP("HLORDER",$J)
52 S GBL=$NA(^TMP("HLORDER",$J)),ROOT=$E(GBL,1,$L(GBL)-1)_","
53 S X=ROOT,X1(VAR)="" D ORDER^%ZOSV
54 QUIT:'$D(GBL) ;->
55 ;
56 ; $Q thru global...
57 S LP=GBL
58 F S LP=$Q(@LP) Q:LP'[ROOT D
59 . S REF=$P(LP,ROOT,2) QUIT:REF'[")" ;->
60 . S REF=$P($TR(REF,"""",""),")") QUIT:REF']"" ;->
61 . I $L(REF)>10 S REF=$E(REF,1,9)_"~"
62 . D STOREIT(+HLEVIENJ,REF,@LP)
63 ;
64 Q
65 ;
66STOREIT(HLEVIENJ,VAR,VAL,EXPL) ; Store VAR in 776...
67 N MIEN
68 S EXPL=$G(EXPL)
69 S MIEN=$O(^HLEV(776,+HLEVIENJ,52,"B",VAR,0))
70 I MIEN'>0 S MIEN=$O(^HLEV(776,+HLEVIENJ,52,":"),-1)+1
71 S ^HLEV(776,+HLEVIENJ,52,+MIEN,0)=VAR_$S(EXPL]"":U_EXPL,1:"")
72 S ^HLEV(776,+HLEVIENJ,52,+MIEN,52)=VAL
73 S ^HLEV(776,+HLEVIENJ,52,"B",VAR,MIEN)=""
74 S MIEN=$O(^HLEV(776,+HLEVIENJ,52,":"),-1)
75 I MIEN'>0 KILL ^HLEV(776,+HLEVIENJ,52) QUIT ;->
76 S ^HLEV(776,+HLEVIENJ,52,0)="^776.003A^"_MIEN_U_MIEN
77 Q
78 ;
79STOREVAR ; Update VARIABLE VALUE multiple in 776...
80 ; HLEVIENJ -- req
81 ;
82 ; Stop all event monitoring to enable on-site debugging...
83 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
84 ;
85 N MIEN,VAL,VAR
86 ; Store variable values in 776...
87 S VAR=""
88 F S VAR=$O(HLEVAR(VAR)) Q:VAR']"" D
89 . S VAL=$S($D(@VAR):@VAR,1:"---")
90 . S MIEN=$O(^HLEV(776,+HLEVIENJ,52,"B",VAR,0))
91 . I MIEN'>0 S MIEN=$O(^HLEV(776,+HLEVIENJ,52,":"),-1)+1
92 . S ^HLEV(776,+HLEVIENJ,52,+MIEN,0)=VAR_U_HLEVAR(VAR)
93 . S ^HLEV(776,+HLEVIENJ,52,+MIEN,52)=VAL
94 . S ^HLEV(776,+HLEVIENJ,52,"B",VAR,MIEN)=""
95 S MIEN=$O(^HLEV(776,+HLEVIENJ,52,":"),-1)
96 I MIEN'>0 KILL ^HLEV(776,+HLEVIENJ,52) QUIT ;->
97 S ^HLEV(776,+HLEVIENJ,52,0)="^776.003A^"_MIEN_U_MIEN
98 Q
99 ;
100START(VARIABLE) ; Start the whole monitoring process.
101 ; HLEVIENE,HLEVIENJ,HLEVIENM -- req --> HLEVAR()
102 ;
103 ; - Pass in by reference the VARIABLEs being tracked.
104 ;
105 ; >S VAR("VARNAME")="REPORT-VARNAME"
106 ; >D DECLARE("MONITOR-NAME",.VAR)
107 ;
108 N E,EXPL,I,MIEN,NO,NODE,TXT,VAR
109 ;
110 D DEBUG^HLEVAPI2("START") ; Debug data created conditionally
111 ;
112 ; Stop all event monitoring to enable on-site debugging...
113 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
114 ;
115 ; Check STATUS-EVENT...
116 QUIT:$P($G(^HLEV(776.999,1,0)),U,6)'="A" ;->
117 ;
118 ; Presets...
119 S NO=0
120 KILL HLEVAR
121 ;
122 ; If passed in a variable name directly in VARIABLE
123 I $G(VARIABLE)]"" F PCE=1:1:$L(VARIABLE,U) D
124 . S X=$P(VARIABLE,U,+PCE) I X]"" S NO=NO+1,HLEVAR(X)=X
125 ;
126 ; Convert passed in variable to format expected by CHECKIN & CHECKOUT
127 S VAR=""
128 F S VAR=$O(VARIABLE(VAR)) Q:VAR']"" D
129 . S EXPL=VARIABLE(VAR) S:EXPL']"" EXPL=VAR
130 . S NO=NO+1,HLEVAR(VAR)=EXPL
131 ;
132 KILL VARIABLE
133 ;
134 ; Make initial DIARY entry...
135 S TXT="DECLARE called - "_$P($G(^HLEV(776.1,+HLEVIENE,0)),U)
136 D WPTXT^HLEVUTIL(776,HLEVIENJ,50,776.001,TXT)
137 ;
138 Q
139 ;
140CHECKIN ; Call here to update the EVENT using "your" DECLARE variables...
141 N D,D0,DA,DI,DIE,DR,NO
142 ;
143 D DEBUG^HLEVAPI2("CHECKIN") ; Debug data created conditionally
144 ;
145 ; Stop all event monitoring to enable on-site debugging...
146 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
147 ;
148 ; Does entry exist?
149 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" ;->
150 ;
151 D STOREVAR
152 ;
153 ; Fill in zero node...
154 S DA=+HLEVIENJ,DIE=776
155 S DR="4///R;6////"_$$NOW^XLFDT
156 D ^DIE
157 ;
158 Q
159 ;
160ABORT(STATUS,APPLST) ; Call here if job is to be aborted...
161 N DA,DIE,DR,NOW
162 ;
163 D DEBUG^HLEVAPI2("ABORT") ; Debug data created conditionally
164 ;
165 ; Stop all event monitoring to enable on-site debugging...
166 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
167 ;
168 ; Does entry exist?
169 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" ;->
170 ;
171 D CHECKIN
172 ;
173 S DA=+HLEVIENJ,DIE=776
174 S NOW=$$NOW^XLFDT
175 S STATUS=$E($$UP^XLFSTR($G(STATUS)_" "))
176 S STATUS=$S("EFQR"[STATUS:STATUS,1:"E")
177 S DR="2////"_NOW_";4///"_STATUS_";6////"_NOW
178 S:$G(APPLST)]"" DR=DR_";5///"_$TR($E(APPLST,1,10),U,"~")
179 D ^DIE
180 ;
181 D EVCHKD^HLEVAPI2($G(HLEVIENM),$G(HLEVIENE),$G(HLEVIENJ),STATUS)
182 ;
183 KILL HLEVAR ; Passed-in user variables...
184 ;
185 Q
186 ;
187CHECKOUT ; Call here to end EVENT using "your" DECLARE variables...
188 N DA,DIE,DR,NOW
189 ;
190 D DEBUG^HLEVAPI2("CHECKOUT") ; Debug data created conditionally
191 ;
192 ; Stop all event monitoring to enable on-site debugging...
193 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
194 ;
195 ; Does entry exist?
196 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" ;->
197 ;
198 D CHECKIN
199 ;
200 S DA=+HLEVIENJ,DIE=776
201 S NOW=$$NOW^XLFDT
202 S DR="2////"_NOW_";4///F;6////"_NOW
203 D ^DIE
204 ;
205 D EVCHKD^HLEVAPI2($G(HLEVIENM),$G(HLEVIENE),$G(HLEVIENJ))
206 ;
207 KILL HLEVAR ; Passed-in user variables...
208 ;
209 Q
210 ;
211MAILIT D MAILIT^HLEVAPI3
212 Q
213 ;
214SENDMAIL(HLEVIENE,HLEVIENJ,XMY) ; Mail info in 776 event monitor's ^(51)...
215 ;
216 ; PARAMETER NOTES
217 ; ---------------------------------------------------------------------
218 ; XMY Pass in XMY by reference.
219 ; XMSUB If XMSUB pre-exists, it will be used.
220 ; XMTEXT The text for the mailman message will come from one of
221 ; three sources:
222 ; (1) If XMTEXT is pre-set, it will be used.
223 ; (2) If XMTEXT is not passed in, then the MAILMAN MESSAGE
224 ; TEXT global ^HLEV(776,IEN,51,#,0) will be used, if it
225 ; exits.
226 ; (3) Otherwise, a generic "message is completed" message
227 ; will be sent.
228 ;
229 N MGRP,NO,SITE,TEXT,XMDUZ,X,XMZ
230 ;
231 ; If no recipients passed in and no mail group exists, quit...
232 QUIT:$O(XMY(""))']"" ;->
233 ;
234 QUIT:$P($G(^HLEV(776.1,+$G(HLEVIENE),0)),U)']"" ;->
235 QUIT:$P($G(^HLEV(776,+$G(HLEVIENJ),0)),U)']"" ;->
236 ;
237 ; Set up sending...
238 S XMDUZ=.5
239 ;
240 ; Subject...
241 S X=$$SITE^VASITE,SITE="HL7 Monitor - "_$P(X,U,2)_"["_$P(X,U,3)_"]"
242 S XMSUB=$S($G(XMSUB)]"":XMSUB,1:SITE_" - "_$P($G(^HLEV(776.1,+HLEVIENE,0)),U))
243 ;
244 ; Load generic message text...
245 I $G(XMTEXT)']"" D
246 . KILL ^TMP($J,"HLMAILMSG")
247 . D LOADALL^HLEVAPI1(+HLEVIENJ,"HLMAILMSG")
248 ;
249 ; Declare where message is stored...
250 S XMTEXT=$S($G(XMTEXT)]"":XMTEXT,1:"^TMP("_$J_",""HLMAILMSG"",")
251 ;
252 D ^XMD
253 ;
254 I '$D(ZTQUEUED) W !!,"Mail message #",$G(XMZ),"..."
255 ;
256 I $G(XMZ)>0 D UPDFLDE(+HLEVIENJ,7,XMZ)
257 ;
258 Q
259 ;
260NEWEVENT(HLEVIENE,QTIME) ; Create a new EVENT and pass back IEN...
261 N DIC,DD,DO,X,Y
262 ;
263 ; Check STATUS-EVENT...
264 QUIT:$P($G(^HLEV(776.999,1,0)),U,6)'="A" ;->
265 ;
266 S X=$$NOW^XLFDT,DIC="^HLEV(776,",DIC(0)="L"
267 S DIC("DR")="3////"_HLEVIENE_";4///Q"
268 I $G(HLEVIENM)>0 S DIC("DR")=DIC("DR")_";9////"_HLEVIENM
269 I $G(QTIME)]"" S DIC("DR")=DIC("DR")_";10////"_QTIME
270 D FILE^DICN
271 ;
272 Q $S(+Y>0:+Y,1:"")
273 ;
274UPDFLDE(HLEVIENJ,FLD,VAL) ; Update a specific piece in 776...
275 N DA,DIE,DR
276 ;
277 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" ;->
278 ;
279 ; Field 50, RUN DIARY...
280 I FLD=50 D QUIT ;->
281 . N DIFF,NO,NOW,TIME
282 . S NO=$O(^HLEV(776,+HLEVIENJ,50,":"),-1)+1
283 . S ^HLEV(776,+HLEVIENJ,50,0)="^776.001^"_NO_U_NO
284 . S ^HLEV(776,+HLEVIENJ,50,+NO,0)=$G(VAL)
285 . ; If FLD=50, update timestamp every 30 seconds...
286 . ; (This is because many 50 nodes might be updated, one after the
287 . ; other in a very disk-intensive way.)
288 . S TIME=$P($G(^HLEV(776,+HLEVIENJ,0)),U,6) ; FM format
289 . S NOW=$$NOW^XLFDT
290 . S DIFF=$$FMDIFF^XLFDT(NOW,TIME,2) S:DIFF<0 DIFF=-DIFF
291 . QUIT:DIFF<30 ;->
292 . S DA=+HLEVIENJ,DIE=776,DR="6////"_NOW
293 ;
294 ; Fields 401-408...
295 I FLD?3N&(FLD>400)&(FLD<409) D QUIT ;->
296 . S ^HLEV(776,+HLEVIENJ,FLD)=VAL
297 ;
298 ; Zero node data...
299 QUIT:$G(VAL)']"" ;->
300 S DA=+HLEVIENJ,DIE=776,DR=FLD_"///"_VAL_";6////"_$$NOW^XLFDT
301 D ^DIE
302 ;
303 I FLD=2 D EVCHKD^HLEVAPI2($G(HLEVIENM),$G(HLEVIENE),$G(HLEVIENJ))
304 ;
305 Q
306 ;
307EOR ;HLEVAPI - Event Monitor APIs ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.