- RORERR ;HCIOFO/SG - ERROR PROCESSING ; 11/7/05 10:29am
- ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
- ;
- Q
- ;
- ;***** INITIALIZES THE ERROR STACK
- ;
- ; [DEFLOC] Default error location
- ; [ENABLE] Enable extended error processing
- ;
- ; Do not forget to NEW the RORERRDL variable before calling
- ; this procedure!
- ;
- CLEAR(DEFLOC,ENABLE) ;
- S:$D(ENABLE) RORPARM("ERR")=+$G(ENABLE)
- I $G(RORPARM("ERR")) K RORERROR("ES") S:$D(DEFLOC) RORERRDL=DEFLOC
- D CLEAN^DILF
- Q
- ;
- ;***** CHECKS THE ERRORS AFTER A FILEMAN DBS CALL
- ;
- ; ROR8MSG Closed reference of the error messages array
- ; (from DBS calls)
- ; [ERRCODE] Error code to assign
- ; [PLACE] Location of the error (see the $$ERROR)
- ; [PATIEN] Patient IEN
- ; [FILE] File number used in the DBS call
- ; [IENS] IENS used in the DBS call
- ;
- ; The $$DBS^RORERR function checks the DIERR and @ROR8MSG 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 ERRCODE
- ; parameter:
- ;
- ; If ERRCODE is omitted or equals 0, the function returns a string
- ; containing the list of error codes separated by comma.
- ;
- ; If ERRCODE is not zero, the $$ERROR^RORERR function is called and
- ; its return value is returned.
- ;
- ; NOTE: This entry point can also be called as a procedure:
- ; D DBS^RORERR(...) if you do not need its return value.
- ;
- DBS(ROR8MSG,ERRCODE,PLACE,PATIEN,FILE,IENS) ;
- K RORERROR("DBS")
- I '$G(DIERR) Q:$QUIT "" Q
- N ERRLST,ERRNODE,I,MSGTEXT
- S ERRNODE=$S($G(ROR8MSG)'="":$NA(@ROR8MSG@("DIERR")),1:$NA(^TMP("DIERR",$J)))
- I $D(@ERRNODE)<10 Q:$QUIT "" Q
- ;--- Get a list of errors
- S I=0
- F S I=$O(@ERRNODE@("E",I)) Q:'I S RORERROR("DBS",I)=""
- ;--- Return a list of errors
- I '$G(ERRCODE) D Q:$QUIT $P(ERRLST,",",2,99) Q
- . S ERRLST="",I=0
- . F S I=$O(RORERROR("DBS",I)) Q:'I S ERRLST=ERRLST_","_I
- . D CLEAN^DILF
- ;--- Record/display the error message
- D MSG^DIALOG("AE",.MSGTEXT,,,$G(ROR8MSG)),CLEAN^DILF
- S I=$S($G(FILE):"; File #"_FILE,1:"")
- S:$G(IENS)'="" I=I_"; IENS: """_IENS_""""
- S I=$$ERROR(ERRCODE,.PLACE,.MSGTEXT,.PATIEN,I)
- Q:$QUIT I Q
- ;
- ;***** SETS DEFAULT ERROR LOCATION
- ;
- ; DEFLOC Default error location
- ;
- ; Do not forget to NEW the RORERRDL variable before calling
- ; this procedure!
- ;
- DFLTLOC(DEFLOC) ;
- I $G(RORPARM("ERR")) S RORERRDL=DEFLOC
- D CLEAN^DILF
- Q
- ;
- ;***** DISPLAYS CONTENT OF THE ERROR STACK
- DSPSTK() ;
- Q:'$G(RORPARM("ERR"))!($D(RORERROR("ES"))<10)
- N EPTR,I,TMP
- D DSPSTKL("Err Message Text",1)
- D DSPSTKL(" Additional info")
- S EPTR=""
- F S EPTR=$O(RORERROR("ES",EPTR)) Q:EPTR="" D
- . S TMP=RORERROR("ES",EPTR)
- . D DSPSTKL($J(+TMP,4)_" "_$P(TMP,U,2),1)
- . S TMP=$G(RORERROR("ES",EPTR,1))
- . D:TMP'="" DSPSTKL(" Location: "_TMP)
- . S I=""
- . F S I=$O(RORERROR("ES",EPTR,2,I)) Q:I="" D
- . . D DSPSTKL(" "_RORERROR("ES",EPTR,2,I))
- Q
- ;
- ; MSG Message to display
- ; [SKIP] Skip a line before the output
- ;
- DSPSTKL(MSG,SKIP) ;
- I '$G(RORPARM("KIDS")) W:$G(SKIP) ! W MSG,! Q
- I $G(SKIP) D BMES^XPDUTL(MSG) Q
- D MES^XPDUTL(MSG)
- Q
- ;
- ;***** PUTS THE ERROR IN THE ERROR STACK AND LOG FILE
- ;
- ; ERRCODE Error code. Debug messages, information messages,
- ; data quality warnings and warnings are not placed
- ; into the stack. However, they are logged and
- ; displayed if this is enabled.
- ;
- ; [PLACE] Location of the error (TAG^ROUTINE).
- ;
- ; If the parameter is undefined then the location is
- ; extracted from the stack (see description of the
- ; $STACK function for more details).
- ;
- ; If an empty string is used as a value of the
- ; parameter then the default location is used
- ; (that has been set by CLEAR or DFLTLOC).
- ;
- ; [[.]RORINFO] Optional additional information (either a string or
- ; a reference to a local array that contains strings
- ; prepared for storing in a word processing field)
- ;
- ; [PATIEN] Patient IEN
- ;
- ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
- ; (|1| is substituted by the value of the PATIEN)
- ;
- ; Return Values:
- ; <0 Error code (value of the ERRCODE)
- ; 0 Ok (if ERRCOCE'<0)
- ;
- ; NOTE: This entry point can also be called as a procedure:
- ; D ERROR^RORERR(...) if you do not need its return value.
- ;
- ERROR(ERRCODE,PLACE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
- I ERRCODE'<0 Q:$QUIT 0 Q
- N IR,SL,MSG,TOP,TYPE
- D:'$D(PLACE)
- . S SL=$STACK(-1)-1
- . F Q:SL'>0 D Q:'(PLACE["^RORERR") S SL=SL-1
- . . S PLACE=$P($STACK(SL,"PLACE")," ")
- S:$G(PLACE)="" PLACE=$G(RORERRDL)
- I $D(RORINFO)=1 S IR=RORINFO K RORINFO S RORINFO(1)=IR,IR=1
- E S IR=$O(RORINFO(""),-1)
- S MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
- ;--- Put the error to the error stack
- D:$G(RORPARM("ERR"))&(TYPE>4)
- . S (RORERROR("ES"),TOP)=$G(RORERROR("ES"))+1
- . S RORERROR("ES",TOP)=+ERRCODE_U_MSG
- . S RORERROR("ES",TOP,1)=PLACE
- . M:$D(RORINFO) RORERROR("ES",TOP,2)=RORINFO
- ;--- Log the message
- S:PLACE'="" IR=IR+1,RORINFO(IR)="Location: "_PLACE
- D LOG^RORLOG(TYPE,MSG,$G(PATIEN),.RORINFO),CLEAN^DILF
- Q:$QUIT ERRCODE Q
- ;
- ;***** CHECKS FOR INVALID POINTER ERROR
- ;
- ; FILE Number of the 'pointed from' file
- ; IENS IENS of the record of the file
- ; FIELD Number of the pointer field
- ; [PLACE] Location of the error (see the $$ERROR)
- ; [PATIEN] Patient IEN
- ; [ERRCODE] Error code to assign (-79 by default)
- ;
- ; The $$INVLDPTR^RORERR function checks the list of latest FileMan
- ; DBS error codes for the pointer errors.
- ;
- ; Return Values:
- ;
- ; If there are no pointer errors found, the function returns zero.
- ; Otherwise, the $$ERROR^RORERR function is called and its value
- ; is returned (a negative value of the ERRCODE or -79 by default).
- ;
- INVLDPTR(FILE,IENS,FIELD,PLACE,PATIEN,ERRCODE) ;
- Q:$D(RORERROR("DBS"))<10 0
- N EC,TMP
- F EC=601,0 Q:$D(RORERROR("DBS",EC))
- Q:'EC 0
- S TMP="File #"_FILE_"; IENS: """_IENS_"""; Field: "_FIELD
- Q $$ERROR($S($G(ERRCODE)<0:ERRCODE,1:-79),$G(PLACE),.TMP,.PATIEN)
- ;
- ;***** RECORDS THE ERROR MESSAGE INTO THE LOG FILE
- ;
- ; ERRCODE Error code.
- ;
- ; [[.]RORINFO] Optional additional information (either a string or
- ; a reference to a local array that contains strings
- ; prepared for storing in a word processing field)
- ;
- ; [PATIEN] Patient IEN
- ;
- ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
- ; (|1| is substituted by the value of the PATIEN)
- ;
- LOG(ERRCODE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
- Q:ERRCODE'<0
- N MSG,TYPE
- S MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
- D LOG^RORLOG(TYPE,MSG,$G(PATIEN),.RORINFO)
- Q
- ;
- ;***** RETURNS THE ERROR STACK FOR 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 the error descriptors
- ;
- ; RESULT(i) Error descriptor
- ; ^01: Error code
- ; ^02: Message
- ; ^03: Place of the error
- ; 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(RORERROR("ES"))<10
- ;
- S EPTR="",(CNT,ECNT)=0
- F S EPTR=$O(RORERROR("ES",EPTR),-1) Q:EPTR="" D
- . S TMP=$G(RORERROR("ES",EPTR)),CNT=CNT+1,ECNT=ECNT+1
- . S RESULT(CNT)=(+TMP)_U_$TR($P(TMP,U,2,999),U,"~")
- . S TMP=$G(RORERROR("ES",EPTR,1))
- . S $P(RESULT(CNT),U,3)=$TR(TMP,U,"~")
- . S I=0
- . F S I=$O(RORERROR("ES",EPTR,2,I)) Q:I'>0 D
- . . S CNT=CNT+1,$P(RESULT(CNT),U,2)=RORERROR("ES",EPTR,2,I)
- ;
- S $P(RESULT(0),U,2)=ECNT
- K ^TMP("DILIST",$J)
- Q
- ;
- ;***** DUMPS LOCAL VARIABLES INTO THE LOG
- ;
- ; M1S2G Message code.
- ;
- ; V1A2R3S List of local variables separated by commas
- ;
- VARDUMP(M1S2G,V1A2R3S) ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORERR 8750 printed Jan 18, 2025@02:42:38 Page 2
- RORERR ;HCIOFO/SG - ERROR PROCESSING ; 11/7/05 10:29am
- +1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;***** INITIALIZES THE ERROR STACK
- +6 ;
- +7 ; [DEFLOC] Default error location
- +8 ; [ENABLE] Enable extended error processing
- +9 ;
- +10 ; Do not forget to NEW the RORERRDL variable before calling
- +11 ; this procedure!
- +12 ;
- CLEAR(DEFLOC,ENABLE) ;
- +1 if $DATA(ENABLE)
- SET RORPARM("ERR")=+$GET(ENABLE)
- +2 IF $GET(RORPARM("ERR"))
- KILL RORERROR("ES")
- if $DATA(DEFLOC)
- SET RORERRDL=DEFLOC
- +3 DO CLEAN^DILF
- +4 QUIT
- +5 ;
- +6 ;***** CHECKS THE ERRORS AFTER A FILEMAN DBS CALL
- +7 ;
- +8 ; ROR8MSG Closed reference of the error messages array
- +9 ; (from DBS calls)
- +10 ; [ERRCODE] Error code to assign
- +11 ; [PLACE] Location of the error (see the $$ERROR)
- +12 ; [PATIEN] Patient IEN
- +13 ; [FILE] File number used in the DBS call
- +14 ; [IENS] IENS used in the DBS call
- +15 ;
- +16 ; The $$DBS^RORERR function checks the DIERR and @ROR8MSG variables
- +17 ; for errors after a FileMan DBS call.
- +18 ;
- +19 ; Return Values:
- +20 ;
- +21 ; If there are no errors found, it returns an empty string.
- +22 ; In case of errors, the result depends on value of the ERRCODE
- +23 ; parameter:
- +24 ;
- +25 ; If ERRCODE is omitted or equals 0, the function returns a string
- +26 ; containing the list of error codes separated by comma.
- +27 ;
- +28 ; If ERRCODE is not zero, the $$ERROR^RORERR function is called and
- +29 ; its return value is returned.
- +30 ;
- +31 ; NOTE: This entry point can also be called as a procedure:
- +32 ; D DBS^RORERR(...) if you do not need its return value.
- +33 ;
- DBS(ROR8MSG,ERRCODE,PLACE,PATIEN,FILE,IENS) ;
- +1 KILL RORERROR("DBS")
- +2 IF '$GET(DIERR)
- if $QUIT
- QUIT ""
- QUIT
- +3 NEW ERRLST,ERRNODE,I,MSGTEXT
- +4 SET ERRNODE=$SELECT($GET(ROR8MSG)'="":$NAME(@ROR8MSG@("DIERR")),1:$NAME(^TMP("DIERR",$JOB)))
- +5 IF $DATA(@ERRNODE)<10
- if $QUIT
- QUIT ""
- QUIT
- +6 ;--- Get a list of errors
- +7 SET I=0
- +8 FOR
- SET I=$ORDER(@ERRNODE@("E",I))
- if 'I
- QUIT
- SET RORERROR("DBS",I)=""
- +9 ;--- Return a list of errors
- +10 IF '$GET(ERRCODE)
- Begin DoDot:1
- +11 SET ERRLST=""
- SET I=0
- +12 FOR
- SET I=$ORDER(RORERROR("DBS",I))
- if 'I
- QUIT
- SET ERRLST=ERRLST_","_I
- +13 DO CLEAN^DILF
- End DoDot:1
- if $QUIT
- QUIT $PIECE(ERRLST,",",2,99)
- QUIT
- +14 ;--- Record/display the error message
- +15 DO MSG^DIALOG("AE",.MSGTEXT,,,$GET(ROR8MSG))
- DO CLEAN^DILF
- +16 SET I=$SELECT($GET(FILE):"; File #"_FILE,1:"")
- +17 if $GET(IENS)'=""
- SET I=I_"; IENS: """_IENS_""""
- +18 SET I=$$ERROR(ERRCODE,.PLACE,.MSGTEXT,.PATIEN,I)
- +19 if $QUIT
- QUIT I
- QUIT
- +20 ;
- +21 ;***** SETS DEFAULT ERROR LOCATION
- +22 ;
- +23 ; DEFLOC Default error location
- +24 ;
- +25 ; Do not forget to NEW the RORERRDL variable before calling
- +26 ; this procedure!
- +27 ;
- DFLTLOC(DEFLOC) ;
- +1 IF $GET(RORPARM("ERR"))
- SET RORERRDL=DEFLOC
- +2 DO CLEAN^DILF
- +3 QUIT
- +4 ;
- +5 ;***** DISPLAYS CONTENT OF THE ERROR STACK
- DSPSTK() ;
- +1 if '$GET(RORPARM("ERR"))!($DATA(RORERROR("ES"))<10)
- QUIT
- +2 NEW EPTR,I,TMP
- +3 DO DSPSTKL("Err Message Text",1)
- +4 DO DSPSTKL(" Additional info")
- +5 SET EPTR=""
- +6 FOR
- SET EPTR=$ORDER(RORERROR("ES",EPTR))
- if EPTR=""
- QUIT
- Begin DoDot:1
- +7 SET TMP=RORERROR("ES",EPTR)
- +8 DO DSPSTKL($JUSTIFY(+TMP,4)_" "_$PIECE(TMP,U,2),1)
- +9 SET TMP=$GET(RORERROR("ES",EPTR,1))
- +10 if TMP'=""
- DO DSPSTKL(" Location: "_TMP)
- +11 SET I=""
- +12 FOR
- SET I=$ORDER(RORERROR("ES",EPTR,2,I))
- if I=""
- QUIT
- Begin DoDot:2
- +13 DO DSPSTKL(" "_RORERROR("ES",EPTR,2,I))
- End DoDot:2
- End DoDot:1
- +14 QUIT
- +15 ;
- +16 ; MSG Message to display
- +17 ; [SKIP] Skip a line before the output
- +18 ;
- DSPSTKL(MSG,SKIP) ;
- +1 IF '$GET(RORPARM("KIDS"))
- if $GET(SKIP)
- WRITE !
- WRITE MSG,!
- QUIT
- +2 IF $GET(SKIP)
- DO BMES^XPDUTL(MSG)
- QUIT
- +3 DO MES^XPDUTL(MSG)
- +4 QUIT
- +5 ;
- +6 ;***** PUTS THE ERROR IN THE ERROR STACK AND LOG FILE
- +7 ;
- +8 ; ERRCODE Error code. Debug messages, information messages,
- +9 ; data quality warnings and warnings are not placed
- +10 ; into the stack. However, they are logged and
- +11 ; displayed if this is enabled.
- +12 ;
- +13 ; [PLACE] Location of the error (TAG^ROUTINE).
- +14 ;
- +15 ; If the parameter is undefined then the location is
- +16 ; extracted from the stack (see description of the
- +17 ; $STACK function for more details).
- +18 ;
- +19 ; If an empty string is used as a value of the
- +20 ; parameter then the default location is used
- +21 ; (that has been set by CLEAR or DFLTLOC).
- +22 ;
- +23 ; [[.]RORINFO] Optional additional information (either a string or
- +24 ; a reference to a local array that contains strings
- +25 ; prepared for storing in a word processing field)
- +26 ;
- +27 ; [PATIEN] Patient IEN
- +28 ;
- +29 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
- +30 ; (|1| is substituted by the value of the PATIEN)
- +31 ;
- +32 ; Return Values:
- +33 ; <0 Error code (value of the ERRCODE)
- +34 ; 0 Ok (if ERRCOCE'<0)
- +35 ;
- +36 ; NOTE: This entry point can also be called as a procedure:
- +37 ; D ERROR^RORERR(...) if you do not need its return value.
- +38 ;
- ERROR(ERRCODE,PLACE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
- +1 IF ERRCODE'<0
- if $QUIT
- QUIT 0
- QUIT
- +2 NEW IR,SL,MSG,TOP,TYPE
- +3 if '$DATA(PLACE)
- Begin DoDot:1
- +4 SET SL=$STACK(-1)-1
- +5 FOR
- if SL'>0
- QUIT
- Begin DoDot:2
- +6 SET PLACE=$PIECE($STACK(SL,"PLACE")," ")
- End DoDot:2
- if '(PLACE["^RORERR")
- QUIT
- SET SL=SL-1
- End DoDot:1
- +7 if $GET(PLACE)=""
- SET PLACE=$GET(RORERRDL)
- +8 IF $DATA(RORINFO)=1
- SET IR=RORINFO
- KILL RORINFO
- SET RORINFO(1)=IR
- SET IR=1
- +9 IF '$TEST
- SET IR=$ORDER(RORINFO(""),-1)
- +10 SET MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
- +11 ;--- Put the error to the error stack
- +12 if $GET(RORPARM("ERR"))&(TYPE>4)
- Begin DoDot:1
- +13 SET (RORERROR("ES"),TOP)=$GET(RORERROR("ES"))+1
- +14 SET RORERROR("ES",TOP)=+ERRCODE_U_MSG
- +15 SET RORERROR("ES",TOP,1)=PLACE
- +16 if $DATA(RORINFO)
- MERGE RORERROR("ES",TOP,2)=RORINFO
- End DoDot:1
- +17 ;--- Log the message
- +18 if PLACE'=""
- SET IR=IR+1
- SET RORINFO(IR)="Location: "_PLACE
- +19 DO LOG^RORLOG(TYPE,MSG,$GET(PATIEN),.RORINFO)
- DO CLEAN^DILF
- +20 if $QUIT
- QUIT ERRCODE
- QUIT
- +21 ;
- +22 ;***** CHECKS FOR INVALID POINTER ERROR
- +23 ;
- +24 ; FILE Number of the 'pointed from' file
- +25 ; IENS IENS of the record of the file
- +26 ; FIELD Number of the pointer field
- +27 ; [PLACE] Location of the error (see the $$ERROR)
- +28 ; [PATIEN] Patient IEN
- +29 ; [ERRCODE] Error code to assign (-79 by default)
- +30 ;
- +31 ; The $$INVLDPTR^RORERR function checks the list of latest FileMan
- +32 ; DBS error codes for the pointer errors.
- +33 ;
- +34 ; Return Values:
- +35 ;
- +36 ; If there are no pointer errors found, the function returns zero.
- +37 ; Otherwise, the $$ERROR^RORERR function is called and its value
- +38 ; is returned (a negative value of the ERRCODE or -79 by default).
- +39 ;
- INVLDPTR(FILE,IENS,FIELD,PLACE,PATIEN,ERRCODE) ;
- +1 if $DATA(RORERROR("DBS"))<10
- QUIT 0
- +2 NEW EC,TMP
- +3 FOR EC=601,0
- if $DATA(RORERROR("DBS",EC))
- QUIT
- +4 if 'EC
- QUIT 0
- +5 SET TMP="File #"_FILE_"; IENS: """_IENS_"""; Field: "_FIELD
- +6 QUIT $$ERROR($SELECT($GET(ERRCODE)<0:ERRCODE,1:-79),$GET(PLACE),.TMP,.PATIEN)
- +7 ;
- +8 ;***** RECORDS THE ERROR MESSAGE INTO THE LOG FILE
- +9 ;
- +10 ; ERRCODE Error code.
- +11 ;
- +12 ; [[.]RORINFO] Optional additional information (either a string or
- +13 ; a reference to a local array that contains strings
- +14 ; prepared for storing in a word processing field)
- +15 ;
- +16 ; [PATIEN] Patient IEN
- +17 ;
- +18 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
- +19 ; (|1| is substituted by the value of the PATIEN)
- +20 ;
- LOG(ERRCODE,RORINFO,PATIEN,ARG2,ARG3,ARG4,ARG5) ;
- +1 if ERRCODE'<0
- QUIT
- +2 NEW MSG,TYPE
- +3 SET MSG=$$MSG^RORERR20(+ERRCODE,.TYPE,.PATIEN,.ARG2,.ARG3,.ARG4,.ARG5)
- +4 DO LOG^RORLOG(TYPE,MSG,$GET(PATIEN),.RORINFO)
- +5 QUIT
- +6 ;
- +7 ;***** RETURNS THE ERROR STACK FOR A REMOTE PROCEDURE
- +8 ;
- +9 ; .RESULT Reference to a local variable where the error
- +10 ; descriptors are returned to.
- +11 ;
- +12 ; LASTERR The last error code
- +13 ;
- +14 ; Return Values:
- +15 ;
- +16 ; RESULT(0) Result descriptor
- +17 ; ^01: The last error code (LASTERR)
- +18 ; ^02: Number of the error descriptors
- +19 ;
- +20 ; RESULT(i) Error descriptor
- +21 ; ^01: Error code
- +22 ; ^02: Message
- +23 ; ^03: Place of the error
- +24 ; RESULT(j) Line of the additional info
- +25 ; ^01: ""
- +26 ; ^02: Text
- +27 ;
- +28 ; Error descriptors are returned in reverse chronological order
- +29 ; (most recent first).
- +30 ;
- 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(RORERROR("ES"))<10
- QUIT
- +5 ;
- +6 SET EPTR=""
- SET (CNT,ECNT)=0
- +7 FOR
- SET EPTR=$ORDER(RORERROR("ES",EPTR),-1)
- if EPTR=""
- QUIT
- Begin DoDot:1
- +8 SET TMP=$GET(RORERROR("ES",EPTR))
- SET CNT=CNT+1
- SET ECNT=ECNT+1
- +9 SET RESULT(CNT)=(+TMP)_U_$TRANSLATE($PIECE(TMP,U,2,999),U,"~")
- +10 SET TMP=$GET(RORERROR("ES",EPTR,1))
- +11 SET $PIECE(RESULT(CNT),U,3)=$TRANSLATE(TMP,U,"~")
- +12 SET I=0
- +13 FOR
- SET I=$ORDER(RORERROR("ES",EPTR,2,I))
- if I'>0
- QUIT
- Begin DoDot:2
- +14 SET CNT=CNT+1
- SET $PIECE(RESULT(CNT),U,2)=RORERROR("ES",EPTR,2,I)
- End DoDot:2
- End DoDot:1
- +15 ;
- +16 SET $PIECE(RESULT(0),U,2)=ECNT
- +17 KILL ^TMP("DILIST",$JOB)
- +18 QUIT
- +19 ;
- +20 ;***** DUMPS LOCAL VARIABLES INTO THE LOG
- +21 ;
- +22 ; M1S2G Message code.
- +23 ;
- +24 ; V1A2R3S List of local variables separated by commas
- +25 ;
- VARDUMP(M1S2G,V1A2R3S) ;
- +1 QUIT