source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVAPI3.m@ 1751

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1HLEVAPI3 ;O-OIFO/LJA - Event Monitor APIs ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4EVENTONE(HLEVIENM,HLEVNM,HLEVIENE) ; Master job check of an event...
5 ; ZTSKMST -- req
6 N CONT,CURR,CURRNOW,IEN,LAPSEMIN,LASTRUN,MAILGRP,MCHECK,MSTART,NO,NODE
7 N NODE0,NODE40,PAR1,PAR2,PAR3,PAR4,PAR5,PAR6,PAR7,PAR8,RUNNOW
8 N START,STAT,ZTDESC,ZTDTH,ZTIO,ZTRTN
9 ;
10 S NODE0=$G(^HLEV(776.1,+$G(HLEVIENE),0))
11 I NODE0']"" D RECEVM(HLEVIENM,HLEVIENE,"X^NO-0-NODE") QUIT ;->
12 S STAT=$P(NODE0,U,2) I STAT'="A" D RECEVM(HLEVIENM,HLEVIENE,"I") QUIT ;->
13 ; Requeue minutes for monitor...
14 S LAPSE=$P(NODE0,U,4) I LAPSE'?1.N D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-LAPSE") QUIT ;->
15 ;
16 ; Required M TAG^RTN for monitor...
17 S MSTART=$TR($P(NODE0,U,6),"~",U) I '$$OKMCODE^HLEVAPI0(MSTART) D QUIT ;->
18 . D RECEVM(HLEVIENM,HLEVIENE,"X^INVALID-M ["_$TR(MSTART,U,"~")_"]")
19 ;
20 ; Optional M $$EXTFUNCTION^RTN for determining whether new job should start
21 S MCHECK=$TR($P(NODE0,U,7),"~",U)
22 ;
23 ; If M check for start code exists, but is not valid M code, quit...
24 I MCHECK]"",'$$OKMCODE^HLEVAPI0($P(MCHECK,"$$",2,99)) D QUIT ;->
25 . D RECEVM(HLEVIENM,HLEVIENE,"X-INVALID-M-CHK ["_$TR(MCHECK,U,"~")_"]")
26 ;
27 ; When last run (started)? Return NULL if not completed...
28 S IEN=$O(^HLEV(776,"M",+HLEVIENE,":"),-1)
29 S (NODE,LASTRUN(1))=$G(^HLEV(776,+IEN,0))
30 S LASTRUN=$P(NODE,U),LASTRUN=$S(LASTRUN?7N1"."1.N:LASTRUN,1:"")
31 S X=$P(NODE,U,2) I X?7N1"."1.N S LASTRUN=X
32 ;
33 ; Set start new job default to YES...
34 S CONT=1
35 ;
36 ; If M start check code doesn't exist, check usual fields...
37 I MCHECK']"" D QUIT:'CONT ;->
38 .
39 . ;Start new monitor if last job running and timestamp is current,
40 . ;or monitor never run...
41 .
42 . ; Never run, so start new monitor...
43 . QUIT:LASTRUN']""
44 .
45 . ; Monitor running now, and is current, so don't do anything...
46 . S CURRNOW=$$CURR^HLEVAPI1(+IEN) I CURRNOW D QUIT ;->
47 . . I CURRNOW S CONT=0
48 . . D RECEVM(HLEVIENM,HLEVIENE,"R") ; Monitor running already...
49 .
50 . ; Monitor run, and if time to run new monitor, quit...
51 . S RUNNOW=$$RUNEV^HLEVAPI0(LASTRUN,LAPSE) QUIT:RUNNOW ;->
52 .
53 . S CONT=0 ; Set "no new monitor job needed" variable...
54 . D RECEVM(HLEVIENM,HLEVIENE,"E") QUIT ;-> Too early...
55 ;
56 I MCHECK]"" D QUIT:'CONT ;->
57 . N HLEVRUN
58 . D RUNS(HLEVIENE,.HLEVRUN) ; Define recent monitor runs for API call...
59 . S CONT="S CONT="_MCHECK X CONT
60 . S CONT=$S(CONT=1:1,1:0) QUIT:CONT ;->
61 . D RECEVM(HLEVIENM,HLEVIENE,"M") ; Package API check failed...
62 ;
63 S HLEVIENJ=$$NEWEVENT^HLEVAPI(HLEVIENE) I HLEVIENJ'>0 D QUIT ;->
64 . KILL HLPAR1D,HLPAR2D,HLPAR3D,HLPAR4D,HLPAR5D,HLPAR6D,HLPAR7D,HLPAR8D
65 ;
66 ; Queue a new job...
67 S ZTIO="",ZTDTH=$H,ZTDESC="HL Event Monitor - #"_HLEVIENE
68 S ZTRTN="QUEUEV^HLEVAPI3"
69 S ZTSAVE("HLEVIENJ")="",ZTSAVE("HLEVIENE")=""
70 S ZTSAVE("HLEVNM")="",ZTSAVE("HLEVIENM")=""
71 D ^%ZTLOAD
72 ;
73 ; Save info in 776.2...
74 D RECEVM(HLEVIENM,HLEVIENE,"Q",ZTSK,+HLEVIENJ)
75 ;
76 ; Save task number in 776...
77 D UPDFLDE^HLEVAPI(+HLEVIENJ,8,ZTSK)
78 ;
79 ; Reset back...
80 S ZTSK=ZTSKMST
81 ;
82 QUIT
83 ;
84RUNS(HLEVIENE,RUN) ; Find latest 10 runs for calling API...
85 N CT,IEN,NODE
86 KILL RUN
87 S CT=0,IEN=":"
88 F S IEN=$O(^HLEV(776,"M",HLEVIENE,IEN),-1) Q:'IEN D QUIT:CT>9
89 . S NODE=$G(^HLEV(776,+IEN,0)) QUIT:NODE']"" ;->
90 . S CT=CT+1
91 . S RUN(CT)=NODE
92 Q
93 ;
94RECEVM(HLEVIENM,HLEVIENE,RES,ZTSK,HLEVIENJ) ;
95 N CT,DATA,REA
96 ;
97 I $E(RES)="X" S REA=$P(RES,U,2),RES="X"
98 ;
99 S RES=$S($G(RES)]"":RES,1:"?")
100 S NOEVCHK(RES)=$G(NOEVCHK(RES))+1
101 ;
102 QUIT:$G(^HLEV(776.2,+$G(HLEVIENM),0))']"" ;->
103 QUIT:$G(^HLEV(776.1,+$G(HLEVIENE),0))']"" ;->
104 ;
105 S CT=$O(^HLEV(776.2,+HLEVIENM,51,":"),-1)+1
106 S ^HLEV(776.2,+HLEVIENM,51,0)="^776.2051PA^"_CT_U_CT
107 S DATA=HLEVIENE_U_$G(RES)_U_$$NOW^XLFDT
108 I $G(ZTSK) S $P(DATA,U,4)=ZTSK
109 I $G(REA)]"" S $P(DATA,U,7)=REA
110 I $G(HLEVIENJ)>0 S $P(DATA,U,8)=HLEVIENJ
111 S ^HLEV(776.2,+HLEVIENM,51,+CT,0)=DATA
112 S ^HLEV(776.2,+HLEVIENM,51,"B",HLEVIENE,CT)=""
113 ;
114 Q
115 ;
116QUEUEV ; Queued event job starts here...
117 ; HLEVIENE,HLEVIENJ,HLEVIENM -- req
118 N EVMCODE,EVMGRP,EVNAME,NODE,EVPAR1,EVPAR2,EVPAR3,EVPAR4,EVPAR5
119 N EVPAR6,DVPAR7,EVPAR8
120 ;
121 S ZTREQ="@"
122 ;
123 ; Mark RUNNING before doing anything else...
124 D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"R",+HLEVIENJ)
125 ;
126 S NODE=$G(^HLEV(776.1,+$G(HLEVIENE),0)) I NODE']"" D QUIT ;->
127 . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
128 S EVNAME=$P(NODE,U),EVMGRP=$P(NODE,U,5)
129 S EVMCODE=$TR($P(NODE,U,6),"~",U) I EVMCODE'?1.8E1"^"1.8E D QUIT ;->
130 . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XE",+HLEVIENJ)
131 ;
132 ; Node 40...
133 S NODE40=$G(^HLEV(776.1,+HLEVIENE,40))
134 F NO=1:1:8 S @("EVPAR"_NO)=$P(NODE40,U,NO)
135 ;
136 ; Final M code check...
137 I '$$OKMCODE^HLEVAPI0(EVMCODE) D QUIT ;->
138 . D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"XM",+HLEVIENJ)
139 ;
140 D @EVMCODE
141 ;
142 D EVRES^HLEVAPI0(+HLEVIENM,+HLEVIENE,"F",+HLEVIENJ)
143 ;
144 Q
145 ;
146MAILIT ; Generic mail out call...
147 ; HLEVIENE,HLEVIENJ -- req
148 ; XMY(...) can be created before this call...
149 N MGRP
150 ;
151 D DEBUG^HLEVAPI2("MAILIT") ; Debug data created conditionally
152 ;
153 ; Stop all event monitoring to enable on-site debugging...
154 QUIT:$G(^TMP("HLEVFLAG",$J))["STOP" ;->
155 ;
156 D ADDXMYS^HLEVAPI2(HLEVIENE,$G(XTMP))
157 ;
158 ; If no mail group, and no passed in XMY, use DUZ...
159 I '$D(XMY),$G(DUZ)>0 S XMY(DUZ)=""
160 ;
161 QUIT:'$D(XMY)
162 ;
163 D SENDMAIL^HLEVAPI(HLEVIENE,+$G(HLEVIENJ),.XMY) ; Use generic email...
164 ;
165 KILL XMSUB,XMTEXT,XMY
166 ;
167 Q
168 ;
169MONFLAG(VAL) ; Set ^TMP("HLEVFLAG",$J), or return it's value...
170 ; User may pass in the following values for VAL...
171 ;
172 ; * ABORT,STOP -> Will set ^TMP("HLEVFLAG",$J)="STOP"
173 ; * START,RUN,XEC -> Will kill ^TMP("HLEVFLAG",$J)
174 ; * SHOW,"" -> Will return value of ^TMP("HLEVFLAG",$J)
175 ;
176 ; What did user pass in?
177 S VAL=$$UP^XLFSTR($G(VAL))
178 S VAL=$S(VAL="STOP":"STOP",VAL="ABORT":"STOP",VAL="SET":"STOP",VAL="KILL":"@",VAL="START":"@",VAL="RUN":"@",VAL="XEC":"@",1:"")
179 ;
180 I VAL']"" QUIT $G(^TMP("HLEVFLAG",$J)) ;-> Just show value...
181 I VAL="@" KILL ^TMP("HLEVFLAG",$J) QUIT "" ;->
182 I VAL="STOP" S ^TMP("HLEVFLAG",$J)="STOP" QUIT "STOP" ;->
183 ;
184 Q $G(^TMP("HLEVFLAG",$J))
185 ;
186COUNT(MON,STATUS,GBL,LIM) ; Number of entries for monitor with STATUS...
187 ;
188 ; Pass in... MON -> Name or IEN of monitor
189 ;
190 ; STATUS -> 776's STATUS field code or full expansion
191 ; -- Default = RUNNING
192 ; -- Pass in ALL for all entries
193 ;
194 ; [GBL] -> Global for entry storage. [OPTIONAL]
195 ; Creates @GBL@(#)=IEN ~ 776 zero node
196 ; (KILL @GBL at beginning!)
197 ;
198 ; [LIM] -> Limit to # entries/status to store in GBL.
199 ;
200 ;
201 ; Examples:
202 ;
203 ; $$COUNT("FAST HL7 PURGE #2") -> # events running (default)
204 ; $$COUNT("FAST HL7 PURGE #2","R") -> # events running
205 ; $$COUNT("FAST HL7 PURGE #2","ALL") -> # events of all statuses
206 ;
207 ; The call... $$COUNT("FAST HL7 PURGE #2","ALL","HLEV",1)
208 ;
209 ; Returns... (1) # event entries that exist of all statuses.
210 ; (2) Stores entries in HLEV(#)=zero node
211 ; (3) Stores only the most recent entry (LIM=1)
212 ;
213 ; If LIM>2, for example, the most recent two entries
214 ; would be returned. But, note that the subscripting
215 ; is not oldest to newest, but newest (with subscript
216 ; of 1) to oldest (with subscript of 2.)
217 ;
218 N CT,IEN,NO
219 ;
220 QUIT:$G(MON)']"" "" ;->
221 S:$G(STATUS)']"" STATUS="R" ; Default to RUNNING...
222 S:STATUS="ALL" STATUS="EFQR"
223 I STATUS'="EFQR" S STATUS=$$UP^XLFSTR($E($G(STATUS)_" "))
224 QUIT:"EFQR"'[STATUS "" ;->
225 ;
226 ; If passed GBL, check/set limit..
227 S GBL=$G(GBL),LIM=$G(LIM)
228 S LIM=$S(LIM:LIM,1:999999)
229 ;
230 ; It's OK to pass in the IEN...
231 I MON'=+MON S MON=$O(^HLEV(776.1,"B",MON,0)) QUIT:MON'>0 "" ;->
232 ;
233 ; Remove any data hanging around from before call...
234 I GBL]"" KILL @GBL
235 ;
236 S CT=0,IEN=":"
237 F S IEN=$O(^HLEV(776,"M",+MON,IEN),-1) Q:'IEN D
238 . S DATA=$G(^HLEV(776,+IEN,0))
239 . ; Don't count if doesn't even have a status!
240 . QUIT:$P(DATA,U,4)']"" ;->
241 . ; If STATUS="EFQR", every status should be counted...
242 . I STATUS'="EFQR" QUIT:$P(DATA,U,4)'=STATUS ;->
243 . S CT=CT+1
244 . QUIT:$G(GBL)']"" ;-> Don't store and return...
245 . S CT(1)=$O(@GBL@($P(DATA,U,4),":"),-1)+1
246 . QUIT:CT(1)>LIM ;->
247 . S @GBL@($P(DATA,U,4),+CT(1))=IEN_"~"_DATA
248 ;
249 Q $S(CT:CT,1:"")
250 ;
251MARKERR ; Mark any RUNNING, but non-current entry's status to ERROR...
252 N DATA,IEN776,HLEVIENE,HLEVIENM,STAT
253 ;
254 S IEN776=0
255 F S IEN776=$O(^HLEV(776,IEN776)) Q:'IEN776 D
256 . S DATA=$G(^HLEV(776,+IEN776,0))
257 . S STAT=$P(DATA,U,4) QUIT:STAT'="R"&(STAT'="Q") ;->
258 . QUIT:$$CURR^HLEVAPI1(+IEN776) ;->
259 . S HLEVIENE=$P(DATA,U,3) QUIT:$G(^HLEV(776.1,+HLEVIENE,0))']"" ;->
260 . S HLEVIENM=$P(DATA,U,9) QUIT:$G(^HLEV(776.2,+HLEVIENM,0))']"" ;->
261 . D EVRES^HLEVAPI0(HLEVIENM,HLEVIENE,"XE",IEN776)
262 ;
263 Q
264 ;
265EOR ;HLEVAPI3 - Event Monitor APIs ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.