PXRMERRH ;SLC/PKR - Error handling routines. ;07/29/2010
;;2.0;CLINICAL REMINDERS;**4,17,18**;Feb 04, 2005;Build 152
;
;=================================================================
ERRHDLR ;PXRM error handler. Send a MailMan message to the mail group defined
;by the site and put the error in the error trap.
;References to %ZTER covered by DBIA #1621.
N ERROR,MGIEN,MGROUP,NL,REMINDER,XMDUZ,XMSUB,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 procesing of
;the error handler.
N $ET S $ET="D ^%ZTER,CLEAN^PXRMERRH,UNWIND^%ZTER"
;
;Save the error then put it in the error trap, this saves the correct
;last global reference.
D ^%ZTER
;
;If this is a test run write out the error.
I $G(PXRMDEBG) W !,ERROR
;
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="The following error occurred:"
S ^TMP("PXRMXMZ",$J,2,0)=ERROR
I +$G(PXRMITEM)>0 S REMINDER=$P(^PXD(811.9,PXRMITEM,0),U,1)
E S PXRMITEM=999999,REMINDER="?"
S ^TMP("PXRMXMZ",$J,3,0)="While evaluating reminder "_REMINDER
S ^TMP("PXRMXMZ",$J,4,0)="For patient DFN="_$G(PXRMPDEM("DFN"))
S ^TMP("PXRMXMZ",$J,5,0)="The time of the error was "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S ^TMP("PXRMXMZ",$J,6,0)="See the error trap for complete details."
S NL=6
;Look for specific error text to append to the message.
I $D(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")) D
. N ESOURCE,IND
. S ESOURCE=""
. F S ESOURCE=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE)) Q:ESOURCE="" D
.. S IND=0
.. F S IND=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)) Q:IND="" D
... S NL=NL+1
... S ^TMP("PXRMXMZ",$J,NL,0)=^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)
;
S MGIEN=$G(^PXRM(800,1,"MGFE"))
;If the mail group has not been defined tell the user.
I MGIEN="" D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="You received this message because your IRM has not set up a mailgroup"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="to receive Clinical Reminder errors; please notify them."
;
D SEND^PXRMMSG("PXRMXMZ","ERROR EVALUATING CLINICAL REMINDER","",DUZ)
;
;If the reminder exists mark that an error occured.
I PXRMITEM=999999 Q
S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")=""
N DEFARR,DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE
S (DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE)=""
D DEF^PXRMLDR(PXRMITEM,.DEFARR)
D OUTPUT^PXRMOUTD(5,.DEFARR,PCLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
;
;Set the first line of ^TMP("PXRHM") to ERROR.
S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"
;
I '$G(PXRMDEBG) D CLEAN
D UNWIND^%ZTER
Q
;
;=================================================================
CLEAN ;Clean-up scratch arrays
K ^TMP("PXRM",$J)
I $D(PXRMPID) K ^TMP(PXRMPID,$J)
Q
;
;=================================================================
NODEF(IEN) ;Non-existent reminder definition.
N SUBJ
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="A request was made to evaluate a non-existent reminder; the ien is "_IEN_"."
S ^TMP("PXRMXMZ",$J,2,0)="An entry was made in the error trap that does not have a description."
S ^TMP("PXRMXMZ",$J,3,0)="Match the time of this message with the time in the error trap."
S SUBJ="Request to evaluate a non-existent reminder"
D SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
K ^TMP("PXRMXMZ",$J)
D ^%ZTER
Q
;
;=================================================================
NOINDEX(FTYPE,IEN,FILENUM) ;Error handling for missing index.
N ETEXT,SUBJ
K ^TMP("PXRMXMZ",$J)
S ETEXT(1)=""
S ETEXT(2)="Index for file number "_FILENUM_" does not exist or is not complete."
I FTYPE="D" S ETEXT(3)="Reminder "_IEN_" will not be properly evaluated!"
I FTYPE="TR" S ETEXT(3)="Term "_IEN_" will not be properly evaluated!"
I FTYPE="TX" S ETEXT(3)="Taxonomy "_IEN_" will not be properly evaluated!"
I $D(PXRMPID) D
. S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","MISSING INDEX")=ETEXT(2)
. S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","MISSING INDEX")=ETEXT(2)
;Mail out the error message.
S ^TMP("PXRMXMZ",$J,1,0)=ETEXT(2)
S ^TMP("PXRMXMZ",$J,2,0)=ETEXT(3)
S ^TMP("PXRMXMZ",$J,3,0)="Patient DFN="_$G(PXRMPDEM("DFN"))_", User DUZ="_DUZ_", Reminder="_$G(PXRMITEM)
S SUBJ="Problem with index for file number "_FILENUM
D SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
K ^TMP("PXRMXMZ",$J)
Q
;
PXRMERRH ;SLC/PKR - Error handling routines. ;07/29/2010
+1 ;;2.0;CLINICAL REMINDERS;**4,17,18**;Feb 04, 2005;Build 152
+2 ;
+3 ;=================================================================
ERRHDLR ;PXRM error handler. Send a MailMan message to the mail group defined
+1 ;by the site and put the error in the error trap.
+2 ;References to %ZTER covered by DBIA #1621.
+3 NEW ERROR,MGIEN,MGROUP,NL,REMINDER,XMDUZ,XMSUB,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 procesing of
+8 ;the error handler.
+9 NEW $ETRAP
SET $ETRAP="D ^%ZTER,CLEAN^PXRMERRH,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 ;If this is a test run write out the error.
+16 IF $GET(PXRMDEBG)
WRITE !,ERROR
+17 ;
+18 KILL ^TMP("PXRMXMZ",$JOB)
+19 SET ^TMP("PXRMXMZ",$JOB,1,0)="The following error occurred:"
+20 SET ^TMP("PXRMXMZ",$JOB,2,0)=ERROR
+21 IF +$GET(PXRMITEM)>0
SET REMINDER=$PIECE(^PXD(811.9,PXRMITEM,0),U,1)
+22 IF '$TEST
SET PXRMITEM=999999
SET REMINDER="?"
+23 SET ^TMP("PXRMXMZ",$JOB,3,0)="While evaluating reminder "_REMINDER
+24 SET ^TMP("PXRMXMZ",$JOB,4,0)="For patient DFN="_$GET(PXRMPDEM("DFN"))
+25 SET ^TMP("PXRMXMZ",$JOB,5,0)="The time of the error was "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+26 SET ^TMP("PXRMXMZ",$JOB,6,0)="See the error trap for complete details."
+27 SET NL=6
+28 ;Look for specific error text to append to the message.
+29 IF $DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP"))
Begin DoDot:1
+30 NEW ESOURCE,IND
+31 SET ESOURCE=""
+32 FOR
SET ESOURCE=$ORDER(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE))
IF ESOURCE=""
QUIT
Begin DoDot:2
+33 SET IND=0
+34 FOR
SET IND=$ORDER(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND))
IF IND=""
QUIT
Begin DoDot:3
+35 SET NL=NL+1
+36 SET ^TMP("PXRMXMZ",$JOB,NL,0)=^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)
End DoDot:3
End DoDot:2
End DoDot:1
+37 ;
+38 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+39 ;If the mail group has not been defined tell the user.
+40 IF MGIEN=""
Begin DoDot:1
+41 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "
+42 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="You received this message because your IRM has not set up a mailgroup"
+43 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="to receive Clinical Reminder errors; please notify them."
End DoDot:1
+44 ;
+45 DO SEND^PXRMMSG("PXRMXMZ","ERROR EVALUATING CLINICAL REMINDER","",DUZ)
+46 ;
+47 ;If the reminder exists mark that an error occured.
+48 IF PXRMITEM=999999
QUIT
+49 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP")=""
+50 NEW DEFARR,DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE
+51 SET (DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE)=""
+52 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+53 DO OUTPUT^PXRMOUTD(5,.DEFARR,PCLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
+54 ;
+55 ;Set the first line of ^TMP("PXRHM") to ERROR.
+56 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"
+57 ;
+58 IF '$GET(PXRMDEBG)
DO CLEAN
+59 DO UNWIND^%ZTER
+60 QUIT
+61 ;
+62 ;=================================================================
CLEAN ;Clean-up scratch arrays
+1 KILL ^TMP("PXRM",$JOB)
+2 IF $DATA(PXRMPID)
KILL ^TMP(PXRMPID,$JOB)
+3 QUIT
+4 ;
+5 ;=================================================================
NODEF(IEN) ;Non-existent reminder definition.
+1 NEW SUBJ
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET ^TMP("PXRMXMZ",$JOB,1,0)="A request was made to evaluate a non-existent reminder; the ien is "_IEN_"."
+4 SET ^TMP("PXRMXMZ",$JOB,2,0)="An entry was made in the error trap that does not have a description."
+5 SET ^TMP("PXRMXMZ",$JOB,3,0)="Match the time of this message with the time in the error trap."
+6 SET SUBJ="Request to evaluate a non-existent reminder"
+7 DO SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
+8 KILL ^TMP("PXRMXMZ",$JOB)
+9 DO ^%ZTER
+10 QUIT
+11 ;
+12 ;=================================================================
NOINDEX(FTYPE,IEN,FILENUM) ;Error handling for missing index.
+1 NEW ETEXT,SUBJ
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET ETEXT(1)=""
+4 SET ETEXT(2)="Index for file number "_FILENUM_" does not exist or is not complete."
+5 IF FTYPE="D"
SET ETEXT(3)="Reminder "_IEN_" will not be properly evaluated!"
+6 IF FTYPE="TR"
SET ETEXT(3)="Term "_IEN_" will not be properly evaluated!"
+7 IF FTYPE="TX"
SET ETEXT(3)="Taxonomy "_IEN_" will not be properly evaluated!"
+8 IF $DATA(PXRMPID)
Begin DoDot:1
+9 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"WARNING","MISSING INDEX")=ETEXT(2)
+10 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"INFO","MISSING INDEX")=ETEXT(2)
End DoDot:1
+11 ;Mail out the error message.
+12 SET ^TMP("PXRMXMZ",$JOB,1,0)=ETEXT(2)
+13 SET ^TMP("PXRMXMZ",$JOB,2,0)=ETEXT(3)
+14 SET ^TMP("PXRMXMZ",$JOB,3,0)="Patient DFN="_$GET(PXRMPDEM("DFN"))_", User DUZ="_DUZ_", Reminder="_$GET(PXRMITEM)
+15 SET SUBJ="Problem with index for file number "_FILENUM
+16 DO SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
+17 KILL ^TMP("PXRMXMZ",$JOB)
+18 QUIT
+19 ;
