Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMERRH

PXRMERRH.m

Go to the documentation of this file.
  1. PXRMERRH ;SLC/PKR - Error handling routines. ;01/22/2021
  1. ;;2.0;CLINICAL REMINDERS;**4,17,18,47,45,42**;Feb 04, 2005;Build 245
  1. ;
  1. ;=================================================================
  1. DERRHRLR ;PXRM error handler. Send a MailMan message to the mail group defined
  1. ;by the site and put the error in the error trap.
  1. ;References to %ZTER covered by DBIA #1621.
  1. N CNT,ERR,ERROR,INDEX,MGIEN,MGROUP,NL,XMDUZ,XMSUB,XMY,XMZ
  1. S ERROR=$$EC^%ZOSV
  1. ;Ignore the "errors" the unwinder creates.
  1. I ERROR["ZTER" D UNWIND^%ZTER
  1. ;If it is a framestack error do not try to send the message
  1. I ERROR["FRAMESTACK" Q
  1. ;Make sure we don't loop if there is an error during procesing of
  1. ;the error handler.
  1. N $ET S $ET="D ^%ZTER,DCLEAN^PXRMERRH,UNWIND^%ZTER"
  1. ;
  1. ;Save the error then put it in the error trap, this saves the correct
  1. ;last global reference.
  1. D ^%ZTER
  1. ;
  1. ;If this is a test run write out the error.
  1. ;I $G(PXRMDEBG) W !,ERROR
  1. ;
  1. K ^TMP("PXRMXMZ",$J)
  1. S CNT=0
  1. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="The following error occurred while saving general findings:"
  1. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=ERROR
  1. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="Please contact the help desk for assistance."
  1. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="See below for the data that was not saved:"
  1. D ACOPY^PXRMUTIL("DATA","ERR()")
  1. S INDEX=0 F S INDEX=$O(ERR(INDEX)) Q:INDEX'>0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=ERR(INDEX)
  1. ;
  1. S MGIEN=$G(^PXRM(800,1,"MGFE"))
  1. ;If the mail group has not been defined tell the user.
  1. I MGIEN="" D
  1. . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
  1. . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="You received this message because your IRM has not set up a mailgroup"
  1. . S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="to receive Clinical Reminder errors; please notify them."
  1. ;
  1. D SEND^PXRMMSG("PXRMXMZ","ERROR SAVING DATA","",DUZ)
  1. ;
  1. ;I '$G(PXRMDEBG) D DCLEAN
  1. S RETURN(0)="-1^A Mumps error occurred while saving data."
  1. D UNWIND^%ZTER
  1. Q
  1. ;
  1. ;=================================================================
  1. 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.
  1. ;References to %ZTER covered by DBIA #1621.
  1. N ERROR,MGIEN,MGROUP,NL,REMINDER,XMDUZ,XMSUB,XMY,XMZ
  1. S ERROR=$$EC^%ZOSV
  1. ;Ignore the "errors" the unwinder creates.
  1. I ERROR["ZTER" D UNWIND^%ZTER
  1. ;If it is a framestack error do not try to send the message
  1. I ERROR["FRAMESTACK" Q
  1. ;Make sure we don't loop if there is an error during procesing of
  1. ;the error handler.
  1. N $ET S $ET="D ^%ZTER,CLEAN^PXRMERRH,UNWIND^%ZTER"
  1. ;
  1. ;Save the error then put it in the error trap, this saves the correct
  1. ;last global reference.
  1. D ^%ZTER
  1. ;
  1. ;If this is a test run write out the error.
  1. I $G(PXRMDEBG) W !,ERROR
  1. ;
  1. K ^TMP("PXRMXMZ",$J)
  1. S ^TMP("PXRMXMZ",$J,1,0)="The following error occurred:"
  1. S ^TMP("PXRMXMZ",$J,2,0)=ERROR
  1. I +$G(PXRMITEM)>0 S REMINDER=$P(^PXD(811.9,PXRMITEM,0),U,1)
  1. E S PXRMITEM=999999,REMINDER="?"
  1. S ^TMP("PXRMXMZ",$J,3,0)="While evaluating reminder "_REMINDER
  1. S ^TMP("PXRMXMZ",$J,4,0)="For patient DFN="_$G(PXRMPDEM("DFN"))
  1. S ^TMP("PXRMXMZ",$J,5,0)="The time of the error was "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. S ^TMP("PXRMXMZ",$J,6,0)="See the error trap for complete details."
  1. S NL=6
  1. ;Look for specific error text to append to the message.
  1. I $D(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")) D
  1. . N ESOURCE,IND
  1. . S ESOURCE=""
  1. . F S ESOURCE=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE)) Q:ESOURCE="" D
  1. .. S IND=0
  1. .. F S IND=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)) Q:IND="" D
  1. ... S NL=NL+1
  1. ... S ^TMP("PXRMXMZ",$J,NL,0)=^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)
  1. ;
  1. S MGIEN=$G(^PXRM(800,1,"MGFE"))
  1. ;If the mail group has not been defined tell the user.
  1. I MGIEN="" D
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="You received this message because your IRM has not set up a mailgroup"
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="to receive Clinical Reminder errors; please notify them."
  1. ;
  1. D SEND^PXRMMSG("PXRMXMZ","ERROR EVALUATING CLINICAL REMINDER","",DUZ)
  1. I ERROR["VCPT",ERROR["PXPXRM" D VCPTINDEXREPAIR(PXRMPDEM("DFN"),ERROR)
  1. ;
  1. ;If the reminder exists mark that an error occured.
  1. I PXRMITEM=999999 Q
  1. S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")=""
  1. N DEFARR,DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE
  1. S (DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE)=""
  1. D DEF^PXRMLDR(PXRMITEM,.DEFARR)
  1. D OUTPUT^PXRMOUTD(5,.DEFARR,PCLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
  1. ;
  1. ;Set the first line of ^TMP("PXRHM") to ERROR.
  1. S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"
  1. ;
  1. I '$G(PXRMDEBG) D CLEAN
  1. D UNWIND^%ZTER
  1. Q
  1. ;
  1. ;=================================================================
  1. CLEAN ;Clean-up scratch arrays
  1. K ^TMP("PXRM",$J)
  1. I $D(PXRMPID) K ^TMP(PXRMPID,$J)
  1. Q
  1. ;
  1. DCLEAN ;
  1. Q
  1. ;
  1. ;=================================================================
  1. NODEF(IEN) ;Non-existent reminder definition.
  1. N SUBJ
  1. K ^TMP("PXRMXMZ",$J)
  1. S ^TMP("PXRMXMZ",$J,1,0)="A request was made to evaluate a non-existent reminder; the IEN is "_IEN_"."
  1. S SUBJ="Attempt to evaluate a non-existent reminder"
  1. D SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
  1. K ^TMP("PXRMXMZ",$J)
  1. D ^%ZTER
  1. Q
  1. ;
  1. ;=================================================================
  1. NOINDEX(FTYPE,IEN,FILENUM) ;Error handling for missing index.
  1. N ETEXT,SUBJ
  1. K ^TMP("PXRMXMZ",$J)
  1. S ETEXT(1)=""
  1. S ETEXT(2)="Warning: Index for file number "_FILENUM_" does not exist or is not complete."
  1. I FTYPE="D" S ETEXT(3)="Reminder "_IEN_" will not be properly evaluated!"
  1. I FTYPE="TR" S ETEXT(3)="Term "_IEN_" will not be properly evaluated!"
  1. I FTYPE="TX" S ETEXT(3)="Taxonomy "_IEN_" will not be properly evaluated!"
  1. I $D(PXRMPID) D
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","MISSING INDEX")=ETEXT(2)
  1. . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","MISSING INDEX")=ETEXT(2)
  1. ;Mail out the error message.
  1. S ^TMP("PXRMXMZ",$J,1,0)=ETEXT(2)
  1. S ^TMP("PXRMXMZ",$J,2,0)=ETEXT(3)
  1. S ^TMP("PXRMXMZ",$J,3,0)="Patient DFN="_$G(PXRMPDEM("DFN"))_", User DUZ="_DUZ_", Reminder="_$G(PXRMITEM)
  1. S SUBJ="Problem with index for file number "_FILENUM
  1. D SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
  1. K ^TMP("PXRMXMZ",$J)
  1. Q
  1. ;
  1. ;=================================================================
  1. VCPTINDEXREPAIR(DFN,ERROR) ;Repair for reminder evaluation errors caused by
  1. ;V CPT index entries that were not deleted when the V CPT entry was
  1. ;deleted.
  1. N CPT,DATE,DONE,PP,SUBJECT,TEMP,VCPTIEN
  1. K ^TMP("PXRMXMZ",$J)
  1. ;Get VCPT IEN.
  1. S TEMP=$P(ERROR,"^AUPNVCPT(",2)
  1. S VCPTIEN=$P(TEMP,",",1)
  1. I +VCPTIEN'>0 Q
  1. ;Check for a spurious error and send a message
  1. ;if one is found.
  1. I $D(^AUPNVCPT(VCPTIEN)) D Q
  1. . S SUBJECT="V CPT Index Spurious Error"
  1. . S ^TMP("PXRMXMZ",$J,1,0)="The error:"
  1. . S ^TMP("PXRMXMZ",$J,2,0)=ERROR
  1. . S ^TMP("PXRMXMZ",$J,3,0)="appears to be spurious because the V CPT entry exists."
  1. . S ^TMP("PXRMXMZ",$J,4,0)="Please enter a ticket so this can be examined."
  1. . D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
  1. . K ^TMP("PXRMXMZ",$J)
  1. ;Delete the Index entries and send a message.
  1. S DONE=0,PP=""
  1. F S PP=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP)) Q:(DONE)!(PP="") D
  1. . S CPT=""
  1. . F S CPT=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT)) Q:(DONE)!(CPT="") D
  1. .. S DATE=""
  1. .. F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE)) Q:(DONE)!(DATE="") D
  1. ... I $D(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN)) D
  1. .... K ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN)
  1. .... K ^PXRMINDX(9000010.18,"IPP",CPT,PP,DFN,DATE,VCPTIEN)
  1. .... S DONE=1
  1. ....;Send the message
  1. .... S SUBJECT="V CPT Index Repair"
  1. .... S ^TMP("PXRMXMZ",$J,1,0)="The Clinical Reminder Index entries related to the error:"
  1. .... S ^TMP("PXRMXMZ",$J,2,0)=ERROR
  1. .... S ^TMP("PXRMXMZ",$J,3,0)="have been deleted, no further action is required."
  1. .... S ^TMP("PXRMXMZ",$J,4,0)="DFN="_DFN
  1. .... S ^TMP("PXRMXMZ",$J,5,0)="PP="_PP
  1. .... S ^TMP("PXRMXMZ",$J,6,0)="CPT="_CPT
  1. .... S ^TMP("PXRMXMZ",$J,7,0)="Date="_DATE
  1. .... S ^TMP("PXRMXMZ",$J,8,0)="V CPT IEN="_VCPTIEN
  1. .... D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
  1. .... K ^TMP("PXRMXMZ",$J)
  1. Q