PXRMERRH ;SLC/PKR - Error handling routines. ;01/22/2021
;;2.0;CLINICAL REMINDERS;**4,17,18,47,45,42**;Feb 04, 2005;Build 245
;
;=================================================================
DERRHRLR ;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 CNT,ERR,ERROR,INDEX,MGIEN,MGROUP,NL,XMDUZ,XMSUB,XMY,XMZ
S ERROR=$$EC^%ZOSV
;Ignore the "errors" the unwinder creates.
I ERROR["ZTER" D UNWIND^%ZTER
;If it is a framestack error do not try to send the message
I ERROR["FRAMESTACK" Q
;Make sure we don't loop if there is an error during procesing of
;the error handler.
N $ET S $ET="D ^%ZTER,DCLEAN^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 CNT=0
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="The following error occurred while saving general findings:"
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=ERROR
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="Please contact the help desk for assistance."
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="See below for the data that was not saved:"
D ACOPY^PXRMUTIL("DATA","ERR()")
S INDEX=0 F S INDEX=$O(ERR(INDEX)) Q:INDEX'>0 S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=ERR(INDEX)
;
S MGIEN=$G(^PXRM(800,1,"MGFE"))
;If the mail group has not been defined tell the user.
I MGIEN="" D
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)=" "
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="You received this message because your IRM has not set up a mailgroup"
. S CNT=CNT+1,^TMP("PXRMXMZ",$J,CNT,0)="to receive Clinical Reminder errors; please notify them."
;
D SEND^PXRMMSG("PXRMXMZ","ERROR SAVING DATA","",DUZ)
;
;I '$G(PXRMDEBG) D DCLEAN
S RETURN(0)="-1^A Mumps error occurred while saving data."
D UNWIND^%ZTER
Q
;
;=================================================================
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
;If it is a framestack error do not try to send the message
I ERROR["FRAMESTACK" Q
;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)
I ERROR["VCPT",ERROR["PXPXRM" D VCPTINDEXREPAIR(PXRMPDEM("DFN"),ERROR)
;
;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
;
DCLEAN ;
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 SUBJ="Attempt 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)="Warning: 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
;
;=================================================================
VCPTINDEXREPAIR(DFN,ERROR) ;Repair for reminder evaluation errors caused by
;V CPT index entries that were not deleted when the V CPT entry was
;deleted.
N CPT,DATE,DONE,PP,SUBJECT,TEMP,VCPTIEN
K ^TMP("PXRMXMZ",$J)
;Get VCPT IEN.
S TEMP=$P(ERROR,"^AUPNVCPT(",2)
S VCPTIEN=$P(TEMP,",",1)
I +VCPTIEN'>0 Q
;Check for a spurious error and send a message
;if one is found.
I $D(^AUPNVCPT(VCPTIEN)) D Q
. S SUBJECT="V CPT Index Spurious Error"
. S ^TMP("PXRMXMZ",$J,1,0)="The error:"
. S ^TMP("PXRMXMZ",$J,2,0)=ERROR
. S ^TMP("PXRMXMZ",$J,3,0)="appears to be spurious because the V CPT entry exists."
. S ^TMP("PXRMXMZ",$J,4,0)="Please enter a ticket so this can be examined."
. D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
. K ^TMP("PXRMXMZ",$J)
;Delete the Index entries and send a message.
S DONE=0,PP=""
F S PP=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP)) Q:(DONE)!(PP="") D
. S CPT=""
. F S CPT=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT)) Q:(DONE)!(CPT="") D
.. S DATE=""
.. F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE)) Q:(DONE)!(DATE="") D
... I $D(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN)) D
.... K ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN)
.... K ^PXRMINDX(9000010.18,"IPP",CPT,PP,DFN,DATE,VCPTIEN)
.... S DONE=1
....;Send the message
.... S SUBJECT="V CPT Index Repair"
.... S ^TMP("PXRMXMZ",$J,1,0)="The Clinical Reminder Index entries related to the error:"
.... S ^TMP("PXRMXMZ",$J,2,0)=ERROR
.... S ^TMP("PXRMXMZ",$J,3,0)="have been deleted, no further action is required."
.... S ^TMP("PXRMXMZ",$J,4,0)="DFN="_DFN
.... S ^TMP("PXRMXMZ",$J,5,0)="PP="_PP
.... S ^TMP("PXRMXMZ",$J,6,0)="CPT="_CPT
.... S ^TMP("PXRMXMZ",$J,7,0)="Date="_DATE
.... S ^TMP("PXRMXMZ",$J,8,0)="V CPT IEN="_VCPTIEN
.... D SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
.... K ^TMP("PXRMXMZ",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMERRH 8341 printed Oct 16, 2024@17:45:27 Page 2
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
+2 ;
+3 ;=================================================================
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.
+2 ;References to %ZTER covered by DBIA #1621.
+3 NEW CNT,ERR,ERROR,INDEX,MGIEN,MGROUP,NL,XMDUZ,XMSUB,XMY,XMZ
+4 SET ERROR=$$EC^%ZOSV
+5 ;Ignore the "errors" the unwinder creates.
+6 IF ERROR["ZTER"
DO UNWIND^%ZTER
+7 ;If it is a framestack error do not try to send the message
+8 IF ERROR["FRAMESTACK"
QUIT
+9 ;Make sure we don't loop if there is an error during procesing of
+10 ;the error handler.
+11 NEW $ETRAP
SET $ETRAP="D ^%ZTER,DCLEAN^PXRMERRH,UNWIND^%ZTER"
+12 ;
+13 ;Save the error then put it in the error trap, this saves the correct
+14 ;last global reference.
+15 DO ^%ZTER
+16 ;
+17 ;If this is a test run write out the error.
+18 ;I $G(PXRMDEBG) W !,ERROR
+19 ;
+20 KILL ^TMP("PXRMXMZ",$JOB)
+21 SET CNT=0
+22 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="The following error occurred while saving general findings:"
+23 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=ERROR
+24 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="Please contact the help desk for assistance."
+25 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+26 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="See below for the data that was not saved:"
+27 DO ACOPY^PXRMUTIL("DATA","ERR()")
+28 SET INDEX=0
FOR
SET INDEX=$ORDER(ERR(INDEX))
if INDEX'>0
QUIT
SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=ERR(INDEX)
+29 ;
+30 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+31 ;If the mail group has not been defined tell the user.
+32 IF MGIEN=""
Begin DoDot:1
+33 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)=" "
+34 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="You received this message because your IRM has not set up a mailgroup"
+35 SET CNT=CNT+1
SET ^TMP("PXRMXMZ",$JOB,CNT,0)="to receive Clinical Reminder errors; please notify them."
End DoDot:1
+36 ;
+37 DO SEND^PXRMMSG("PXRMXMZ","ERROR SAVING DATA","",DUZ)
+38 ;
+39 ;I '$G(PXRMDEBG) D DCLEAN
+40 SET RETURN(0)="-1^A Mumps error occurred while saving data."
+41 DO UNWIND^%ZTER
+42 QUIT
+43 ;
+44 ;=================================================================
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 ;If it is a framestack error do not try to send the message
+8 IF ERROR["FRAMESTACK"
QUIT
+9 ;Make sure we don't loop if there is an error during procesing of
+10 ;the error handler.
+11 NEW $ETRAP
SET $ETRAP="D ^%ZTER,CLEAN^PXRMERRH,UNWIND^%ZTER"
+12 ;
+13 ;Save the error then put it in the error trap, this saves the correct
+14 ;last global reference.
+15 DO ^%ZTER
+16 ;
+17 ;If this is a test run write out the error.
+18 IF $GET(PXRMDEBG)
WRITE !,ERROR
+19 ;
+20 KILL ^TMP("PXRMXMZ",$JOB)
+21 SET ^TMP("PXRMXMZ",$JOB,1,0)="The following error occurred:"
+22 SET ^TMP("PXRMXMZ",$JOB,2,0)=ERROR
+23 IF +$GET(PXRMITEM)>0
SET REMINDER=$PIECE(^PXD(811.9,PXRMITEM,0),U,1)
+24 IF '$TEST
SET PXRMITEM=999999
SET REMINDER="?"
+25 SET ^TMP("PXRMXMZ",$JOB,3,0)="While evaluating reminder "_REMINDER
+26 SET ^TMP("PXRMXMZ",$JOB,4,0)="For patient DFN="_$GET(PXRMPDEM("DFN"))
+27 SET ^TMP("PXRMXMZ",$JOB,5,0)="The time of the error was "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+28 SET ^TMP("PXRMXMZ",$JOB,6,0)="See the error trap for complete details."
+29 SET NL=6
+30 ;Look for specific error text to append to the message.
+31 IF $DATA(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP"))
Begin DoDot:1
+32 NEW ESOURCE,IND
+33 SET ESOURCE=""
+34 FOR
SET ESOURCE=$ORDER(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE))
if ESOURCE=""
QUIT
Begin DoDot:2
+35 SET IND=0
+36 FOR
SET IND=$ORDER(^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND))
if IND=""
QUIT
Begin DoDot:3
+37 SET NL=NL+1
+38 SET ^TMP("PXRMXMZ",$JOB,NL,0)=^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP",ESOURCE,IND)
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+41 ;If the mail group has not been defined tell the user.
+42 IF MGIEN=""
Begin DoDot:1
+43 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "
+44 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="You received this message because your IRM has not set up a mailgroup"
+45 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="to receive Clinical Reminder errors; please notify them."
End DoDot:1
+46 ;
+47 DO SEND^PXRMMSG("PXRMXMZ","ERROR EVALUATING CLINICAL REMINDER","",DUZ)
+48 IF ERROR["VCPT"
IF ERROR["PXPXRM"
DO VCPTINDEXREPAIR(PXRMPDEM("DFN"),ERROR)
+49 ;
+50 ;If the reminder exists mark that an error occured.
+51 IF PXRMITEM=999999
QUIT
+52 SET ^TMP(PXRMPID,$JOB,PXRMITEM,"FERROR","ERROR TRAP")=""
+53 NEW DEFARR,DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE
+54 SET (DUE,DUEDATE,FREQ,FIEVAL,PCLOGIC,RESDATE)=""
+55 DO DEF^PXRMLDR(PXRMITEM,.DEFARR)
+56 DO OUTPUT^PXRMOUTD(5,.DEFARR,PCLOGIC,DUE,DUEDATE,RESDATE,FREQ,.FIEVAL)
+57 ;
+58 ;Set the first line of ^TMP("PXRHM") to ERROR.
+59 SET ^TMP("PXRHM",$JOB,PXRMITEM,PXRMRNAM)="ERROR"
+60 ;
+61 IF '$GET(PXRMDEBG)
DO CLEAN
+62 DO UNWIND^%ZTER
+63 QUIT
+64 ;
+65 ;=================================================================
CLEAN ;Clean-up scratch arrays
+1 KILL ^TMP("PXRM",$JOB)
+2 IF $DATA(PXRMPID)
KILL ^TMP(PXRMPID,$JOB)
+3 QUIT
+4 ;
DCLEAN ;
+1 QUIT
+2 ;
+3 ;=================================================================
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 SUBJ="Attempt to evaluate a non-existent reminder"
+5 DO SEND^PXRMMSG("PXRMXMZ",SUBJ,"",DUZ)
+6 KILL ^TMP("PXRMXMZ",$JOB)
+7 DO ^%ZTER
+8 QUIT
+9 ;
+10 ;=================================================================
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)="Warning: 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 ;
+20 ;=================================================================
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
+2 ;deleted.
+3 NEW CPT,DATE,DONE,PP,SUBJECT,TEMP,VCPTIEN
+4 KILL ^TMP("PXRMXMZ",$JOB)
+5 ;Get VCPT IEN.
+6 SET TEMP=$PIECE(ERROR,"^AUPNVCPT(",2)
+7 SET VCPTIEN=$PIECE(TEMP,",",1)
+8 IF +VCPTIEN'>0
QUIT
+9 ;Check for a spurious error and send a message
+10 ;if one is found.
+11 IF $DATA(^AUPNVCPT(VCPTIEN))
Begin DoDot:1
+12 SET SUBJECT="V CPT Index Spurious Error"
+13 SET ^TMP("PXRMXMZ",$JOB,1,0)="The error:"
+14 SET ^TMP("PXRMXMZ",$JOB,2,0)=ERROR
+15 SET ^TMP("PXRMXMZ",$JOB,3,0)="appears to be spurious because the V CPT entry exists."
+16 SET ^TMP("PXRMXMZ",$JOB,4,0)="Please enter a ticket so this can be examined."
+17 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
+18 KILL ^TMP("PXRMXMZ",$JOB)
End DoDot:1
QUIT
+19 ;Delete the Index entries and send a message.
+20 SET DONE=0
SET PP=""
+21 FOR
SET PP=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,PP))
if (DONE)!(PP="")
QUIT
Begin DoDot:1
+22 SET CPT=""
+23 FOR
SET CPT=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT))
if (DONE)!(CPT="")
QUIT
Begin DoDot:2
+24 SET DATE=""
+25 FOR
SET DATE=$ORDER(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE))
if (DONE)!(DATE="")
QUIT
Begin DoDot:3
+26 IF $DATA(^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN))
Begin DoDot:4
+27 KILL ^PXRMINDX(9000010.18,"PPI",DFN,PP,CPT,DATE,VCPTIEN)
+28 KILL ^PXRMINDX(9000010.18,"IPP",CPT,PP,DFN,DATE,VCPTIEN)
+29 SET DONE=1
+30 ;Send the message
+31 SET SUBJECT="V CPT Index Repair"
+32 SET ^TMP("PXRMXMZ",$JOB,1,0)="The Clinical Reminder Index entries related to the error:"
+33 SET ^TMP("PXRMXMZ",$JOB,2,0)=ERROR
+34 SET ^TMP("PXRMXMZ",$JOB,3,0)="have been deleted, no further action is required."
+35 SET ^TMP("PXRMXMZ",$JOB,4,0)="DFN="_DFN
+36 SET ^TMP("PXRMXMZ",$JOB,5,0)="PP="_PP
+37 SET ^TMP("PXRMXMZ",$JOB,6,0)="CPT="_CPT
+38 SET ^TMP("PXRMXMZ",$JOB,7,0)="Date="_DATE
+39 SET ^TMP("PXRMXMZ",$JOB,8,0)="V CPT IEN="_VCPTIEN
+40 DO SEND^PXRMMSG("PXRMXMZ",SUBJECT,"",DUZ)
+41 KILL ^TMP("PXRMXMZ",$JOB)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+42 QUIT
