source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVAPI2.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1HLEVAPI2 ;O-OIFO/LJA - Event Monitor APIs ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4VARLIST(HLEVIENJ,SUB) ; Return event variable information in ^TMP($J,SUB)...
5 N CT,DATA,EXP,MIEN,VAL,VAR
6 ;
7 QUIT:$G(^HLEV(776,+$G(HLEVIENJ),0))']"" "" ;->
8 ;
9 S MIEN=0,CT=""
10 F S MIEN=$O(^HLEV(776,HLEVIENJ,52,MIEN)) Q:MIEN'>0 D
11 . S CT=CT+1
12 . S DATA=$G(^HLEV(776,+HLEVIENJ,52,+MIEN,0))
13 . S VAR=$P(DATA,U),EXP=$P(DATA,U,2)
14 . S VAL=$G(^HLEV(776,+HLEVIENJ,52,+MIEN,52))
15 . S ^TMP($J,SUB,VAR,"V")=VAL
16 . I EXP]"" S ^TMP($J,SUB,VAR,"E")=EXP
17 ;
18 Q CT
19 ;
20PREVENT(HLEVIENE,SUB,STATUS) ; Return <PR>evious <event> runs in ^TMP($J,SUB)
21 N CT,DATA,IEN
22 ;
23 S HLEVIENE=$G(HLEVIENE) QUIT:HLEVIENE']"" "" ;->
24 QUIT:$G(SUB)']"" "" ;->
25 ;
26 S STATUS=$$UP^XLFSTR($E($G(STATUS)))
27 ;
28 ; Maybe passed in the event name...
29 I HLEVIENE'=+HLEVIENE D QUIT:HLEVIENE'>0 "" ;->
30 . S HLEVIENE=$O(^HLEV(776.1,"B",HLEVIENE,0))
31 ;
32 ; Loop thru entries...
33 S IEN=0,CT=0
34 F S IEN=$O(^HLEV(776,"M",+HLEVIENE,IEN)) Q:IEN'>0 D
35 . S DATA=$G(^HLEV(776,+IEN,0)) QUIT:DATA']"" ;->
36 . I STATUS]"",$P(DATA,U,4)'=STATUS QUIT ;->
37 . S CT=CT+1
38 . S X=$P(DATA,U,4),STATUS(1)=$S(X]"":X,1:"?")
39 . S ^TMP($J,SUB,"D",IEN)=DATA
40 . S ^TMP($J,SUB,"S",STATUS(1),IEN)=""
41 ;
42 Q CT
43 ;
44EVCHKD(HLEVIENM,HLEVIENE,HLEVIENJ,STATUS) ; Event code finished. Mark event check multiple in 776.2 done...
45 ; ZTSK -- req
46 N DATA,MIEN
47 ;
48 QUIT:HLEVIENM=9999999 ;-> No master job...
49 ; Not usually passed. But, passed by ABORT^HLEVAPI...
50 S STATUS=$S($G(STATUS)]"":$E(STATUS),1:"F")
51 ;
52 S MIEN=$O(^HLEV(776.2,+$G(HLEVIENM),51,"B",+$G(HLEVIENE),":"),-1) QUIT:MIEN'>0 ;->
53 S DATA=$G(^HLEV(776.2,+HLEVIENM,51,+MIEN,0)) QUIT:$P(DATA,U,4)'=$G(ZTSK) ;->
54 S $P(DATA,U,5)=STATUS,$P(DATA,U,6)=$$NOW^XLFDT,$P(DATA,U,8)=$G(HLEVIENJ)
55 S ^HLEV(776.2,+HLEVIENM,51,+MIEN,0)=DATA
56 Q
57 ;
58ADDXMYS(HLEVIENE,XTMP) ; Set up XMY()s...
59 N DATA,MIEN,MONM,NODE,RECIP
60 ;
61 ; Any recipients built into monitor?
62 F NODE=60,61,62 D
63 . S MIEN=0
64 . F S MIEN=$O(^HLEV(776.1,+HLEVIENE,+NODE,MIEN)) Q:MIEN'>0 D
65 . . S DATA=$P($G(^HLEV(776.1,+HLEVIENE,+NODE,+MIEN,0)),U) QUIT:DATA']"" ;->
66 . . I NODE=60 S DATA=$P($G(^XMB(3.8,+DATA,0)),U),DATA=$S(DATA]"":"G."_DATA,1:"") QUIT:DATA']"" ;->
67 . . S XMY(DATA)=""
68 ;
69 ; Any recipients passed in in data request?
70 QUIT:$G(XTMP)']"" ;->
71 S MONM=$P($G(^HLEV(776.1,+HLEVIENE,0)),U) QUIT:MONM']"" ;->
72 S RECIP=""
73 F S RECIP=$O(^XTMP(XTMP,"MONREQ","MON",+HLEVIENE,RECIP)) Q:RECIP']"" D
74 . S XMY(RECIP)=""
75 ;
76 Q
77 ;
78MGRP(HLEVIENE) ; Return G.MAIL-GROUP...
79 N MGRP
80 S MGRP=$P($G(^HLEV(776.1,+$G(HLEVIENE),0)),U,5)
81 S MGRP=$P($G(^XMB(3.8,+MGRP,0)),U) QUIT:MGRP']"" "" ;->
82 Q "G."_MGRP
83 ;
84LOADBODY(HLEVIENJ,SVSUB) ; Load body into global to mail...
85 N END,NODE,P1,P2,P3,P4,P5,P6,P7,PCE,START,TXT
86 ;
87 S SVSUB=$S($G(SVSUB)]"":SVSUB,1:"HLMAILMSG")
88 ;
89 S NODE=$G(^HLEV(776,+HLEVIENJ,0))
90 F PCE=1:1:7 S @("P"_PCE)=$P(NODE,U,PCE)
91 ;
92 ; START - END
93 S START=$$FMTE^XLFDT(P1),END=$$FMTE^XLFDT(P2)
94 S TXT(1)=$E("Start time: "_START_$$REPEAT^XLFSTR(" ",40),1,34)_" "
95 S TXT(2)="End time: "_END
96 D ADD^HLEVAPI1(TXT(1)_TXT(2))
97 ;
98 ; STATUS-RUN - STATUS-APPL
99 S P4=$S(P4="E":"ERROR",P4="F":"FINISHED",P4="Q":"QUEUED (NOT RUNNING YE T)",1:"??")
100 S TXT(1)=$E("Status: "_P4_$$REPEAT^XLFSTR(" ",40),1,34)_" "
101 S TXT(2)=$S(P5]"":"Status-Appl: "_P5,1:"")
102 D ADD^HLEVAPI1(TXT(1)_TXT(2))
103 ;
104 Q
105 ;
106LOADDGBL(HLEVIENJ,SUBDD,SVSUB) ; Load event text into global to mail...
107 N HDR,MIEN
108 S HDR=$S(SUBDD=50:"Run Diary",SUBDD=51:"Additional Text",1:"")
109 S SVSUB=$S($G(SVSUB)]"":SVSUB,1:"HLMAILMSG")
110 I $O(^HLEV(776,+HLEVIENJ,SUBDD,0))>0 D
111 . D ADD^HLEVAPI1("") ; Always add a blank line...
112 . I HDR]"" D ADD^HLEVAPI1(HDR),ADD^HLEVAPI1($$REPEAT^XLFSTR("-",$L(HDR)))
113 S MIEN=0
114 F S MIEN=$O(^HLEV(776,+HLEVIENJ,SUBDD,MIEN)) Q:'MIEN D
115 . D ADD^HLEVAPI1($G(^HLEV(776,+HLEVIENJ,SUBDD,+MIEN,0)))
116 Q
117 ;
118DEBUGSET ; Set debugging on/off for a tag...
119 N CUT,TAG
120DSET1 ;
121 I $O(^XTMP("HLEV DEBUG",0))']"" D
122 . KILL ^XTMP("HLEV DEBUG")
123 ;
124 I $O(^XTMP("HLEV DEBUG",""))]"" D
125 . W !!,"Current debug sets..."
126 . W !
127 . S TAG=0
128 . F S TAG=$O(^XTMP("HLEV DEBUG",TAG)) Q:TAG']"" D
129 . . S CUT=$G(^XTMP("HLEV DEBUG",TAG)) QUIT:CUT']"" ;->
130 . . W !,TAG,?20,CUT,"..."
131 ;
132 R !!,"Tag: ",TAG:99 Q:TAG']"" ;->
133 S CUT=$G(^XTMP("HLEV DEBUG",TAG))
134 I CUT]"" W " ... set to ",CUT," ..."
135 R !,"Cutoff time (FM): ",CUT:99
136 ;
137 I CUT="@" D
138 . KILL ^XTMP("HLEV DEBUG",TAG)
139 . W " removing data..."
140 . I $O(^XTMP("HLEV DEBUG",0))']"" KILL ^XTMP("HLEV DEBUG")
141 ;
142 I CUT?7N1"."1.N D DSET2(TAG,CUT) W " setting cutoff time..."
143 ;
144 G DSET1 ;->
145 ;
146DSET2(TAG,CUT) ;
147 S ^XTMP("HLEV DEBUG",0)=$$FMADD^XLFDT($$NOW^XLFDT,0,1)_U_$$NOW^XLFDT_U_"HL7 event monitor debug data"
148 S ^XTMP("HLEV DEBUG",TAG)=CUT ; Cutoff time after which not to store...
149 Q
150 ;
151DEBUG(TAG,TMPSUB) ; Conditionally store ^XTMP debug data...
152 ; Pass-by-reference references to save by merging...
153 ; TMPSUB(SAVESUB)=REFERENCE
154 ; (E.g., TMPSUB("HLEVREP")=$NA(^TMP($J,"HLEVREP")))
155 N DATE,NO,SUB,REF,X
156 ;
157 ; Is debugging enabled?
158 S DATE=$G(^XTMP("HLEV DEBUG",TAG)) QUIT:DATE<$$NOW^XLFDT ;->
159 ;
160 ; There must be a task number...
161 I $G(ZTSK)'>0 N ZTSK S ZTSK=9999999
162 ;
163 ; Save data...
164 S NO=$O(^XTMP("HLEV DEBUG",TAG,ZTSK,":"),-1)+1
165 S ^XTMP("HLEV DEBUG",TAG,ZTSK,+NO)=$$NOW^XLFDT
166 S X="^XTMP(""HLEV DEBUG"","""_TAG_""","_ZTSK_","_NO_"," D DOLRO^%ZOSV
167 ;
168 ; Save reference data by merging...
169 S SUB=""
170 F S SUB=$O(TMPSUB(SUB)) Q:SUB']"" D
171 . S REF=TMPSUB(SUB) QUIT:REF']"" ;->
172 . MERGE ^XTMP("HLEV DEBUG",TAG,ZTSK,NO,SUB)=@REF
173 ;
174 ; Remove all but last 20 entries for TAG...
175 F NO(1)=NO-20:-1:1 KILL ^XTMP("HLEV DEBUG",TAG,ZTSK,NO(1))
176 ;
177 Q
178 ;
179ASKDATE(DATEPMT,PARM,DEFAULT) ; Select date...
180 N DIR,DIRUT,DTOUT,DUOUT,X,Y
181 S DIR(0)="DO^::"_$S($G(PARM):PARM,1:"EXT")
182 S DIR("A")=$S($G(DATEPMT)]"":DATEPMT,1:"Select DATE")
183 I $G(DEFAULT)]"" S DIR("B")=DEFAULT
184 D ^DIR
185 I $G(PARM)]"",PARM'["T" QUIT:+Y?7N +Y ;->
186 I +Y?7N1"."1.N Q +Y
187 Q ""
188 ;
189LOG(ETYPE,STORE) ; Log event type, record variables, create index...
190 ;
191 ; STORE = variables to store, separated by up-arrows. (At the time
192 ; of call to LOG, the value of the variables must be set to
193 ; the value to be stored!)
194 ;
195 ; Returns: Piece 1 -- 0 -> No new log entry made
196 ; 1 -> New log entry made
197 ; Piece 2 -- 776.4 IEN
198 ;
199 N IEN1,IEN2,LIEN,LIST,LOG,PCE,VAR,X,XRF
200 ;
201 ; Quit if no event type passed. (Event type always used for APPNAME)
202 QUIT:$G(ETYPE)']"" "" ;->
203 ;
204 ; Defaults...
205 S LOG="",STORE=$G(STORE)
206 ;
207 ; Extract out the variables used for index (and stored below)...
208 F PCE=1:1:$L($G(STORE),U) D
209 . S VAR=$P(STORE,U,+PCE) QUIT:VAR']""!('($D(@VAR)#2)) ;->
210 . S LIST(PCE)=@VAR
211 ;
212 ; Quit if this problem has already been logged?
213 I STORE]"" D QUIT:+LOG=1 "^"_$P(LOG,U,2) ;->
214 . S LOG=$$LOGGED^HLEME1(ETYPE,.LIST)
215 ;
216 ; Make a log entry...
217 S LIEN=$$EVENT^HLEME(ETYPE,"HEALTH LEVEL SEVEN") QUIT:'LIEN "" ;->
218 ;
219 ; Store event in log, log in event, and create xref...
220 I $G(HLEVIENJ) D
221 .
222 . N LIST
223 .
224 . ; Store event in log...
225 . S X=$$ADDNOTE^HLEME(+LIEN,"Event monitor# "_HLEVIENJ_" created this log entry.")
226 . ; Store log in event...
227 . KILL ^TMP($J,"HLZZ")
228 . S ^TMP($J,"HLZZ",1)="Log# "_LIEN_" was created by this event monitor.)"
229 . D RUNDIARY^HLEVAPI1($NA(^TMP($J,"HLZZ")))
230 . KILL ^TMP($J,"HLZZ")
231 .
232 . ; Add Xrefs...
233 . S LIST(1)="X776",LIST(2)=HLEVIENJ,LIST(3)=LIEN
234 . S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
235 .
236 . S LIST(1)="X7764",LIST(2)=LIEN,LIST(3)=HLEVIENJ
237 . S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
238 ;
239 ; If no variables to store, stop now...
240 I STORE']"" QUIT 1_U_LIEN ;->
241 ;
242 ; Re-extract variables, get values, and store in log entry...
243 F PCE=1:1:$L($G(STORE),U) D
244 . S VAR=$P(STORE,U,+PCE) QUIT:VAR']""!('($D(@VAR)#2)) ;->
245 . S X=$$STOREVAR^HLEME(+LIEN,@VAR,VAR) ; Store variable
246 . S LIST(PCE)=@VAR
247 ;
248 ; Make a new index...
249 S X=$$NEWINDEX^HLEME1(+LIEN,ETYPE,.LIST)
250 ;
251 Q 1_U_LIEN
252 ;
253LOGVAR(IEN,VAR) ; Store variable in 776.4...
254 N CT,MIEN,ZERO
255 ;
256 QUIT:$G(^HLEV(776.4,+$G(IEN),0))']""!('$D(@VAR)) ;->
257 S ZERO=$G(^HLEV(776.4,+IEN,3,0)),$P(ZERO,U,2)=776.43
258 ;
259 S CT=0
260 ;
261 ; Individual variable...
262 I $D(VAR)#2 D SV(VAR,@VAR) QUIT:'CT ;->
263 ;
264 S ^HLEV(776.4,+IEN,3,0)=ZERO
265 ;
266 Q
267 ;
268LOGQUERY(IEN,QUERYBEG,QUERYEND) ; Store ARR() in 776.4...
269 N CT,MIEN,ZERO
270 ;
271 QUIT:$G(^HLEV(776.4,+$G(IEN),0))']"" ;->
272 S ZERO=$G(^HLEV(776.4,+IEN,3,0)),$P(ZERO,U,2)=776.43
273 ;
274 S CT=0
275 F S QUERYBEG=$Q(@QUERYBEG) Q:QUERYBEG'[QUERYEND D
276 . D SV(QUERYBEG,@QUERYBEG)
277 ;
278 QUIT:CT'>0 ;->
279 ;
280 S ^HLEV(776.4,+IEN,3,0)=ZERO
281 ;
282 Q
283 ;
284SV(VAR,VAL) ; Store individual variable... (Increments CT, updates ZERO,
285 ; and creates MIEN.)
286 ; CT,IEN,ZERO -- req --> CT,MIEN,ZERO
287 S CT=CT+1
288 S MIEN=$O(^HLEV(776.4,+IEN,3,":"),-1)+1
289 S ^HLEV(776.4,+IEN,3,+MIEN,0)=VAR_"="_VAL
290 S $P(ZERO,U,3)=MIEN,$P(ZERO,U,4)=MIEN
291 Q
292 ;
293EOR ;HLEVAPI2 - Event Monitor APIs ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.