1 | HLEVSRV0 ;O-OIFO/LJA - Event Monitor SERVER ;02/04/2004 14:42
|
---|
2 | ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
|
---|
3 | ;
|
---|
4 | M(TXT) ; Called when M code data requested in...
|
---|
5 | ; MXEC,XTMP -- req
|
---|
6 | N MCODE,NO,MTAG,WHEN
|
---|
7 | ;
|
---|
8 | ; Sets...
|
---|
9 | S WHEN=$P(TXT,U)
|
---|
10 | ;
|
---|
11 | ; Has license been sent?
|
---|
12 | I WHEN="LICENSE" D QUIT ;->
|
---|
13 | . QUIT:$P(MXEC,U,4)]"" ;->
|
---|
14 | . S MCODE=$P(TXT,U,2)
|
---|
15 | . I '$$OKCODE^HLEVSRV1(MCODE) S $P(MXEC,U,4)=0 QUIT ;->
|
---|
16 | . S $P(MXEC,U,4)=1 ; Force DOWN...
|
---|
17 | ;
|
---|
18 | QUIT:WHEN'="BEFORE"&(WHEN'="AFTER") ;->
|
---|
19 | S MTAG=$P(TXT,U,2) QUIT:MTAG']"" ;->
|
---|
20 | S MCODE=$P(TXT,U,3,999) Q:MCODE']"" ;->
|
---|
21 | ;
|
---|
22 | ; Is it valid M code?
|
---|
23 | S X=MCODE D ^DIM QUIT:'$D(X) ;->
|
---|
24 | ;
|
---|
25 | S NO=$O(^XTMP(XTMP,"M",WHEN,MTAG,":"),-1)+1
|
---|
26 | S ^XTMP(XTMP,"M",WHEN,MTAG,+NO)=MCODE
|
---|
27 | ;
|
---|
28 | Q
|
---|
29 | ;
|
---|
30 | MPRE ; Run M code before load of data...
|
---|
31 | ; XTMP -- req
|
---|
32 | D MRUN("BEFORE")
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | MPST ; Run M code after load of data...
|
---|
36 | ; XTMP -- req
|
---|
37 | D MRUN("AFTER")
|
---|
38 | Q
|
---|
39 | ;
|
---|
40 | MRUN(WHEN) ; Run M code's INIT...
|
---|
41 | ; XTMP -- req
|
---|
42 | N ZZADD,ZZCALL,ZZMCODE,ZZMLNO,ZZMTAG,ZZNEXT,ZZNO,ZZREC
|
---|
43 | ;
|
---|
44 | ; Get starting M code...
|
---|
45 | QUIT:$G(^XTMP(XTMP,"M",WHEN,"INIT",1))']"" ;->
|
---|
46 | ;
|
---|
47 | ; Values set up as a service for the developer sending in M code...
|
---|
48 | ;
|
---|
49 | ; NEXT LINE - Executable code to execute next line in "subroutine"...
|
---|
50 | S ZZNEXT="S ZZMLNO=ZZMLNO+1,ZZMCODE=$G(^XTMP(XTMP,""M"",WHEN,ZZMTAG,ZZMLNO)) QUIT:ZZMCODE']"""" X ZZMCODE,ZZREC"
|
---|
51 | S ZZREC="S ZZCALL=$G(ZZCALL)+1,^XTMP(XTMP,""M"",""REC"",WHEN,ZZCALL)=ZZMLNO_U_ZZMTAG"
|
---|
52 | S ZZADD="D ADDMTXT^HLEVSRV0($G(ZZTXT))"
|
---|
53 | ;
|
---|
54 | ; Set up every "subroutine" in an executable call "tag"
|
---|
55 | S ZZMCODE=""
|
---|
56 | F S ZZMCODE=$O(^XTMP(XTMP,"M",WHEN,ZZMCODE)) Q:ZZMCODE']"" D
|
---|
57 | . S @ZZMCODE="S ZZMTAG="""_ZZMCODE_""",ZZMLNO=0 X ZZNEXT"
|
---|
58 | ;
|
---|
59 | S ZZCALL=0
|
---|
60 | ;
|
---|
61 | ; Start...
|
---|
62 | X INIT
|
---|
63 | ;
|
---|
64 | Q
|
---|
65 | ;
|
---|
66 | MCOND ; Condense M call data...
|
---|
67 | N DATA,TAG,TAGL,TAGN,TXT,WHEN,ZZCALL
|
---|
68 | ;
|
---|
69 | QUIT:'$D(^XTMP(XTMP,"M","REC")) ;->
|
---|
70 | ;
|
---|
71 | KILL ^TMP($J,"HLMCOND")
|
---|
72 | ;
|
---|
73 | F WHEN="BEFORE","AFTER" D
|
---|
74 | . S ZZCALL=0,TXT=WHEN_": ",POSX=$L(TXT),TAGL="",TAGN=0
|
---|
75 | . F S ZZCALL=$O(^XTMP(XTMP,"M","REC",WHEN,ZZCALL)) Q:ZZCALL'>0 D
|
---|
76 | . . S DATA=^XTMP(XTMP,"M","REC",WHEN,ZZCALL),TAG=$P(DATA,U,2) QUIT:TAG']"" ;->
|
---|
77 | . . I $L(TXT)>55 D
|
---|
78 | . . . D ADD(TXT)
|
---|
79 | . . . S TXT=$$REPEAT^XLFSTR(" ",POSX)
|
---|
80 | . . I TAGL'=TAG D
|
---|
81 | . . . I TAGL]"",TAGN>0 S TXT=TXT_"(#"_TAGN_")",TAGN=0
|
---|
82 | . . . S TXT=TXT_$S($L(TXT)>POSX:"-",1:"")_TAG,TAGN=1
|
---|
83 | . . I TAGL=TAG S TAGN=TAGN+1
|
---|
84 | . . S TAGL=TAG
|
---|
85 | . I TAGN>0,$L(TXT)>POSX S TXT=TXT_"(#"_TAGN_")",TAGN=0
|
---|
86 | . I $L(TXT)>POSX D ADD(TXT)
|
---|
87 | ;
|
---|
88 | QUIT:'$D(^TMP($J,"HLMCOND")) ;->
|
---|
89 | ;
|
---|
90 | KILL ^XTMP(XTMP,"M","REC")
|
---|
91 | MERGE ^XTMP(XTMP,"M","REC")=^TMP($J,"HLMCOND")
|
---|
92 | ;
|
---|
93 | Q
|
---|
94 | ;
|
---|
95 | MCALLREC ; Store MCOND data in mail message..
|
---|
96 | N NO
|
---|
97 | ;
|
---|
98 | QUIT:'$D(^XTMP(XTMP,"M","REC")) ;->
|
---|
99 | ;
|
---|
100 | D ADDMAIL^HLEVSRV(""),ADDMAIL^HLEVSRV("M Call Record")
|
---|
101 | D ADDMAIL^HLEVSRV($$REPEAT^XLFSTR("-",74))
|
---|
102 | ;
|
---|
103 | S NO=0
|
---|
104 | F S NO=$O(^XTMP(XTMP,"M","REC",NO)) Q:NO'>0 D
|
---|
105 | . D ADDMAIL^HLEVSRV(^XTMP(XTMP,"M","REC",NO))
|
---|
106 | ;
|
---|
107 | Q
|
---|
108 | ;
|
---|
109 | ADDMTXT(TXT) ;
|
---|
110 | N NO
|
---|
111 | S NO=$O(^XTMP(XTMP,"MTEXT",":"),-1)+1
|
---|
112 | S ^XTMP(XTMP,"MTEXT",+NO)=TXT
|
---|
113 | Q
|
---|
114 | ;
|
---|
115 | MTEXT ; Add text to Mailman message created by M code...
|
---|
116 | N NO
|
---|
117 | ;
|
---|
118 | I $G(^XTMP(XTMP,"MTEXT")) D
|
---|
119 | . D ADDMAIL("")
|
---|
120 | . D ADDMAIL($$CJ^XLFSTR(" M-Created Text ",74,"-"))
|
---|
121 | ;
|
---|
122 | S NO=0
|
---|
123 | F S NO=$O(^XTMP(XTMP,"MTEXT",NO)) Q:NO'>0 D
|
---|
124 | . D ADDMAIL(^XTMP(XTMP,"MTEXT",NO))
|
---|
125 | ;
|
---|
126 | Q
|
---|
127 | ;
|
---|
128 | ADD(TXT) ;
|
---|
129 | N NO
|
---|
130 | S NO=$O(^TMP($J,"HLMCOND",":"),-1)+1
|
---|
131 | S ^TMP($J,"HLMCOND",+NO)=TXT
|
---|
132 | Q
|
---|
133 | ;
|
---|
134 | MTEST ; Test M code embedded in a Mailman message...
|
---|
135 | N IOINHI,IOINORM,MIEN,X,XTMP
|
---|
136 | ;
|
---|
137 | S X="IOINHI;IOINORM" D ENDR^%ZISS
|
---|
138 | ;
|
---|
139 | W @IOF,$$CJ^XLFSTR("M Code Test",IOM)
|
---|
140 | W !,$$REPEAT^XLFSTR("=",IOM)
|
---|
141 | W !!,"This utility will execute the code in the BEFORE and AFTER sections of the"
|
---|
142 | W !,"M code embedded in a Mailman message. The message must be in the format"
|
---|
143 | W !,"used by the [HLEV-INFORMATION-SERVER] menu option."
|
---|
144 | ;
|
---|
145 | MT1 W !
|
---|
146 | F R !,"Message IEN: ",MIEN:60 Q:MIEN'>0 D QUIT:$G(^XMB(3.9,+MIEN,0))]""
|
---|
147 | . I $G(^XMB(3.9,+MIEN,0))']"" D QUIT ;->
|
---|
148 | . . W " no message found..."
|
---|
149 | . W " ",$P(^XMB(3.9,+MIEN,0),U),"..."
|
---|
150 | ;
|
---|
151 | QUIT:$G(^XMB(3.9,+MIEN,0))']"" ;->
|
---|
152 | ;
|
---|
153 | S XTMP="HLEV SERVER 9999999",NOW=$$NOW^XLFDT
|
---|
154 | KILL ^XTMP(XTMP)
|
---|
155 | S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,1)_U_NOW_U_"TEST"
|
---|
156 | ;
|
---|
157 | W !!,"Loading M code..."
|
---|
158 | S LNO=0
|
---|
159 | F S LNO=$O(^XMB(3.9,+MIEN,2,LNO)) Q:LNO'>0 D
|
---|
160 | . S TXT=$G(^XMB(3.9,+MIEN,2,+LNO,0)) QUIT:$E(TXT,1,2)'="M^" ;->
|
---|
161 | . S TXT=$P(TXT,U,2,999) QUIT:TXT']"" ;->
|
---|
162 | . W "."
|
---|
163 | . D M(TXT)
|
---|
164 | ;
|
---|
165 | I '$D(^XTMP(XTMP,"M")) D G MT1 ;->
|
---|
166 | . W !!,"No M code embedded in this Mailman message..."
|
---|
167 | ;
|
---|
168 | W !
|
---|
169 | S LP=$NA(^XTMP(XTMP,"M")),ST="^XTMP("""_XTMP_""",""M"","
|
---|
170 | F S LP=$Q(@LP) Q:LP'[ST D
|
---|
171 | . W !,IOINHI,"...",$P(LP,",""M"",",2,99),IOINORM," = "
|
---|
172 | . S POSX=$X,DATA=@LP
|
---|
173 | . F QUIT:DATA']"" D
|
---|
174 | . . W $E(DATA,1,IOM-POSX)
|
---|
175 | . . S DATA=$E(DATA,IOM-POSX+1,999)
|
---|
176 | ;
|
---|
177 | W !!,"You can execute the BEFORE load M code, or the AFTER load M code. The BEFORE"
|
---|
178 | W !,"load M code requires a BEFORE^INIT... node(s). The AFTER load M code"
|
---|
179 | W !,"requires an AFTER^INIT... node(s)."
|
---|
180 | ;
|
---|
181 | I '$D(^XTMP(XTMP,"M","BEFORE"))&('$D(^XTMP(XTMP,"M","AFTER"))) D G MT1 ;->
|
---|
182 | . W !!,"You must add a BEFORE and/or AFTER section to the M code embedded in the"
|
---|
183 | . W !,"Mailman message before you can use this utility to test."
|
---|
184 | ;
|
---|
185 | D MEX("BEFORE")
|
---|
186 | D MEX("AFTER")
|
---|
187 | ;
|
---|
188 | KILL ^XTMP(XTMP)
|
---|
189 | ;
|
---|
190 | W !!,"Done..."
|
---|
191 | ;
|
---|
192 | Q
|
---|
193 | ;
|
---|
194 | MEX(WHEN) ; Called by MTEST to execute ^XTMP(XTMP,"M") code...
|
---|
195 | N X
|
---|
196 | QUIT:'$D(^XTMP(XTMP,"M",WHEN)) ;->
|
---|
197 | W !!,"Press RETURN to execute the ",IOINHI,WHEN,IOINORM
|
---|
198 | W " code, or '^' to skip... "
|
---|
199 | R X:60 I '$T!(X[U) W " no action taken..." QUIT ;->
|
---|
200 | W !,"Executing the ",WHEN," code..."
|
---|
201 | I WHEN="BEFORE" D MPRE
|
---|
202 | I WHEN="AFTER" D MPST
|
---|
203 | W " M code finished..."
|
---|
204 | Q
|
---|
205 | ;
|
---|
206 | UNIT(TXT) ; Load IEN list found by MSG ID... (TXT=MsgID)
|
---|
207 | ; XTMP -- req
|
---|
208 | ;
|
---|
209 | ; Data request line must equal UNIT^#^TYPE (#^TYPE passed in here)
|
---|
210 | ;
|
---|
211 | ; TYPE = "IEN772", "IEN773", or "MSGID"
|
---|
212 | ; # = IEN772, IEN773 or MSGID
|
---|
213 | ;
|
---|
214 | ; The # used to find any IEN772 in the unit.
|
---|
215 | ; All messages in unit found using $$LOAD772S^HLUCM009, and
|
---|
216 | ; formatted by LOADUNIT and returned in email to user.
|
---|
217 | ;
|
---|
218 | N CT,HL772,HLID,HLTYPE,IEN772,IEN773,IEN773,NO772S
|
---|
219 | ;
|
---|
220 | ; Initial sets...
|
---|
221 | S HLID=$P($G(TXT),U) QUIT:HLID']"" ;->
|
---|
222 | S HLTYPE=$P(TXT,U,2) ; IEN772, IEN773, or MSGID
|
---|
223 | S IEN772=""
|
---|
224 | ;
|
---|
225 | ; Try to get IEN772 from MSGID...
|
---|
226 | I HLTYPE="MSGID" D QUIT:'IEN772 ;->
|
---|
227 | . S IEN772=$O(^HL(772,"C",HLID,":"),-1)
|
---|
228 | . I IEN772 D QUIT:IEN772'>0 ;->
|
---|
229 | . . S IEN773=$O(^HLMA("C",HLID,0)) QUIT:IEN773'>0 ;->
|
---|
230 | . . S IEN772=+$G(^HLMA(+IEN773,0))
|
---|
231 | . S IEN773=$O(^HLMA("C",HLID,":"),-1) QUIT:'IEN773 ;->
|
---|
232 | . S IEN772=+$G(^HLMA(+IEN773,0))
|
---|
233 | ;
|
---|
234 | ; If passed IEN772...
|
---|
235 | I HLTYPE="IEN772" D QUIT:IEN772'>0 ;->
|
---|
236 | . QUIT:$G(^HL(772,+HLID,0))']"" ;->
|
---|
237 | . S IEN772=+HLID
|
---|
238 | ;
|
---|
239 | ; If passed IEN773...
|
---|
240 | I HLTYPE="IEN773" D QUIT:IEN772'>0 ;->
|
---|
241 | . S IEN772=+$G(^HLMA(+HLID,0))
|
---|
242 | . QUIT:$G(^HL(772,+IEN772,0))]"" ;-> It's OK
|
---|
243 | . S IEN772=""
|
---|
244 | ;
|
---|
245 | QUIT:$G(^HL(772,+$G(IEN772),0))']"" ;->
|
---|
246 | ;
|
---|
247 | ; Load associated entries...
|
---|
248 | S NO772S=$$LOAD772S^HLUCM009(+IEN772,.HL772) QUIT:NO772S'>0 ;->
|
---|
249 | ;
|
---|
250 | ; Load data...
|
---|
251 | S IEN772=0
|
---|
252 | F S IEN772=$O(HL772("HLPARENT",IEN772)) Q:IEN772'>0 D
|
---|
253 | . S IEN772C=0
|
---|
254 | . F S IEN772C=$O(HL772("HLPARENT",IEN772,IEN772C)) Q:IEN772C'>0 D
|
---|
255 | . . S ^XTMP(XTMP,"HLUNIT",IEN772,IEN772C)=""
|
---|
256 | ;
|
---|
257 | Q
|
---|
258 | ;
|
---|
259 | LOADUNIT ; Load data found by UNIT above...
|
---|
260 | N IEN772C,IEN772P,POSX,TXT
|
---|
261 | ;
|
---|
262 | QUIT:'$D(^XTMP(XTMP,"HLUNIT")) ;->
|
---|
263 | ;
|
---|
264 | D ADDMAIL(""),ADDMAIL($$CJ^XLFSTR(" Msg ID-requested Message Units ",74,"-"))
|
---|
265 | ;
|
---|
266 | S IEN772P=0
|
---|
267 | F S IEN772P=$O(^XTMP(XTMP,"HLUNIT",IEN772P)) Q:IEN772P'>0 D
|
---|
268 | . S TXT=IEN772P_": ",POSX=$L(TXT)
|
---|
269 | . S IEN772C=0
|
---|
270 | . F S IEN772C=$O(^XTMP(XTMP,"HLUNIT",IEN772P,IEN772C)) Q:IEN772C'>0 D
|
---|
271 | . . I ($L(TXT)+$L(IEN772C)+2)>74 D
|
---|
272 | . . . D ADDMAIL(TXT)
|
---|
273 | . . . S TXT=$$REPEAT^XLFSTR(" ",POSX)
|
---|
274 | . . S TXT=TXT_$S($L(TXT)>POSX:",",1:"")_IEN772C
|
---|
275 | . I TXT]"" D ADDMAIL(TXT) S TXT=""
|
---|
276 | ;
|
---|
277 | Q
|
---|
278 | ;
|
---|
279 | ADDMAIL(TXT) D ADDMAIL^HLEVSRV(TXT)
|
---|
280 | Q
|
---|
281 | ;
|
---|
282 | QUITQ(LPVAL,STOP,NOLINE,CT) ; Should looping stop?
|
---|
283 | QUIT:LPVAL']"" 1 ;->
|
---|
284 | QUIT:LPVAL'[STOP 1 ;->
|
---|
285 | QUIT:(CT+1)>NOLINE 1 ;->
|
---|
286 | Q ""
|
---|
287 | ;
|
---|
288 | QUITS(LPVAL,SCREEN) ; Should this be included?
|
---|
289 | N DATA,DIV,MAXNO,OK,PCE,VAL,X
|
---|
290 | S DIV=""
|
---|
291 | S MAXNO=$L(LPVAL,",") I $L(SCREEN,",")'=MAXNO QUIT 1 ;->
|
---|
292 | F PCE=1:1:MAXNO D QUIT:'OK
|
---|
293 | . S OK=0
|
---|
294 | . S X=$P(SCREEN,"#",PCE),DIV=$S(DIV]"":",",1:$E(X,$L(X)))
|
---|
295 | . S DATA(1)=$P(LPVAL,DIV,+PCE) QUIT:DATA(1)']"" ;->
|
---|
296 | . S DATA(2)=$P(SCREEN,DIV,+PCE) QUIT:DATA(2)']"" ;->
|
---|
297 | . I DATA(2)="#" QUIT:DATA(1)'?1.N ;->
|
---|
298 | . I DATA(2)'="#" QUIT:DATA(1)'=DATA(2) ;->
|
---|
299 | . S OK=1
|
---|
300 | S OK='OK ; Because this is a QUIT IF extrinsic function
|
---|
301 | Q OK
|
---|
302 | ;
|
---|
303 | ADDLINE(TXT) D ADDLINE^HLEVSRV(TXT)
|
---|
304 | Q
|
---|
305 | ;
|
---|
306 | EOR ;HLEVSRV0 - Event Monitor SERVER ;5/16/03 14:42
|
---|