source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLEVUTI1.m@ 1240

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

initial load of WorldVistAEHR

File size: 8.1 KB
RevLine 
[613]1HLEVUTI1 ;OIFO-O/LJA - Event Monitor UTILITIES ;02/04/2004 14:42
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;;
4 ;
5 ; Utility to aid in displaying 870 data...
6 ;
7CTRL ;
8 N ABRT,CT,CONT,DATA,DATE,DIC,GBL,HD,IOINHI,IOINORM,L870,LAST
9 N LNM,LNO,LNS,N,NO,NODE,TOT,TXT,WAY,WHAT,X,Y
10 ;
11 S X="IOINHI;IOINORM" D ENDR^%ZISS
12CTRL0 W @IOF,$$CJ^XLFSTR("Logical Link Display",IOM),!,$$REPEAT^XLFSTR("=",IOM)
13 D QUEUES
14 W ! S L870=$$LINK Q:'L870
15 S GBL="^HLCS(870,"_L870_")"
16 S LNM=$$LNM(L870)
17 W " ",LNM
18CTRL1 D SHOWHD(LNM,L870)
19 W !!,"What information for IN and OUT QUEUEs do you want to see?"
20 W !!,"1 Show IENs",!,"2 Show Summary nodes",!,"3 Totals",!,"4 Dots",!,"5 Find skips",!,"6 Message date search"
21 R !!,"Enter #: ",WHAT:99 G:WHAT<1!(WHAT>6) CTRL0 ;->
22 W !!,$$CJ^XLFSTR(" "_IOINHI_LNM_IOINORM_" ",IOM+$L(IOINHI)+$L(IOINORM),"=")
23 S ABRT=0,CONT=0,CT=0
24 S WAY=$$ASKWAY QUIT:WAY[U ;->
25 S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
26 I WHAT=6 D SEARCH(L870,WAY,NO) G CTRL1 ;->
27 S TOT(WAY)=0,LAST=""
28 QUIT:$O(@GBL@(WAY,0))'>0 ;->
29 W !,$$CJ^XLFSTR(" "_$S(WAY=1:"IN",1:"OUT")_" QUEUE ",IOM,"-")
30 I WHAT=3 W !,"Totaling..."
31 F S NO=$O(@GBL@(WAY,NO)) Q:'NO!ABRT D
32 . S CT=CT+1
33 . S NODE=$G(@GBL@(WAY,NO,0)),DATE=$P($G(@GBL@(WAY,NO,1,0)),U,5)
34 . S TXT=$G(@GBL@(WAY,NO,1,1,0))
35 . S TXT=$E(DATE_" ",1,10)_$E(NODE_" ",1,12)_" "_$E(TXT,1,56)
36 . I WHAT=1 W:($X+$L(NO)+1)>IOM ! W:$X>0 "," W NO
37 . I WHAT=2 D
38 . . W !,TXT
39 . I WHAT=3 W:'(CT#5000) "." S TOT(WAY)=TOT(WAY)+1
40 . I WHAT=4 Q:$$CT W "."
41 . I WHAT=5 D
42 . . I LAST,+LAST'=(NO-1) D
43 . . . W !,+LAST,?10," ",$E($P(LAST,"~",2,999),1,IOM-$X)
44 . . . W !,+NO,?10," ",$E(TXT,1,69)
45 . . S LAST=NO_"~"_TXT
46 . I 'CONT,'(CT#20) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
47 I 'ABRT,TOT(WAY) W !,"--- Total = #",TOT(WAY)
48 S ABRT="",CT=0
49 ;
50 R !,"End of output... ",X:999
51 ;
52 W !!,$$CJ^XLFSTR(" "_LNM_" ",IOM,"=")
53 ;
54 G CTRL1 ;->
55 ;
56SHOWHD(LNM,L870) ; Show summary information...
57 N NODE
58 W !!,$$REPEAT^XLFSTR("=",IOM)
59 F NODE=0,100,200,300,400,"IN QUEUE BACK POINTER","IN QUEUE FRONT POINTER","OUT QUEUE BACK POINTER","OUT QUEUE FRONT POINTER" D
60 . S DATA=$G(@GBL@(NODE)) Q:DATA']"" ;->
61 . D PHD(NODE,DATA)
62 W !,$$REPEAT^XLFSTR("=",IOM)
63 Q
64 ;
65CT() QUIT:(CT#500) ""
66 R X:999 Q:X']"" ""
67 S ABRT=1
68 Q 1
69 ;
70PHD(HD,DATA) ;
71 S HD=$$HD(HD)
72 S HD=$E(" ",1,4-$L(HD))_HD
73 W !,HD,"="
74 F D QUIT:DATA']""
75 . QUIT:DATA']""
76 . W $E(DATA,1,76)
77 . S DATA=$E(DATA,77,999)
78 . W:DATA]"" !,?4
79 Q
80 ;
81HD(HD) ;
82 I HD["IN QUEUE F" S HD="IQFP"
83 I HD["IN QUEUE B" S HD="IQBP"
84 I HD["OUT QUEUE F" S HD="OQFP"
85 I HD["OUT QUEUE B" S HD="OQBP"
86 Q HD
87 ;
88LINK() N DIC,X,Y
89 S DIC=870,DIC(0)="AEMQN",DIC("A")="Select LINK: "
90 D ^DIC
91 QUIT $S(+Y:+Y,1:"")
92 ;
93QUEUES N LNM,LNO
94 KILL ^TMP($J,"ZZLJA")
95 S LNM=""
96 F S LNM=$O(^HLCS(870,"B",LNM)) Q:LNM']"" D
97 . S LNO=0
98 . F S LNO=$O(^HLCS(870,"B",LNM,LNO)) Q:'LNO D
99 . . S LNS=$$LNM(LNO)
100 . . I $O(^HLCS(870,+LNO,1,0))>0 D
101 . . . S ^TMP($J,"ZZLJA",LNS,1)=$P($G(^HLCS(870,+LNO,1,0)),U,3)
102 . . I $O(^HLCS(870,+LNO,2,0))>0 D
103 . . . S ^TMP($J,"ZZLJA",LNS,2)=$P($G(^HLCS(870,+LNO,2,0)),U,3)
104 ;
105 W !!,"Links with queues"
106 W !,"Link",?30,"IQ Totals",?45,"OQ Totals"
107 W !,$$REPEAT^XLFSTR("-",IOM)
108 ;
109 S LNS=""
110 F S LNS=$O(^TMP($J,"ZZLJA",LNS)) Q:LNS']"" D
111 . W !
112 . W:LNS["Mail]" IOINHI W $E(LNS_" --------------------",1,20),IOINORM
113 . F WAY=1,2 D
114 . . S TOT=$G(^TMP($J,"ZZLJA",LNS,WAY))
115 . . S TOT=$E("---------------",1,15-$L(TOT))_TOT
116 . . W TOT
117 ;
118 KILL ^TMP($J,"ZZLJA")
119 ;
120 Q
121 ;
122LNM(L870) N GBL,X
123 S GBL="^HLCS(870,"_L870_")",X=$G(@GBL@(0))
124 Q $P(X,U)_" #"_L870_" ["_$P("Mail^HLLP^X3.28^TCP",U,+$P(X,U,3))_"] "
125 ;
126ASKNO(LNM,L870,WAY) ; Ask for beginning IEN to display...
127 N DIR,DIRUT,DTOUT,DUOUT,FIRST,LAST,X,Y
128 S FIRST=$O(^HLCS(870,+L870,WAY,0))
129 S LAST=$O(^HLCS(870,+L870,WAY,":"),-1)
130 W !!,"First IEN = ",FIRST
131 W !," Last IEN = ",LAST
132 W !
133 S DIR(0)="N^"_FIRST_":"_LAST,DIR("A")="Enter IEN"
134 I FIRST S DIR("B")=FIRST
135 D ^DIR
136 QUIT:$D(DIRUT)!($D(DTOUT))!($D(DUOUT)) U ;->
137 QUIT:+Y>0 (+Y-1) ;-> Will be used for $ORDER
138 Q 0
139 ;
140ASKWAY() ; In or Out...
141 N DIR,DIRUT,DTOUT,DUOUT,X,Y
142 S DIR(0)="S^1:Inbound Queue;2:Outbound Queue"
143 S DIR("A")="Select QUEUE"
144 D ^DIR
145 QUIT:+Y>0&(+Y<3) $P("1^2",U,+Y)
146 Q U
147 ;
148SEARCH(L870,WAY,NO,SKIP) ; Search for a date...
149 ; LNM -- req
150 N ABRT,CONT,CT,NUM
151 I '$D(SKIP) N SKIP
152S1 S SKIP=$S($G(SKIP):+SKIP,1:5000),ABRT=0,CT=0,CONT=0
153 S NUM=NO-1,NUM=$O(^HLCS(870,+L870,WAY,NUM))
154 W !!
155 D SRCH1(L870,WAY,+NUM)
156 F D QUIT:NUM'>0!(ABRT)
157 . S NUM=NUM+SKIP
158 . S NUM=$O(^HLCS(870,+L870,WAY,NUM)) QUIT:NUM'>0 ;->
159 . D SRCH1(L870,WAY,+NUM)
160 W !,"Just completed a search using a starting point of IEN=",NO,", and an offset"
161 W !,"of #",SKIP,". You may now enter a new starting IEN and offset."
162 W !
163 S NO=$$ASKNO(LNM,L870,WAY) QUIT:NO[U ;->
164 R !,"Enter OFFSET: ",OFFSET:90 I OFFSET>0 S SKIP=OFFSET G S1 ;->
165 Q
166 ;
167SRCH1(L870,WAY,IEN) ; Show date of entry...
168 N MSH,DATE,DEL
169 S MSH=$G(^HLCS(870,+L870,WAY,IEN,1,1,0))
170 S DEL=$E(MSH,4),DATE=$P(MSH,DEL,7)
171 S DATE=$S(DATE?14N.1"-".N:$$HTFM^XLFDT(DATE),1:"")
172 S DATE=$S(DATE?7N.E:DATE,1:$P($G(^HLCS(870,+L870,WAY,IEN,1,0)),U,5))
173 QUIT:DATE'?7N.E ;->
174 W $J($$SDT(DATE)_"(#"_IEN_")",18)_" "
175 S CT=CT+1
176 I 'CONT,'(CT#80) R X:999 S:X[U ABRT=1 S:X=" " CONT=1
177 Q
178 ;
179SDT(DATE) ; Return shortened form of date...
180 I DATE?7N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3) ;->
181 I DATE?7N1"."1.N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)_"@"_$E($P($$FMTE^XLFDT(DATE),"@",2),1,5)
182 QUIT ""
183 ;
184TEST ; Hardwire IENs and test M code in monitor (only)...
185 N IEN,MCODE,STATE,WAY
186 ;
187 W @IOF,$$CJ^XLFSTR("Monitor Test Utility",IOM)
188 W !,$$REPEAT^XLFSTR("=",IOM)
189 W !,"This utility sets the ^TMP(""HLEVFLAG"",$J) node to ""STOP"" to avoid any"
190 W !,"Event Monitor activity. This enables the debugging of M code."
191 ;
192 S STATE=$G(^TMP("HLEVFLAG",$J))
193 ;
194 F D QUIT:'IEN
195 . W !
196 . S IEN=$$ASKIEN^HLEVREP(776.1) QUIT:'IEN ;->
197 .
198 . S MCODE=$TR($P($G(^HLEV(776.1,+IEN,0)),U,6),"~",U)
199 . I MCODE']"" W " no M code found..." QUIT ;->
200 . W !!,"M code = ",MCODE
201 .
202 . W !!,"You may ZG ",MCODE," or D ",MCODE,"..."
203 . W !
204 . S WAY=$$YN^HLCSRPT4("DO the MCODE","Yes")
205 . S WAY=$S(WAY=1:1,1:2) ; 1=DO, 2=ZG
206 .
207 . W !
208 . I '$$YN^HLCSRPT4("OK to test now","Yes") D QUIT ;->
209 . . W " no action taken..."
210 .
211 . S ^TMP("HLEVFLAG",$J)="STOP"
212 .
213 . D TESTRUN
214 .
215 . KILL ^TMP("HLEVFLAG",$J)
216 . W !!,$$REPEAT^XLFSTR("-",IOM)
217 ;
218 I STATE]"" S ^TMP("HLEVFLAG",$J)=STATE
219 ;
220 Q
221 ;
222TESTRUN ; Call here from above to avoid LEVEL ERRORs with ZGo...
223 ; MCODE,WAY -- req
224 I WAY=1 D
225 . W " DOing ",MCODE,"... "
226 . D @MCODE
227 I WAY=2 D
228 . W " ZGOing ",MCODE,"... "
229 . X "ZG "_@MCODE
230 Q
231 ;
232COLLECT(I772) ; Collect 772 & 773 data...
233 N CT,I773
234 D ADD(""),ADD($$CJ^XLFSTR(" 772# "_I772_" ",74,"-"))
235 S I773=0,CT=0
236 F S I773=$O(^TMP($J,"HLIEN",IEN,I773)) Q:'I773 D
237 . I CT>0 D ADD("")
238 . D COLL773(+I773)
239 . S CT=CT+1
240 D ADD($$CJ^XLFSTR("----------------------------------------",74))
241 D COLL772(+I772)
242 Q
243 ;
244COLL773(I773) ;
245 N LP,ST
246 S LP="^HLMA("_I773,ST=LP_",",LP=LP_")"
247 F S LP=$Q(@LP) Q:LP'[ST D
248 . D ADD(LP_"="_@LP)
249 Q
250 ;
251COLL772(I772) ;
252 N CT,LASTIN,LP,ST
253 S LP="^HL(772,"_I772,ST=LP_",",LP=LP_")",CT=0,LASTIN=""
254 F S LP=$Q(@LP) Q:LP'[ST D
255 . I $TR(LP,"""","")?1"^HL(772,"1.N1",IN,"1.N.E D QUIT:CT>5 ;->
256 . . S CT=CT+1
257 . . I CT=7 D ADD("... some data not shown ...")
258 . . S LASTIN=LP
259 . D ADD(LP_"="_@LP)
260 I LASTIN]"",CT>6 D ADD(LASTIN_"="_@LASTIN)
261 Q
262 ;
263ADD(TXT) ; Add text for report...
264 ; SCRN -- req
265 N NO,POSX
266 S POSX=$L($P(TXT,"="))+1
267 F D QUIT:TXT']""
268 . I 'SCRN D ; Store for email message...
269 . . S NO=$O(^TMP($J,"HLMAIL",":"),-1)+1
270 . . S ^TMP($J,"HLMAIL",+NO)=$E(TXT,1,74)
271 . I SCRN W !,$E(TXT,1,74) ; Display on-screen
272 . S TXT=$E(TXT,75,999) QUIT:TXT']"" ;->
273 . S TXT=$$REPEAT^XLFSTR(" ",$S(POSX:POSX,1:5))_TXT
274 Q
275 ;
276DOLRO(TAG,SNO) ; Store debug data in ^XTMP("HLEVUTI1 "_DT,NO)...
277 N NO,X,XTMP
278 ;
279 S XTMP="HLEVUTI1 "_TAG_"-"_DT
280 S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,1)_U_$$NOW^XLFDT_"^Debug data created by DOLRO~HLEVUTI1"
281 ;
282 S NO=$O(^XTMP(XTMP,":"),-1)+1,NO=$S(NO>($G(SNO)-1):NO,1:SNO)
283 ;
284 S X="^XTMP("""_XTMP_""","_NO_"," D DOLRO^%ZOSV
285 ;
286 Q
287 ;
288EOR ;HLEVUTI1 - Event Monitor UTILITIES ;5/16/03 14:42
Note: See TracBrowser for help on using the repository browser.