PXRMDIEV ;SLC/PKR - Routines for disabling/enabling evaluation. ;11/16/2015
;;2.0;CLINICAL REMINDERS;**26,47**;Feb 04, 2005;Build 291
;
;=================================
BUILDD(BUILD) ;Disable for a build installation.
N REASON
S REASON="install of "_BUILD_" build"
D BMES^XPDUTL("Disabling reminder evaluation.")
D SDISXTMP(REASON)
Q
;
;=================================
BUILDE(BUILD) ;Enable after a build installation is complete.
N REASON
S REASON="install of "_BUILD_" build"
D BMES^XPDUTL("Enabling reminder evaluation.")
D KDISXTMP(REASON)
Q
;
;=================================
DMSG ;Send a message that reminder evaluation has been disabled.
N DTIME,NL,RDATA,REASON,TO
K ^TMP("PXRMXMZ",$J)
S NL=0
S DTIME=$$FMTE^XLFDT($P(^XTMP("PXRM_DISEV",0),U,2))
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Reminder evaluation was disabled on "_DTIME_"."
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Because of this, the following TaskMan jobs can produce erroneous results."
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Pending jobs should not be allowed to start until evaluation is enabled."
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="The results of running jobs should be discarded and if possible, running jobs"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="should be stopped."
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
;
S REASON=""
F S REASON=$O(^XTMP("PXRM_DISEV","REASON",REASON)) Q:REASON="" D
. I $D(^XTMP("PXRM_DISEV","REASON",REASON))=1 D Q
.. S TEXT="Reason: "_REASON_"."
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
. S RDATA=""
. F S RDATA=$O(^XTMP("PXRM_DISEV","REASON",REASON,RDATA)) Q:RDATA="" D
.. I REASON["index" S TEXT="Reason: "_REASON_" for file #"_RDATA_"."
.. I REASON["manager" D
... S USER=$P(^VA(200,RDATA,0),U,1)
... S TEXT="Reason: "_REASON_" - "_USER_"."
.. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
;
D TSKJOBS(.NL)
D TOLIST(.TO)
D SEND^PXRMMSG("PXRMXMZ","REMINDER EVALUATION DISABLED",.TO,.5)
K ^TMP("PXRMXMZ",$J)
Q
;
;=================================
EMSG(DTIME) ;Send a message that reminder evaluation has been enabled.
N ETIME,NL,TO
K ^TMP("PXRMXMZ",$J)
S NL=0
S DTIME=$$FMTE^XLFDT(DTIME)
S ETIME=$$FMTE^XLFDT($$NOW^XLFDT)
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Reminder evaluation was enabled on "_ETIME_"."
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="It was disabled on "_DTIME_"."
D TOLIST(.TO)
D SEND^PXRMMSG("PXRMXMZ","REMINDER EVALUATION ENABLED",.TO,.5)
K ^TMP("PXRMXMZ",$J)
Q
;
;=================================
INDEXD(INDEX,INDEXL) ;Disable for index rebuilding.
N REASON,TASKNUM
S REASON="index rebuild"
K ^PXRMINDX(INDEX,"DATE BUILT")
D SDISXTMP(REASON,INDEX,.INDEXL)
;Start a TaskMan job to periodically check for completion of the
;rebuilding.
S TASKNUM=$$TINDXCHK(REASON,INDEX)
I TASKNUM'="" D
. W !,"Started job ",TASKNUM," to check for completion of the rebuilding"
. W !,"of the index for file # ",INDEX,"."
Q
;
;=================================
INDXCHK(REASON,INDEX) ;If reminder evaluation is disabled for index
;rebuilding check to see if the index has been rebuilt.
I $D(^PXRMINDX(INDEX,"DATE BUILT")) D KDISXTMP(REASON,INDEX)
Q
;
;=================================
KDISXTMP(REASON,RDATA) ;Kill ^XTMP nodes for disabling evaluation.
I $G(RDATA)'="" K ^XTMP("PXRM_DISEV","REASON",REASON,RDATA)
E K ^XTMP("PXRM_DISEV","REASON",REASON)
I $O(^XTMP("PXRM_DISEV","REASON",""))="" D
. N DTIME
. S DTIME=$P(^XTMP("PXRM_DISEV",0),U,2)
. K ^XTMP("PXRM_DISEV")
.;Enable PXRM options and protocols.
. D OPTIONS("")
. D PROTCOLS("")
.;Send a message that evaluation has been enabled.
. D EMSG(DTIME)
Q
;
;=================================
MGRD ;Code for disabling evaluation by the reminder manager.
N ANS,REASON
W !,"Disabling reminder evaluation will stop all evaluation, dialogs,"
W !,"reminder order checks, and anything using reminder evaluation!"
W !,"Are you sure you want to proceed?"
S ANS=$$ASKYN^PXRMEUT("N","Disable reminder evaluation")
I 'ANS Q
S REASON="by reminder manager"
D SDISXTMP(REASON,DUZ)
Q
;
;=================================
MGRE ;Code for enabling evaluation by the reminder manager.
N ANS,DTIME,RDATA,REASON,TEXT
W !,"Reminder evaluation is currently disabled for the following reason(s):"
S REASON=""
F S REASON=$O(^XTMP("PXRM_DISEV","REASON",REASON)) Q:REASON="" D
. I $D(^XTMP("PXRM_DISEV","REASON",REASON))=1 D Q
.. S TEXT="Reason: "_REASON_"."
.. W !,TEXT
. S RDATA=""
. F S RDATA=$O(^XTMP("PXRM_DISEV","REASON",REASON,RDATA)) Q:RDATA="" D
.. I REASON["index" S TEXT="Reason: "_REASON_" of file #"_RDATA_"."
.. I REASON["manager" D
... S MNAME=$P(^VA(200,RDATA,0),U,1)
... S TEXT="Reason: "_REASON_" - "_MNAME_"."
.. W !,TEXT
S ANS=$$ASKYN^PXRMEUT("N","Enable reminder evaluation")
I 'ANS Q
S DTIME=$P(^XTMP("PXRM_DISEV",0),U,2)
K ^XTMP("PXRM_DISEV")
D EMSG(DTIME)
D OPTIONS("")
D PROTCOLS("")
Q
;
;=================================
MGRO ;Called by the option PXRM DISABLE/ENABLE EVALUATION.
I '$D(^XUSEC("PXRM MANAGER",DUZ)) D Q
. W !,"You must have the reminder managers key to use this option."
I $D(^XTMP("PXRM_DISEV",0)) D MGRE Q
D MGRD
Q
;
;=================================
OPTIONS(TEXT) ;Disable/enable critical PXRM options.
;;PXRM DEF INTEGRITY CHECK ALL
;;PXRM DEF INTEGRITY CHECK ONE
;;PXRM ORDER CHECK TESTER
;;PXRM REMINDERS DUE
;;PXRM REMINDERS DUE (USER)
;;END
N IND,DONE,OPTION
S DONE=0
F IND=1:1 Q:DONE D
. S OPTION=$P($T(OPTIONS+IND),";",3,99)
. I OPTION="END" S DONE=1 Q
. D OUT^XPDMENU(OPTION,TEXT)
Q
;
;=================================
PINDXCHK ;If reminder evaluation is disabled for index
;rebuilding periodically check to see if the index has been rebuilt.
;This is run as a TaskMan job INDEX and REASON are passed through
;ZTSAVE.
N DONE
S ZTREQ="@"
S DONE=0
F Q:DONE D
. I $D(^PXRMINDX(INDEX,"DATE BUILT")) D
.. S DONE=1
.. I $D(^XTMP("PXRM_DISEV","REASON",REASON)) D KDISXTMP^PXRMDIEV(REASON,INDEX)
. I 'DONE H 60
Q
;
;=================================
PROTCOLS(TEXT) ;Disable/enable critical PXRM protocols.
;;PXRM PATIENT LIST CREATE
;;PXRM EXTRACT MANUAL TRANSMISSION
;;END
N IND,DONE,PROTOCOL
S DONE=0
F IND=1:1 Q:DONE D
. S PROTOCOL=$P($T(PROTCOLS+IND),";",3,99)
. I PROTOCOL="END" S DONE=1 Q
. D OUT^XPDPROT(PROTOCOL,TEXT)
Q
;
;=================================
SDISXTMP(REASON,RDATA,INDEXL) ;Set ^XTMP nodes for disabling evaluation.
N CDATE,INDEX,NINDEX,PUDATE
I '$D(^XTMP("PXRM_DISEV",0)) D
. S CDATE=$$NOW^XLFDT
. S PUDATE=$$FMADD^XLFDT(CDATE,0,12,0,0)
. S ^XTMP("PXRM_DISEV",0)=PUDATE_U_CDATE_U_"Temporarily disable reminder evaluation"
I $G(RDATA)="" S ^XTMP("PXRM_DISEV","REASON",REASON)=""
E S ^XTMP("PXRM_DISEV","REASON",REASON,RDATA)=""
;Disable and send the message once for the multiple index case.
I $D(^XTMP("PXRM_DISEV","MULTI-INDEX","MSG SENT")) Q
I $D(INDEXL) D
. S INDEX="",NINDEX=0
. F S INDEX=$O(INDEXL(INDEX)) Q:INDEX="" S ^XTMP("PXRM_DISEV","REASON",REASON,INDEX)="",NINDEX=NINDEX+1
;Disable some PXRM options and protocols.
D OPTIONS(REASON)
D PROTCOLS(REASON)
;Send a message that evaluation is disabled.
D DMSG
I $G(NINDEX)>1 S ^XTMP("PXRM_DISEV","MULTI-INDEX","MSG SENT")=""
Q
;
;=================================
TINDXCHK(REASON,INDEX) ;If reminder evaluation is disabled for index
;rebuilding start a TaskMan job to periodically check to see
;if the index has been rebuilt.
N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
S ZTSAVE("INDEX")=""
S ZTSAVE("RDATA")=""
S ZTSAVE("REASON")=""
S ZTRTN="PINDXCHK^PXRMDIEV"
S ZTDESC="Clinical Reminders Index building check, file #"_INDEX
S ZTDTH=$$NOW^XLFDT
S ZTIO=""
D ^%ZTLOAD
Q ZTSK
;
;=================================
TOLIST(TO) ;Return the list of who to send the message to.
N MGIEN,MGROUP
S TO(DUZ)=""
S MGIEN=$G(^PXRM(800,1,"MGFE"))
I MGIEN'="" D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
Q
;
;=================================
TSKJOBS(NL) ;Search for TaskMan jobs that may be affected by disabled reminder
;evaluation. For any that are found add information to the MailMan
;message.
N TDESC
S TDESC="Reminder Due Report"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Reminders Due Report Jobs"
D TSKLIST(TDESC,.NL)
;
S TDESC="Build Reminder Patient List"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Reminder Patient List Jobs"
D TSKLIST(TDESC,.NL)
;
S TDESC="Run Reminder Extract"
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Reminder Extract Jobs"
D TSKLIST(TDESC,.NL)
Q
;
;=================================
TSKLIST(TDESC,NL) ;Search for tasks with the description TDESC. For any
;that are found add their information to the message text.
N DTIME,STATUS,TIME,TLIST,TASKNUM,USER,ZTSK
D DESC^%ZTLOAD(TDESC,"TLIST")
S TASKNUM=""
F S TASKNUM=$O(TLIST(TASKNUM)) Q:TASKNUM="" D
. K ZTSK
. S ZTSK=TASKNUM
. D STAT^%ZTLOAD
. I ZTSK(0)=0 Q
.;Only tasks that are pending or running.
. I ZTSK(2)'["Active" Q
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Task number - "_TASKNUM
. S STATUS=ZTSK(2)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Status - "_STATUS
. D ISQED^%ZTLOAD
. I $D(ZTSK("D")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Time - "_$$HTE^XLFDT(ZTSK("D"))
. I $D(ZTSK("DUZ")) S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="User - "_$P(^VA(200,ZTSK("DUZ"),0),U,1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDIEV 9643 printed Apr 09, 2024@20:54:22 Page 2
PXRMDIEV ;SLC/PKR - Routines for disabling/enabling evaluation. ;11/16/2015
+1 ;;2.0;CLINICAL REMINDERS;**26,47**;Feb 04, 2005;Build 291
+2 ;
+3 ;=================================
BUILDD(BUILD) ;Disable for a build installation.
+1 NEW REASON
+2 SET REASON="install of "_BUILD_" build"
+3 DO BMES^XPDUTL("Disabling reminder evaluation.")
+4 DO SDISXTMP(REASON)
+5 QUIT
+6 ;
+7 ;=================================
BUILDE(BUILD) ;Enable after a build installation is complete.
+1 NEW REASON
+2 SET REASON="install of "_BUILD_" build"
+3 DO BMES^XPDUTL("Enabling reminder evaluation.")
+4 DO KDISXTMP(REASON)
+5 QUIT
+6 ;
+7 ;=================================
DMSG ;Send a message that reminder evaluation has been disabled.
+1 NEW DTIME,NL,RDATA,REASON,TO
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET NL=0
+4 SET DTIME=$$FMTE^XLFDT($PIECE(^XTMP("PXRM_DISEV",0),U,2))
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Reminder evaluation was disabled on "_DTIME_"."
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Because of this, the following TaskMan jobs can produce erroneous results."
+7 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Pending jobs should not be allowed to start until evaluation is enabled."
+8 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="The results of running jobs should be discarded and if possible, running jobs"
+9 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="should be stopped."
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+11 ;
+12 SET REASON=""
+13 FOR
SET REASON=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON))
if REASON=""
QUIT
Begin DoDot:1
+14 IF $DATA(^XTMP("PXRM_DISEV","REASON",REASON))=1
Begin DoDot:2
+15 SET TEXT="Reason: "_REASON_"."
+16 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:2
QUIT
+17 SET RDATA=""
+18 FOR
SET RDATA=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON,RDATA))
if RDATA=""
QUIT
Begin DoDot:2
+19 IF REASON["index"
SET TEXT="Reason: "_REASON_" for file #"_RDATA_"."
+20 IF REASON["manager"
Begin DoDot:3
+21 SET USER=$PIECE(^VA(200,RDATA,0),U,1)
+22 SET TEXT="Reason: "_REASON_" - "_USER_"."
End DoDot:3
+23 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:2
End DoDot:1
+24 ;
+25 DO TSKJOBS(.NL)
+26 DO TOLIST(.TO)
+27 DO SEND^PXRMMSG("PXRMXMZ","REMINDER EVALUATION DISABLED",.TO,.5)
+28 KILL ^TMP("PXRMXMZ",$JOB)
+29 QUIT
+30 ;
+31 ;=================================
EMSG(DTIME) ;Send a message that reminder evaluation has been enabled.
+1 NEW ETIME,NL,TO
+2 KILL ^TMP("PXRMXMZ",$JOB)
+3 SET NL=0
+4 SET DTIME=$$FMTE^XLFDT(DTIME)
+5 SET ETIME=$$FMTE^XLFDT($$NOW^XLFDT)
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Reminder evaluation was enabled on "_ETIME_"."
+7 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="It was disabled on "_DTIME_"."
+8 DO TOLIST(.TO)
+9 DO SEND^PXRMMSG("PXRMXMZ","REMINDER EVALUATION ENABLED",.TO,.5)
+10 KILL ^TMP("PXRMXMZ",$JOB)
+11 QUIT
+12 ;
+13 ;=================================
INDEXD(INDEX,INDEXL) ;Disable for index rebuilding.
+1 NEW REASON,TASKNUM
+2 SET REASON="index rebuild"
+3 KILL ^PXRMINDX(INDEX,"DATE BUILT")
+4 DO SDISXTMP(REASON,INDEX,.INDEXL)
+5 ;Start a TaskMan job to periodically check for completion of the
+6 ;rebuilding.
+7 SET TASKNUM=$$TINDXCHK(REASON,INDEX)
+8 IF TASKNUM'=""
Begin DoDot:1
+9 WRITE !,"Started job ",TASKNUM," to check for completion of the rebuilding"
+10 WRITE !,"of the index for file # ",INDEX,"."
End DoDot:1
+11 QUIT
+12 ;
+13 ;=================================
INDXCHK(REASON,INDEX) ;If reminder evaluation is disabled for index
+1 ;rebuilding check to see if the index has been rebuilt.
+2 IF $DATA(^PXRMINDX(INDEX,"DATE BUILT"))
DO KDISXTMP(REASON,INDEX)
+3 QUIT
+4 ;
+5 ;=================================
KDISXTMP(REASON,RDATA) ;Kill ^XTMP nodes for disabling evaluation.
+1 IF $GET(RDATA)'=""
KILL ^XTMP("PXRM_DISEV","REASON",REASON,RDATA)
+2 IF '$TEST
KILL ^XTMP("PXRM_DISEV","REASON",REASON)
+3 IF $ORDER(^XTMP("PXRM_DISEV","REASON",""))=""
Begin DoDot:1
+4 NEW DTIME
+5 SET DTIME=$PIECE(^XTMP("PXRM_DISEV",0),U,2)
+6 KILL ^XTMP("PXRM_DISEV")
+7 ;Enable PXRM options and protocols.
+8 DO OPTIONS("")
+9 DO PROTCOLS("")
+10 ;Send a message that evaluation has been enabled.
+11 DO EMSG(DTIME)
End DoDot:1
+12 QUIT
+13 ;
+14 ;=================================
MGRD ;Code for disabling evaluation by the reminder manager.
+1 NEW ANS,REASON
+2 WRITE !,"Disabling reminder evaluation will stop all evaluation, dialogs,"
+3 WRITE !,"reminder order checks, and anything using reminder evaluation!"
+4 WRITE !,"Are you sure you want to proceed?"
+5 SET ANS=$$ASKYN^PXRMEUT("N","Disable reminder evaluation")
+6 IF 'ANS
QUIT
+7 SET REASON="by reminder manager"
+8 DO SDISXTMP(REASON,DUZ)
+9 QUIT
+10 ;
+11 ;=================================
MGRE ;Code for enabling evaluation by the reminder manager.
+1 NEW ANS,DTIME,RDATA,REASON,TEXT
+2 WRITE !,"Reminder evaluation is currently disabled for the following reason(s):"
+3 SET REASON=""
+4 FOR
SET REASON=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON))
if REASON=""
QUIT
Begin DoDot:1
+5 IF $DATA(^XTMP("PXRM_DISEV","REASON",REASON))=1
Begin DoDot:2
+6 SET TEXT="Reason: "_REASON_"."
+7 WRITE !,TEXT
End DoDot:2
QUIT
+8 SET RDATA=""
+9 FOR
SET RDATA=$ORDER(^XTMP("PXRM_DISEV","REASON",REASON,RDATA))
if RDATA=""
QUIT
Begin DoDot:2
+10 IF REASON["index"
SET TEXT="Reason: "_REASON_" of file #"_RDATA_"."
+11 IF REASON["manager"
Begin DoDot:3
+12 SET MNAME=$PIECE(^VA(200,RDATA,0),U,1)
+13 SET TEXT="Reason: "_REASON_" - "_MNAME_"."
End DoDot:3
+14 WRITE !,TEXT
End DoDot:2
End DoDot:1
+15 SET ANS=$$ASKYN^PXRMEUT("N","Enable reminder evaluation")
+16 IF 'ANS
QUIT
+17 SET DTIME=$PIECE(^XTMP("PXRM_DISEV",0),U,2)
+18 KILL ^XTMP("PXRM_DISEV")
+19 DO EMSG(DTIME)
+20 DO OPTIONS("")
+21 DO PROTCOLS("")
+22 QUIT
+23 ;
+24 ;=================================
MGRO ;Called by the option PXRM DISABLE/ENABLE EVALUATION.
+1 IF '$DATA(^XUSEC("PXRM MANAGER",DUZ))
Begin DoDot:1
+2 WRITE !,"You must have the reminder managers key to use this option."
End DoDot:1
QUIT
+3 IF $DATA(^XTMP("PXRM_DISEV",0))
DO MGRE
QUIT
+4 DO MGRD
+5 QUIT
+6 ;
+7 ;=================================
OPTIONS(TEXT) ;Disable/enable critical PXRM options.
+1 ;;PXRM DEF INTEGRITY CHECK ALL
+2 ;;PXRM DEF INTEGRITY CHECK ONE
+3 ;;PXRM ORDER CHECK TESTER
+4 ;;PXRM REMINDERS DUE
+5 ;;PXRM REMINDERS DUE (USER)
+6 ;;END
+7 NEW IND,DONE,OPTION
+8 SET DONE=0
+9 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+10 SET OPTION=$PIECE($TEXT(OPTIONS+IND),";",3,99)
+11 IF OPTION="END"
SET DONE=1
QUIT
+12 DO OUT^XPDMENU(OPTION,TEXT)
End DoDot:1
+13 QUIT
+14 ;
+15 ;=================================
PINDXCHK ;If reminder evaluation is disabled for index
+1 ;rebuilding periodically check to see if the index has been rebuilt.
+2 ;This is run as a TaskMan job INDEX and REASON are passed through
+3 ;ZTSAVE.
+4 NEW DONE
+5 SET ZTREQ="@"
+6 SET DONE=0
+7 FOR
if DONE
QUIT
Begin DoDot:1
+8 IF $DATA(^PXRMINDX(INDEX,"DATE BUILT"))
Begin DoDot:2
+9 SET DONE=1
+10 IF $DATA(^XTMP("PXRM_DISEV","REASON",REASON))
DO KDISXTMP^PXRMDIEV(REASON,INDEX)
End DoDot:2
+11 IF 'DONE
HANG 60
End DoDot:1
+12 QUIT
+13 ;
+14 ;=================================
PROTCOLS(TEXT) ;Disable/enable critical PXRM protocols.
+1 ;;PXRM PATIENT LIST CREATE
+2 ;;PXRM EXTRACT MANUAL TRANSMISSION
+3 ;;END
+4 NEW IND,DONE,PROTOCOL
+5 SET DONE=0
+6 FOR IND=1:1
if DONE
QUIT
Begin DoDot:1
+7 SET PROTOCOL=$PIECE($TEXT(PROTCOLS+IND),";",3,99)
+8 IF PROTOCOL="END"
SET DONE=1
QUIT
+9 DO OUT^XPDPROT(PROTOCOL,TEXT)
End DoDot:1
+10 QUIT
+11 ;
+12 ;=================================
SDISXTMP(REASON,RDATA,INDEXL) ;Set ^XTMP nodes for disabling evaluation.
+1 NEW CDATE,INDEX,NINDEX,PUDATE
+2 IF '$DATA(^XTMP("PXRM_DISEV",0))
Begin DoDot:1
+3 SET CDATE=$$NOW^XLFDT
+4 SET PUDATE=$$FMADD^XLFDT(CDATE,0,12,0,0)
+5 SET ^XTMP("PXRM_DISEV",0)=PUDATE_U_CDATE_U_"Temporarily disable reminder evaluation"
End DoDot:1
+6 IF $GET(RDATA)=""
SET ^XTMP("PXRM_DISEV","REASON",REASON)=""
+7 IF '$TEST
SET ^XTMP("PXRM_DISEV","REASON",REASON,RDATA)=""
+8 ;Disable and send the message once for the multiple index case.
+9 IF $DATA(^XTMP("PXRM_DISEV","MULTI-INDEX","MSG SENT"))
QUIT
+10 IF $DATA(INDEXL)
Begin DoDot:1
+11 SET INDEX=""
SET NINDEX=0
+12 FOR
SET INDEX=$ORDER(INDEXL(INDEX))
if INDEX=""
QUIT
SET ^XTMP("PXRM_DISEV","REASON",REASON,INDEX)=""
SET NINDEX=NINDEX+1
End DoDot:1
+13 ;Disable some PXRM options and protocols.
+14 DO OPTIONS(REASON)
+15 DO PROTCOLS(REASON)
+16 ;Send a message that evaluation is disabled.
+17 DO DMSG
+18 IF $GET(NINDEX)>1
SET ^XTMP("PXRM_DISEV","MULTI-INDEX","MSG SENT")=""
+19 QUIT
+20 ;
+21 ;=================================
TINDXCHK(REASON,INDEX) ;If reminder evaluation is disabled for index
+1 ;rebuilding start a TaskMan job to periodically check to see
+2 ;if the index has been rebuilt.
+3 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+4 SET ZTSAVE("INDEX")=""
+5 SET ZTSAVE("RDATA")=""
+6 SET ZTSAVE("REASON")=""
+7 SET ZTRTN="PINDXCHK^PXRMDIEV"
+8 SET ZTDESC="Clinical Reminders Index building check, file #"_INDEX
+9 SET ZTDTH=$$NOW^XLFDT
+10 SET ZTIO=""
+11 DO ^%ZTLOAD
+12 QUIT ZTSK
+13 ;
+14 ;=================================
TOLIST(TO) ;Return the list of who to send the message to.
+1 NEW MGIEN,MGROUP
+2 SET TO(DUZ)=""
+3 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+4 IF MGIEN'=""
Begin DoDot:1
+5 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+6 SET TO(MGROUP)=""
End DoDot:1
+7 QUIT
+8 ;
+9 ;=================================
TSKJOBS(NL) ;Search for TaskMan jobs that may be affected by disabled reminder
+1 ;evaluation. For any that are found add information to the MailMan
+2 ;message.
+3 NEW TDESC
+4 SET TDESC="Reminder Due Report"
+5 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+6 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Reminders Due Report Jobs"
+7 DO TSKLIST(TDESC,.NL)
+8 ;
+9 SET TDESC="Build Reminder Patient List"
+10 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Reminder Patient List Jobs"
+12 DO TSKLIST(TDESC,.NL)
+13 ;
+14 SET TDESC="Run Reminder Extract"
+15 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+16 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Reminder Extract Jobs"
+17 DO TSKLIST(TDESC,.NL)
+18 QUIT
+19 ;
+20 ;=================================
TSKLIST(TDESC,NL) ;Search for tasks with the description TDESC. For any
+1 ;that are found add their information to the message text.
+2 NEW DTIME,STATUS,TIME,TLIST,TASKNUM,USER,ZTSK
+3 DO DESC^%ZTLOAD(TDESC,"TLIST")
+4 SET TASKNUM=""
+5 FOR
SET TASKNUM=$ORDER(TLIST(TASKNUM))
if TASKNUM=""
QUIT
Begin DoDot:1
+6 KILL ZTSK
+7 SET ZTSK=TASKNUM
+8 DO STAT^%ZTLOAD
+9 IF ZTSK(0)=0
QUIT
+10 ;Only tasks that are pending or running.
+11 IF ZTSK(2)'["Active"
QUIT
+12 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+13 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Task number - "_TASKNUM
+14 SET STATUS=ZTSK(2)
+15 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Status - "_STATUS
+16 DO ISQED^%ZTLOAD
+17 IF $DATA(ZTSK("D"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Time - "_$$HTE^XLFDT(ZTSK("D"))
+18 IF $DATA(ZTSK("DUZ"))
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="User - "_$PIECE(^VA(200,ZTSK("DUZ"),0),U,1)
End DoDot:1
+19 QUIT
+20 ;
