ORERRH ; SLC/AGP - Error handling routines;Jul 10, 2023@09:19:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,588**;Dec 17, 1997;Build 29
;
ACOPY(REF,OUTPUT) ;Copy all the descendants of the array reference into a linear
;array. REF is the starting array reference, for example A or
;^TMP("OR",$J). OUTPUT is the linear array for the output. It
;should be in the form of a closed root, i.e., A() or ^TMP($J,).
;Note OUTPUT cannot be used as the name of the output array.
N DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP
I REF="" Q
S NL=0
S OROOT=$P(OUTPUT,")",1)
S PROOT=$P(REF,")",1)
;Build the root so we can tell when we are done.
S TEMP=$NA(@REF)
S ROOT=$P(TEMP,")",1)
S REF=$Q(@REF)
I REF'[ROOT Q
S DONE=0
F Q:(REF="")!(DONE) D
. S START=$F(REF,ROOT)
. S LEN=$L(REF)
. S IND=$E(REF,START,LEN)
. S NL=NL+1
. S OUT=OROOT_NL_")"
. S @OUT=PROOT_IND_"="_@REF
. S REF=$Q(@REF)
. I REF'[ROOT S DONE=1
Q
;
BUILDMSG(TYPE,ERROR) ;
N CNT,ERR,INDEX
I TYPE=1 D Q
.S CNT=0
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="The following error occurred while saving PCE Data:"
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=ERROR
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="Please contact the help desk for assistance."
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=" "
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="See below for the data that was not saved:"
.S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="NOTEIEN: "_+$G(NOTEIEN)
.s CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)="LOCATION: "_+$G(ORLOC)
.D ACOPY("PCELIST","ERR()")
.S INDEX=0 F S INDEX=$O(ERR(INDEX)) Q:INDEX'>0 S CNT=CNT+1,^TMP("OR MSG",$J,CNT,0)=ERR(INDEX)
I TYPE=2 D Q
.S CNT=$O(^TMP($J,"ORORDRPT ERRORS",""),-1)+1
.S CNT=CNT+1,^TMP($J,"ORORDRPT ERRORS",CNT)=""
.S CNT=CNT+1,^TMP($J,"ORORDRPT ERRORS",CNT)="Patient: "_$G(ORERRARR("PATIENT"))_" Order #: "_ORERRARR("IEN")
Q
;
;=================================================================
ERRHRLR(TYPE,HEADER) ;PCE Save Data error handler. Send a MailMan message to the OR CACS mail group
;by the site and put the error in the error trap.
;References to %ZTER covered by DBIA #1621.
N ERROR,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
S ERROR=$$EC^%ZOSV
;Ignore the "errors" the unwinder creates.
I ERROR["ZTER" D UNWIND^%ZTER
;Make sure we don't loop if there is an error during processing of
;the error handler.
N $ET S $ET="D ^%ZTER,CLEAN^ORERRH,UNWIND^%ZTER"
;
;Save the error then put it in the error trap, this saves the correct
;last global reference.
D ^%ZTER
;
;
S XMDUZ="CPRS, SEARCH",XMSUB=$G(HEADER),XMTEXT="^TMP(""OR MSG"",$J,",XMY(DUZ)="",XMY("G.OR CACS")=""
K ^TMP("OR MSG",$J)
D BUILDMSG(TYPE,ERROR)
;
I TYPE'=2 D ^XMD
;
D CLEAN
S RESULT(0)="-1^"
S RESULT(1)="A Mumps error occurred while saving data."
D UNWIND^%ZTER
Q
;
;=================================================================
CLEAN ;Clean-up scratch arrays
K ^TMP("OR MSG")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORERRH 2953 printed Oct 16, 2024@18:31:11 Page 2
ORERRH ; SLC/AGP - Error handling routines;Jul 10, 2023@09:19:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377,588**;Dec 17, 1997;Build 29
+2 ;
ACOPY(REF,OUTPUT) ;Copy all the descendants of the array reference into a linear
+1 ;array. REF is the starting array reference, for example A or
+2 ;^TMP("OR",$J). OUTPUT is the linear array for the output. It
+3 ;should be in the form of a closed root, i.e., A() or ^TMP($J,).
+4 ;Note OUTPUT cannot be used as the name of the output array.
+5 NEW DONE,IND,LEN,NL,OROOT,OUT,PROOT,ROOT,START,TEMP
+6 IF REF=""
QUIT
+7 SET NL=0
+8 SET OROOT=$PIECE(OUTPUT,")",1)
+9 SET PROOT=$PIECE(REF,")",1)
+10 ;Build the root so we can tell when we are done.
+11 SET TEMP=$NAME(@REF)
+12 SET ROOT=$PIECE(TEMP,")",1)
+13 SET REF=$QUERY(@REF)
+14 IF REF'[ROOT
QUIT
+15 SET DONE=0
+16 FOR
if (REF="")!(DONE)
QUIT
Begin DoDot:1
+17 SET START=$FIND(REF,ROOT)
+18 SET LEN=$LENGTH(REF)
+19 SET IND=$EXTRACT(REF,START,LEN)
+20 SET NL=NL+1
+21 SET OUT=OROOT_NL_")"
+22 SET @OUT=PROOT_IND_"="_@REF
+23 SET REF=$QUERY(@REF)
+24 IF REF'[ROOT
SET DONE=1
End DoDot:1
+25 QUIT
+26 ;
BUILDMSG(TYPE,ERROR) ;
+1 NEW CNT,ERR,INDEX
+2 IF TYPE=1
Begin DoDot:1
+3 SET CNT=0
+4 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="The following error occurred while saving PCE Data:"
+5 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=ERROR
+6 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="Please contact the help desk for assistance."
+7 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=" "
+8 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="See below for the data that was not saved:"
+9 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="NOTEIEN: "_+$GET(NOTEIEN)
+10 SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)="LOCATION: "_+$GET(ORLOC)
+11 DO ACOPY("PCELIST","ERR()")
+12 SET INDEX=0
FOR
SET INDEX=$ORDER(ERR(INDEX))
if INDEX'>0
QUIT
SET CNT=CNT+1
SET ^TMP("OR MSG",$JOB,CNT,0)=ERR(INDEX)
End DoDot:1
QUIT
+13 IF TYPE=2
Begin DoDot:1
+14 SET CNT=$ORDER(^TMP($JOB,"ORORDRPT ERRORS",""),-1)+1
+15 SET CNT=CNT+1
SET ^TMP($JOB,"ORORDRPT ERRORS",CNT)=""
+16 SET CNT=CNT+1
SET ^TMP($JOB,"ORORDRPT ERRORS",CNT)="Patient: "_$GET(ORERRARR("PATIENT"))_" Order #: "_ORERRARR("IEN")
End DoDot:1
QUIT
+17 QUIT
+18 ;
+19 ;=================================================================
ERRHRLR(TYPE,HEADER) ;PCE Save Data error handler. Send a MailMan message to the OR CACS mail group
+1 ;by the site and put the error in the error trap.
+2 ;References to %ZTER covered by DBIA #1621.
+3 NEW ERROR,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+4 SET ERROR=$$EC^%ZOSV
+5 ;Ignore the "errors" the unwinder creates.
+6 IF ERROR["ZTER"
DO UNWIND^%ZTER
+7 ;Make sure we don't loop if there is an error during processing of
+8 ;the error handler.
+9 NEW $ETRAP
SET $ETRAP="D ^%ZTER,CLEAN^ORERRH,UNWIND^%ZTER"
+10 ;
+11 ;Save the error then put it in the error trap, this saves the correct
+12 ;last global reference.
+13 DO ^%ZTER
+14 ;
+15 ;
+16 SET XMDUZ="CPRS, SEARCH"
SET XMSUB=$GET(HEADER)
SET XMTEXT="^TMP(""OR MSG"",$J,"
SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+17 KILL ^TMP("OR MSG",$JOB)
+18 DO BUILDMSG(TYPE,ERROR)
+19 ;
+20 IF TYPE'=2
DO ^XMD
+21 ;
+22 DO CLEAN
+23 SET RESULT(0)="-1^"
+24 SET RESULT(1)="A Mumps error occurred while saving data."
+25 DO UNWIND^%ZTER
+26 QUIT
+27 ;
+28 ;=================================================================
CLEAN ;Clean-up scratch arrays
+1 KILL ^TMP("OR MSG")
+2 QUIT
+3 ;
