source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORERR.m@ 1094

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

initial load of FOIAVistA 6/30/08 version

File size: 8.3 KB
Line 
1RORERR ;HCIOFO/SG - ERROR PROCESSING ; 11/7/05 10:29am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** INITIALIZES THE ERROR STACK
7 ;
8 ; [DEFLOC] Default error location
9 ; [ENABLE] Enable extended error processing
10 ;
11 ; Do not forget to NEW the RORERRDL variable before calling
12 ; this procedure!
13 ;
14CLEAR(DEFLOC,ENABLE) ;
15 S:$D(ENABLE) RORPARM("ERR")=+$G(ENABLE)
16 I $G(RORPARM("ERR")) K RORERROR("ES") S:$D(DEFLOC) RORERRDL=DEFLOC
17 D CLEAN^DILF
18 Q
19 ;
20 ;***** CHECKS THE ERRORS AFTER A FILEMAN DBS CALL
21 ;
22 ; ROR8MSG Closed reference of the error messages array
23 ; (from DBS calls)
24 ; [ERRCODE] Error code to assign
25 ; [PLACE] Location of the error (see the $$ERROR)
26 ; [PATIEN] Patient IEN
27 ; [FILE] File number used in the DBS call
28 ; [IENS] IENS used in the DBS call
29 ;
30 ; The $$DBS^RORERR function checks the DIERR and @ROR8MSG variables
31 ; for errors after a FileMan DBS call.
32 ;
33 ; Return Values:
34 ;
35 ; If there are no errors found, it returns an empty string.
36 ; In case of errors, the result depends on value of the ERRCODE
37 ; parameter:
38 ;
39 ; If ERRCODE is omitted or equals 0, the function returns a string
40 ; containing the list of error codes separated by comma.
41 ;
42 ; If ERRCODE is not zero, the $$ERROR^RORERR function is called and
43 ; its return value is returned.
44 ;
45 ; NOTE: This entry point can also be called as a procedure:
46 ; D DBS^RORERR(...) if you do not need its return value.
47 ;
48DBS(ROR8MSG,ERRCODE,PLACE,PATIEN,FILE,IENS) ;
49 K RORERROR("DBS")
50 I '$G(DIERR) Q:$QUIT "" Q
51 N ERRLST,ERRNODE,I,MSGTEXT
52 S ERRNODE=$S($G(ROR8MSG)'="":$NA(@ROR8MSG@("DIERR")),1:$NA(^TMP("DIERR",$J)))
53 I $D(@ERRNODE)<10 Q:$QUIT "" Q
54 ;--- Get a list of errors
55 S I=0
56 F S I=$O(@ERRNODE@("E",I)) Q:'I S RORERROR("DBS",I)=""
57 ;--- Return a list of errors
58 I '$G(ERRCODE) D Q:$QUIT $P(ERRLST,",",2,99) Q
59 . S ERRLST="",I=0
60 . F S I=$O(RORERROR("DBS",I)) Q:'I S ERRLST=ERRLST_","_I
61 . D CLEAN^DILF
62 ;--- Record/display the error message
63 D MSG^DIALOG("AE",.MSGTEXT,,,$G(ROR8MSG)),CLEAN^DILF
64 S I=$S($G(FILE):"; File #"_FILE,1:"")
65 S:$G(IENS)'="" I=I_"; IENS: """_IENS_""""
66 S I=$$ERROR(ERRCODE,.PLACE,.MSGTEXT,.PATIEN,I)
67 Q:$QUIT I Q
68 ;
69 ;***** SETS DEFAULT ERROR LOCATION
70 ;
71 ; DEFLOC Default error location
72 ;
73 ; Do not forget to NEW the RORERRDL variable before calling
74 ; this procedure!
75 ;
76DFLTLOC(DEFLOC) ;
77 I $G(RORPARM("ERR")) S RORERRDL=DEFLOC
78 D CLEAN^DILF
79 Q
80 ;
81 ;***** DISPLAYS CONTENT OF THE ERROR STACK
82DSPSTK() ;
83 Q:'$G(RORPARM("ERR"))!($D(RORERROR("ES"))<10)
84 N EPTR,I,TMP
85 D DSPSTKL("Err Message Text",1)
86 D DSPSTKL(" Additional info")
87 S EPTR=""
88 F S EPTR=$O(RORERROR("ES",EPTR)) Q:EPTR="" D
89 . S TMP=RORERROR("ES",EPTR)
90 . D DSPSTKL($J(+TMP,4)_" "_$P(TMP,U,2),1)
91 . S TMP=$G(RORERROR("ES",EPTR,1))
92 . D:TMP'="" DSPSTKL(" Location: "_TMP)
93 . S I=""
94 . F S I=$O(RORERROR("ES",EPTR,2,I)) Q:I="" D
95 . . D DSPSTKL(" "_RORERROR("ES",EPTR,2,I))
96 Q
97 ;
98 ; MSG Message to display
99 ; [SKIP] Skip a line before the output
100 ;
101DSPSTKL(MSG,SKIP) ;
102 I '$G(RORPARM("KIDS")) W:$G(SKIP) ! W MSG,! Q
103 I $G(SKIP) D BMES^XPDUTL(MSG) Q
104 D MES^XPDUTL(MSG)
105 Q
106 ;
107 ;***** PUTS THE ERROR IN THE ERROR STACK AND LOG FILE
108 ;
109 ; ERRCODE Error code. Debug messages, information messages,
110 ; data quality warnings and warnings are not placed
111 ; into the stack. However, they are logged and
112 ; displayed if this is enabled.
113 ;
114 ; [PLACE] Location of the error (TAG^ROUTINE).
115 ;
116 ; If the parameter is undefined then the location is
117 ; extracted from the stack (see description of the
118 ; $STACK function for more details).
119 ;
120 ; If an empty string is used as a value of the
121 ; parameter then the default location is used
122 ; (that has been set by CLEAR or DFLTLOC).
123 ;
124 ; [[.]RORINFO] Optional additional information (either a string or
125 ; a reference to a local array that contains strings
126 ; prepared for storing in a word processing field)
127 ;
128 ; [PATIEN] Patient IEN
129 ;
130 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
131 ; (|1| is substituted by the value of the PATIEN)
132 ;
133 ; Return Values:
134 ; <0 Error code (value of the ERRCODE)
135 ; 0 Ok (if ERRCOCE'<0)
136 ;
137 ; NOTE: This entry point can also be called as a procedure:
138 ; D ERROR^RORERR(...) if you do not need its return value.
139 ;
140ERROR(ERRCODE,PLACE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
141 I ERRCODE'<0 Q:$QUIT 0 Q
142 N IR,SL,MSG,TOP,TYPE
143 D:'$D(PLACE)
144 . S SL=$STACK(-1)-1
145 . F Q:SL'>0 D Q:'(PLACE["^RORERR") S SL=SL-1
146 . . S PLACE=$P($STACK(SL,"PLACE")," ")
147 S:$G(PLACE)="" PLACE=$G(RORERRDL)
148 I $D(RORINFO)=1 S IR=RORINFO K RORINFO S RORINFO(1)=IR,IR=1
149 E S IR=$O(RORINFO(""),-1)
150 S MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
151 ;--- Put the error to the error stack
152 D:$G(RORPARM("ERR"))&(TYPE>4)
153 . S (RORERROR("ES"),TOP)=$G(RORERROR("ES"))+1
154 . S RORERROR("ES",TOP)=+ERRCODE_U_MSG
155 . S RORERROR("ES",TOP,1)=PLACE
156 . M:$D(RORINFO) RORERROR("ES",TOP,2)=RORINFO
157 ;--- Log the message
158 S:PLACE'="" IR=IR+1,RORINFO(IR)="Location: "_PLACE
159 D LOG^RORLOG(TYPE,MSG,$G(PATIEN),.RORINFO),CLEAN^DILF
160 Q:$QUIT ERRCODE Q
161 ;
162 ;***** CHECKS FOR INVALID POINTER ERROR
163 ;
164 ; FILE Number of the 'pointed from' file
165 ; IENS IENS of the record of the file
166 ; FIELD Number of the pointer field
167 ; [PLACE] Location of the error (see the $$ERROR)
168 ; [PATIEN] Patient IEN
169 ; [ERRCODE] Error code to assign (-79 by default)
170 ;
171 ; The $$INVLDPTR^RORERR function checks the list of latest FileMan
172 ; DBS error codes for the pointer errors.
173 ;
174 ; Return Values:
175 ;
176 ; If there are no pointer errors found, the function returns zero.
177 ; Otherwise, the $$ERROR^RORERR function is called and its value
178 ; is returned (a negative value of the ERRCODE or -79 by default).
179 ;
180INVLDPTR(FILE,IENS,FIELD,PLACE,PATIEN,ERRCODE) ;
181 Q:$D(RORERROR("DBS"))<10 0
182 N EC,TMP
183 F EC=601,0 Q:$D(RORERROR("DBS",EC))
184 Q:'EC 0
185 S TMP="File #"_FILE_"; IENS: """_IENS_"""; Field: "_FIELD
186 Q $$ERROR($S($G(ERRCODE)<0:ERRCODE,1:-79),$G(PLACE),.TMP,.PATIEN)
187 ;
188 ;***** RECORDS THE ERROR MESSAGE INTO THE LOG FILE
189 ;
190 ; ERRCODE Error code.
191 ;
192 ; [[.]RORINFO] Optional additional information (either a string or
193 ; a reference to a local array that contains strings
194 ; prepared for storing in a word processing field)
195 ;
196 ; [PATIEN] Patient IEN
197 ;
198 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
199 ; (|1| is substituted by the value of the PATIEN)
200 ;
201LOG(ERRCODE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
202 Q:ERRCODE'<0
203 N MSG,TYPE
204 S MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
205 D LOG^RORLOG(TYPE,MSG,$G(PATIEN),.RORINFO)
206 Q
207 ;
208 ;***** RETURNS THE ERROR STACK FOR A REMOTE PROCEDURE
209 ;
210 ; .RESULT Reference to a local variable where the error
211 ; descriptors are returned to.
212 ;
213 ; LASTERR The last error code
214 ;
215 ; Return Values:
216 ;
217 ; RESULT(0) Result descriptor
218 ; ^01: The last error code (LASTERR)
219 ; ^02: Number of the error descriptors
220 ;
221 ; RESULT(i) Error descriptor
222 ; ^01: Error code
223 ; ^02: Message
224 ; ^03: Place of the error
225 ; RESULT(j) Line of the additional info
226 ; ^01: ""
227 ; ^02: Text
228 ;
229 ; Error descriptors are returned in reverse chronological order
230 ; (most recent first).
231 ;
232RPCSTK(RESULT,LASTERR) ;
233 N CNT,ECNT,EPTR,I,TMP
234 K RESULT S RESULT(0)=(+LASTERR)_U_"0"
235 S TMP=$$RTRNFMT^XWBLIB(2,1)
236 Q:$D(RORERROR("ES"))<10
237 ;
238 S EPTR="",(CNT,ECNT)=0
239 F S EPTR=$O(RORERROR("ES",EPTR),-1) Q:EPTR="" D
240 . S TMP=$G(RORERROR("ES",EPTR)),CNT=CNT+1,ECNT=ECNT+1
241 . S RESULT(CNT)=(+TMP)_U_$TR($P(TMP,U,2,999),U,"~")
242 . S TMP=$G(RORERROR("ES",EPTR,1))
243 . S $P(RESULT(CNT),U,3)=$TR(TMP,U,"~")
244 . S I=0
245 . F S I=$O(RORERROR("ES",EPTR,2,I)) Q:I'>0 D
246 . . S CNT=CNT+1,$P(RESULT(CNT),U,2)=RORERROR("ES",EPTR,2,I)
247 ;
248 S $P(RESULT(0),U,2)=ECNT
249 K ^TMP("DILIST",$J)
250 Q
251 ;
252 ;***** DUMPS LOCAL VARIABLES INTO THE LOG
253 ;
254 ; M1S2G Message code.
255 ;
256 ; V1A2R3S List of local variables separated by commas
257 ;
258VARDUMP(M1S2G,V1A2R3S) ;
259 Q
Note: See TracBrowser for help on using the repository browser.