Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMINDC

PXRMINDC.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;========================================================
  1. CNT5(FILENUM,COUNT) ;Get date counts for indexes where the date
  1. ;is at subscript 5. Works for file numbers:
  1. ;63, 70, 120.5, 601.2, 601.84,
  1. ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23
  1. N DAS,DATE,DFN,IND,ITEM,YEAR
  1. I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
  1. S IND=0
  1. S DFN=""
  1. F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D
  1. . S IND=IND+1
  1. . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. . S ITEM=""
  1. . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D
  1. .. S DATE=""
  1. .. F S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE="" D
  1. ... S YEAR=$E(DATE,1,3)
  1. ... S DAS=""
  1. ... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS="" D
  1. .... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. Q
  1. ;
  1. ;========================================================
  1. CNT6(FILENUM,COUNT) ;Get date counts for indexes where the date
  1. ;is at subscript 6. Works for file numbers:
  1. ;9000010.07, 9000010.18
  1. N CODESYS,DAS,DATE,DFN,IND,ITEM,TYPE,YEAR
  1. I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
  1. S DFN="",IND=0
  1. F S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN="" D
  1. . S IND=IND+1
  1. . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. . S TYPE=""
  1. . F S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE="" D
  1. .. S ITEM=""
  1. .. F S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D
  1. ... S DATE=""
  1. ... F S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
  1. .... S YEAR=$E(DATE,1,3),DAS=""
  1. .... F S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
  1. ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. I FILENUM'=9000010.07 Q
  1. S CODESYS=""
  1. F S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS="" D
  1. . I (CODESYS="PPI")!(CODESYS="IPP") Q
  1. . S DFN=""
  1. . F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN)) Q:DFN="" D
  1. .. S IND=IND+1
  1. .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. .. S TYPE=""
  1. .. F S TYPE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE)) Q:TYPE="" D
  1. ... S ITEM=""
  1. ... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D
  1. .... S DATE=""
  1. .... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
  1. ..... S YEAR=$E(DATE,1,3),DAS=""
  1. ..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D
  1. ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. Q
  1. ;
  1. ;========================================================
  1. CNTPL(FILENUM,COUNT) ;Get date counts for Problem List indexes where the
  1. ;date is at subscript 8. Works for file numbers:
  1. ;9000011
  1. N CODESYS,DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE,YEAR
  1. I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
  1. S CODESYS="",IND=0
  1. F S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS="" D
  1. . S DFN=""
  1. . F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN)) Q:DFN="" D
  1. .. S IND=IND+1
  1. .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. .. S STATUS=""
  1. .. F S STATUS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS)) Q:STATUS="" D
  1. ... S PRIORITY=""
  1. ... F S PRIORITY=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
  1. .... S ITEM=""
  1. .... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D
  1. ..... S DATE=""
  1. ..... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
  1. ...... S YEAR=$E(DATE,1,3)
  1. ...... S DAS=""
  1. ...... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS="" D
  1. ....... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. Q
  1. ;
  1. ;========================================================
  1. CNTPTF(FILENUM,COUNT) ;Get date counts for PTF indexes where the
  1. ;date is at subscript 7. Works for file numbers:
  1. ;45
  1. N CODESYS,DAS,DATE,DFN,IND,ITEM,NODE,YEAR
  1. I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
  1. S CODESYS="",IND=0
  1. ;F TYPE="ICD0","ICD9" D
  1. F S CODESYS=$O(^PXRMINDX(FILENUM,CODESYS)) Q:CODESYS="" D
  1. . S DFN=""
  1. . F S DFN=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN)) Q:DFN="" D
  1. .. S IND=IND+1
  1. .. I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. .. S NODE=""
  1. .. F S NODE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE)) Q:NODE="" D
  1. ... S ITEM=""
  1. ... F S ITEM=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM)) Q:ITEM="" D
  1. .... S DATE=""
  1. .... F S DATE=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE="" D
  1. ..... S YEAR=$E(DATE,1,3)
  1. ..... S DAS=""
  1. ..... F S DAS=$O(^PXRMINDX(FILENUM,CODESYS,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS="" D
  1. ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. Q
  1. ;
  1. ;========================================================
  1. 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.
  1. ;Works for file numbers: 52, 55, 100
  1. N DAS,DFN,IND,ITEM,START,STOP,YEAR
  1. I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM
  1. S IND=0
  1. S DFN=""
  1. F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D
  1. . S IND=IND+1
  1. . I '$D(ZTQUEUED),(IND#10000=0) W "."
  1. . S ITEM=""
  1. . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D
  1. .. S START=""
  1. .. F S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START="" D
  1. ... S YEAR=$E(START,1,3)
  1. ... S STOP=""
  1. ... F S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP="" D
  1. .... S DAS=""
  1. .... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS="" D
  1. ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1
  1. Q
  1. ;
  1. ;========================================================
  1. COUNT ;Driver for making index counts.
  1. N GBL,LIST,TASKIT
  1. W !,"Which indexes do you want to count?"
  1. D SEL^PXRMSXRM(.LIST,.GBL)
  1. I LIST="" Q
  1. ;See if this should be tasked.
  1. S TASKIT=$$ASKTASK^PXRMSXRM
  1. I TASKIT D
  1. . W !,"Queue the Clinical Reminders Index count."
  1. . D TASKIT(LIST,.GBL,.ROUTINE)
  1. E D RUNNOW(LIST,.GBL)
  1. Q
  1. ;
  1. ;========================================================
  1. MESSAGE(FILENUM,COUNT,TOTAL,START,END) ;Build the MailMan message giving the
  1. ;count breakdown.
  1. N COFF,FROM,ML,NAME,NL,PERC,TEXT,TO,YEAR,XMSUB
  1. K ^TMP("PXRMXMZ",$J)
  1. S ML=$$MAX^XLFMTH($L(TOTAL)+2,8)
  1. S COFF=ML-5
  1. S NAME=$$GET1^DID(FILENUM,"","","NAME")
  1. S XMSUB="Yearly data distribution for global "_NAME
  1. S ^TMP("PXRMXMZ",$J,1,0)="File name: "_NAME
  1. S ^TMP("PXRMXMZ",$J,2,0)="Count finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
  1. S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END)
  1. S ^TMP("PXRMXMZ",$J,4,0)=" "
  1. S ^TMP("PXRMXMZ",$J,5,0)="Year"_$$INSCHR^PXRMEXLC(COFF," ")_"Count"_$J("%",8)
  1. S ^TMP("PXRMXMZ",$J,6,0)="----"_$$INSCHR^PXRMEXLC(COFF," ")_"-----"_$J("-----",10)
  1. S NL=6,YEAR=0
  1. F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D
  1. . S PERC=100*COUNT(YEAR)/TOTAL
  1. . S TEXT=YEAR_$J(COUNT(YEAR),ML,0)_$J(PERC,10,2)
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
  1. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "
  1. S TEXT="Total entries: "_TOTAL
  1. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
  1. I TOTAL=0 D
  1. . I '$D(^PXRMINDX(FILENUM)) S TEXT="The index for file "_NAME_" does not exist!"
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
  1. I TOTAL>0,'$D(^PXRMINDX(FILENUM,"DATE BUILT")) D
  1. . S TEXT="Warning, the index for file "_NAME_" may be incomplete or corrupted!"
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT
  1. S FROM=$$GET1^DIQ(200,DUZ,.01)
  1. S TO(DUZ)=""
  1. D SEND^PXRMMSG("PXRMXMZ",XMSUB,.TO,FROM)
  1. K ^TMP("PXRMXMZ",$J)
  1. Q
  1. ;
  1. ;===============================================================
  1. RUNNOW(LIST,GBL) ;Run the routines now.
  1. N COUNT,END,FN,IND,LI,NUM,ROUTINE,RTN,START,TOTAL
  1. S ROUTINE(45)="CNTPTF^PXRMINDC"
  1. S ROUTINE(52)="CNTSS^PXRMINDC"
  1. S ROUTINE(55)="CNTSS^PXRMINDC"
  1. S ROUTINE(63)="CNT5^PXRMINDC"
  1. S ROUTINE(70)="CNT5^PXRMINDC"
  1. S ROUTINE(100)="CNTSS^PXRMINDC"
  1. S ROUTINE(120.5)="CNT5^PXRMINDC"
  1. S ROUTINE(601.2)="CNT5^PXRMINDC"
  1. S ROUTINE(601.84)="CNT5^PXRMINDC"
  1. S ROUTINE(9000011)="CNTPL^PXRMINDC"
  1. S ROUTINE(9000010.07)="CNT6^PXRMINDC"
  1. S ROUTINE(9000010.11)="CNT5^PXRMINDC"
  1. S ROUTINE(9000010.12)="CNT5^PXRMINDC"
  1. S ROUTINE(9000010.13)="CNT5^PXRMINDC"
  1. S ROUTINE(9000010.16)="CNT5^PXRMINDC"
  1. S ROUTINE(9000010.18)="CNT6^PXRMINDC"
  1. S ROUTINE(9000010.23)="CNT5^PXRMINDC"
  1. ;IHS/MSC/MGH Added counts for V files not used by VA
  1. S ROUTINE(9000010.08)="CNT6^PXRMINDC"
  1. S ROUTINE(9000010.01)="CNT5^PXRMINDC"
  1. S NUM=$L(LIST,",")-1
  1. F IND=1:1:NUM D
  1. . S LI=$P(LIST,",",IND)
  1. . S FN=GBL(LI)
  1. . S RTN=ROUTINE(FN)
  1. . S RTN=RTN_"("_FN_",.COUNT)"
  1. . S START=$H
  1. . K COUNT
  1. . I $D(^PXRMINDX(FN)) D @RTN
  1. . S END=$H
  1. . D TOTAL(.COUNT,.TOTAL)
  1. . D MESSAGE(FN,.COUNT,TOTAL,START,END)
  1. Q
  1. ;
  1. ;===============================================================
  1. TASKIT(LIST,GBL,ROUTINE) ;Count the indexes as a tasked job.
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y
  1. S MINDT=$$NOW^XLFDT
  1. S DIR("A",1)="Enter the date and time you want the job to start."
  1. S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
  1. S DIR("A")="Start the task at: "
  1. S DIR(0)="DAU"_U_MINDT_"::RSX"
  1. D ^DIR
  1. I $D(DIROUT)!$D(DIRUT) Q
  1. I $D(DTOUT)!$D(DUOUT) Q
  1. S SDTIME=Y
  1. K DIR
  1. ;Put the task into the queue.
  1. K ZTSAVE
  1. S ZTSAVE("LIST")=""
  1. S ZTSAVE("GBL(")=""
  1. S ZTRTN="TASKJOB^PXRMINDC"
  1. S ZTDESC="Clinical Reminders Index count"
  1. S ZTDTH=SDTIME
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. W !,"Task number ",ZTSK," queued."
  1. Q
  1. ;
  1. ;===============================================================
  1. TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE.
  1. N IND,LI,NUM
  1. S ZTREQ="@"
  1. S ZTSTOP=0
  1. S NUM=$L(LIST,",")-1
  1. F IND=1:1:NUM D
  1. .;Check to see if the task has had a stop request
  1. . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q
  1. . S LI=$P(LIST,",",IND)_","
  1. . D RUNNOW^PXRMINDC(LI,.GBL)
  1. Q
  1. ;
  1. ;========================================================
  1. TOTAL(COUNT,TOTAL) ;Convert the FileMan years in COUNT to regular
  1. ;years get the total number of entries in count.
  1. N TC,YEAR
  1. S (TOTAL,YEAR)=0
  1. F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D
  1. . S TOTAL=TOTAL+COUNT(YEAR)
  1. . S TC(YEAR+1700)=COUNT(YEAR)
  1. K COUNT
  1. M COUNT=TC
  1. Q
  1. ;