- PXRMINDC ; SLC/PKR - Index counting routines. ;23-Mar-2015 10:36;DU
- ;;2.0;CLINICAL REMINDERS;**4,6,1001,17,26,1005**;Feb 04, 2005;Build 23
- ;
- ;========================================================
- 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"
- ;IHS/MSC/MGH Added counts for V files not used by VA
- S ROUTINE(9000010.08)="CNT6^PXRMINDC"
- S ROUTINE(9000010.01)="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
- ;
- PXRMINDC ; SLC/PKR - Index counting routines. ;23-Mar-2015 10:36;DU
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,1001,17,26,1005**;Feb 04, 2005;Build 23
- +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 ;IHS/MSC/MGH Added counts for V files not used by VA
- +20 SET ROUTINE(9000010.08)="CNT6^PXRMINDC"
- +21 SET ROUTINE(9000010.01)="CNT5^PXRMINDC"
- +22 SET NUM=$LENGTH(LIST,",")-1
- +23 FOR IND=1:1:NUM
- Begin DoDot:1
- +24 SET LI=$PIECE(LIST,",",IND)
- +25 SET FN=GBL(LI)
- +26 SET RTN=ROUTINE(FN)
- +27 SET RTN=RTN_"("_FN_",.COUNT)"
- +28 SET START=$HOROLOG
- +29 KILL COUNT
- +30 IF $DATA(^PXRMINDX(FN))
- DO @RTN
- +31 SET END=$HOROLOG
- +32 DO TOTAL(.COUNT,.TOTAL)
- +33 DO MESSAGE(FN,.COUNT,TOTAL,START,END)
- End DoDot:1
- +34 QUIT
- +35 ;
- +36 ;===============================================================
- 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 ;