RAERR ;HCIOFO/SG - ERROR HANDLING ; 4/10/08 4:46pm
 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
 ;
 ; * Error codes are negative numbers.
 ;
 ; * The corresponding error messages are stored in the DIALOG file
 ;   (#.84). Dialog numbers are calculated as follows:
 ;
 ;         Dialog# = 700000 - (ErrorCode / 1000).
 ;
 ;   For example, dialog number for the error code -9 is 700000.009.
 ;
 ; * A message itself is stored in the second "^"-piece of the dialog 
 ;   text line. The first piece determines the problem type:
 ;
 ;     I - Information. No actions are required.
 ;
 ;         The $$ERROR^RAERR does not store this kind of messages in
 ;         the RAERROR stack. However, they can be explicitly stored
 ;         there using the PUSH^RAERR.
 ;
 ;     W - Warning. There was a problem but the code was able to
 ;         ignore/recover and continue. It would be a good idea
 ;         to review the problem and fix it if/when possible.
 ;
 ;     E - Error. The code encountered a major problem and could
 ;         not continue. Data, code, or both should be fixed!
 ;
 Q
 ;
 ;***** INITIALIZES THE ERROR STACK
 ;
 ; [ENABLE]      Enable error stack (0|1). If the stack is enabled,
 ;               the $$ERROR function stores all error descriptors
 ;               there. Otherwise, only the latest error descriptor
 ;               is accessible (the result value of the $$ERROR
 ;               function).
 ;
CLEAR(ENABLE) ;
 S:$G(ENABLE)="" ENABLE=+$G(RAERROR("ES"))
 K RAERROR("ES")  D:ENABLE ENABLE(1)
 D CLEAN^DILF
 Q
 ;
 ;***** CHECKS THE ERRORS AFTER A FILEMAN DBS CALL
 ;
 ; RA8MSG        Closed reference of the error message array
 ;               (from DBS calls). If this parameter is empty,
 ;               then ^TMP("DIERR",$J) is assumed.
 ;
 ; [ERRCODE]     Error code to assign (see dialogs #700000.*).
 ;
 ; [FILE]        File number used in the DBS call.
 ; [IENS]        IENS used in the DBS call.
 ;
 ; This function checks the DIERR and @RA8MSG variables for
 ; errors after a FileMan DBS call.
 ; 
 ; Return Values:
 ;
 ; If there are no errors found, it returns an empty string.
 ; In case of errors, the result depends on value of the
 ; parameter:
 ;
 ; If ERRCODE is omitted or equals 0, the function returns a string
 ; containing the list of FileMan error codes separated by comma.
 ; 
 ; If ERRCODE is not zero, the $$ERROR^RAERR function is called
 ; and its result is returned.
 ;
 ; NOTE: This entry point can also be called as a procedure:
 ;       D DBS^RAERR(...) if you do not need its return value.
 ;
DBS(RA8MSG,ERRCODE,FILE,IENS) ;
 I '$G(DIERR)  Q:$QUIT ""  Q
 N ERRLST,ERRNODE,I,MSGTEXT
 S ERRNODE=$S($G(RA8MSG)'="":$NA(@RA8MSG@("DIERR")),1:$NA(^TMP("DIERR",$J)))
 I $D(@ERRNODE)<10  Q:$QUIT ""  Q
 ;--- Return a list of errors
 I '$G(ERRCODE)  D  Q:$QUIT $P(ERRLST,",",2,999)  Q
 . S ERRLST="",I=0
 . F  S I=$O(@ERRNODE@("E",I))  Q:'I  S ERRLST=ERRLST_","_I
 . D CLEAN^DILF
 ;--- Record the error message
 D MSG^DIALOG("AE",.MSGTEXT,,,$G(RA8MSG)),CLEAN^DILF
 S I=$S($G(FILE):"; File #"_FILE,1:"")
 S:$G(IENS)'="" I=I_"; IENS: """_IENS_""""
 S I=$$ERROR(ERRCODE,.MSGTEXT,I)
 Q:$QUIT I  Q
 ;
 ;***** ENABLES/DISABLES THE ERROR STACK
 ;
 ; ENABLE        Enable (1) or disable (0) the error stack.
 ;               Content of the stack is not affected.
 ; 
 ; Return Values:
 ;
 ; Previous state of the stack: 1 - enabled, 0 - disabled.
 ;
 ; NOTE: This entry point can also be called as a procedure:
 ;       D ENABLE^RAERR(...) if you do not need its return value.
 ;
ENABLE(ENABLE) ;
 N OLD
 S OLD=+$G(RAERROR("ES"))
 S RAERROR("ES")=+ENABLE
 Q:$QUIT OLD  Q
 ;
 ;***** GENERATES THE ERROR MESSAGE
 ;
 ; ERRCODE       Error code (see dialogs #700000.*).
 ;
 ; [[.]RAINFO]   Optional additional information: either a string or
 ;               a reference to a local array that contains strings
 ;               prepared for storing in a word processing field
 ;               (first level nodes; no 0-nodes).
 ;
 ; [ARG1-ARG5]   Optional parameters for $$MSG^RAERR01.
 ;
 ; Return Values:
 ;       <0  Error code^Message text^Error location^Type
 ;        0  Ok (if ERRCODE'<0)
 ;
 ; NOTE: "^" is replaced with "~" in the error location stored
 ;       in the 3rd piece of the error descriptor.
 ;
 ; NOTE: This entry point can also be called as a procedure:
 ;       D ERROR^RAERR(...) if you do not need its return value.
 ;
ERROR(ERRCODE,RAINFO,ARG1,ARG2,ARG3,ARG4,ARG5) ;
 I ERRCODE'<0  Q:$QUIT 0  Q
 N IEN,MSG,PLACE,SL,TMP,TYPE
 ;--- Get the error location
 S SL=$STACK(-1)-1,PLACE=""
 F  Q:SL'>0  D  Q:'(PLACE[$T(+0))  S SL=SL-1
 . S PLACE=$P($STACK(SL,"PLACE")," ")
 ;--- Prepare the additional information
 I $D(RAINFO)=1  S TMP=RAINFO  K RAINFO  S RAINFO(1)=TMP
 ;--- Prepare the message descriptor
 S MSG=$$MSG^RAERR01(ERRCODE,.TYPE,.ARG1,.ARG2,.ARG3,.ARG4,.ARG5)
 S MSG=(+ERRCODE)_U_MSG_U_$TR(PLACE,U,"~")_U_TYPE
 ;--- Store the descriptor
 D:TYPE'="I" PUSH(MSG,.RAINFO)
 ;--- Display the error if debug mode is on
 I $G(RAPARAMS("DEBUG"))>1  U $G(IO(0),0)  D  U $G(IO,0)
 . D PRTERRS^RAERR01(MSG,.RAINFO)
 ;---
 Q:$QUIT MSG  Q
 ;
 ;***** GENERATES THE 'INVALID PARAMETER VALUE' ERROR
 ;
 ; RA8NAME       Name of the parameter
 ;
 ; NOTE: This entry point can also be called as a procedure:
 ;       D IPVE^RAERR(...) if you do not need its return value.
 ;
IPVE(RA8NAME) ;
 N RA8RC
 S RA8RC=$S($D(@RA8NAME)#10:"'"_@RA8NAME_"'",1:"<UNDEFINED>")
 S RA8RC=$$ERROR(-3,RA8NAME_"="_RA8RC,RA8NAME)
 Q:$QUIT RA8RC  Q
 ;
 ;***** PROCESSES THE ERROR DESCRIPTOR RETURNED BY $$LOCKFM^RALOCK
 ;
 ; ERROR         Error descriptor
 ;
 ; OBJNAME       Name of the object that the $$LOCKFM^RALOCK tried
 ;               to lock when it returned the error descriptor.
 ;
LOCKERR(ERROR,OBJNAME) ;
 Q $S(ERROR>0:$$ERROR(-15,$$TEXT^RALOCK(ERROR),OBJNAME),1:ERROR)
 ;
 ;***** PUSHES THE ERROR INTO THE ERROR STACK
 ;
 ; ERROR         Error descriptor
 ;
 ; [.RAINFO]     Reference to a local array with additional
 ;               information
 ;
PUSH(ERROR,RAINFO) ;
 Q:'$G(RAERROR("ES"))
 N IEN
 ;--- Store the descriptor
 S IEN=$O(RAERROR("ES"," "),-1)+1
 S RAERROR("ES",IEN,0)=ERROR
 M RAERROR("ES",IEN,1)=RAINFO
 Q
 ;
 ;***** ASSIGNS THE DEFAULT ERROR HANDLER
 ;
 ; [RCVNAME]     Name of a variable for the error code
 ;
 ;               See the RTEHNDLR^RAERR01 for more details.
 ;
SETDEFEH(RCVNAME) ;
 S $ECODE="",$ETRAP="D RTEHNDLR^"_$NA(RAERR01($G(RCVNAME),$STACK(-1)-2))
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAERR   6647     printed  Sep 23, 2025@20:11                                                                                                                                                                                                          Page 2
RAERR     ;HCIOFO/SG - ERROR HANDLING ; 4/10/08 4:46pm
 +1       ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
 +2       ;
 +3       ; * Error codes are negative numbers.
 +4       ;
 +5       ; * The corresponding error messages are stored in the DIALOG file
 +6       ;   (#.84). Dialog numbers are calculated as follows:
 +7       ;
 +8       ;         Dialog# = 700000 - (ErrorCode / 1000).
 +9       ;
 +10      ;   For example, dialog number for the error code -9 is 700000.009.
 +11      ;
 +12      ; * A message itself is stored in the second "^"-piece of the dialog 
 +13      ;   text line. The first piece determines the problem type:
 +14      ;
 +15      ;     I - Information. No actions are required.
 +16      ;
 +17      ;         The $$ERROR^RAERR does not store this kind of messages in
 +18      ;         the RAERROR stack. However, they can be explicitly stored
 +19      ;         there using the PUSH^RAERR.
 +20      ;
 +21      ;     W - Warning. There was a problem but the code was able to
 +22      ;         ignore/recover and continue. It would be a good idea
 +23      ;         to review the problem and fix it if/when possible.
 +24      ;
 +25      ;     E - Error. The code encountered a major problem and could
 +26      ;         not continue. Data, code, or both should be fixed!
 +27      ;
 +28       QUIT 
 +29      ;
 +30      ;***** INITIALIZES THE ERROR STACK
 +31      ;
 +32      ; [ENABLE]      Enable error stack (0|1). If the stack is enabled,
 +33      ;               the $$ERROR function stores all error descriptors
 +34      ;               there. Otherwise, only the latest error descriptor
 +35      ;               is accessible (the result value of the $$ERROR
 +36      ;               function).
 +37      ;
CLEAR(ENABLE) ;
 +1        if $GET(ENABLE)=""
               SET ENABLE=+$GET(RAERROR("ES"))
 +2        KILL RAERROR("ES")
           if ENABLE
               DO ENABLE(1)
 +3        DO CLEAN^DILF
 +4        QUIT 
 +5       ;
 +6       ;***** CHECKS THE ERRORS AFTER A FILEMAN DBS CALL
 +7       ;
 +8       ; RA8MSG        Closed reference of the error message array
 +9       ;               (from DBS calls). If this parameter is empty,
 +10      ;               then ^TMP("DIERR",$J) is assumed.
 +11      ;
 +12      ; [ERRCODE]     Error code to assign (see dialogs #700000.*).
 +13      ;
 +14      ; [FILE]        File number used in the DBS call.
 +15      ; [IENS]        IENS used in the DBS call.
 +16      ;
 +17      ; This function checks the DIERR and @RA8MSG variables for
 +18      ; errors after a FileMan DBS call.
 +19      ; 
 +20      ; Return Values:
 +21      ;
 +22      ; If there are no errors found, it returns an empty string.
 +23      ; In case of errors, the result depends on value of the
 +24      ; parameter:
 +25      ;
 +26      ; If ERRCODE is omitted or equals 0, the function returns a string
 +27      ; containing the list of FileMan error codes separated by comma.
 +28      ; 
 +29      ; If ERRCODE is not zero, the $$ERROR^RAERR function is called
 +30      ; and its result is returned.
 +31      ;
 +32      ; NOTE: This entry point can also be called as a procedure:
 +33      ;       D DBS^RAERR(...) if you do not need its return value.
 +34      ;
DBS(RA8MSG,ERRCODE,FILE,IENS) ;
 +1        IF '$GET(DIERR)
               if $QUIT
                   QUIT ""
               QUIT 
 +2        NEW ERRLST,ERRNODE,I,MSGTEXT
 +3        SET ERRNODE=$SELECT($GET(RA8MSG)'="":$NAME(@RA8MSG@("DIERR")),1:$NAME(^TMP("DIERR",$JOB)))
 +4        IF $DATA(@ERRNODE)<10
               if $QUIT
                   QUIT ""
               QUIT 
 +5       ;--- Return a list of errors
 +6        IF '$GET(ERRCODE)
               Begin DoDot:1
 +7                SET ERRLST=""
                   SET I=0
 +8                FOR 
                       SET I=$ORDER(@ERRNODE@("E",I))
                       if 'I
                           QUIT 
                       SET ERRLST=ERRLST_","_I
 +9                DO CLEAN^DILF
               End DoDot:1
               if $QUIT
                   QUIT $PIECE(ERRLST,",",2,999)
               QUIT 
 +10      ;--- Record the error message
 +11       DO MSG^DIALOG("AE",.MSGTEXT,,,$GET(RA8MSG))
           DO CLEAN^DILF
 +12       SET I=$SELECT($GET(FILE):"; File #"_FILE,1:"")
 +13       if $GET(IENS)'=""
               SET I=I_"; IENS: """_IENS_""""
 +14       SET I=$$ERROR(ERRCODE,.MSGTEXT,I)
 +15       if $QUIT
               QUIT I
           QUIT 
 +16      ;
 +17      ;***** ENABLES/DISABLES THE ERROR STACK
 +18      ;
 +19      ; ENABLE        Enable (1) or disable (0) the error stack.
 +20      ;               Content of the stack is not affected.
 +21      ; 
 +22      ; Return Values:
 +23      ;
 +24      ; Previous state of the stack: 1 - enabled, 0 - disabled.
 +25      ;
 +26      ; NOTE: This entry point can also be called as a procedure:
 +27      ;       D ENABLE^RAERR(...) if you do not need its return value.
 +28      ;
ENABLE(ENABLE) ;
 +1        NEW OLD
 +2        SET OLD=+$GET(RAERROR("ES"))
 +3        SET RAERROR("ES")=+ENABLE
 +4        if $QUIT
               QUIT OLD
           QUIT 
 +5       ;
 +6       ;***** GENERATES THE ERROR MESSAGE
 +7       ;
 +8       ; ERRCODE       Error code (see dialogs #700000.*).
 +9       ;
 +10      ; [[.]RAINFO]   Optional additional information: either a string or
 +11      ;               a reference to a local array that contains strings
 +12      ;               prepared for storing in a word processing field
 +13      ;               (first level nodes; no 0-nodes).
 +14      ;
 +15      ; [ARG1-ARG5]   Optional parameters for $$MSG^RAERR01.
 +16      ;
 +17      ; Return Values:
 +18      ;       <0  Error code^Message text^Error location^Type
 +19      ;        0  Ok (if ERRCODE'<0)
 +20      ;
 +21      ; NOTE: "^" is replaced with "~" in the error location stored
 +22      ;       in the 3rd piece of the error descriptor.
 +23      ;
 +24      ; NOTE: This entry point can also be called as a procedure:
 +25      ;       D ERROR^RAERR(...) if you do not need its return value.
 +26      ;
ERROR(ERRCODE,RAINFO,ARG1,ARG2,ARG3,ARG4,ARG5) ;
 +1        IF ERRCODE'<0
               if $QUIT
                   QUIT 0
               QUIT 
 +2        NEW IEN,MSG,PLACE,SL,TMP,TYPE
 +3       ;--- Get the error location
 +4        SET SL=$STACK(-1)-1
           SET PLACE=""
 +5        FOR 
               if SL'>0
                   QUIT 
               Begin DoDot:1
 +6                SET PLACE=$PIECE($STACK(SL,"PLACE")," ")
               End DoDot:1
               if '(PLACE[$TEXT(+0))
                   QUIT 
               SET SL=SL-1
 +7       ;--- Prepare the additional information
 +8        IF $DATA(RAINFO)=1
               SET TMP=RAINFO
               KILL RAINFO
               SET RAINFO(1)=TMP
 +9       ;--- Prepare the message descriptor
 +10       SET MSG=$$MSG^RAERR01(ERRCODE,.TYPE,.ARG1,.ARG2,.ARG3,.ARG4,.ARG5)
 +11       SET MSG=(+ERRCODE)_U_MSG_U_$TRANSLATE(PLACE,U,"~")_U_TYPE
 +12      ;--- Store the descriptor
 +13       if TYPE'="I"
               DO PUSH(MSG,.RAINFO)
 +14      ;--- Display the error if debug mode is on
 +15       IF $GET(RAPARAMS("DEBUG"))>1
               USE $GET(IO(0),0)
               Begin DoDot:1
 +16               DO PRTERRS^RAERR01(MSG,.RAINFO)
               End DoDot:1
               USE $GET(IO,0)
 +17      ;---
 +18       if $QUIT
               QUIT MSG
           QUIT 
 +19      ;
 +20      ;***** GENERATES THE 'INVALID PARAMETER VALUE' ERROR
 +21      ;
 +22      ; RA8NAME       Name of the parameter
 +23      ;
 +24      ; NOTE: This entry point can also be called as a procedure:
 +25      ;       D IPVE^RAERR(...) if you do not need its return value.
 +26      ;
IPVE(RA8NAME) ;
 +1        NEW RA8RC
 +2        SET RA8RC=$SELECT($DATA(@RA8NAME)#10:"'"_@RA8NAME_"'",1:"<UNDEFINED>")
 +3        SET RA8RC=$$ERROR(-3,RA8NAME_"="_RA8RC,RA8NAME)
 +4        if $QUIT
               QUIT RA8RC
           QUIT 
 +5       ;
 +6       ;***** PROCESSES THE ERROR DESCRIPTOR RETURNED BY $$LOCKFM^RALOCK
 +7       ;
 +8       ; ERROR         Error descriptor
 +9       ;
 +10      ; OBJNAME       Name of the object that the $$LOCKFM^RALOCK tried
 +11      ;               to lock when it returned the error descriptor.
 +12      ;
LOCKERR(ERROR,OBJNAME) ;
 +1        QUIT $SELECT(ERROR>0:$$ERROR(-15,$$TEXT^RALOCK(ERROR),OBJNAME),1:ERROR)
 +2       ;
 +3       ;***** PUSHES THE ERROR INTO THE ERROR STACK
 +4       ;
 +5       ; ERROR         Error descriptor
 +6       ;
 +7       ; [.RAINFO]     Reference to a local array with additional
 +8       ;               information
 +9       ;
PUSH(ERROR,RAINFO) ;
 +1        if '$GET(RAERROR("ES"))
               QUIT 
 +2        NEW IEN
 +3       ;--- Store the descriptor
 +4        SET IEN=$ORDER(RAERROR("ES"," "),-1)+1
 +5        SET RAERROR("ES",IEN,0)=ERROR
 +6        MERGE RAERROR("ES",IEN,1)=RAINFO
 +7        QUIT 
 +8       ;
 +9       ;***** ASSIGNS THE DEFAULT ERROR HANDLER
 +10      ;
 +11      ; [RCVNAME]     Name of a variable for the error code
 +12      ;
 +13      ;               See the RTEHNDLR^RAERR01 for more details.
 +14      ;
SETDEFEH(RCVNAME) ;
 +1        SET $ECODE=""
           SET $ETRAP="D RTEHNDLR^"_$NAME(RAERR01($GET(RCVNAME),$STACK(-1)-2))
 +2        QUIT