source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLDIEDB0.m@ 681

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1HLDIEDB0 ;CIOFO-O/LJA - Debug Data Display Code ;12/29/03 10:39
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
3 ;
4FILEIEN ; Input FILE,IEN to find debug data to display...
5 N ABORT,CT,DATE,FILE,GBL,GCT,IEN,JOB,LOC,RTN,X
6 ;
7 W @IOF,$$CJ^XLFSTR("Debug Data Display by FILE,IEN",IOM)
8 W !,$$REPEAT^XLFSTR("=",IOM)
9 ;
10 I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
11 . W !!,"No debug data exists..."
12 . H 1
13 ;
14 S GBL="^XTMP(""HLDIE-DEBUGX"")"
15 ;
16 F D QUIT:'FILE ;->
17 . D SF
18 . R !!,"Enter FILE#: ",FILE:99 Q:FILE']""!(FILE[U) ;->
19 . F D QUIT:'IEN ;->
20 . . D SI(FILE)
21 . . R !!,"Enter IEN: ",IEN:99 Q:'IEN ;->
22 . . W !!,?2,"#",?5,"File & IEN",?20,"Date",?35,"Job#",?50,"Rtn",?68,"Debug#"
23 . . W !,$$REPEAT^XLFSTR("=",IOM)
24 . . KILL ^TMP($J,"H")
25 . . S DATE=0,ABORT=0,GCT=0
26 . . F S DATE=$O(@GBL@(FILE,IEN,DATE)) Q:'DATE!(ABORT) D
27 . . . S JOB=0
28 . . . F S JOB=$O(@GBL@(FILE,IEN,DATE,JOB)) Q:'JOB!(ABORT) D
29 . . . . S RTN=""
30 . . . . F S RTN=$O(@GBL@(FILE,IEN,DATE,JOB,RTN)) Q:RTN']""!(ABORT) D
31 . . . . . S LOC=""
32 . . . . . F S LOC=$O(@GBL@(FILE,IEN,DATE,JOB,RTN,LOC)) Q:LOC']""!(ABORT) D
33 . . . . . . S GCT=GCT+1
34 . . . . . . S ^TMP($J,"H",GCT)=DATE_U_JOB_U_RTN_U_LOC
35 . . . . . . W !,$J(GCT,3),?5,FILE,"[#",IEN,"]",?20,DATE,?35,JOB,?50,RTN,?68,LOC
36 . . F D QUIT:'GCT
37 . . . R !!,"Enter #: ",GCT:99 Q:'GCT ;->
38 . . . S X=$G(^TMP($J,"H",+GCT)),DATE=+X,JOB=$P(X,U,2),RTN=$P(X,U,3),LOC=$P(X,U,4) QUIT:LOC']"" ;->
39 . . . D INDIV(DATE\1,JOB,RTN,LOC)
40 . . . W !,$$REPEAT^XLFSTR("-",IOM)
41 ;
42 KILL ^TMP($J,"H")
43 ;
44 Q
45 ;
46SF ; Show files...
47 ; GBL -- req
48 N CT,FILE
49 W !!,$$CJ^XLFSTR(" Files w/Debug Data ",IOM,"=")
50 S CT=0,FILE=0
51 F S FILE=$O(@GBL@(FILE)) Q:'FILE D
52 . S CT=CT+1 W:CT>1 ", "
53 . W FILE
54 W !,$$REPEAT^XLFSTR("-",IOM)
55 Q
56 ;
57SI(FILE) ; Show IENs for file...
58 ; GBL -- req
59 N CT,IEN
60 W !!,$$CJ^XLFSTR(" IENs w/Debug Data for File# "_FILE_" ",IOM,"=")
61 S CT=0,IEN=0
62 F S IEN=$O(@GBL@(FILE,IEN)) Q:'IEN!(CT>100) D
63 . S CT=CT+1
64 . W:$X>65 ! W:$X<6 ?6 W:$X>6 ","
65 . W IEN
66 I CT>100 D
67 . W !!,"Some IENs not displayed (because there were too many)..."
68 . W !,"(The LAST IEN is ",$O(@GBL@(FILE,":"),-1),".)"
69 W !,$$REPEAT^XLFSTR("-",IOM)
70 Q
71 ;
72SEARCH ; Search of global data to find & display...
73 N ABORT,CONT,CT,DATA,FIND,LP,ORIG,POSX,SRCH,ST,X
74 ;
75 W @IOF,$$CJ^XLFSTR("Debug Data Display by Global Search",IOM)
76 W !,$$REPEAT^XLFSTR("=",IOM)
77 ;
78 I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
79 . W !!,"No debug data exists..."
80 . H 1
81 ;
82S1 KILL SRCH
83 ;
84 F R !!,"Search string: ",SRCH:999 Q:SRCH']""!(SRCH=U) D
85 . S SRCH($$UP^XLFSTR(SRCH))=""
86 ;
87 QUIT:$O(SRCH(""))']"" ;->
88 ;
89 W !!,"Searching..."
90 ;
91 S CT=0,ABORT=0,CONT=0
92 ;
93 S LP="^XTMP(""HLDIE-DEBUF""",ST="^XTMP(""HLDIE-DEBUG",LP=LP_")"
94 F S LP=$Q(@LP) Q:LP'[ST!(ABORT) D
95 . S ORIG=@LP,DATA=$$UP^XLFSTR(ORIG),FIND=0,SRCH=""
96 . F S SRCH=$O(SRCH(SRCH)) Q:SRCH']""!(FIND) D
97 . . QUIT:DATA'[SRCH&(LP'[SRCH) ;->
98 . . S FIND=1
99 . QUIT:'FIND ;->
100 . W !,LP,"="
101 . W:$X>55 !,?10,"-> "
102 . S POSX=$X
103 . F D QUIT:ORIG']""
104 . . W:$X>POSX ! W:$X<POSX ?POSX
105 . . W $E(ORIG,1,IOM-POSX)
106 . . S ORIG=$E(ORIG,IOM-POSX+1,999)
107 . QUIT:CONT ;->
108 . S CT=CT+1 Q:(CT#10) ;->
109 . W " <-" R X:99 S:X]""&(X'=" ") ABORT=1 S:X=" " CONT=1
110 ;
111 I ABORT=1 W !!,"... aborting ..."
112 ;
113 G S1 ;->
114 ;
115API ; Select RTN & SUBRTN to find & show debug data...
116 N DATE,FILE,MAX,NUM,RTN,SUB
117 ;
118 W @IOF,$$CJ^XLFSTR("Debug Data Display by API Call",IOM)
119 W !,$$REPEAT^XLFSTR("=",IOM)
120 ;
121 I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
122 . W !!,"No debug data exists..."
123 . H 1
124 ;
125 W !
126 D COLLECT
127 D SHOW
128 ;
129R1 R !!,"File: ",FILE:99 QUIT:FILE']"" ;->
130 I '$D(^XTMP("HLDIE-DEBUGX",FILE)) D G R1 ;->
131 . W " no data..."
132 ;
133 R !,"Rtn: ",RTN:99 G:RTN']"" R1 ;->
134 R !,"Subrtn: ",SUB:99 G:SUB']"" R1 ;->
135 S RTN=RTN_"~"_SUB
136 ;
137 R !,"Max#: 20// ",MAX:99 S:MAX']"" MAX=20
138 S MAX=$S(MAX:MAX,1:20)
139 ;
140 F D QUIT:DATE']"" ;->
141 . KILL ^TMP($J,"R")
142 . R !!,"Enter Date/time (FM): ",DATE:99 QUIT:DATE']"" ;->
143 . I DATE'?7N.E W " invalid format..." QUIT ;->
144 .
145 . W !
146 . D SHOWDT(FILE,DATE,RTN,MAX)
147 . QUIT:'$D(^TMP($J,"R")) ;->
148 .
149 . F D QUIT:NUM']""!(NUM[U)
150 . . R !!,"Enter # to display: ",NUM:99 Q:NUM']""!(NUM[U) ;->
151 . . I '$D(^TMP($J,"R",NUM)) D QUIT ;->
152 . . . W " entry not found..."
153 . . D SHOWONE(+NUM)
154 ;
155 H 2
156 ;
157 D SHOW
158 ;
159 G R1 ;->
160 ;
161SHOWONE(NUM) ; REquires ^TMP($J,"R",NUM)
162 N DATA,DATE,FILE,IEN,JOB,LOC,RTN
163 ;
164 S DATA=^TMP($J,"R",NUM)
165 ;
166 S FILE=+DATA,IEN=$P(DATA,U,2),DATE=$P(DATA,U,3)\1
167 S JOB=$P(DATA,U,4),RTN=$P(DATA,U,5),LOC=$P(DATA,U,6)
168 ;
169 D INDIV(DATE,JOB,RTN,LOC)
170 ;
171 Q
172 ;
173INDIV(DATE,JOB,RTN,LOC) ; Display entry's data from ^XTMP global...
174 N LP,REF,ST
175 ;
176 S LP="^XTMP(""HLDIE-DEBUG-"_DATE_""","_JOB_","""_RTN_""","_LOC
177 S ST=LP,LP=LP_")"
178 ;
179 W !!,"...",$P(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2),"="
180 D SDATA($X,$G(@LP))
181 ;
182 F S LP=$Q(@LP) Q:LP'[ST D
183 . S REF=$P(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2)_"="
184 . W !,"...",REF
185 . D SDATA($X,@LP)
186 ;
187 W !
188 ;
189 Q
190 ;
191SDATA(POSX,DATA) ; Show data...
192 ;
193 F D Q:DATA']""
194 . QUIT:DATA']"" ;->
195 . W:$X>POSX ! W:$X<POSX ?POSX
196 . W $E(DATA,1,IOM-POSX)
197 . S DATA=$E(DATA,IOM-POSX+1,999)
198 ;
199 Q
200 ;
201SHOWDT(FILE,DATE,RTN,MAX) ; Show entries and create ^TMP($J,"R")...
202 N ABORT,CT,DATA,GBL,IEN,JOB,JOBLAST,LDT,NO,NUM
203 ;
204 S GBL="^XTMP(""HLDIE-DEBUGX"","_FILE_")"
205 ;
206 D SHOWDTHD
207 ;
208 S IEN=0,CT=0,ABORT=0,JOBLAST=""
209 F S IEN=$O(@GBL@(IEN)) Q:'IEN!(CT'<MAX) D
210 . S LDT=DATE-.0000000001
211 . F S LDT=$O(@GBL@(IEN,LDT)) Q:'LDT D
212 . . S JOB=0
213 . . F S JOB=$O(@GBL@(IEN,LDT,JOB)) Q:JOB'>0 D
214 . . . S NO=$O(@GBL@(IEN,LDT,JOB,RTN,":"),-1)/2\1 QUIT:'NO ;->
215 . . . S NUM=0
216 . . . F S NUM=$O(@GBL@(IEN,LDT,JOB,RTN,NUM)) Q:'NUM D
217 . . . . S CT=CT+1
218 . . . . S DATA=$G(@GBL@(IEN,LDT,JOB,RTN,NUM))
219 . . . . S ^TMP($J,"R",CT)=FILE_U_IEN_U_LDT_U_JOB_U_RTN_U_NUM
220 . . . . I JOBLAST'=""&(JOBLAST) W ! S JOBLAST=0
221 . . . . D EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,+DATA)
222 . . . S JOBLAST=JOB
223 ;
224 Q
225 ;
226EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,LOC) ;
227 W !,$J(CT,3),?5,FILE,?15,+IEN,?25,"@",$P(LDT,".",2)
228 W ?35,JOB,?50,RTN,?70,LOC,$S(LOC=1:"<-Beg",1:"")
229 Q
230 ;
231SHOWDTHD ;
232 W !!,"#",?5,"File",?15,"IEN",?25,"Time",?35,"Job#",?50,"Location"
233 W ?70,"Call#"
234 W !,$$REPEAT^XLFSTR("=",IOM)
235 Q
236 ;
237SHOW ;
238 N CT,DATE,FILE,RTN
239 ;
240 W !!,"File",?17,"Date",?40,"API"
241 W !,$$REPEAT^XLFSTR("=",IOM)
242 ;
243 S FILE=0
244 F S FILE=$O(^TMP($J,"D",FILE)) Q:'FILE D
245 . W !,FILE," [#",^TMP($J,"D",FILE),"]"
246 . S DATE=0
247 . F S DATE=$O(^TMP($J,"D",FILE,DATE)) Q:'DATE D
248 . . W:$X>17 ! W:$X<17 ?17
249 . . W DATE," [#",^TMP($J,"D",FILE,DATE),"]"
250 . . S RTN=""
251 . . F S RTN=$O(^TMP($J,"D",FILE,DATE,RTN)) Q:RTN']"" D
252 . . . W:$X>40 ! W:$X<40 ?40
253 . . . W RTN," [#",^TMP($J,"D",FILE,DATE,RTN),"]"
254 ;
255 Q
256 ;
257COLLECT ; Collect data into ^TMP($J,"D")...
258 N DATE,FILE,IEN,JOB,LOC,RTN
259 ;
260 KILL ^TMP($J)
261 ;
262 S FILE=0
263 F S FILE=$O(^XTMP("HLDIE-DEBUGX",FILE)) QUIT:'FILE D
264 . S IEN=0
265 . F S IEN=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN)) Q:'IEN D
266 . . S DATE=0
267 . . F S DATE=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE)) Q:'DATE D
268 . . . ; HLDIE-DEBUGX data hangs around longer...
269 . . . QUIT:'$D(^XTMP("HLDIE-DEBUG-"_(DATE\1))) ;->
270 . . . S JOB=0
271 . . . F S JOB=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB)) Q:'JOB D
272 . . . . S RTN=""
273 . . . . F S RTN=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN)) Q:RTN']"" D
274 . . . . . S LOC=0
275 . . . . . F S LOC=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN,LOC)) Q:'LOC D
276 . . . . . . D COLL1(FILE,IEN,DATE\1,JOB,RTN,LOC)
277 ;
278 Q
279 ;
280COLL1(FILE,IEN,DATE,JOB,RTN,LOC) ; Called by COLLECT...
281 ;
282 S ^TMP($J,"D",FILE)=$G(^TMP($J,"D",FILE))+1
283 S ^TMP($J,"D",FILE,DATE)=$G(^TMP($J,"D",FILE,DATE))+1
284 S ^TMP($J,"D",FILE,DATE,RTN)=$G(^TMP($J,"D",FILE,DATE,RTN))+1
285 ;
286 Q
287 ;
288ONLYASC(TXT) ; Return ASCII only. No CTRL characters...
289 N ASCII,CHAR,NTXT,POS
290 S NTXT=""
291 F POS=1:1:$L(TXT) D
292 . S CHAR=$E(TXT,+POS),ASCII=$A(CHAR)
293 . I ASCII<32 S CHAR="{"_ASCII_"}"
294 . S NTXT=NTXT_CHAR
295 QUIT NTXT
296 ;
297EOR ;HLDIEDBO - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
Note: See TracBrowser for help on using the repository browser.