PXRMINDD ; SLC/PKR - Index string date checking routines. ;09/27/2012
;;2.0;CLINICAL REMINDERS;**4,6,17,26**;Feb 04, 2005;Build 404
;
;========================================================
CNT5(FILENUM,NSD) ;Check for string dates for indexes where the date
;is at subscript 5. Works for file numbers:
;63, 70, 120.5, 601.2, 601.84
;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
N DAS,DATE,DFN,IND,ITEM
I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
S IND=0
S DFN=""
F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D
. S IND=IND+1
. I '$D(ZTQUEUED),(IND#10000=0) W "."
. S ITEM=""
. F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D
.. S DATE=""
.. F S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE="" D
... I +DATE=DATE Q
... S DAS=""
... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS="" D
.... S NSD=NSD+1
.... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_DATE_""","_DAS_")"
Q
;
;========================================================
CNT6(FILENUM,NSD) ;Check for string dates for indexes where the date
;is at subscript 6. Works for file numbers:
;9000010.07, 9000010.18
N CODESYS,DAS,DATE,DFN,IND,ITEM,TYPE
I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
S DFN="",IND=0
F S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN="" D
. S IND=IND+1
. I '$D(ZTQUEUED),(IND#10000=0) W "."
. S TYPE=""
. F S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE="" D
.. S ITEM=""
.. F S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D
... S DATE=""
... F S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
.... I +DATE=DATE Q
.... S DAS=""
.... F S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
..... S NSD=NSD+1
..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
I FILENUM'=9000010.07 Q
S CODESYS=""
F S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS="" D
. I (CODESYS="PPI")!(CODESYS="IPP") Q
. S DFN=""
. F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN)) Q:DFN="" D
.. S IND=IND+1
.. I '$D(ZTQUEUED),(IND#10000=0) W "."
.. S TYPE=""
.. F S TYPE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE)) Q:TYPE="" D
... S ITEM=""
... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D
.... S DATE=""
.... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
..... I +DATE=DATE Q
..... S DAS=""
..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
...... S NSD=NSD+1
...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
Q
;
;========================================================
CNTPL(FILENUM,NSD) ;Check for string date for Problem List indexes where the
;date is at subscript 8. Works for file numbers:
;9000011
N CODESYS,DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE
I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
S CODESYS=""
F S CODESYS=$O(^PXRMINDX(9000011,CODESYS)) Q:CODESYS="" D
. S DFN="",IND=0
. F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN)) Q:DFN="" D
.. S IND=IND+1
.. I '$D(ZTQUEUED),(IND#10000=0) W "."
.. S STATUS=""
.. F S STATUS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS)) Q:STATUS="" D
... S PRIORITY=""
... F S PRIORITY=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
.... S ITEM=""
.... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
..... S DATE=""
..... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
...... I +DATE=DATE Q
...... S DAS=""
...... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS="" D
....... S NSD=NSD+1
....... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PSPI"","_DFN_","_STATUS_","_PRIORITY_","_ITEM_","""_DATE_""","_DAS_")"
Q
;
;========================================================
CNTPTF(FILENUM,NSD) ;Check for string dates for PTF indexes where the
;date is at subscript 7. Works for file numbers:
;45
N CODESYS,DAS,DATE,DFN,IND,ITEM,NODE
I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
S CODESYS="",IND=0
F S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS="" D
. S DFN=""
. F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN)) Q:DFN="" D
.. S IND=IND+1
.. I '$D(ZTQUEUED),(IND#10000=0) W "."
.. S NODE=""
.. F S NODE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE)) Q:NODE="" D
... S ITEM=""
... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM)) Q:ITEM="" D
.... S DATE=""
.... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE="" D
..... I +DATE=DATE Q
..... S DAS=""
..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS="" D
...... S NSD=NSD+1
...... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PNI"","_DFN_","_NODE_","_ITEM_","""_DATE_""","_DAS_")"
Q
;
;========================================================
CNTSS(FILENUM,NSD) ;Check for string dates for indexes where the start date
;is at subscript 5 and the stop date is at subscript 6.
;Works for file numbers: 52, 55, 100
N DAS,DFN,IND,ITEM,START,STOP
I '$D(ZTQUEUED) W !,"Checking file number "_FILENUM
S IND=0
S DFN=""
F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D
. S IND=IND+1
. I '$D(ZTQUEUED),(IND#10000=0) W "."
. S ITEM=""
. F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D
.. S START=""
.. F S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START="" D
... I +START=START Q
... S STOP=""
... F S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP="" D
.... S DAS=""
.... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS="" D
..... S NSD=NSD+1
..... S ^TMP($J,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_START_""","_STOP_","_DAS_")"
Q
;
;========================================================
CHECK ;Driver for making index date checks.
N GBL,LIST,TASKIT
W !,"Which indexes do you want to check?"
D SEL^PXRMSXRM(.LIST,.GBL)
I LIST="" Q
;See if this should be tasked.
S TASKIT=$$ASKTASK^PXRMSXRM
I TASKIT D
. W !,"Queue the Clinical Reminders Index date check."
. D TASKIT(LIST,.GBL,.ROUTINE)
E D RUNNOW(LIST,.GBL)
Q
;
;========================================================
MESSAGE(FILENUM,NSD,START,END) ;Build the MailMan message giving the
;list of entries with string dates.
N FROM,IND,NAME,NL,TEXT,TO,XMSUB
K ^TMP("PXRMXMZ",$J)
S XMSUB="CR Index string date check for file #"_FILENUM
S NAME=$$GET1^DID(FILENUM,"","","NAME")_", file #"_FILENUM
I NSD=0 S TEXT="No string dates were found for "_NAME_"."
I NSD>0 S TEXT="A total of "_NSD_" string dates were found for "_NAME_"."
S ^TMP("PXRMXMZ",$J,1,0)=TEXT
S ^TMP("PXRMXMZ",$J,2,0)="Check finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
S ^TMP("PXRMXMZ",$J,4,0)=" "
I NSD=0,'$D(^PXRMINDX(FILENUM)) D
. S ^TMP("PXRMXMZ",$J,5,0)="The index for file number "_FILENUM_" does not exist."
. S ^TMP("PXRMXMZ",$J,6,0)=" "
I NSD>0 D
. S ^TMP("PXRMXMZ",$J,5,0)="The following entries with string dates were found:"
. S NL=5
. F IND=1:1:NSD D
.. S NL=NL+1
.. S ^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDATE",IND)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
S FROM=$$GET1^DIQ(200,DUZ,.01)
S TO(DUZ)=""
D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
K ^TMP($J,"SDATE"),^TMP("PXRMXMZ",$J)
Q
;
;===============================================================
RUNNOW(LIST,GBL) ;Run the routines now.
N END,FN,IND,LI,NSD,NUM,ROUTINE,RTN,START,TOTAL
K ^TMP($J,"SDATE")
S ROUTINE(45)="CNTPTF^PXRMINDD"
S ROUTINE(52)="CNTSS^PXRMINDD"
S ROUTINE(55)="CNTSS^PXRMINDD"
S ROUTINE(63)="CNT5^PXRMINDD"
S ROUTINE(70)="CNT5^PXRMINDD"
S ROUTINE(100)="CNTSS^PXRMINDD"
S ROUTINE(120.5)="CNT5^PXRMINDD"
S ROUTINE(601.2)="CNT5^PXRMINDD"
S ROUTINE(601.84)="CNT5^PXRMINDD"
S ROUTINE(9000011)="CNTPL^PXRMINDD"
S ROUTINE(9000010.07)="CNT6^PXRMINDD"
S ROUTINE(9000010.11)="CNT5^PXRMINDD"
S ROUTINE(9000010.12)="CNT5^PXRMINDD"
S ROUTINE(9000010.13)="CNT5^PXRMINDD"
S ROUTINE(9000010.16)="CNT5^PXRMINDD"
S ROUTINE(9000010.18)="CNT6^PXRMINDD"
S ROUTINE(9000010.23)="CNT5^PXRMINDD"
S NUM=$L(LIST,",")-1
F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S NSD=0
. S FN=GBL(LI)
. S RTN=ROUTINE(FN)
. S RTN=RTN_"("_FN_",.NSD)"
. S START=$H
. I $D(^PXRMINDX(FN)) D @RTN
. S END=$H
. D MESSAGE(FN,NSD,START,END)
Q
;
;===============================================================
TASKIT(LIST,GBL,ROUTINE) ;Check the indexes as a tasked job.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
S MINDT=$$NOW^XLFDT
S DIR("A",1)="Enter the date and time you want the job to start."
S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
S DIR("A")="Start the task at: "
S DIR(0)="DAU"_U_MINDT_"::RSX"
D ^DIR
I $D(DIROUT)!$D(DIRUT) Q
I $D(DTOUT)!$D(DUOUT) Q
S SDTIME=Y
K DIR
;Put the task into the queue.
K ZTSAVE
S ZTSAVE("LIST")=""
S ZTSAVE("GBL(")=""
S ZTRTN="TASKJOB^PXRMINDD"
S ZTDESC="Clinical Reminders Index string date check"
S ZTDTH=SDTIME
S ZTIO=""
D ^%ZTLOAD
W !,"Task number ",ZTSK," queued."
Q
;
;===============================================================
TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
N IND,LI,NUM
S ZTREQ="@"
S ZTSTOP=0
S NUM=$L(LIST,",")-1
F IND=1:1:NUM D
.;Check to see if the task has had a stop request
. I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
. S LI=$P(LIST,",",IND)_","
. D RUNNOW^PXRMINDD(LI,.GBL)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINDD 9912 printed Dec 13, 2024@01:46:10 Page 2
PXRMINDD ; SLC/PKR - Index string date checking routines. ;09/27/2012
+1 ;;2.0;CLINICAL REMINDERS;**4,6,17,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;========================================================
CNT5(FILENUM,NSD) ;Check for string dates for indexes where the date
+1 ;is at subscript 5. Works for file numbers:
+2 ;63, 70, 120.5, 601.2, 601.84
+3 ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
+4 NEW DAS,DATE,DFN,IND,ITEM
+5 IF '$DATA(ZTQUEUED)
WRITE !,"Checking file number "_FILENUM
+6 SET IND=0
+7 SET DFN=""
+8 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,"PI",DFN))
if DFN=""
QUIT
Begin DoDot:1
+9 SET IND=IND+1
+10 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+11 SET ITEM=""
+12 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+13 SET DATE=""
+14 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:3
+15 IF +DATE=DATE
QUIT
+16 SET DAS=""
+17 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:4
+18 SET NSD=NSD+1
+19 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_DATE_""","_DAS_")"
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
+22 ;========================================================
CNT6(FILENUM,NSD) ;Check for string dates for indexes where the date
+1 ;is at subscript 6. Works for file numbers:
+2 ;9000010.07, 9000010.18
+3 NEW CODESYS,DAS,DATE,DFN,IND,ITEM,TYPE
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Checking file number "_FILENUM
+5 SET DFN=""
SET IND=0
+6 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN))
if DFN=""
QUIT
Begin DoDot:1
+7 SET IND=IND+1
+8 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+9 SET TYPE=""
+10 FOR
SET TYPE=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:2
+11 SET ITEM=""
+12 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM))
if ITEM=""
QUIT
Begin DoDot:3
+13 SET DATE=""
+14 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:4
+15 IF +DATE=DATE
QUIT
+16 SET DAS=""
+17 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:5
+18 SET NSD=NSD+1
+19 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF FILENUM'=9000010.07
QUIT
+21 SET CODESYS=""
+22 FOR
SET CODESYS=$ORDER(^PXRMINDX(FILENUM,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+23 IF (CODESYS="PPI")!(CODESYS="IPP")
QUIT
+24 SET DFN=""
+25 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN))
if DFN=""
QUIT
Begin DoDot:2
+26 SET IND=IND+1
+27 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+28 SET TYPE=""
+29 FOR
SET TYPE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:3
+30 SET ITEM=""
+31 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM))
if ITEM=""
QUIT
Begin DoDot:4
+32 SET DATE=""
+33 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:5
+34 IF +DATE=DATE
QUIT
+35 SET DAS=""
+36 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:6
+37 SET NSD=NSD+1
+38 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PPI"","_DFN_","_TYPE_","_ITEM_","""_DATE_""","_DAS_")"
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
+41 ;========================================================
CNTPL(FILENUM,NSD) ;Check for string date for Problem List indexes where the
+1 ;date is at subscript 8. Works for file numbers:
+2 ;9000011
+3 NEW CODESYS,DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Checking file number "_FILENUM
+5 SET CODESYS=""
+6 FOR
SET CODESYS=$ORDER(^PXRMINDX(9000011,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+7 SET DFN=""
SET IND=0
+8 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN))
if DFN=""
QUIT
Begin DoDot:2
+9 SET IND=IND+1
+10 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+11 SET STATUS=""
+12 FOR
SET STATUS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS))
if STATUS=""
QUIT
Begin DoDot:3
+13 SET PRIORITY=""
+14 FOR
SET PRIORITY=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY))
if PRIORITY=""
QUIT
Begin DoDot:4
+15 SET ITEM=""
+16 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM))
if ITEM=""
QUIT
Begin DoDot:5
+17 SET DATE=""
+18 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:6
+19 IF +DATE=DATE
QUIT
+20 SET DAS=""
+21 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:7
+22 SET NSD=NSD+1
+23 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PSPI"","_DFN_","_STATUS_","_PRIORITY_","_ITEM_","""_DATE_""","_DAS_")"
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
+26 ;========================================================
CNTPTF(FILENUM,NSD) ;Check for string dates for PTF indexes where the
+1 ;date is at subscript 7. Works for file numbers:
+2 ;45
+3 NEW CODESYS,DAS,DATE,DFN,IND,ITEM,NODE
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Checking file number "_FILENUM
+5 SET CODESYS=""
SET IND=0
+6 FOR
SET CODESYS=$ORDER(^PXRMINDX(FILENUM,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+7 SET DFN=""
+8 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN))
if DFN=""
QUIT
Begin DoDot:2
+9 SET IND=IND+1
+10 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+11 SET NODE=""
+12 FOR
SET NODE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE))
if NODE=""
QUIT
Begin DoDot:3
+13 SET ITEM=""
+14 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM))
if ITEM=""
QUIT
Begin DoDot:4
+15 SET DATE=""
+16 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:5
+17 IF +DATE=DATE
QUIT
+18 SET DAS=""
+19 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:6
+20 SET NSD=NSD+1
+21 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_","_CODESYS_",""PNI"","_DFN_","_NODE_","_ITEM_","""_DATE_""","_DAS_")"
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;========================================================
CNTSS(FILENUM,NSD) ;Check for string dates for indexes where the start date
+1 ;is at subscript 5 and the stop date is at subscript 6.
+2 ;Works for file numbers: 52, 55, 100
+3 NEW DAS,DFN,IND,ITEM,START,STOP
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Checking file number "_FILENUM
+5 SET IND=0
+6 SET DFN=""
+7 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,"PI",DFN))
if DFN=""
QUIT
Begin DoDot:1
+8 SET IND=IND+1
+9 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+10 SET ITEM=""
+11 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+12 SET START=""
+13 FOR
SET START=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START))
if START=""
QUIT
Begin DoDot:3
+14 IF +START=START
QUIT
+15 SET STOP=""
+16 FOR
SET STOP=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP))
if STOP=""
QUIT
Begin DoDot:4
+17 SET DAS=""
+18 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS))
if DAS=""
QUIT
Begin DoDot:5
+19 SET NSD=NSD+1
+20 SET ^TMP($JOB,"SDATE",NSD)="^PXRMINDX("_FILENUM_",""PI"","_DFN_","_ITEM_","""_START_""","_STOP_","_DAS_")"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
+23 ;========================================================
CHECK ;Driver for making index date checks.
+1 NEW GBL,LIST,TASKIT
+2 WRITE !,"Which indexes do you want to check?"
+3 DO SEL^PXRMSXRM(.LIST,.GBL)
+4 IF LIST=""
QUIT
+5 ;See if this should be tasked.
+6 SET TASKIT=$$ASKTASK^PXRMSXRM
+7 IF TASKIT
Begin DoDot:1
+8 WRITE !,"Queue the Clinical Reminders Index date check."
+9 DO TASKIT(LIST,.GBL,.ROUTINE)
End DoDot:1
+10 IF '$TEST
DO RUNNOW(LIST,.GBL)
+11 QUIT
+12 ;
+13 ;========================================================
MESSAGE(FILENUM,NSD,START,END) ;Build the MailMan message giving the
+1 ;list of entries with string dates.
+2 NEW FROM,IND,NAME,NL,TEXT,TO,XMSUB
+3 KILL ^TMP("PXRMXMZ",$JOB)
+4 SET XMSUB="CR Index string date check for file #"_FILENUM
+5 SET NAME=$$GET1^DID(FILENUM,"","","NAME")_", file #"_FILENUM
+6 IF NSD=0
SET TEXT="No string dates were found for "_NAME_"."
+7 IF NSD>0
SET TEXT="A total of "_NSD_" string dates were found for "_NAME_"."
+8 SET ^TMP("PXRMXMZ",$JOB,1,0)=TEXT
+9 SET ^TMP("PXRMXMZ",$JOB,2,0)="Check finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
+10 SET ^TMP("PXRMXMZ",$JOB,3,0)=$$ETIME^PXRMSXRM(START,END)
+11 SET ^TMP("PXRMXMZ",$JOB,4,0)=" "
+12 IF NSD=0
IF '$DATA(^PXRMINDX(FILENUM))
Begin DoDot:1
+13 SET ^TMP("PXRMXMZ",$JOB,5,0)="The index for file number "_FILENUM_" does not exist."
+14 SET ^TMP("PXRMXMZ",$JOB,6,0)=" "
End DoDot:1
+15 IF NSD>0
Begin DoDot:1
+16 SET ^TMP("PXRMXMZ",$JOB,5,0)="The following entries with string dates were found:"
+17 SET NL=5
+18 FOR IND=1:1:NSD
Begin DoDot:2
+19 SET NL=NL+1
+20 SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_^TMP($JOB,"SDATE",IND)
End DoDot:2
+21 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "
End DoDot:1
+22 SET FROM=$$GET1^DIQ(200,DUZ,.01)
+23 SET TO(DUZ)=""
+24 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
+25 KILL ^TMP($JOB,"SDATE"),^TMP("PXRMXMZ",$JOB)
+26 QUIT
+27 ;
+28 ;===============================================================
RUNNOW(LIST,GBL) ;Run the routines now.
+1 NEW END,FN,IND,LI,NSD,NUM,ROUTINE,RTN,START,TOTAL
+2 KILL ^TMP($JOB,"SDATE")
+3 SET ROUTINE(45)="CNTPTF^PXRMINDD"
+4 SET ROUTINE(52)="CNTSS^PXRMINDD"
+5 SET ROUTINE(55)="CNTSS^PXRMINDD"
+6 SET ROUTINE(63)="CNT5^PXRMINDD"
+7 SET ROUTINE(70)="CNT5^PXRMINDD"
+8 SET ROUTINE(100)="CNTSS^PXRMINDD"
+9 SET ROUTINE(120.5)="CNT5^PXRMINDD"
+10 SET ROUTINE(601.2)="CNT5^PXRMINDD"
+11 SET ROUTINE(601.84)="CNT5^PXRMINDD"
+12 SET ROUTINE(9000011)="CNTPL^PXRMINDD"
+13 SET ROUTINE(9000010.07)="CNT6^PXRMINDD"
+14 SET ROUTINE(9000010.11)="CNT5^PXRMINDD"
+15 SET ROUTINE(9000010.12)="CNT5^PXRMINDD"
+16 SET ROUTINE(9000010.13)="CNT5^PXRMINDD"
+17 SET ROUTINE(9000010.16)="CNT5^PXRMINDD"
+18 SET ROUTINE(9000010.18)="CNT6^PXRMINDD"
+19 SET ROUTINE(9000010.23)="CNT5^PXRMINDD"
+20 SET NUM=$LENGTH(LIST,",")-1
+21 FOR IND=1:1:NUM
Begin DoDot:1
+22 SET LI=$PIECE(LIST,",",IND)
+23 SET NSD=0
+24 SET FN=GBL(LI)
+25 SET RTN=ROUTINE(FN)
+26 SET RTN=RTN_"("_FN_",.NSD)"
+27 SET START=$HOROLOG
+28 IF $DATA(^PXRMINDX(FN))
DO @RTN
+29 SET END=$HOROLOG
+30 DO MESSAGE(FN,NSD,START,END)
End DoDot:1
+31 QUIT
+32 ;
+33 ;===============================================================
TASKIT(LIST,GBL,ROUTINE) ;Check the indexes as a tasked job.
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
+2 SET MINDT=$$NOW^XLFDT
+3 SET DIR("A",1)="Enter the date and time you want the job to start."
+4 SET DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
+5 SET DIR("A")="Start the task at: "
+6 SET DIR(0)="DAU"_U_MINDT_"::RSX"
+7 DO ^DIR
+8 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+10 SET SDTIME=Y
+11 KILL DIR
+12 ;Put the task into the queue.
+13 KILL ZTSAVE
+14 SET ZTSAVE("LIST")=""
+15 SET ZTSAVE("GBL(")=""
+16 SET ZTRTN="TASKJOB^PXRMINDD"
+17 SET ZTDESC="Clinical Reminders Index string date check"
+18 SET ZTDTH=SDTIME
+19 SET ZTIO=""
+20 DO ^%ZTLOAD
+21 WRITE !,"Task number ",ZTSK," queued."
+22 QUIT
+23 ;
+24 ;===============================================================
TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
+1 NEW IND,LI,NUM
+2 SET ZTREQ="@"
+3 SET ZTSTOP=0
+4 SET NUM=$LENGTH(LIST,",")-1
+5 FOR IND=1:1:NUM
Begin DoDot:1
+6 ;Check to see if the task has had a stop request
+7 IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IND=NUM
QUIT
+8 SET LI=$PIECE(LIST,",",IND)_","
+9 DO RUNNOW^PXRMINDD(LI,.GBL)
End DoDot:1
+10 QUIT
+11 ;
