Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDC.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDC.m
r613 r623 1 PXRMINDC ; SLC/PKR - Index counting routines. ;03/06/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;======================================================== 5 CNT5(FILENUM,COUNT) ;Get date counts for indexes where the date 6 ;is at subscript 5. Works for file numbers: 7 ;63, 70, 120.5, 601.2, 601.84, 8 ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23 9 N DAS,DATE,DFN,IND,ITEM,YEAR 10 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 11 S IND=0 12 S DFN="" 13 F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D 14 . S IND=IND+1 15 . I '$D(ZTQUEUED),(IND#10000=0) W "." 16 . S ITEM="" 17 . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D 18 .. S DATE="" 19 .. F S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE="" D 20 ... S YEAR=$E(DATE,1,3) 21 ... S DAS="" 22 ... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS="" D 23 .... S COUNT(YEAR)=$G(COUNT(YEAR))+1 24 Q 25 ; 26 ;======================================================== 27 CNT6(FILENUM,COUNT) ;Get date counts for indexes where the date 28 ;is at subscript 6. Works for file numbers: 29 ;9000010.07, 9000010.18 30 N DAS,DATE,DFN,IND,ITEM,TYPE,YEAR 31 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 32 S IND=0 33 S DFN="" 34 F S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN="" D 35 . S IND=IND+1 36 . I '$D(ZTQUEUED),(IND#10000=0) W "." 37 . S TYPE="" 38 . F S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE="" D 39 .. S ITEM="" 40 .. F S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D 41 ... S DATE="" 42 ... F S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D 43 .... S YEAR=$E(DATE,1,3) 44 .... S DAS="" 45 .... F S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D 46 ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1 47 Q 48 ; 49 ;======================================================== 50 CNTPL(FILENUM,COUNT) ;Get date counts for Problem List indexes where the 51 ;date is at subscript 7. Works for file numbers: 52 ;9000011 53 N DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE,YEAR 54 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 55 S IND=0 56 S DFN="" 57 F S DFN=$O(^PXRMINDX(FILENUM,"PSPI",DFN)) Q:DFN="" D 58 . S IND=IND+1 59 . I '$D(ZTQUEUED),(IND#10000=0) W "." 60 . S STATUS="" 61 . F S STATUS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS)) Q:STATUS="" D 62 .. S PRIORITY="" 63 .. F S PRIORITY=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D 64 ... S ITEM="" 65 ... F S ITEM=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D 66 .... S DATE="" 67 .... F S DATE=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D 68 ..... S YEAR=$E(DATE,1,3) 69 ..... S DAS="" 70 ..... F S DAS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS="" D 71 ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1 72 Q 73 ; 74 ;======================================================== 75 CNTPTF(FILENUM,COUNT) ;Get date counts for PTF indexes where the 76 ;date is at subscript 7. Works for file numbers: 77 ;45 78 N DAS,DATE,DFN,IND,ITEM,NODE,TYPE,YEAR 79 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 80 S IND=0 81 F TYPE="ICD0","ICD9" D 82 . S DFN="" 83 . F S DFN=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN)) Q:DFN="" D 84 .. S IND=IND+1 85 .. I '$D(ZTQUEUED),(IND#10000=0) W "." 86 .. S NODE="" 87 .. F S NODE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE)) Q:NODE="" D 88 ... S ITEM="" 89 ... F S ITEM=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM)) Q:ITEM="" D 90 .... S DATE="" 91 .... F S DATE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE="" D 92 ..... S YEAR=$E(DATE,1,3) 93 ..... S DAS="" 94 ..... F S DAS=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS="" D 95 ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1 96 Q 97 ; 98 ;======================================================== 99 CNTSS(FILENUM,COUNT) ;Get date counts for indexes where the start date 100 ;is at subscript 5 and the stop date is at subscript 6. 101 ;Works for file numbers: 52, 55, 100 102 N DAS,DFN,IND,ITEM,START,STOP,YEAR 103 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 104 S IND=0 105 S DFN="" 106 F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D 107 . S IND=IND+1 108 . I '$D(ZTQUEUED),(IND#10000=0) W "." 109 . S ITEM="" 110 . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D 111 .. S START="" 112 .. F S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START="" D 113 ... S YEAR=$E(START,1,3) 114 ... S STOP="" 115 ... F S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP="" D 116 .... S DAS="" 117 .... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS="" D 118 ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1 119 Q 120 ; 121 ;======================================================== 122 COUNT ;Driver for making index counts. 123 N GBL,LIST,TASKIT 124 W !,"Which indexes do you want to count?" 125 D SEL^PXRMSXRM(.LIST,.GBL) 126 I LIST="" Q 127 ;See if this should be tasked. 128 S TASKIT=$$ASKTASK^PXRMSXRM 129 I TASKIT D 130 . W !,"Queue the Clinical Reminders Index count." 131 . D TASKIT(LIST,.GBL,.ROUTINE) 132 E D RUNNOW(LIST,.GBL) 133 Q 134 ; 135 ;======================================================== 136 MESSAGE(FILENUM,COUNT,TOTAL,START,END) ;Build the MailMan message giving the 137 ;count breakdown. 138 N COFF,ML,NAME,NL,PERC,TEXT,YEAR,XMSUB 139 K ^TMP("PXRMXMZ",$J) 140 S ML=$$MAX^XLFMTH($L(TOTAL)+2,8) 141 S COFF=ML-5 142 S NAME=$$GET1^DID(FILENUM,"","","NAME") 143 S XMSUB="Yearly data distribution for global "_NAME 144 S ^TMP("PXRMXMZ",$J,1,0)="File name: "_NAME 145 S ^TMP("PXRMXMZ",$J,2,0)="Count finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z") 146 S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END) 147 S ^TMP("PXRMXMZ",$J,4,0)=" " 148 S ^TMP("PXRMXMZ",$J,5,0)="Year"_$$INSCHR^PXRMEXLC(COFF," ")_"Count"_$J("%",8) 149 S ^TMP("PXRMXMZ",$J,6,0)="----"_$$INSCHR^PXRMEXLC(COFF," ")_"-----"_$J("-----",10) 150 S NL=6,YEAR=0 151 F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D 152 . S PERC=100*COUNT(YEAR)/TOTAL 153 . S TEXT=YEAR_$J(COUNT(YEAR),ML,0)_$J(PERC,10,2) 154 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 155 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" " 156 S TEXT="Total entries: "_TOTAL 157 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 158 I TOTAL=0 D 159 . I '$D(^PXRMINDX(FILENUM)) S TEXT="The index for file "_NAME_" does not exist!" 160 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 161 I TOTAL>0,'$D(^PXRMINDX(FILENUM,"DATE BUILT")) D 162 . S TEXT="Warning, the index for file "_NAME_" may be incomplete or corrupted!" 163 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 164 D SEND^PXRMMSG(XMSUB) 165 K ^TMP("PXRMXMZ",$J) 166 Q 167 ; 168 ;=============================================================== 169 RUNNOW(LIST,GBL) ;Run the routines now. 170 N COUNT,END,FN,IND,LI,NUM,ROUTINE,RTN,START,TOTAL 171 S ROUTINE(45)="CNTPTF^PXRMINDC" 172 S ROUTINE(52)="CNTSS^PXRMINDC" 173 S ROUTINE(55)="CNTSS^PXRMINDC" 174 S ROUTINE(63)="CNT5^PXRMINDC" 175 S ROUTINE(70)="CNT5^PXRMINDC" 176 S ROUTINE(100)="CNTSS^PXRMINDC" 177 S ROUTINE(120.5)="CNT5^PXRMINDC" 178 S ROUTINE(601.2)="CNT5^PXRMINDC" 179 S ROUTINE(601.84)="CNT5^PXRMINDC" 180 S ROUTINE(9000011)="CNTPL^PXRMINDC" 181 S ROUTINE(9000010.07)="CNT6^PXRMINDC" 182 S ROUTINE(9000010.11)="CNT5^PXRMINDC" 183 S ROUTINE(9000010.12)="CNT5^PXRMINDC" 184 S ROUTINE(9000010.13)="CNT5^PXRMINDC" 185 S ROUTINE(9000010.16)="CNT5^PXRMINDC" 186 S ROUTINE(9000010.18)="CNT6^PXRMINDC" 187 S ROUTINE(9000010.23)="CNT5^PXRMINDC" 188 S NUM=$L(LIST,",")-1 189 F IND=1:1:NUM D 190 . S LI=$P(LIST,",",IND) 191 . S FN=GBL(LI) 192 . S RTN=ROUTINE(FN) 193 . S RTN=RTN_"("_FN_",.COUNT)" 194 . S START=$H 195 . K COUNT 196 . I $D(^PXRMINDX(FN)) D @RTN 197 . S END=$H 198 . D TOTAL(.COUNT,.TOTAL) 199 . D MESSAGE(FN,.COUNT,TOTAL,START,END) 200 Q 201 ; 202 ;=============================================================== 203 TASKIT(LIST,GBL,ROUTINE) ;Count the indexes as a tasked job. 204 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y 205 S MINDT=$$NOW^XLFDT 206 S DIR("A",1)="Enter the date and time you want the job to start." 207 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z") 208 S DIR("A")="Start the task at: " 209 S DIR(0)="DAU"_U_MINDT_"::RSX" 210 D ^DIR 211 I $D(DIROUT)!$D(DIRUT) Q 212 I $D(DTOUT)!$D(DUOUT) Q 213 S SDTIME=Y 214 K DIR 215 ;Put the task into the queue. 216 K ZTSAVE 217 S ZTSAVE("LIST")="" 218 S ZTSAVE("GBL(")="" 219 S ZTRTN="TASKJOB^PXRMINDC" 220 S ZTDESC="Clinical Reminders Index count" 221 S ZTDTH=SDTIME 222 S ZTIO="" 223 D ^%ZTLOAD 224 W !,"Task number ",ZTSK," queued." 225 Q 226 ; 227 ;=============================================================== 228 TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE. 229 N IND,LI,NUM 230 S ZTREQ="@" 231 S ZTSTOP=0 232 S NUM=$L(LIST,",")-1 233 F IND=1:1:NUM D 234 .;Check to see if the task has had a stop request 235 . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q 236 . S LI=$P(LIST,",",IND)_"," 237 . D RUNNOW^PXRMINDC(LI,.GBL) 238 Q 239 ; 240 ;======================================================== 241 TOTAL(COUNT,TOTAL) ;Convert the FileMan years in COUNT to regular 242 ;years get the total number of entries in count. 243 N TC,YEAR 244 S (TOTAL,YEAR)=0 245 F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D 246 . S TOTAL=TOTAL+COUNT(YEAR) 247 . S TC(YEAR+1700)=COUNT(YEAR) 248 K COUNT 249 M COUNT=TC 250 Q 251 ; 1 PXRMINDC ; SLC/PKR - Index counting routines. ;04/20/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;======================================================== 5 CNT5(FILENUM,COUNT) ;Get date counts for indexes where the date 6 ;is at subscript 5. Works for file numbers: 7 ;63, 70, 120.5, 601.2, 8 ;9000010.11, 9000010.12, 9000010.13, 9000010.16, 9000010.23 9 N DAS,DATE,DFN,IND,ITEM,YEAR 10 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 11 S IND=0 12 S DFN="" 13 F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D 14 . S IND=IND+1 15 . I '$D(ZTQUEUED),(IND#10000=0) W "." 16 . S ITEM="" 17 . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D 18 .. S DATE="" 19 .. F S DATE=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE)) Q:DATE="" D 20 ... S YEAR=$E(DATE,1,3) 21 ... S DAS="" 22 ... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,DATE,DAS)) Q:DAS="" D 23 .... S COUNT(YEAR)=$G(COUNT(YEAR))+1 24 Q 25 ; 26 ;======================================================== 27 CNT6(FILENUM,COUNT) ;Get date counts for indexes where the date 28 ;is at subscript 6. Works for file numbers: 29 ;9000010.07, 9000010.18 30 N DAS,DATE,DFN,IND,ITEM,TYPE,YEAR 31 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 32 S IND=0 33 S DFN="" 34 F S DFN=$O(^PXRMINDX(FILENUM,"PPI",DFN)) Q:DFN="" D 35 . S IND=IND+1 36 . I '$D(ZTQUEUED),(IND#10000=0) W "." 37 . S TYPE="" 38 . F S TYPE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE)) Q:TYPE="" D 39 .. S ITEM="" 40 .. F S ITEM=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM)) Q:ITEM="" D 41 ... S DATE="" 42 ... F S DATE=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D 43 .... S YEAR=$E(DATE,1,3) 44 .... S DAS="" 45 .... F S DAS=$O(^PXRMINDX(FILENUM,"PPI",DFN,TYPE,ITEM,DATE,DAS)) Q:DAS="" D 46 ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1 47 Q 48 ; 49 ;======================================================== 50 CNTPL(FILENUM,COUNT) ;Get date counts for Problem List indexes where the 51 ;date is at subscript 7. Works for file numbers: 52 ;9000011 53 N DAS,DATE,DFN,IND,ITEM,PRIORITY,STATUS,TYPE,YEAR 54 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 55 S IND=0 56 S DFN="" 57 F S DFN=$O(^PXRMINDX(FILENUM,"PSPI",DFN)) Q:DFN="" D 58 . S IND=IND+1 59 . I '$D(ZTQUEUED),(IND#10000=0) W "." 60 . S STATUS="" 61 . F S STATUS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS)) Q:STATUS="" D 62 .. S PRIORITY="" 63 .. F S PRIORITY=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D 64 ... S ITEM="" 65 ... F S ITEM=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM)) Q:ITEM="" D 66 .... S DATE="" 67 .... F S DATE=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D 68 ..... S YEAR=$E(DATE,1,3) 69 ..... S DAS="" 70 ..... F S DAS=$O(^PXRMINDX(FILENUM,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,DAS)) Q:DAS="" D 71 ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1 72 Q 73 ; 74 ;======================================================== 75 CNTPTF(FILENUM,COUNT) ;Get date counts for PTF indexes where the 76 ;date is at subscript 7. Works for file numbers: 77 ;45 78 N DAS,DATE,DFN,IND,ITEM,NODE,TYPE,YEAR 79 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 80 S IND=0 81 F TYPE="ICD0","ICD9" D 82 . S DFN="" 83 . F S DFN=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN)) Q:DFN="" D 84 .. S IND=IND+1 85 .. I '$D(ZTQUEUED),(IND#10000=0) W "." 86 .. S NODE="" 87 .. F S NODE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE)) Q:NODE="" D 88 ... S ITEM="" 89 ... F S ITEM=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM)) Q:ITEM="" D 90 .... S DATE="" 91 .... F S DATE=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE)) Q:DATE="" D 92 ..... S YEAR=$E(DATE,1,3) 93 ..... S DAS="" 94 ..... F S DAS=$O(^PXRMINDX(FILENUM,TYPE,"PNI",DFN,NODE,ITEM,DATE,DAS)) Q:DAS="" D 95 ...... S COUNT(YEAR)=$G(COUNT(YEAR))+1 96 Q 97 ; 98 ;======================================================== 99 CNTSS(FILENUM,COUNT) ;Get date counts for indexes where the start date 100 ;is at subscript 5 and the stop date is at subscript 6. 101 ;Works for file numbers: 52, 55, 100 102 N DAS,DFN,IND,ITEM,START,STOP,YEAR 103 I '$D(ZTQUEUED) W !,"Counting file number "_FILENUM 104 S IND=0 105 S DFN="" 106 F S DFN=$O(^PXRMINDX(FILENUM,"PI",DFN)) Q:DFN="" D 107 . S IND=IND+1 108 . I '$D(ZTQUEUED),(IND#10000=0) W "." 109 . S ITEM="" 110 . F S ITEM=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM)) Q:ITEM="" D 111 .. S START="" 112 .. F S START=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START)) Q:START="" D 113 ... S YEAR=$E(START,1,3) 114 ... S STOP="" 115 ... F S STOP=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP)) Q:STOP="" D 116 .... S DAS="" 117 .... F S DAS=$O(^PXRMINDX(FILENUM,"PI",DFN,ITEM,START,STOP,DAS)) Q:DAS="" D 118 ..... S COUNT(YEAR)=$G(COUNT(YEAR))+1 119 Q 120 ; 121 ;======================================================== 122 COUNT ;Driver for making index counts. 123 N GBL,LIST,TASKIT 124 W !,"Which indexes do you want to count?" 125 D SEL^PXRMSXRM(.LIST,.GBL) 126 I LIST="" Q 127 ;See if this should be tasked. 128 S TASKIT=$$ASKTASK^PXRMSXRM 129 I TASKIT D 130 . W !,"Queue the Clinical Reminders Index count." 131 . D TASKIT(LIST,.GBL,.ROUTINE) 132 E D RUNNOW(LIST,.GBL) 133 Q 134 ; 135 ;======================================================== 136 MESSAGE(FILENUM,COUNT,TOTAL,START,END) ;Build the MailMan message giving the 137 ;count breakdown. 138 N COFF,ML,NAME,NL,PERC,TEXT,YEAR,XMSUB 139 K ^TMP("PXRMXMZ",$J) 140 S ML=$$MAX^XLFMTH($L(TOTAL)+2,8) 141 S COFF=ML-5 142 S NAME=$$GET1^DID(FILENUM,"","","NAME") 143 S XMSUB="Yearly data distribution for global "_NAME 144 S ^TMP("PXRMXMZ",$J,1,0)="File name: "_NAME 145 S ^TMP("PXRMXMZ",$J,2,0)="Count finished at "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z") 146 S ^TMP("PXRMXMZ",$J,3,0)=$$ETIME^PXRMSXRM(START,END) 147 S ^TMP("PXRMXMZ",$J,4,0)=" " 148 S ^TMP("PXRMXMZ",$J,5,0)="Year"_$$INSCHR^PXRMEXLC(COFF," ")_"Count"_$J("%",8) 149 S ^TMP("PXRMXMZ",$J,6,0)="----"_$$INSCHR^PXRMEXLC(COFF," ")_"-----"_$J("-----",10) 150 S NL=6,YEAR=0 151 F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D 152 . S PERC=100*COUNT(YEAR)/TOTAL 153 . S TEXT=YEAR_$J(COUNT(YEAR),ML,0)_$J(PERC,10,2) 154 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 155 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" " 156 S TEXT="Total entries: "_TOTAL 157 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 158 I TOTAL=0 D 159 . I '$D(^PXRMINDX(FILENUM)) S TEXT="The index for file "_NAME_" does not exist!" 160 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 161 I TOTAL>0,'$D(^PXRMINDX(FILENUM,"DATE BUILT")) D 162 . S TEXT="Warning, the index for file "_NAME_" may be incomplete or corrupted!" 163 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXT 164 D SEND^PXRMMSG(XMSUB) 165 K ^TMP("PXRMXMZ",$J) 166 Q 167 ; 168 ;=============================================================== 169 RUNNOW(LIST,GBL) ;Run the routines now. 170 N COUNT,END,FN,IND,LI,NUM,ROUTINE,RTN,START,TOTAL 171 S ROUTINE(45)="CNTPTF^PXRMINDC" 172 S ROUTINE(52)="CNTSS^PXRMINDC" 173 S ROUTINE(55)="CNTSS^PXRMINDC" 174 S ROUTINE(63)="CNT5^PXRMINDC" 175 S ROUTINE(70)="CNT5^PXRMINDC" 176 S ROUTINE(100)="CNTSS^PXRMINDC" 177 S ROUTINE(120.5)="CNT5^PXRMINDC" 178 S ROUTINE(601.2)="CNT5^PXRMINDC" 179 S ROUTINE(9000011)="CNTPL^PXRMINDC" 180 S ROUTINE(9000010.07)="CNT6^PXRMINDC" 181 S ROUTINE(9000010.11)="CNT5^PXRMINDC" 182 S ROUTINE(9000010.12)="CNT5^PXRMINDC" 183 S ROUTINE(9000010.13)="CNT5^PXRMINDC" 184 S ROUTINE(9000010.16)="CNT5^PXRMINDC" 185 S ROUTINE(9000010.18)="CNT6^PXRMINDC" 186 S ROUTINE(9000010.23)="CNT5^PXRMINDC" 187 S NUM=$L(LIST,",")-1 188 F IND=1:1:NUM D 189 . S LI=$P(LIST,",",IND) 190 . S FN=GBL(LI) 191 . S RTN=ROUTINE(FN) 192 . S RTN=RTN_"("_FN_",.COUNT)" 193 . S START=$H 194 . K COUNT 195 . I $D(^PXRMINDX(FN)) D @RTN 196 . S END=$H 197 . D TOTAL(.COUNT,.TOTAL) 198 . D MESSAGE(FN,.COUNT,TOTAL,START,END) 199 Q 200 ; 201 ;=============================================================== 202 TASKIT(LIST,GBL,ROUTINE) ;Count the indexes as a tasked job. 203 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MINDT,SDTIME,X,Y 204 S MINDT=$$NOW^XLFDT 205 S DIR("A",1)="Enter the date and time you want the job to start." 206 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z") 207 S DIR("A")="Start the task at: " 208 S DIR(0)="DAU"_U_MINDT_"::RSX" 209 D ^DIR 210 I $D(DIROUT)!$D(DIRUT) Q 211 I $D(DTOUT)!$D(DUOUT) Q 212 S SDTIME=Y 213 K DIR 214 ;Put the task into the queue. 215 K ZTSAVE 216 S ZTSAVE("LIST")="" 217 S ZTSAVE("GBL(")="" 218 S ZTRTN="TASKJOB^PXRMINDC" 219 S ZTDESC="Clinical Reminders Index count" 220 S ZTDTH=SDTIME 221 S ZTIO="" 222 D ^%ZTLOAD 223 W !,"Task number ",ZTSK," queued." 224 Q 225 ; 226 ;=============================================================== 227 TASKJOB ;Execute as tasked job. LIST and GBL come through ZTSAVE. 228 N IND,LI,NUM 229 S ZTREQ="@" 230 S ZTSTOP=0 231 S NUM=$L(LIST,",")-1 232 F IND=1:1:NUM D 233 .;Check to see if the task has had a stop request 234 . I $$S^%ZTLOAD S ZTSTOP=1,IND=NUM Q 235 . S LI=$P(LIST,",",IND)_"," 236 . D RUNNOW^PXRMINDC(LI,.GBL) 237 Q 238 ; 239 ;======================================================== 240 TOTAL(COUNT,TOTAL) ;Convert the FileMan years in COUNT to regular 241 ;years get the total number of entries in count. 242 N TC,YEAR 243 S (TOTAL,YEAR)=0 244 F S YEAR=$O(COUNT(YEAR)) Q:YEAR="" D 245 . S TOTAL=TOTAL+COUNT(YEAR) 246 . S TC(YEAR+1700)=COUNT(YEAR) 247 K COUNT 248 M COUNT=TC 249 Q 250 ;
Note:
See TracChangeset
for help on using the changeset viewer.
