source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVUTIL.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: 7.6 KB
Line 
1HLEVUTIL ;O-OIFO/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4SLM() ; Return info to Systems Link Monitor [HLCSMON1]...
5 N BAD,DATA,DATE,DAY,DOWN,FIEN,HR,IEN,IOBON,IOBOFF,LASTDT,MIN,SEC,X
6 ;
7 S X="IOBOFF;IOBON" D ENDR^%ZISS
8 S DOWN="Monitor "_IOBON_"DOWN"_IOBOFF
9 ;
10 I $P($G(^HLEV(776.999,1,0)),U,2)'="A" D QUIT DOWN ;->
11 . S DOWN="Monitor "_IOBON_"STOPPED"_IOBOFF
12 ;
13 S LASTDT=":",FIEN=0
14 F S LASTDT=$O(^HLEV(776.2,"B",LASTDT),-1) Q:'LASTDT!(FIEN) D
15 . S IEN=":"
16 . F S IEN=$O(^HLEV(776.2,"B",+LASTDT,IEN),-1) Q:'IEN!(FIEN) D
17 . . S DATA=$G(^HLEV(776.2,+IEN,0)) QUIT:$P(DATA,U,4)'="Q" ;->
18 . . S FIEN=IEN
19 I 'FIEN QUIT DOWN ;->
20 S DATA=$G(^HLEV(776.2,+FIEN,0))
21 S DATE=$P(DATA,U,6) QUIT:DATE'?7N1"."1.N DOWN ;->
22 S DATE=$$FMTH^XLFDT(DATE),DATE(1)=$$SEC^HLEVMST0(DATE)
23 S NOW=$H,NOW(1)=$$SEC^HLEVMST0(NOW)
24 I DATE(1)<NOW(1) D QUIT $S(BAD:DOWN,1:"Monitor current") ;->
25 . S BAD=0
26 . QUIT:(NOW(1)-DATE(1))<(5*60) ;-> OK if less than 5 minutes old
27 . S BAD=1,DOWN="Monitor "_IOBON_"OVERDUE"_IOBOFF
28 S DIFF=$$DIFFDH^HLCSFMN1(NOW,DATE)
29 S DAY=+DIFF,DIFF=$TR($P(DIFF,U,2),":",U)
30 S HR=+DIFF+(DAY*24),MIN=+$P(DIFF,U,2),SEC=+$P(DIFF,U,3)
31 S:SEC>30 MIN=MIN+1
32 S HR=HR+MIN/60,HR=$J(HR,"",1)
33 Q "Monitor current [next job "_HR_" hr]"
34 ;
35DHMSFM(DTFM,NOW,LONG) ; Convert Fileman d/t to Days-Hr-Min-Sec
36 N HORO
37 QUIT:$G(DTFM)'?7N.1".".10N "" ;->
38 S NOW=$$FMTH^XLFDT($S($G(NOW)?7N.E:NOW,1:$$NOW^XLFDT)) ; Default
39 S HORO=$$FMTH^XLFDT(DTFM)
40 Q $$DHMSH(HORO,NOW,LONG)
41 ;
42DHMSH(DTH,NOW,LONG) ; Convert HORO d/t to Days-Hr-Min-Sec
43 N DIFF,FUTURE,TIME,X
44 S LONG=+$G(LONG)
45 QUIT:$G(DTH)'?5N1","1.N "" ;->
46 S NOW=$S($G(NOW)]"":NOW,1:$H),FUTURE=0
47 I +NOW<DTH!(+NOW=+DTH&($P(NOW,",",2)<$P(DTH,",",2))) D
48 . S X=DTH,DTH=NOW,NOW=X,FUTURE=1
49 S DIFF=$$DIFFDH^HLCSFMN1(DTH,NOW)
50 S TIME=""
51 D C($P(DIFF,U),$S(LONG:$S(+$P(DIFF,U)>1:" days",1:" day"),1:"d"))
52 D C($P($P(DIFF,U,2),":"),$S(LONG:" hr",1:"h"))
53 D C($P($P(DIFF,U,2),":",2),$S(LONG:" min",1:"m"))
54 D C($P($P(DIFF,U,2),":",3),$S(LONG:" sec",1:"s"))
55 F Q:$E(TIME)'=" " S TIME=$E(TIME,2,999)
56 F Q:$E(TIME,$L(TIME))'=" " S TIME=$E(TIME,1,$L(TIME)-1)
57 I FUTURE,TIME]"" S TIME="["_TIME_"]"
58 Q TIME
59 ;
60C(NO,UN) ; Convert to #[UN]...
61 I NO'>0 QUIT ;->
62 S TIME=TIME_$S(TIME]"":" ",1:"")_" "_+NO_UN
63 Q
64 ;
65WPTXT(FILE,IEN,NODE,DDNO,TXT) ; Add text to multiple WP field...
66 N NO
67 QUIT:$G(^HLEV(+FILE,+IEN,0))']"" ;->
68 S NO=$O(^HLEV(+FILE,+IEN,NODE,":"),-1)+1
69 S ^HLEV(+FILE,+IEN,NODE,+NO,0)=$G(TXT)
70 S ^HLEV(+FILE,+IEN,NODE,0)=U_DDNO_U_NO_U_NO
71 Q
72 ;
73DOLRO(SUB,KILL,DAYS) ; Store data in ^XTMP("HLEV-"_SUB)...
74 N NO,NOW,X
75 ;
76 ; Defaults and setup variables...
77 S:$E(SUB,1,5)'="HLEV-" SUB="HLEV-"_SUB
78 S:$G(DAYS)'>0 DAYS=2
79 S NOW=$$NOW^XLFDT
80 ;
81 ; KILL?
82 I $G(KILL)=1 KILL ^XTMP(SUB)
83 ;
84 ; Always reset 0 node...
85 S ^XTMP(SUB,0)=$$FMADD^XLFDT(NOW,DAYS)_U_NOW_"^HL7 Event Monitoring debug code (LJA)"
86 ;
87 ; Store data...
88 S NO=$O(^XTMP(SUB,":"),-1)+1
89 S X=$NA(^XTMP(SUB,NO)),X=$E(X,1,$L(X)-1)_"," D DOLRO^%ZOSV
90 ;
91 Q
92 ;
93UNQUEUE ; Unqueue any future master jobs...
94 N CT,DATA,IEN,LASTDT
95 S LASTDT=":",CT=0
96 F S LASTDT=$O(^HLEV(776.2,"B",LASTDT),-1) Q:'LASTDT!(CT>4) D
97 . S IEN=":"
98 . F S IEN=$O(^HLEV(776.2,"B",+LASTDT,IEN),-1) Q:'IEN!(CT>4) D
99 . . S DATA=$G(^HLEV(776.2,+IEN,0)) QUIT:DATA']"" ;->
100 . . QUIT:$P(DATA,U,4)'="Q" ;-> Not queued for future...
101 . . S TASKNO=$P(DATA,U,5) QUIT:TASKNO'>0 ;->
102 . . D UNQ(+IEN,+TASKNO,"Aborted by installation pre-init.")
103 Q
104 ;
105UNQ(IEN7762,TASKNO,REASON) ; Unqueue Taskman task and mark 776.2 properly...
106 N ZTSK
107 S ZTSK=+TASKNO
108 D DQ^%ZTLOAD
109 D UPDFLDM^HLEVMST(+IEN7762,4,"A")
110 D UPDFLDM^HLEVMST(+IEN7762,50,REASON)
111 Q
112 ;
113PURGEV(HLEVIENM) ; Purge master job entries...
114 N CUTIME,IEN,LOOPTM,NOPURG,RETHRM
115 ;
116 S NOPURG=0
117 ;
118 ; Get retention time (HR) for master job data...
119 S RETHRM=$O(^HLEV(776.999,":"),-1)
120 S RETHRM=$P($G(^HLEV(776.999,+RETHRM,0)),U,4)
121 S RETHRM=$S(RETHRM>0:RETHRM,1:96) ; Default to 96 hours
122 ;
123 ; Cutoff time...
124 S CUTIME=$$FMADD^XLFDT($$NOW^XLFDT,0,-RETHRM)
125 ;
126 F S CUTIME=$O(^HLEV(776,"B",CUTIME),-1) Q:CUTIME'>0 D
127 . S IEN=0
128 . F S IEN=$O(^HLEV(776,"B",CUTIME,IEN)) Q:IEN'>0 D
129 . . S NOPURG=NOPURG+1
130 . . D DELETE(776,+IEN)
131 ;
132 Q NOPURG
133 ;
134PURGEME(IEN7762) ; Purge events "pointed to" by 776.2...
135 ; NOPURG -- req
136 N DATA,IEN776,MIEN
137 S MIEN=0
138 F S MIEN=$O(^HLEV(776.2,+IEN7762,51,MIEN)) Q:'MIEN D
139 . S DATA=$G(^HLEV(776.2,+IEN7762,51,MIEN,0)) Q:DATA']"" ;->
140 . S IEN776=+DATA QUIT:$G(^HLEV(776,+IEN776,0))']"" ;->
141 . D DELETE(776,+IEN776)
142 . S NOPURG=$G(NOPURG)+1
143 Q
144 ;
145 ;
146 ;
147 ;
148 ;
149 ; GENERAL CODE
150PURGEALL(HLEVIENM) ; Purge all EVENT MONITORing files...
151 N NOPURGE,NOPURGM,TXT
152 ;
153 QUIT:$G(^HLEV(776.2,+$G(HLEVIENM),0))']"" ;->
154 ;
155 ; Check parameter...
156 QUIT:$P($G(^HLEV(776.999,1,0)),U,2)'="A" ;->
157 ;
158 S NOPURGM=$$PURGEM^HLEVMST(HLEVIENM) ; Master job data...
159 S NOPURGE=$$PURGEV(HLEVIENM) ; Event job data...
160 QUIT:(NOPURGE+NOPURGM)'>0 ;->
161 S TXT="Purges: "_$S(NOPURGE:"#"_NOPURGE_" events. ",1:"")_$S(NOPURGM:"#"_NOPURGM_" master jobs. ",1:"")
162 D UPDFLDM^HLEVMST(+HLEVIENM,50,TXT)
163 ;
164 Q
165 ;
166DELETE(FILE,IEN) ; Delete entry...
167 N DA,DIK
168 QUIT:$G(^HLEV(+$G(FILE),+$G(IEN),0))']"" ;->
169 S DA=+IEN,DIK="^HLEV("_$G(FILE)_","
170 D ^DIK
171 Q
172 ;
173REMOVALL ; Remove all Event Monitor Job (#776) and HL7 Monitor Master
174 ; Job (#776.2) data. Leave only setup file (#776.1 & 776.999)
175 ; data untouched.
176 N FILE,NODE
177 W @IOF,$$CJ^XLFSTR("Purging of 776 and 776.2 (non-setup) Data",IOM)
178 W !,$$REPEAT^XLFSTR("=",IOM)
179 W !
180 I $O(^HLEV(776,0))'>0&($O(^HLEV(776.2,0))'>0) D QUIT ;->
181 . W !,"There is no data to delete..."
182 F FILE=776,776.2 D
183 . I $O(^HLEV(+FILE,0))'>0 D QUIT ;->
184 . . W !,"No data to delete for file ",FILE,"..."
185 . S X=$$YN^HLCSRPT4("OK to delete file "_FILE_" data","No") I 'X D QUIT ;->
186 . . W " ... not deleted ..."
187 . W " ... deleting!!"
188 . S NODE=$P($G(^HLEV(+FILE,0)),U,1,2)
189 . KILL ^HLEV(+FILE)
190 . S ^HLEV(+FILE,0)=NODE
191 Q
192 ;
193YN(PMT,DEF,FF) ; Generic YES/NO DIR call... ;HL*1.6*85
194 N DIR,DIRUT,DTOUT,DUOUT,X,Y
195 F X=1:1:$G(FF) W !
196 S DIR(0)="Y",DIR("A")=PMT
197 S:$G(DEF)]"" DIR("B")=DEF
198 D ^DIR
199 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) U ;->
200 QUIT $S(Y=1:1,1:"")
201 ;
202ENDIQ1(FILE,IEN,GBLSV) ; Create ^TMP($J,GBLSV,) data...
203 N DA,DIC,DIQ,DR
204 ;
205 KILL ^TMP($J,GBLSV),^UTILITY("DIQ1",$J)
206 ;
207 ; Sets...
208 S DIC=$G(FILE) QUIT:FILE']"" ;->
209 S DR=$$DICDR(FILE) QUIT:DR']"" ;->
210 S DA=+IEN
211 S GBLSV=$S($G(GBLSV)]"":GBLSV,1:"HLEVDIQ")
212 S DIQ(0)="E"
213 ;
214 ; Generate data...
215 D EN^DIQ1
216 ;
217 ; Add more data (usually multiples)...
218 D ADDIQ(FILE,IEN)
219 ;
220 QUIT:'$D(^UTILITY("DIQ1",$J)) ;->
221 ;
222 ; Prep fields and move into ^TMP...
223 D MOVETMP^HLEVUTI3(FILE,IEN,GBLSV)
224 ;
225 KILL ^UTILITY("DIQ1",$J)
226 ;
227 Q
228 ;
229ADDIQ(FILE,IEN,GBLSV) ; Add more data to ^TMP($J,GBLSV)
230 I FILE=772 D ADDMULT(FILE,"^HL(772,"_IEN_",""IN"")",IEN,10,"MESSAGE TEXT",200)
231 I FILE=773 D ADDMULT(FILE,"^HLMA("_IEN_",""MSH"")",IEN,10,"MSH",200)
232 Q
233 ;
234ADDMULT(FILE,GBL,IEN,LIM,FLDNM,FLD) ; Add LIM number of lines of multiple...
235 N MIEN,NO
236 S NO=0,MIEN=0,LIM=$S($G(LIM):LIM,1:10)
237 F S MIEN=$O(@GBL@(MIEN)) Q:MIEN'>0!(NO>LIM) D
238 . S DATA=$G(@GBL@(MIEN,0)) QUIT:$TR(DATA," ","")']"" ;->
239 . S NO=NO+1
240 . S ^UTILITY("DIQ1",$J,FILE,IEN,FLD,"E",NO)=DATA
241 Q
242 ;
243DICDR(FILE) ; Return fields for display by EN^DIQ1...
244 I FILE=772 QUIT ".01:199" ;->
245 I FILE=773 QUIT ".01:999" ;->
246 I FILE=776 QUIT ".01:20" ;->
247 I FILE=776.1 QUIT ".01:20" ;->
248 I FILE=776.2 QUIT ".01:20" ;->
249 I FILE=776.3 QUIT ".01:20" ;->
250 I FILE=776.4 QUIT ".01:20" ;->
251 I FILE=776.999 QUIT ".01:20" ;->
252 I FILE=870 QUIT ".01:18;21;100:499" ;->
253 QUIT ""
254 ;
255LAST D LASTIEN^HLEVUTI3 Q
256LASTIEN D LASTIEN^HLEVUTI3 Q
257LAST772 D LASTIEN^HLEVUTI3 Q
258LAST773 D LASTIEN^HLEVUTI3 Q
259 ;
260EOR ;HLEVUTIL - Event Monitor UTILITIES ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.