RAERR01 ;HCIOFO/SG - ERROR HANDLING UTILITIES ; 1/18/08 4:27pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
Q
;
;***** RETURNS A LIST OF ERROR CODES FROM THE STACK
;
; [ENCLOSE] Enclose the list in commas.
;
; Return Values:
; "" No errors
; ... List of error codes (in reverse chronological order)
; separated by commas.
;
ERRLST(ENCLOSE) ;
N I,LST
S I=" ",LST=""
F S I=$O(RAERROR("ES",I),-1) Q:I'>0 D
. S LST=LST_","_$P(RAERROR("ES",I,0),U)
Q $S(LST="":"",$G(ENCLOSE):LST_",",1:$P(LST,",",2,999999))
;
;***** RETURNS THE TEXT AND TYPE OF THE MESSAGE
;
; ERRCODE Error code
;
; [.TYPE] Reference to a local variable where the problem
; type is returned ("I" - Information, "W" - warning,
; "E" - error).
;
; [ARG1-ARG5] Optional parameters that substitute the |n| "windows"
; in the text of the message (for example, the |2| will
; be substituted by the value of the ARG2).
;
; NOTE: The "^" is replaced with the "~" in the resulting message.
;
MSG(ERRCODE,TYPE,ARG1,ARG2,ARG3,ARG4,ARG5) ;
Q:ERRCODE'<0 ""
N ARG,I1,I2,MSG
;--- Get a descriptor of the message
S MSG=$$EZBLD^DIALOG(700000-(ERRCODE/1000))
;--- Parse and validate the descriptor
S TYPE=$E(MSG),MSG=$P(MSG,U,2,999)
S:("IWE"'[TYPE)!(TYPE="") TYPE="E"
Q:MSG?." " "Unknown error ("_ERRCODE_")"
;--- Substitute parameters
S I1=2
F S I1=$F(MSG,"|",I1-1) Q:'I1 D
. S I2=$F(MSG,"|",I1) Q:'I2
. X "S ARG=$G(ARG"_+$TR($E(MSG,I1,I2-2)," ")_")"
. S $E(MSG,I1-1,I2-1)=ARG
Q $TR($$TRIM^XLFSTR(MSG),U,"~")
;
;***** DISPLAYS THE ERROR STACK OR A SINGLE ERROR MESSAGE
;
; [ERROR] Descriptor of a single error to be displayed.
;
; [.RAINFO] Reference to a local array with additional
; information for a single error.
;
PRTERRS(ERROR,RAINFO) ;
Q:($G(ERROR)'<0)&($D(RAERROR("ES"))<10)
N EXIT,IMSG
;--- Print table header
Q:$$PAGE^RAUTL22(3)<0
D W^RAUTL22("Code Message")
D W^RAUTL22(" Additional Information")
D W^RAUTL22(" Location")
D W^RAUTL22("---- "_$$REPEAT^XLFSTR("-",IOM-7))
;--- Print a single error message
I $G(ERROR)<0 S EXIT=$$PRT1ERR(ERROR,"RAINFO") Q
;--- Print the error stack (most recent messages first)
S IMSG=" " K EXIT
F S IMSG=$O(RAERROR("ES",IMSG),-1) Q:IMSG'>0 D Q:$G(EXIT)
. D:$D(EXIT) W^RAUTL22(" ")
. S EXIT=$$PRT1ERR(RAERROR("ES",IMSG,0),$NA(RAERROR("ES",IMSG,1)))
Q
;
PRT1ERR(ERR,RA8INFO) ;
N I,RC,SP6
S RC=0,SP6=" "
;===
D
. S RC=$$PAGE^RAUTL22 Q:RC<0
. D W^RAUTL22($J(+ERR,4)_" "_$$TRUNC^RAUTL22($P(ERR,U,2),IOM-7))
. ;--- Display the additional information
. I $G(RA8INFO)'="",$D(@RA8INFO)>1 S I="" D
. . F S I=$O(@RA8INFO@(I)) Q:I="" D Q:RC<0
. . . S RC=$$PAGE^RAUTL22 Q:RC<0
. . . D W^RAUTL22(SP6_$$TRUNC^RAUTL22(@RA8INFO@(I),IOM-7))
. Q:RC<0
. ;--- Display the location
. S I=$TR($P(ERR,U,3),"~","^")
. I I'="" S RC=$$PAGE^RAUTL22 D:RC'<0 W^RAUTL22(SP6_I)
Q:RC<0 RC
;===
S RC=$$PAGE^RAUTL22
Q $S(RC<0:RC,1:0)
;
;***** RETURNS THE ERROR STACK FROM A REMOTE PROCEDURE
;
; .RESULT Reference to a local variable where the error
; descriptors are returned to.
;
; LASTERR The last error code.
;
; Return Values:
;
; RESULT(0) Result descriptor
; ^01: The last error code (LASTERR)
; ^02: Number of error descriptors
;
; RESULT(i) Error descriptor
; ^01: Error code
; ^02: Message
; ^03: Error location
; RESULT(j) Line of the additional info
; ^01: ""
; ^02: Text
;
; Error descriptors are returned in reverse chronological order
; (most recent first).
;
RPCSTK(RESULT,LASTERR) ;
N CNT,ECNT,EPTR,I,TMP
K RESULT S RESULT(0)=(+LASTERR)_U_"0"
S TMP=$$RTRNFMT^XWBLIB(2,1)
Q:$D(RAERROR("ES"))<10
;
S EPTR="",(CNT,ECNT)=0
F S EPTR=$O(RAERROR("ES",EPTR),-1) Q:EPTR="" D
. S TMP=$G(RAERROR("ES",EPTR,0)) Q:'TMP
. S CNT=CNT+1,ECNT=ECNT+1,RESULT(CNT)=TMP
. S I=0
. F S I=$O(RAERROR("ES",EPTR,1,I)) Q:I'>0 D
. . S CNT=CNT+1,$P(RESULT(CNT),U,2)=RAERROR("ES",EPTR,1,I)
;
S $P(RESULT(0),U,2)=ECNT
K ^TMP("DILIST",$J)
Q
;
;+++++ DEFAULT RUN-TIME ERROR HANDLER
;
; RAZZRCV Name of a variable that the error code
; (-1, -2, or -4) is assigned to.
;
; RAZZSTL Stack level (value of the $STACK special variable)
; where execution control is returned to.
;
RTEHNDLR(RAZZRCV,RAZZSTL) ;
N RAZZERR,RAZZRC
S RAZZERR=$$EC^%ZOSV
S:$ECODE=",UTIMEOUT," RAZZRC=-2
S:$ECODE=",UCANCEL," RAZZRC=-1
;--- Record the error if this is not user "^" or timeout
I '$G(RAZZRC) D ^%ZTER S RAZZRC=+$$ERROR^RAERR(-4,,RAZZERR)
;--- Unwind the stack and assign/return the error code
S $ECODE="",RAZZSTL=RAZZSTL+1
I RAZZSTL>0,$STACK(-1)>RAZZSTL D
. S $ETRAP="S:$ESTACK'>0 $ECODE="""""
. S:RAZZRCV'="" $ETRAP=$ETRAP_","_RAZZRCV_"="_RAZZRC
. S $ETRAP=$ETRAP_" Q:$QUIT "_RAZZRC_" Q"
. S $ECODE=",U1,"
E S:RAZZRCV'="" @RAZZRCV=RAZZRC
Q:$QUIT RAZZRC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAERR01 5365 printed Apr 09, 2024@21:40:24 Page 2
RAERR01 ;HCIOFO/SG - ERROR HANDLING UTILITIES ; 1/18/08 4:27pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 QUIT
+4 ;
+5 ;***** RETURNS A LIST OF ERROR CODES FROM THE STACK
+6 ;
+7 ; [ENCLOSE] Enclose the list in commas.
+8 ;
+9 ; Return Values:
+10 ; "" No errors
+11 ; ... List of error codes (in reverse chronological order)
+12 ; separated by commas.
+13 ;
ERRLST(ENCLOSE) ;
+1 NEW I,LST
+2 SET I=" "
SET LST=""
+3 FOR
SET I=$ORDER(RAERROR("ES",I),-1)
if I'>0
QUIT
Begin DoDot:1
+4 SET LST=LST_","_$PIECE(RAERROR("ES",I,0),U)
End DoDot:1
+5 QUIT $SELECT(LST="":"",$GET(ENCLOSE):LST_",",1:$PIECE(LST,",",2,999999))
+6 ;
+7 ;***** RETURNS THE TEXT AND TYPE OF THE MESSAGE
+8 ;
+9 ; ERRCODE Error code
+10 ;
+11 ; [.TYPE] Reference to a local variable where the problem
+12 ; type is returned ("I" - Information, "W" - warning,
+13 ; "E" - error).
+14 ;
+15 ; [ARG1-ARG5] Optional parameters that substitute the |n| "windows"
+16 ; in the text of the message (for example, the |2| will
+17 ; be substituted by the value of the ARG2).
+18 ;
+19 ; NOTE: The "^" is replaced with the "~" in the resulting message.
+20 ;
MSG(ERRCODE,TYPE,ARG1,ARG2,ARG3,ARG4,ARG5) ;
+1 if ERRCODE'<0
QUIT ""
+2 NEW ARG,I1,I2,MSG
+3 ;--- Get a descriptor of the message
+4 SET MSG=$$EZBLD^DIALOG(700000-(ERRCODE/1000))
+5 ;--- Parse and validate the descriptor
+6 SET TYPE=$EXTRACT(MSG)
SET MSG=$PIECE(MSG,U,2,999)
+7 if ("IWE"'[TYPE)!(TYPE="")
SET TYPE="E"
+8 if MSG?." "
QUIT "Unknown error ("_ERRCODE_")"
+9 ;--- Substitute parameters
+10 SET I1=2
+11 FOR
SET I1=$FIND(MSG,"|",I1-1)
if 'I1
QUIT
Begin DoDot:1
+12 SET I2=$FIND(MSG,"|",I1)
if 'I2
QUIT
+13 XECUTE "S ARG=$G(ARG"_+$TRANSLATE($EXTRACT(MSG,I1,I2-2)," ")_")"
+14 SET $EXTRACT(MSG,I1-1,I2-1)=ARG
End DoDot:1
+15 QUIT $TRANSLATE($$TRIM^XLFSTR(MSG),U,"~")
+16 ;
+17 ;***** DISPLAYS THE ERROR STACK OR A SINGLE ERROR MESSAGE
+18 ;
+19 ; [ERROR] Descriptor of a single error to be displayed.
+20 ;
+21 ; [.RAINFO] Reference to a local array with additional
+22 ; information for a single error.
+23 ;
PRTERRS(ERROR,RAINFO) ;
+1 if ($GET(ERROR)'<0)&($DATA(RAERROR("ES"))<10)
QUIT
+2 NEW EXIT,IMSG
+3 ;--- Print table header
+4 if $$PAGE^RAUTL22(3)<0
QUIT
+5 DO W^RAUTL22("Code Message")
+6 DO W^RAUTL22(" Additional Information")
+7 DO W^RAUTL22(" Location")
+8 DO W^RAUTL22("---- "_$$REPEAT^XLFSTR("-",IOM-7))
+9 ;--- Print a single error message
+10 IF $GET(ERROR)<0
SET EXIT=$$PRT1ERR(ERROR,"RAINFO")
QUIT
+11 ;--- Print the error stack (most recent messages first)
+12 SET IMSG=" "
KILL EXIT
+13 FOR
SET IMSG=$ORDER(RAERROR("ES",IMSG),-1)
if IMSG'>0
QUIT
Begin DoDot:1
+14 if $DATA(EXIT)
DO W^RAUTL22(" ")
+15 SET EXIT=$$PRT1ERR(RAERROR("ES",IMSG,0),$NAME(RAERROR("ES",IMSG,1)))
End DoDot:1
if $GET(EXIT)
QUIT
+16 QUIT
+17 ;
PRT1ERR(ERR,RA8INFO) ;
+1 NEW I,RC,SP6
+2 SET RC=0
SET SP6=" "
+3 ;===
+4 Begin DoDot:1
+5 SET RC=$$PAGE^RAUTL22
if RC<0
QUIT
+6 DO W^RAUTL22($JUSTIFY(+ERR,4)_" "_$$TRUNC^RAUTL22($PIECE(ERR,U,2),IOM-7))
+7 ;--- Display the additional information
+8 IF $GET(RA8INFO)'=""
IF $DATA(@RA8INFO)>1
SET I=""
Begin DoDot:2
+9 FOR
SET I=$ORDER(@RA8INFO@(I))
if I=""
QUIT
Begin DoDot:3
+10 SET RC=$$PAGE^RAUTL22
if RC<0
QUIT
+11 DO W^RAUTL22(SP6_$$TRUNC^RAUTL22(@RA8INFO@(I),IOM-7))
End DoDot:3
if RC<0
QUIT
End DoDot:2
+12 if RC<0
QUIT
+13 ;--- Display the location
+14 SET I=$TRANSLATE($PIECE(ERR,U,3),"~","^")
+15 IF I'=""
SET RC=$$PAGE^RAUTL22
if RC'<0
DO W^RAUTL22(SP6_I)
End DoDot:1
+16 if RC<0
QUIT RC
+17 ;===
+18 SET RC=$$PAGE^RAUTL22
+19 QUIT $SELECT(RC<0:RC,1:0)
+20 ;
+21 ;***** RETURNS THE ERROR STACK FROM A REMOTE PROCEDURE
+22 ;
+23 ; .RESULT Reference to a local variable where the error
+24 ; descriptors are returned to.
+25 ;
+26 ; LASTERR The last error code.
+27 ;
+28 ; Return Values:
+29 ;
+30 ; RESULT(0) Result descriptor
+31 ; ^01: The last error code (LASTERR)
+32 ; ^02: Number of error descriptors
+33 ;
+34 ; RESULT(i) Error descriptor
+35 ; ^01: Error code
+36 ; ^02: Message
+37 ; ^03: Error location
+38 ; RESULT(j) Line of the additional info
+39 ; ^01: ""
+40 ; ^02: Text
+41 ;
+42 ; Error descriptors are returned in reverse chronological order
+43 ; (most recent first).
+44 ;
RPCSTK(RESULT,LASTERR) ;
+1 NEW CNT,ECNT,EPTR,I,TMP
+2 KILL RESULT
SET RESULT(0)=(+LASTERR)_U_"0"
+3 SET TMP=$$RTRNFMT^XWBLIB(2,1)
+4 if $DATA(RAERROR("ES"))<10
QUIT
+5 ;
+6 SET EPTR=""
SET (CNT,ECNT)=0
+7 FOR
SET EPTR=$ORDER(RAERROR("ES",EPTR),-1)
if EPTR=""
QUIT
Begin DoDot:1
+8 SET TMP=$GET(RAERROR("ES",EPTR,0))
if 'TMP
QUIT
+9 SET CNT=CNT+1
SET ECNT=ECNT+1
SET RESULT(CNT)=TMP
+10 SET I=0
+11 FOR
SET I=$ORDER(RAERROR("ES",EPTR,1,I))
if I'>0
QUIT
Begin DoDot:2
+12 SET CNT=CNT+1
SET $PIECE(RESULT(CNT),U,2)=RAERROR("ES",EPTR,1,I)
End DoDot:2
End DoDot:1
+13 ;
+14 SET $PIECE(RESULT(0),U,2)=ECNT
+15 KILL ^TMP("DILIST",$JOB)
+16 QUIT
+17 ;
+18 ;+++++ DEFAULT RUN-TIME ERROR HANDLER
+19 ;
+20 ; RAZZRCV Name of a variable that the error code
+21 ; (-1, -2, or -4) is assigned to.
+22 ;
+23 ; RAZZSTL Stack level (value of the $STACK special variable)
+24 ; where execution control is returned to.
+25 ;
RTEHNDLR(RAZZRCV,RAZZSTL) ;
+1 NEW RAZZERR,RAZZRC
+2 SET RAZZERR=$$EC^%ZOSV
+3 if $ECODE=",UTIMEOUT,"
SET RAZZRC=-2
+4 if $ECODE=",UCANCEL,"
SET RAZZRC=-1
+5 ;--- Record the error if this is not user "^" or timeout
+6 IF '$GET(RAZZRC)
DO ^%ZTER
SET RAZZRC=+$$ERROR^RAERR(-4,,RAZZERR)
+7 ;--- Unwind the stack and assign/return the error code
+8 SET $ECODE=""
SET RAZZSTL=RAZZSTL+1
+9 IF RAZZSTL>0
IF $STACK(-1)>RAZZSTL
Begin DoDot:1
+10 SET $ETRAP="S:$ESTACK'>0 $ECODE="""""
+11 if RAZZRCV'=""
SET $ETRAP=$ETRAP_","_RAZZRCV_"="_RAZZRC
+12 SET $ETRAP=$ETRAP_" Q:$QUIT "_RAZZRC_" Q"
+13 SET $ECODE=",U1,"
End DoDot:1
+14 IF '$TEST
if RAZZRCV'=""
SET @RAZZRCV=RAZZRC
+15 if $QUIT
QUIT RAZZRC
QUIT
