source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDC.m@ 1766

PXRMINDC ; SLC/PKR - Index counting routines. ;04/20/2006
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ;
 ;========================================================
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,
 ;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 DAS,DATE,DFN,IND,ITEM,TYPE,YEAR
 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
 S IND=0
 S DFN=""
 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)
 .... S DAS=""
 .... F  S DAS=$O(^PXRMINDX(FILENUM,"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 7. Works for file numbers:
 ;9000011
 N DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE,YEAR
 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
 S IND=0
 S DFN=""
 F  S DFN=$O(^PXRMINDX(FILENUM,"PSPI",DFN)) Q:DFN=""  D
 . S IND=IND+1
 . I '$D(ZTQUEUED),(IND#10000=0) W "."
 . S STATUS=""
 . F  S STATUS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS)) Q:STATUS=""  D
 .. S PRIORITY=""
 .. F  S PRIORITY=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY=""  D
 ... S ITEM=""
 ... F  S ITEM=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM=""  D
 .... S DATE=""
 .... F  S DATE=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE=""  D
 ..... S YEAR=$E(DATE,1,3)
 ..... S DAS=""
 ..... F  S DAS=$O(^PXRMINDX(FILENUM,"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 DAS,DATE,DFN,IND,ITEM,NODE,TYPE,YEAR
 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
 S IND=0
 F TYPE="ICD0","ICD9" D
 . S DFN=""
 . F  S DFN=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN)) Q:DFN=""  D
 .. S IND=IND+1
 .. I '$D(ZTQUEUED),(IND#10000=0) W "."
 .. S NODE=""
 .. F  S NODE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE)) Q:NODE=""  D
 ... S ITEM=""
 ... F  S ITEM=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM)) Q:ITEM=""  D
 .... S DATE=""
 .... F  S DATE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE=""  D
 ..... S YEAR=$E(DATE,1,3)
 ..... S DAS=""
 ..... F  S DAS=$O(^PXRMINDX(FILENUM,TYPE,"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,ML,NAME,NL,PERC,TEXT,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
 D SEND^PXRMMSG(XMSUB)
 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(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
 ;