source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLDIEDBG.m@ 1259

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

initial load of WorldVistAEHR

File size: 7.3 KB
Line 
1HLDIEDBG ;CIOFO-O/LJA - Direct 772 & 773 Sets DEBUG CODE ;12/29/03 10:39
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
3 ;
4 ; D MENU^HLDIE to invoke debug menu. Debugger documentation included.
5 ;
6MENU ; Additional documentation available in INIT^HLDIEDB1...
7 D INIT^HLDIEDB1
8 Q
9 ;
10SETDEBUG ; Set or "unset" the DEBUG string...
11 N IOBOFF,IOBON,IOINHI,IOINORM,NEWSTR,STRING,X
12 W @IOF,$$CJ^XLFSTR("HLDIE Debug String Set/Unset Utility",IOM)
13 W !,$$REPEAT^XLFSTR("=",IOM)
14 ;
15 S X="IOINHI;IOINORM" D ENDR^%ZISS
16 ;
17 ; Ask for a new string...
18 W !!,"When asked for a new debug string, you may take one of the following actions:"
19 W !!," * Enter RETURN or '^' to exit."
20 W !," * Enter a debug string. (E.g., '1' or '1^2' or '1^1^1'.)"
21 W !," * Enter '@' to delete the debug string, (If a debug string exists)."
22 ;
23SET1 ;
24 ; Get current DEBUG value...
25 S STRING=$G(^XTMP("HLDIE-DEBUG","STATUS"))
26 ;
27 ; Show user current value...
28 W !!!!,"Current DEBUG string = ",IOINHI,STRING,IOINORM
29 ;
30 ; Get new debug string...
31 W !!,"Enter DEBUG string, ",$S(STRING]"":"'@', ",1:""),"or RETURN to exit: "
32 R NEWSTR:999 QUIT:'$T ;->
33 ;
34 ; Exit conditions...
35 I NEWSTR=U!(NEWSTR']"") D QUIT ;->
36 . I STRING']"" D QUIT ;->
37 . . W " no changes made. Exiting... "
38 . . H 2
39 . W !!,"No changes made. (If you want to stop debugging, enter '"
40 . W IOINHI,"@",IOINORM,"'.) Exiting..."
41 ;
42 ; Reset to null if @...
43 I NEWSTR="@" S NEWSTR=""
44 ;
45 ; User didn't change anything!!!
46 I NEWSTR=STRING W " no changes made... " G SET1 ;->
47 ;
48 ; If debug string to be set to null...
49 I NEWSTR']"" D G SET1 ;->
50 . KILL ^XTMP("HLDIE-DEBUG","STATUS")
51 . W " stopped all debugging!"
52 ;
53 ; Debug string has text, so just set it...
54 S ^XTMP("HLDIE-DEBUG",0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Control string for HLDIE debugging"
55 S ^XTMP("HLDIE-DEBUG","STATUS")=NEWSTR
56 W " debugging set..."
57 ;
58 Q
59 ;
60 ;
61 ; ================================================================
62 ;
63 ;
64DEBUG(RTN,LOC,STORE,XEC) ; Store debug data... (Don't call unless all
65 ; checks have been made and debug data IS to be stored!)
66 ;
67 ; ROOT() -- req
68 ;
69 ; RTN -- Where (subrtn~rtn, usually) call to FILE^HLDIE made from.
70 ;
71 ; LOC -- Location... BEFORE FILE^HLDIE call = 1
72 ; AFTER FILE^HLDIE call = 2
73 ;
74 ; STORE -- "" = Don't collect
75 ; 1 = Collect "select" (see above) data.
76 ; 2 = Collect "all" data.
77 ;
78 ; XEC -- If XEC=1 then S STORE=$$STORE^HLDIEDB0(RTN,LOC,STORE) is
79 ; called to optionally change the value of STORE (and thus
80 ; control whether data is stored.)
81 ;
82 N CT,DEBUGNO,DEBUGNOW,HLFILE,HLIEN,INCRNO,NO,X,XTMP
83 ;
84 S DEBUGNOW=$$NOW^XLFDT,DT=DEBUGNOW\1
85 ;
86 ; Get file and ien for storing in XTMP...
87 S FILE=$G(FILE),IEN=$G(IEN)
88 I FILE,IEN S HLFILE=FILE,HLIEN=IEN
89 I 'FILE!('IEN) D
90 . S (HLFILE,HLIEN)=0
91 . I $G(ROOT)]"" S HLFILE=$O(@ROOT@(0)),HLIEN=+$O(@ROOT@(+HLFILE,""))
92 ;
93 ; Get storage number...
94 S DEBUGNO=$O(^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,":"),-1)+1
95 ;
96 ; How many stored? Can't store more than 20...
97 S CT=0,NO=0
98 F S NO=$O(^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,NO)) Q:'NO D
99 . S CT=CT+1
100 ;
101 ; If M code passed, check w/^DIM, then execute.
102 I XEC=1 S STORE=$$STORESCR^HLDIEDB2(RTN,LOC,STORE) QUIT:'STORE ;->
103 ;
104ERRESUME ; If $$STORESCR code errors, there has to be a place for
105 ; error trapping to GOTO. This is that place...
106 ;
107 ; Quit if 20 occurences stored...
108 QUIT:CT'<20 ;->
109 ;
110 ; Zero node & XTMP...
111 ;
112 ; Debug data retained for 7 days...
113 S XTMP="HLDIE-DEBUG-"_DT
114 S:$G(^XTMP(XTMP,0))']"" ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_DEBUGNOW_U_"Debug data created by HLDIEDBG routine"
115 ;
116 ; Xref data retain for 7 days from last time any DEBUG data created...
117 S XTMP="HLDIE-DEBUGX"
118 S:$G(^XTMP(XTMP,0))']"" ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Debug data created by HLDIEDBG routine"
119 I $P(^XTMP(XTMP,0),U)'=$$FMADD^XLFDT(DT,7) S $P(^XTMP(XTMP,0),U)=$$FMADD^XLFDT(DT,7)
120 ;
121 ; Get incremental number...
122 S INCRNO=$I(^XTMP("HLDIE-DEBUGN","N"),1)
123 ;
124 ; Do following for STORE=1 and STORE=2...
125 S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,+DEBUGNO)=LOC_U_DEBUGNOW_U_$G(HLFILE)_U_$G(HLIEN)_U_$TR($P($G(XQY0),U,1,2),U,"~")_U_$TR($G(HLEDITOR),U,"~")
126 D STOREMSG(+$G(HLFILE),+$G(HLIEN),RTN,DEBUGNO,LOC,INCRNO)
127 ;
128 ; Store "select" data...
129 I STORE=1,LOC'=2,$G(ROOT)]"" D QUIT ;->
130 . MERGE ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,+DEBUGNO)=@ROOT
131 ;
132 QUIT:STORE'=2 ;->
133 ;
134 ; Store "all" local variable data...
135 S X="^XTMP(""HLDIE-DEBUG-"_DT_""","_$J_","""_RTN_""","_DEBUGNO_","
136 D DOLRO^%ZOSV
137 ;
138 D ONLYASC(X)
139 ;
140 Q
141 ;
142ONLYASC(REF) ; Convert control characters to {ASCII}...
143 N DATA,LP
144 ;
145 S LP=$E(REF,1,$L(REF)-1)_")"
146 F S LP=$Q(@LP) Q:LP'[REF D
147 . S DATA=$$ONLYASC^HLDIEDB0(@LP)
148 . I $L(DATA),$TR(DATA," ","")']"" S DATA="{#"_$L(DATA)_" spaces}"
149 . S @LP=DATA
150 ;
151 Q
152 ;
153STOREMSG(FILE,IEN,RTN,DEBUGNO,LOC,INCRNO) ; Store message data in ^XTMP...
154 ; DEBUGNOW -- req
155 N GBL,NODE
156 ;
157 ; Set XREF XTMP...
158 S ^XTMP("HLDIE-DEBUGX",FILE,IEN,DEBUGNOW,$J,RTN,DEBUGNO)=LOC_U_$TR($G(HLEDITOR),U,"~")
159 S ^XTMP("HLDIE-DEBUGN","N",INCRNO)=FILE_U_IEN_U_DEBUGNOW_U_$J_U_RTN_U_DEBUGNO_U_LOC_U_$TR($G(HLEDITOR),U,"~")
160 ;
161 ; Get GBL...
162 S GBL=$S(FILE=772:"^HL(772,"_IEN_")",1:"^HLMA("_IEN_")")
163 ;
164 ; Collect message data...
165 F NODE=0,1,2,"P","S",$S(FILE=772:"IN",1:"MSH") D NODE(GBL,NODE)
166 ;
167 Q
168 ;
169NODE(GBL,NODE) ; Collect message data...
170 ; RTN,DEBUGNO -- req
171 N LAST,LNO,TXT,X
172 ;
173 I NODE="MSH" D QUIT ;->
174 . N LNO,TXT
175 . S LNO=0
176 . F S LNO=$O(@GBL@("MSH",LNO)) Q:'LNO D
177 . . S TXT=$G(@GBL@("MSH",+LNO,0)) QUIT:TXT']"" ;->
178 . . S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D","MSH",LNO,0)=TXT
179 ;
180 I NODE="IN" D QUIT ;->
181 . N LAST,TXT
182 . S LAST=$O(@GBL@("IN",":"),-1)
183 . S TXT=$G(@GBL@("IN",1,0)) QUIT:TXT']"" ;->
184 . S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D","IN",1,0)=1_":"_LAST_"~"_TXT
185 ;
186 ; Store node...
187 S X=$G(@GBL@(NODE)) I X]"" S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D",NODE)=X
188 ;
189 Q
190 ;
191KILLALL ; Don't call here unless it's OK to remove ALL-ALL debug data...
192 N KILL,OFF,XTMP
193 ;
194 I $O(^XTMP("HLDIE-DEBUG"))']"HLDIE-DEBUG" D QUIT ;->
195 . W !!,"No debug data exists..."
196 ;
197 W !
198 S KILL=$$YN^HLCSRPT4("Kill **ALL** debug data","No")
199 I 'KILL W " no data will be killed..." QUIT ;->
200 ;
201 W !!,"KILLing all debug data..."
202 S XTMP="HLDIE-DEBUG"
203 F S XTMP=$O(^XTMP(XTMP)) Q:XTMP'["HLDIE-DEBUG" D
204 . KILL ^XTMP(XTMP)
205 ;
206 Q
207 ;
208LOG(SUBSV,KEEP,STOP) ; Log local vars into ^XTMP("HLDIE "_DT)...
209 ;
210 ; Documentation in MENU^HLDIE...
211 ;
212 N NO,NOW,NOXTMP,X,XTMP
213 ;
214 ; Presets...
215 S SUBSV=$G(SUBSV),KEEP=$G(KEEP),STOP=$G(STOP),NOXTMP=0,NOW=$$NOW^XLFDT
216 S SUBSV=$TR($S(SUBSV]"":SUBSV,1:"UNKNOWN"),"""","")
217 ;
218 ; # to keep setup...
219 S KEEP=$S(KEEP&(KEEP<100):KEEP,1:20)
220 ;
221 ; XTMP setup...
222 S XTMP="HLDIE-"_DT
223 S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,7)_U_$$NOW^XLFDT_U_"Data logged by LOG~HLDIE"
224 ;
225 ; Count number entries...
226 I STOP=1 D
227 . S NOXTMP=0,NO=0
228 . F S NO=$O(^XTMP(XTMP,SUBSV,NO)) Q:'NO D
229 . . S NOXTMP=NOXTMP+1
230 ;
231 ; Incremented sequential store #...
232 S NO=$O(^XTMP(XTMP,SUBSV,":"),-1)+1
233 ;
234 ; STOP now?
235 I STOP,NOXTMP'<KEEP QUIT ;->
236 ;
237 ; Store all local variables...
238 S X="^XTMP("""_XTMP_""","""_SUBSV_""","_NO_"," D DOLRO^%ZOSV
239 S ^XTMP(XTMP,SUBSV,NO)=$$NOW^XLFDT
240 ;
241 I $ZE]"" S ^XTMP(XTMP,SUBSV,NO,"$ZE")=$ZE
242 ;
243 ; Keep only KEEP instances...
244 F NO=NO-KEEP:-1:1 KILL ^XTMP(XTMP,SUBSV,NO)
245 ;
246 Q
247 ;
248EOR ;HLDIEDBG - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
Note: See TracBrowser for help on using the repository browser.