source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMERRH.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1PXRMERRH ; SLC/PKR - Error handling routines. ;03/27/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;=================================================================
5ERRHDLR ;PXRM error handler. Send a MailMan message to the mail group defined
6 ;by the site and put the error in the error trap.
7 ;References to %ZTER covered by DBIA #1621.
8 N ERROR,MGIEN,MGROUP,NL,REMINDER,XMDUZ,XMSUB,XMY,XMZ
9 S ERROR=$$EC^%ZOSV
10 ;Ignore the "errors" the unwinder creates.
11 I ERROR["ZTER" D UNWIND^%ZTER
12 ;Make sure we don't loop if there is an error during procesing of
13 ;the error handler.
14 N $ET S $ET="D ^%ZTER,CLEAN^PXRMERRH,UNWIND^%ZTER"
15 ;
16 ;Save the error then put it in the error trap, this saves the correct
17 ;last global reference.
18 D ^%ZTER
19 ;
20 ;If this is a test run write out the error.
21 I $G(PXRMDEBG) W !,ERROR
22 ;
23 ;Make the sender the Postmaster.
24 S XMDUZ=0.5
25 S XMSUB="ERROR EVALUATING CLINICAL REMINDER"
26 ;
27RETRY ;Get the message number.
28 D XMZ^XMA2
29 I XMZ<1 G RETRY
30 ;
31 ;Load the message
32 S ^XMB(3.9,XMZ,2,1,0)="The following error occurred:"
33 S ^XMB(3.9,XMZ,2,2,0)=ERROR
34 I +$G(PXRMITEM)>0 S REMINDER=$P(^PXD(811.9,PXRMITEM,0),U,1)
35 E S PXRMITEM=999999,REMINDER="?"
36 S ^XMB(3.9,XMZ,2,3,0)="While evaluating reminder "_REMINDER
37 S ^XMB(3.9,XMZ,2,4,0)="For patient DFN="_$G(PXRMPDEM("DFN"))
38 S ^XMB(3.9,XMZ,2,5,0)="The time of the error was "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
39 S ^XMB(3.9,XMZ,2,6,0)="See the error trap for complete details."
40 S NL=6
41 ;Look for specific error text to append to the message.
42 I $D(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")) D
43 . N ESOURCE,IND
44 . S ESOURCE=""
45 . F S ESOURCE=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE)) Q:ESOURCE="" D
46 .. S IND=0
47 .. F S IND=$O(^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)) Q:IND="" D
48 ... S NL=NL+1
49 ... S ^XMB(3.9,XMZ,2,NL,0)=^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)
50 ;
51 ;Send the message to the site defined mailgroup.
52 S MGIEN=$G(^PXRM(800,1,"MGFE"))
53 ;If the mailgroup has not been defined send the message to the user.
54 I MGIEN="" D
55 . S MGROUP=DUZ
56 . S NL=NL+1,^XMB(3.9,XMZ,2,NL,0)=" "
57 . S NL=NL+1,^XMB(3.9,XMZ,2,NL,0)="You received this message because your IRM has not set up a mailgroup"
58 . S NL=NL+1,^XMB(3.9,XMZ,2,NL,0)="to receive Clinical Reminder errors; please notify them."
59 E S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
60 ;
61 S ^XMB(3.9,XMZ,2,0)="^3.92^"_+NL_U_+NL_U_DT
62 S XMY(MGROUP)=""
63 D ENT1^XMD
64 ;
65 ;If the reminder exists mark that an error occured.
66 I PXRMITEM=999999 Q
67 S ^TMP(PXRMPID,$J,PXRMITEM,"FERROR","ERROR TRAP")=""
68 N DEFARR,DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE
69 S (DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE)=""
70 D DEF^PXRMLDR(PXRMITEM,.DEFARR)
71 D OUTPUT^PXRMOUTD(5,.DEFARR,PCLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
72 ;
73 ;Set the first line of ^TMP("PXRHM") to ERROR.
74 S ^TMP("PXRHM",$J,PXRMITEM,PXRMRNAM)="ERROR"
75 ;
76 I '$G(PXRMDEBG) D CLEAN
77 D UNWIND^%ZTER
78 Q
79 ;
80 ;=================================================================
81CLEAN ;Clean-up scratch arrays
82 K ^TMP("PXRM",$J)
83 I $D(PXRMPID) K ^TMP(PXRMPID,$J)
84 Q
85 ;
86 ;=================================================================
87NODEF(IEN) ;Non-existent reminder definition.
88 N SUBJ
89 K ^TMP("PXRMXMZ",$J)
90 S ^TMP("PXRMXMZ",$J,1,0)="A request was made to evaluate a non-existent reminder; the ien is "_IEN_"."
91 S ^TMP("PXRMXMZ",$J,2,0)="An entry was made in the error trap that does not have a description."
92 S ^TMP("PXRMXMZ",$J,3,0)="Match the time of this message with the time in the error trap."
93 S SUBJ="Request to evaluate a non-existent reminder"
94 D SEND^PXRMMSG(SUBJ)
95 K ^TMP("PXRMXMZ",$J)
96 D ^%ZTER
97 Q
98 ;
99 ;=================================================================
100NOINDEX(FTYPE,IEN,FILENUM) ;Error handling for missing index.
101 N ETEXT,SUBJ
102 K ^TMP("PXRMXMZ",$J)
103 S ETEXT(1)=""
104 S ETEXT(2)="Index for file number "_FILENUM_" does not exist or is not complete."
105 I FTYPE="D" S ETEXT(3)="Reminder "_IEN_" will not be properly evaluated!"
106 I FTYPE="TR" S ETEXT(3)="Term "_IEN_" will not be properly evaluated!"
107 I FTYPE="TX" S ETEXT(3)="Taxonomy "_IEN_" will not be properly evaluated!"
108 I $D(PXRMPID) D
109 . S ^TMP(PXRMPID,$J,PXRMITEM,"WARNING","MISSING INDEX")=ETEXT(2)
110 . S ^TMP(PXRMPID,$J,PXRMITEM,"INFO","MISSING INDEX")=ETEXT(2)
111 ;Mail out the error message.
112 S ^TMP("PXRMXMZ",$J,1,0)=ETEXT(2)
113 S ^TMP("PXRMXMZ",$J,2,0)=ETEXT(3)
114 S ^TMP("PXRMXMZ",$J,3,0)="Patient DFN="_$G(PXRMPDEM("DFN"))_", User DUZ="_DUZ_", Reminder="_$G(PXRMITEM)
115 S SUBJ="Problem with index for file number "_FILENUM
116 D SEND^PXRMMSG(SUBJ)
117 K ^TMP("PXRMXMZ",$J)
118 Q
119 ;
Note: See TracBrowser for help on using the repository browser.