- 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 Jan 18, 2025@02:45:49 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