source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVSRV.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1HLEVSRV ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4 ; Send email to S.XQSCHK@SITE.VA.GOV to check server status.
5 ; (Include the name of server (w/o S.) in body of message.)
6 ;
7SERVER ; Called to get information about local monitoring system
8 N ADDREQHD,MXEC,NOW,XMER,XMPOS,XMRG,XTMP
9 ;
10 ;[M]S MXEC=$$MST^HLEVSRV1 ; Is M code execution allowed?
11 ;
12 S NOW=$$NOW^XLFDT,XTMP="HLEV SERVER "_NOW
13 S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,2)_U_NOW_"^HLEV SERVER REQUEST^"_$G(XMFROM)
14 ;
15 I $G(XMZ)'>0!($G(XMREC)']"") D QUIT ;->
16 . S ^XTMP(XTMP,"ERR")="No XMZ or XMREC"
17 ;
18 S ^XTMP(XTMP,"MAIL")=XMZ
19 ;
20 S XMPOS=""
21 ;
22READ ; Sequentially read thru message
23 X XMREC
24 I $D(XMER) G PROCESS:XMER<0 ;->
25 D ADDLINE(XMRG)
26 G READ ;->
27 ;
28 ;======================================================================
29 ;
30PROCESS ; Multiple "data request" formats possible...
31 ;[M]; MXEC -- req
32 N SUB
33 ;
34 D EXTRACT
35 D REQBACK ; Echo what was requested
36 ;
37 ;[M]S MXEC=$P(MXEC,U)+$P(MXEC,U,4)
38 ;[M]I MXEC=2 D QUIT:$G(HLEVQUIT) ;-> Pre-load M code execution
39 ;[M]. D MPRE^HLEVSRV0
40 D LOADATA
41 ;[M]I MXEC=2 D QUIT:$G(HLEVQUIT) ;-> Post-load M code execution
42 ;[M]. D MPST^HLEVSRV0
43 ;[M]. D MCOND^HLEVSRV0
44 ;[M]. D MCALLREC^HLEVSRV0
45 ;[M]. D MTEXT^HLEVSRV0
46 D XTMPMAIL ; Place at bottom of message XTMP value
47 D MAILIT
48 D KILLS
49 ;
50 Q
51 ;
52 ;======================================================================
53 ;
54EXTRACT ; Extract out the work list...
55 ; XTMP -- req
56 N CT,FILE,LNO,TXT
57 S LNO=0,CT=0
58 F S LNO=$O(^XTMP(XTMP,"RQ",LNO)) Q:LNO'>0 D
59 . S TXT=$$CHKREQ($G(^XTMP(XTMP,"RQ",LNO))) QUIT:TXT']"" ;->
60 . S FILE=$P(TXT,U) ; Type of request in "FILE"...
61 .
62 . ; There are 3 types of "data requests"...
63 . I FILE="QUERY" D EXTQUERY($P(TXT,U,2,99)) QUIT ;-> $QUERY format...
64 . I FILE="UNIT" D UNIT^HLEVSRV0($P(TXT,U,2,99)) QUIT ;-> Msg ID
65 . I $$OKFILE(+FILE) D EXTFILE(TXT) QUIT ;->
66 .
67 . ; If not a data request, must be a non-VistA HL7 request. And,
68 . ; if so, they have to pass a license
69 . I FILE="LICENSE" D CHKLIC^HLEVSRV4($P(TXT,U,2,99),$G(XMFROM)) QUIT ;->
70 .
71 . D ADDREQHD,ADDREQ("Error (HEADER)^"_TXT)
72 Q
73 ;
74CHKREQ(TXT) ; Check request, strip comments, etc...
75 N I
76 ;
77 ; Strip comments...
78 I $L(TXT,";")>1 S TXT=$P(TXT,";",1,$L(TXT,";")-1)
79 ;
80 ; Ignore blank lines, and dashed lines...
81 QUIT:$TR(TXT," -=;")']"" "" ;->
82 ;
83 ; Strip leading and trailing spaces...
84 X "F I=1:1:$L(TXT) Q:$E(TXT,I)'="" """ S TXT=$E(TXT,I,999) ; Leading
85 X "F I=$L(TXT):-1:1 Q:$E(TXT,I)'="" """ S TXT=$E(TXT,1,I) ; Trailing
86 ;
87 Q TXT
88 ;
89LOADATA ; Process the work list...
90 D LOADFNO
91 D LOADQRY
92 D LOADUNIT^HLEVSRV0 ; Msg ID-related data
93 D GBLTOXM^HLEVSRV1 ; 776 format data to send back
94 Q
95 ;
96LOADFNO ; Load data from file number...
97 N FILE,NODE,WHAT
98 D ADDMAIL("")
99 S FILE=0
100 F S FILE=$O(^XTMP(XTMP,"HLEV PROC","F",FILE)) Q:FILE'>0 D
101 . S WHAT=""
102 . F S WHAT=$O(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT)) Q:WHAT']"" D
103 . . S NODE=""
104 . . F S NODE=$O(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE)) Q:NODE']"" D
105 . . . S LIMIT=$G(^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE))
106 . . . D LOAD(FILE,WHAT,NODE,LIMIT)
107 Q
108 ;
109LOADQRY ; Load $QUERY data...
110 N NO
111 ;
112 QUIT:'$D(^XTMP(XTMP,"HLQUERY")) ;->
113 D ADDMAIL("")
114 D ADDMAIL("$QUERY Data"),ADDMAIL($$REPEAT^XLFSTR("-",74))
115 ;
116 ; Load $QUERY format data...
117 S NO=0
118 F S NO=$O(^XTMP(XTMP,"HLQUERY",NO)) Q:NO'>0 D
119 . D LOADQ(^XTMP(XTMP,"HLQUERY",+NO))
120 ;
121 Q
122 ;
123REQBACK ; Send back what was requested...
124 N SNO
125 ;
126 S SNO=0
127 F S SNO=$O(^XTMP(XTMP,"HLREQ",SNO)) Q:SNO'>0 D
128 . D ADDMAIL(^XTMP(XTMP,"HLREQ",SNO))
129 ;
130 Q
131 ;
132XTMPMAIL ; Add XTMP reference to bottom of email...
133 D ADDMAIL(""),ADDMAIL("")
134 D ADDMAIL("Remote request by: "_$G(XMFROM)),ADDMAIL("")
135 D ADDMAIL("[Query log stored in ^XTMP("""_XTMP_""") at site.]")
136 Q
137 ;
138MAILIT ; Mail report back to HL7 mail group...
139 ; XTMP -- req
140 N NO,TEXT,X,XMDUZ,XMSUB,XMTEXT,XMZ
141 S XMDUZ=.5,XMTEXT="^XTMP("""_XTMP_""",""HLMAIL"","
142 S X=$$SITE^VASITE,XMSUB="HLEV SERVER REQUEST "_$P(X,U,2)_" [#"_$P(X,U,3)_"]"
143 ;
144 ; Only send to VistA HL7 team members!!!!
145 S XMY("HL7SystemMonitoring@med.va.gov")=""
146 ;
147 D ^XMD
148 ;
149 S $P(^XTMP(XTMP,"MAIL"),U,2)=$G(XMZ)
150 ;
151 QUIT
152 ;
153KILLS ; Remove unwanted ^XTMP subscripts...
154 F SUB="DATA","HLEV PROC","HLMAIL","HLUNIT","HLQUERY","HLREQ","M","MTXT" D
155 . KILL ^XTMP(XTMP,SUB)
156 ;
157 Q
158 ;
159 ; =====================================================================
160 ;
161LOAD(FILE,WHAT,NODE,LIMIT) ;
162 N CT,DATA,GBL,IEN
163 ;
164 S LIMIT=$G(LIMIT)
165 S GBL=$$GBLFILE(+FILE) QUIT:GBL']"" ;->
166 ;
167 ; If passed in an IEN...
168 I WHAT=+WHAT D LOADONE(FILE,+WHAT,NODE),ADDMAIL("")
169 ;
170 ; Check to make sure it is ALL...
171 QUIT:WHAT'["ALL" ;->
172 ;
173 S IEN=0,CT=0,LIMIT=$S(LIMIT:LIMIT,1:99999)
174 F S IEN=$O(@GBL@(IEN)) Q:IEN'>0!(CT>(LIMIT-1)) D
175 . D LOADONE(FILE,+IEN,NODE,LIMIT)
176 . S CT=CT+1
177 ;
178 I CT D ADDMAIL("")
179 ;
180 Q
181 ;
182LOADONE(FILE,IEN,NODE,LIMIT) ; Load one entry...
183 N DATA,GBL,MIEN,MONM,ND,TXT
184 ;
185 S LIMIT=$G(LIMIT)
186 S GBL=$$GBLFILE(+FILE) QUIT:GBL']"" ;->
187 ;
188 ; Node (not multiple or WP) requested...
189 I $D(@GBL@(+IEN,NODE))#2 D QUIT ;->
190 . S DATA=$G(@GBL@(+IEN,NODE))
191 . S ^XTMP(XTMP,"DATA",FILE,+IEN,NODE)=DATA
192 ;
193 Q
194 ;
195 ; =====================================================================
196 ;
197EXTFILE(TXT) ; Extract 776 data...
198 N FILE,GBL,LIMIT,LOOPI,NODES,WHAT
199 ;
200 ; Sets...
201 S FILE=+TXT,GBL=$$GBLFILE(FILE) QUIT:GBL']"" ;->
202 S WHAT=$P(TXT,U,2)
203 I WHAT']"" S WHAT="ALL"
204 I WHAT=+WHAT QUIT:$G(@GBL@(+WHAT,0))']"" ;->
205 S NODES=$TR($P(TXT,U,3),"~",U),LIMIT=$P(TXT,U,4)
206 ;
207 ; Build nodes requested list...
208 F LOOPI=1:1:$L(NODES,U) S NODE=$P(NODES,U,LOOPI) I NODE]"" D
209 . S ^XTMP(XTMP,"HLEV PROC","F",FILE,WHAT,NODE)=LIMIT
210 . D ADDREQHD
211 . S TXT=$E("[#1] "_FILE_$S(LIMIT:" #"_LIMIT,1:"")_$$REPEAT^XLFSTR(" ",18),1,18)
212 . I LOOPI>1 S LIMIT=""
213 . S TXT=TXT_$E("[#2] "_$S(WHAT=+WHAT:"#"_WHAT,1:WHAT)_$$REPEAT^XLFSTR(" ",18),1,18)
214 . S TXT=TXT_"[#3] "_NODE
215 . D ADDREQ(TXT)
216 ;
217 Q
218 ;
219GBLFILE(FILE) ; Return closed global root...
220 N CH,GBL
221 S GBL=$G(^DIC(+FILE,0,"GL"))
222 S CH=$E(GBL,$L(GBL))
223 I CH="," QUIT $E(GBL,1,$L(GBL)-1)_")" ;->
224 I CH="(" QUIT $E(GBL,1,$L(GBL)-1)
225 Q ""
226 ;
227EXTQUERY(VAL) ; Extract $QUERY format requests...
228 ;
229 ; Format: p(1) = $QUERY reference. (E.g., "^DPT(25)")
230 ; p(2) = $QUERY stop value. (E.g., "^DPT(25,")
231 ; p(3) = # lines limit
232 ; p(4) = Screen format (E.g., "^DPT(#,0)")
233 ;
234 N LPVAL,NO,NOLINE,SCREEN,STOP
235 ;
236 ; Get values...
237 QUIT:'$$OKVARSQ(VAL) ;->
238 ;
239 ; Loop and collect now...
240 S NO=$O(^XTMP(XTMP,"HLQUERY",":"),-1)+1
241 S ^XTMP(XTMP,"HLQUERY",+NO)=VAL
242 ;
243 ; Add to list of items being queried...
244 S TXT=""
245 F PCE=1:1:$L(VAL,U) D
246 . S DATA=$P(VAL,U,PCE)
247 . I PCE=1!(PCE=2)!(PCE=4) S DATA=U_DATA
248 . I PCE=3 D
249 . . I DATA']"" S DATA="[1000]"
250 . . S DATA=" "_DATA
251 . S DATA="[#"_PCE_"]"_DATA
252 . I $L(DATA)>15 S DATA=$P(DATA,"]",2,99)
253 . S DATA=$S($L(DATA)>15:DATA_" ",1:$E(DATA_$$REPEAT^XLFSTR(" ",15),1,15))
254 . S TXT=TXT_$S(TXT]"":" ",1:"")_DATA
255 ;
256 I TXT]"" D
257 . D ADDREQHD
258 . D ADDREQ(TXT)
259 ;
260 Q
261 ;
262OKVARSQ(VAL) ; Are variables OK for $QUERY looping?
263 ; Defines (and "leaves around") LPVAL,STOP,NOLINE,SCREEN...
264 S (LPVAL,NOLINE,SCREEN,STOP)=""
265 S LPVAL=U_$P(VAL,U) S X="W "_LPVAL D ^DIM QUIT:'$D(X) "" ;->
266 QUIT:$E(LPVAL,1,3)'="^HL"&($E(LPVAL,1,8)'="^ORD(101") "" ;->
267 S STOP=U_$P(VAL,U,2) S X="W "_STOP_"25)" D ^DIM QUIT:'$D(X) "" ;->
268 S X=$P(VAL,U,3),NOLINE=$S(X>1000:1000,X>0:X,1:1000)
269 S SCREEN=$P(VAL,U,4) I SCREEN]"" D QUIT:'$D(X) "" ;->
270 . S SCREEN=U_SCREEN
271 . S X="W "_$TR(SCREEN,"#",1) D ^DIM
272 QUIT 1
273 ;
274LOADQ(VAL) ; Load $QUERY format data...
275 N CT,LPVAL,NO,NOLINE,POSX,REF,SCREEN,STOP,TXT
276 ;
277 ; Already checked format. But, this call sets up looping variables...
278 QUIT:'$$OKVARSQ(VAL) ;->
279 ;
280 S CT=0
281 F S LPVAL=$Q(@LPVAL) Q:$$QUITQ^HLEVSRV0(LPVAL,STOP,NOLINE,CT) D
282 . I SCREEN]"" QUIT:$$QUITS^HLEVSRV0(LPVAL,SCREEN) ;->
283 . S REF=LPVAL_"=",POSX=$L(REF)
284 . S DATA=@LPVAL,CT=CT+1
285 . F D QUIT:$TR(REF," ","")']""&(DATA']"")
286 . . S TXT=REF_$E(DATA,1,74-$L(REF))
287 . . D ADDMAIL(TXT)
288 . . S CT=CT+1
289 . . S DATA=$E(DATA,74-$L(REF)+1,999)
290 . . S REF=$$REPEAT^XLFSTR(" ",POSX)
291 ;
292 I CT D ADDMAIL("")
293 ;
294 Q
295 ;
296 ; =====================================================================
297 ;
298ADDREQHD ; Add Header to request record in email...
299 S ADDREQHD=$G(ADDREQHD)+1 QUIT:ADDREQHD>1 ;->
300 D ADDREQ(""),ADDREQ("Data Requests")
301 D ADDREQ($$REPEAT^XLFSTR("-",74))
302 Q
303 ;
304ADDLINE(XMRG) ; Add read line of text to ^TMP...
305 N LNO
306 S LNO=$O(^XTMP(XTMP,"RQ",":"),-1)+1
307 S ^XTMP(XTMP,"RQ",+LNO)=XMRG
308 Q
309 ;
310ADDREQ(TXT) ; Add data request to be added to ^XTMP(XTMP,"HLMAIL") later
311 N SNO
312 S SNO=$O(^XTMP(XTMP,"HLREQ",":"),-1)+1
313 S ^XTMP(XTMP,"HLREQ",+SNO)=TXT
314 Q
315 ;
316ADDMAIL(TXT) D ADDMAIL^HLEVSRV2(TXT)
317 Q
318 ;
319OKFILE(FILE) QUIT:+FILE=101 1 ;->
320 I FILE>769.99999&(FILE<870) QUIT 1 ;->
321 Q ""
322 ;
323EOR ;HLEVSRV - Event Monitor SERVER ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.