| [613] | 1 | RORERR ;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 |  ;
 | 
|---|
 | 14 | CLEAR(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 |  ;
 | 
|---|
 | 48 | DBS(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 |  ;
 | 
|---|
 | 76 | DFLTLOC(DEFLOC) ;
 | 
|---|
 | 77 |  I $G(RORPARM("ERR"))  S RORERRDL=DEFLOC
 | 
|---|
 | 78 |  D CLEAN^DILF
 | 
|---|
 | 79 |  Q
 | 
|---|
 | 80 |  ;
 | 
|---|
 | 81 |  ;***** DISPLAYS CONTENT OF THE ERROR STACK
 | 
|---|
 | 82 | DSPSTK() ;
 | 
|---|
 | 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 |  ;
 | 
|---|
 | 101 | DSPSTKL(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 |  ;
 | 
|---|
 | 140 | ERROR(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 |  ;
 | 
|---|
 | 180 | INVLDPTR(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 |  ;
 | 
|---|
 | 201 | LOG(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 |  ; 
 | 
|---|
 | 232 | RPCSTK(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 |  ;
 | 
|---|
 | 258 | VARDUMP(M1S2G,V1A2R3S) ;
 | 
|---|
 | 259 |  Q
 | 
|---|