PXRMINDC ; SLC/PKR - Index counting routines. ;09/27/2012
;;2.0;CLINICAL REMINDERS;**4,6,17,26**;Feb 04, 2005;Build 404
;
;========================================================
CNT5(FILENUM,COUNT) ;Get date counts 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,YEAR
I '$D(ZTQUEUED) W !,"Counting 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
... S YEAR=$E(DATE,1,3)
... S DAS=""
... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS="" D
.... S COUNT(YEAR)=$G(COUNT(YEAR))+1
Q
;
;========================================================
CNT6(FILENUM,COUNT) ;Get date counts 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,YEAR
I '$D(ZTQUEUED) W !,"Counting 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
.... S YEAR=$E(DATE,1,3),DAS=""
.... F S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
..... S COUNT(YEAR)=$G(COUNT(YEAR))+1
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
..... S YEAR=$E(DATE,1,3),DAS=""
..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
...... S COUNT(YEAR)=$G(COUNT(YEAR))+1
Q
;
;========================================================
CNTPL(FILENUM,COUNT) ;Get date counts 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,YEAR
I '$D(ZTQUEUED) W !,"Counting 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,"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
...... S YEAR=$E(DATE,1,3)
...... S DAS=""
...... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS="" D
....... S COUNT(YEAR)=$G(COUNT(YEAR))+1
Q
;
;========================================================
CNTPTF(FILENUM,COUNT) ;Get date counts for PTF indexes where the
;date is at subscript 7. Works for file numbers:
;45
N CODESYS,DAS,DATE,DFN,IND,ITEM,NODE,YEAR
I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
S CODESYS="",IND=0
;F TYPE="ICD0","ICD9" D
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
..... S YEAR=$E(DATE,1,3)
..... S DAS=""
..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS="" D
...... S COUNT(YEAR)=$G(COUNT(YEAR))+1
Q
;
;========================================================
CNTSS(FILENUM,COUNT) ;Get date counts 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,YEAR
I '$D(ZTQUEUED) W !,"Counting 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
... S YEAR=$E(START,1,3)
... 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 COUNT(YEAR)=$G(COUNT(YEAR))+1
Q
;
;========================================================
COUNT ;Driver for making index counts.
N GBL,LIST,TASKIT
W !,"Which indexes do you want to count?"
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 count."
. D TASKIT(LIST,.GBL,.ROUTINE)
E D RUNNOW(LIST,.GBL)
Q
;
;========================================================
MESSAGE(FILENUM,COUNT,TOTAL,START,END) ;Build the MailMan message giving the
;count breakdown.
N COFF,FROM,ML,NAME,NL,PERC,TEXT,TO,YEAR,XMSUB
K ^TMP("PXRMXMZ",$J)
S ML=$$MAX^XLFMTH($L(TOTAL)+2,8)
S COFF=ML-5
S NAME=$$GET1^DID(FILENUM,"","","NAME")
S XMSUB="Yearly data distribution for global "_NAME
S ^TMP("PXRMXMZ",$J,1,0)="File name: "_NAME
S ^TMP("PXRMXMZ",$J,2,0)="Count finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
S ^TMP("PXRMXMZ",$J,4,0)=" "
S ^TMP("PXRMXMZ",$J,5,0)="Year"_$$INSCHR^PXRMEXLC(COFF," ")_"Count"_$J("%",8)
S ^TMP("PXRMXMZ",$J,6,0)="----"_$$INSCHR^PXRMEXLC(COFF," ")_"-----"_$J("-----",10)
S NL=6,YEAR=0
F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D
. S PERC=100*COUNT(YEAR)/TOTAL
. S TEXT=YEAR_$J(COUNT(YEAR),ML,0)_$J(PERC,10,2)
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
S TEXT="Total entries: "_TOTAL
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
I TOTAL=0 D
. I '$D(^PXRMINDX(FILENUM)) S TEXT="The index for file "_NAME_" does not exist!"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
I TOTAL>0,'$D(^PXRMINDX(FILENUM,"DATE BUILT")) D
. S TEXT="Warning, the index for file "_NAME_" may be incomplete or corrupted!"
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
S FROM=$$GET1^DIQ(200,DUZ,.01)
S TO(DUZ)=""
D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
K ^TMP("PXRMXMZ",$J)
Q
;
;===============================================================
RUNNOW(LIST,GBL) ;Run the routines now.
N COUNT,END,FN,IND,LI,NUM,ROUTINE,RTN,START,TOTAL
S ROUTINE(45)="CNTPTF^PXRMINDC"
S ROUTINE(52)="CNTSS^PXRMINDC"
S ROUTINE(55)="CNTSS^PXRMINDC"
S ROUTINE(63)="CNT5^PXRMINDC"
S ROUTINE(70)="CNT5^PXRMINDC"
S ROUTINE(100)="CNTSS^PXRMINDC"
S ROUTINE(120.5)="CNT5^PXRMINDC"
S ROUTINE(601.2)="CNT5^PXRMINDC"
S ROUTINE(601.84)="CNT5^PXRMINDC"
S ROUTINE(9000011)="CNTPL^PXRMINDC"
S ROUTINE(9000010.07)="CNT6^PXRMINDC"
S ROUTINE(9000010.11)="CNT5^PXRMINDC"
S ROUTINE(9000010.12)="CNT5^PXRMINDC"
S ROUTINE(9000010.13)="CNT5^PXRMINDC"
S ROUTINE(9000010.16)="CNT5^PXRMINDC"
S ROUTINE(9000010.18)="CNT6^PXRMINDC"
S ROUTINE(9000010.23)="CNT5^PXRMINDC"
S NUM=$L(LIST,",")-1
F IND=1:1:NUM D
. S LI=$P(LIST,",",IND)
. S FN=GBL(LI)
. S RTN=ROUTINE(FN)
. S RTN=RTN_"("_FN_",.COUNT)"
. S START=$H
. K COUNT
. I $D(^PXRMINDX(FN)) D @RTN
. S END=$H
. D TOTAL(.COUNT,.TOTAL)
. D MESSAGE(FN,.COUNT,TOTAL,START,END)
Q
;
;===============================================================
TASKIT(LIST,GBL,ROUTINE) ;Count 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^PXRMINDC"
S ZTDESC="Clinical Reminders Index count"
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^PXRMINDC(LI,.GBL)
Q
;
;========================================================
TOTAL(COUNT,TOTAL) ;Convert the FileMan years in COUNT to regular
;years get the total number of entries in count.
N TC,YEAR
S (TOTAL,YEAR)=0
F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D
. S TOTAL=TOTAL+COUNT(YEAR)
. S TC(YEAR+1700)=COUNT(YEAR)
K COUNT
M COUNT=TC
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINDC 9964 printed Apr 09, 2024@20:50:41 Page 2
PXRMINDC ; SLC/PKR - Index counting routines. ;09/27/2012
+1 ;;2.0;CLINICAL REMINDERS;**4,6,17,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;========================================================
CNT5(FILENUM,COUNT) ;Get date counts 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,YEAR
+5 IF '$DATA(ZTQUEUED)
WRITE !,"Counting 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 SET YEAR=$EXTRACT(DATE,1,3)
+16 SET DAS=""
+17 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:4
+18 SET COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
+21 ;========================================================
CNT6(FILENUM,COUNT) ;Get date counts 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,YEAR
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Counting 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 SET YEAR=$EXTRACT(DATE,1,3)
SET DAS=""
+16 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:5
+17 SET COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF FILENUM'=9000010.07
QUIT
+19 SET CODESYS=""
+20 FOR
SET CODESYS=$ORDER(^PXRMINDX(FILENUM,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+21 IF (CODESYS="PPI")!(CODESYS="IPP")
QUIT
+22 SET DFN=""
+23 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN))
if DFN=""
QUIT
Begin DoDot:2
+24 SET IND=IND+1
+25 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+26 SET TYPE=""
+27 FOR
SET TYPE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE))
if TYPE=""
QUIT
Begin DoDot:3
+28 SET ITEM=""
+29 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM))
if ITEM=""
QUIT
Begin DoDot:4
+30 SET DATE=""
+31 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:5
+32 SET YEAR=$EXTRACT(DATE,1,3)
SET DAS=""
+33 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:6
+34 SET COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
+37 ;========================================================
CNTPL(FILENUM,COUNT) ;Get date counts 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,YEAR
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Counting 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,"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 SET YEAR=$EXTRACT(DATE,1,3)
+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 COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:7
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
+25 ;========================================================
CNTPTF(FILENUM,COUNT) ;Get date counts 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,YEAR
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Counting file number "_FILENUM
+5 SET CODESYS=""
SET IND=0
+6 ;F TYPE="ICD0","ICD9" D
+7 FOR
SET CODESYS=$ORDER(^PXRMINDX(FILENUM,CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+8 SET DFN=""
+9 FOR
SET DFN=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN))
if DFN=""
QUIT
Begin DoDot:2
+10 SET IND=IND+1
+11 IF '$DATA(ZTQUEUED)
IF (IND#10000=0)
WRITE "."
+12 SET NODE=""
+13 FOR
SET NODE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE))
if NODE=""
QUIT
Begin DoDot:3
+14 SET ITEM=""
+15 FOR
SET ITEM=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM))
if ITEM=""
QUIT
Begin DoDot:4
+16 SET DATE=""
+17 FOR
SET DATE=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE))
if DATE=""
QUIT
Begin DoDot:5
+18 SET YEAR=$EXTRACT(DATE,1,3)
+19 SET DAS=""
+20 FOR
SET DAS=$ORDER(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS))
if DAS=""
QUIT
Begin DoDot:6
+21 SET COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
+24 ;========================================================
CNTSS(FILENUM,COUNT) ;Get date counts 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,YEAR
+4 IF '$DATA(ZTQUEUED)
WRITE !,"Counting 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 SET YEAR=$EXTRACT(START,1,3)
+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 COUNT(YEAR)=$GET(COUNT(YEAR))+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
+22 ;========================================================
COUNT ;Driver for making index counts.
+1 NEW GBL,LIST,TASKIT
+2 WRITE !,"Which indexes do you want to count?"
+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 count."
+9 DO TASKIT(LIST,.GBL,.ROUTINE)
End DoDot:1
+10 IF '$TEST
DO RUNNOW(LIST,.GBL)
+11 QUIT
+12 ;
+13 ;========================================================
MESSAGE(FILENUM,COUNT,TOTAL,START,END) ;Build the MailMan message giving the
+1 ;count breakdown.
+2 NEW COFF,FROM,ML,NAME,NL,PERC,TEXT,TO,YEAR,XMSUB
+3 KILL ^TMP("PXRMXMZ",$JOB)
+4 SET ML=$$MAX^XLFMTH($LENGTH(TOTAL)+2,8)
+5 SET COFF=ML-5
+6 SET NAME=$$GET1^DID(FILENUM,"","","NAME")
+7 SET XMSUB="Yearly data distribution for global "_NAME
+8 SET ^TMP("PXRMXMZ",$JOB,1,0)="File name: "_NAME
+9 SET ^TMP("PXRMXMZ",$JOB,2,0)="Count 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 SET ^TMP("PXRMXMZ",$JOB,5,0)="Year"_$$INSCHR^PXRMEXLC(COFF," ")_"Count"_$JUSTIFY("%",8)
+13 SET ^TMP("PXRMXMZ",$JOB,6,0)="----"_$$INSCHR^PXRMEXLC(COFF," ")_"-----"_$JUSTIFY("-----",10)
+14 SET NL=6
SET YEAR=0
+15 FOR
SET YEAR=$ORDER(COUNT(YEAR))
if YEAR=""
QUIT
Begin DoDot:1
+16 SET PERC=100*COUNT(YEAR)/TOTAL
+17 SET TEXT=YEAR_$JUSTIFY(COUNT(YEAR),ML,0)_$JUSTIFY(PERC,10,2)
+18 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:1
+19 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "
+20 SET TEXT="Total entries: "_TOTAL
+21 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
+22 IF TOTAL=0
Begin DoDot:1
+23 IF '$DATA(^PXRMINDX(FILENUM))
SET TEXT="The index for file "_NAME_" does not exist!"
+24 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:1
+25 IF TOTAL>0
IF '$DATA(^PXRMINDX(FILENUM,"DATE BUILT"))
Begin DoDot:1
+26 SET TEXT="Warning, the index for file "_NAME_" may be incomplete or corrupted!"
+27 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXT
End DoDot:1
+28 SET FROM=$$GET1^DIQ(200,DUZ,.01)
+29 SET TO(DUZ)=""
+30 DO SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
+31 KILL ^TMP("PXRMXMZ",$JOB)
+32 QUIT
+33 ;
+34 ;===============================================================
RUNNOW(LIST,GBL) ;Run the routines now.
+1 NEW COUNT,END,FN,IND,LI,NUM,ROUTINE,RTN,START,TOTAL
+2 SET ROUTINE(45)="CNTPTF^PXRMINDC"
+3 SET ROUTINE(52)="CNTSS^PXRMINDC"
+4 SET ROUTINE(55)="CNTSS^PXRMINDC"
+5 SET ROUTINE(63)="CNT5^PXRMINDC"
+6 SET ROUTINE(70)="CNT5^PXRMINDC"
+7 SET ROUTINE(100)="CNTSS^PXRMINDC"
+8 SET ROUTINE(120.5)="CNT5^PXRMINDC"
+9 SET ROUTINE(601.2)="CNT5^PXRMINDC"
+10 SET ROUTINE(601.84)="CNT5^PXRMINDC"
+11 SET ROUTINE(9000011)="CNTPL^PXRMINDC"
+12 SET ROUTINE(9000010.07)="CNT6^PXRMINDC"
+13 SET ROUTINE(9000010.11)="CNT5^PXRMINDC"
+14 SET ROUTINE(9000010.12)="CNT5^PXRMINDC"
+15 SET ROUTINE(9000010.13)="CNT5^PXRMINDC"
+16 SET ROUTINE(9000010.16)="CNT5^PXRMINDC"
+17 SET ROUTINE(9000010.18)="CNT6^PXRMINDC"
+18 SET ROUTINE(9000010.23)="CNT5^PXRMINDC"
+19 SET NUM=$LENGTH(LIST,",")-1
+20 FOR IND=1:1:NUM
Begin DoDot:1
+21 SET LI=$PIECE(LIST,",",IND)
+22 SET FN=GBL(LI)
+23 SET RTN=ROUTINE(FN)
+24 SET RTN=RTN_"("_FN_",.COUNT)"
+25 SET START=$HOROLOG
+26 KILL COUNT
+27 IF $DATA(^PXRMINDX(FN))
DO @RTN
+28 SET END=$HOROLOG
+29 DO TOTAL(.COUNT,.TOTAL)
+30 DO MESSAGE(FN,.COUNT,TOTAL,START,END)
End DoDot:1
+31 QUIT
+32 ;
+33 ;===============================================================
TASKIT(LIST,GBL,ROUTINE) ;Count 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^PXRMINDC"
+17 SET ZTDESC="Clinical Reminders Index count"
+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^PXRMINDC(LI,.GBL)
End DoDot:1
+10 QUIT
+11 ;
+12 ;========================================================
TOTAL(COUNT,TOTAL) ;Convert the FileMan years in COUNT to regular
+1 ;years get the total number of entries in count.
+2 NEW TC,YEAR
+3 SET (TOTAL,YEAR)=0
+4 FOR
SET YEAR=$ORDER(COUNT(YEAR))
if YEAR=""
QUIT
Begin DoDot:1
+5 SET TOTAL=TOTAL+COUNT(YEAR)
+6 SET TC(YEAR+1700)=COUNT(YEAR)
End DoDot:1
+7 KILL COUNT
+8 MERGE COUNT=TC
+9 QUIT
+10 ;
