source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMINDC.m@ 1420

Last change on this file since 1420 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1PXRMINDC ; SLC/PKR - Index counting routines. ;03/06/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ;========================================================
5CNT5(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 ;========================================================
27CNT6(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 ;========================================================
50CNTPL(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 ;========================================================
75CNTPTF(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 ;========================================================
99CNTSS(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 ;========================================================
122COUNT ;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 ;========================================================
136MESSAGE(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 ;===============================================================
169RUNNOW(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 ;===============================================================
203TASKIT(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 ;===============================================================
228TASKJOB ;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 ;========================================================
241TOTAL(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 ;
Note: See TracBrowser for help on using the repository browser.