source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMISE.m@ 1250

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1PXRMISE ; SLC/PKR - Index size estimating routines. ;03/13/2006
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;========================================================
5EST ;Driver for making index counts.
6 N BLOCKS,FUNCTION,GBL,GLIST,IND,NE,NL,NUMGBL,RTN
7 N SF,TASKIT,TBLOCKS,XMSUB
8 D SETDATA(.GBL,.GLIST,.NUMGBL,.RTN,.SF)
9 I +SF=-1 D ERRORMSG^PXRMISF(SF) Q
10 S (NL,TBLOCKS)=0
11 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Start time "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
12 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
13 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Size Estimate for ^PXRMINDX"
14 F IND=1:1:NUMGBL D
15 . S FUNCTION="S NE=$$"_RTN(GBL(IND))
16 . X FUNCTION
17 . S BLOCKS=NE*SF(GBL(IND))
18 . S BLOCKS=$FN(BLOCKS,"","")+1
19 . S TBLOCKS=TBLOCKS+BLOCKS
20 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
21 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Estimates for "_GLIST(IND)
22 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Number of entries: "_NE
23 . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Number of blocks: "_BLOCKS
24 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
25 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Total estimated blocks: "_TBLOCKS
26 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
27 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="End time "_$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
28 S XMSUB="Size estimate for index global"
29 D SEND^PXRMMSG(XMSUB)
30 S ZTREQ="@"
31 Q
32 ;
33 ;===============================================================
34ESTTASK ;Task the index size estimation.
35 N DIR,DTOUT,DUOUT,MINDT,SDTIME,X,Y
36 S MINDT=$$NOW^XLFDT
37 W !,"Queue the Clinical Reminders index size estimation."
38 S DIR("A",1)="Enter the date and time you want the job to start."
39 S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
40 S DIR("A")="Start the task at: "
41 S DIR(0)="DAU"_U_MINDT_"::RSX"
42 D ^DIR
43 I $D(DTOUT)!$D(DUOUT) Q
44 S SDTIME=Y
45 K DIR
46 ;Put the task into the queue.
47 S ZTRTN="EST^PXRMISE"
48 S ZTDESC="Clinical Reminders index size estimation"
49 S ZTDTH=SDTIME
50 S ZTIO=""
51 D ^%ZTLOAD
52 W !,"Task number ",ZTSK," queued."
53 Q
54 ;
55 ;===============================================================
56NEOR() ;Return number of entries in OR.
57 ;DBIA #4180
58 Q $P(^OR(100,0),U,4)
59 ;
60 ;===============================================================
61NEPROB() ;Return number of entries in PROBLEM LIST.
62 ;DBIA #3837
63 Q $P(^AUPNPROB(0),U,4)
64 ;
65 ;===============================================================
66NEPS() ;Return number of entries in PS(55).
67 N ADD,DA,DA1,DFN,DRUG,IND,NE,SDATE,SOL,STARTD,TEMP
68 ;DBIA #4181
69 S (DFN,IND,NE)=0
70 F S DFN=+$O(^PS(55,DFN)) Q:DFN=0 D
71 .;Process Unit Dose.
72 . S DA=0
73 . F S DA=+$O(^PS(55,DFN,5,DA)) Q:DA=0 D
74 .. S TEMP=$G(^PS(55,DFN,5,DA,2))
75 .. S STARTD=$P(TEMP,U,2)
76 .. I STARTD="" Q
77 ..;If the order is purged then SDATE is 1.
78 .. S SDATE=$P(TEMP,U,4)
79 .. I SDATE=1 Q
80 .. S DA1=0
81 .. F S DA1=+$O(^PS(55,DFN,5,DA,1,DA1)) Q:DA1=0 D
82 ... S DRUG=$P(^PS(55,DFN,5,DA,1,DA1,0),U,1)
83 ... I DRUG="" Q
84 ... S NE=NE+1
85 .;Process the IV mutiple.
86 . S DA=0
87 . F S DA=+$O(^PS(55,DFN,"IV",DA)) Q:DA=0 D
88 .. S TEMP=$G(^PS(55,DFN,"IV",DA,0))
89 .. S STARTD=$P(TEMP,U,2)
90 .. I STARTD="" Q
91 .. S SDATE=$P(TEMP,U,3)
92 .. I SDATE=1 Q
93 ..;Process Additives
94 .. S DA1=0
95 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"AD",DA1)) Q:DA1=0 D
96 ... S ADD=$P(^PS(55,DFN,"IV",DA,"AD",DA1,0),U,1)
97 ... I ADD="" Q
98 ... S DRUG=$P($G(^PS(52.6,ADD,0)),U,2)
99 ... I DRUG="" Q
100 ... S NE=NE+1
101 ..;Process Solutions
102 .. S DA1=0
103 .. F S DA1=+$O(^PS(55,DFN,"IV",DA,"SOL",DA1)) Q:DA1=0 D
104 ... S SOL=$P(^PS(55,DFN,"IV",DA,"SOL",DA1,0),U,1)
105 ... I SOL="" Q
106 ... S DRUG=$P($G(^PS(52.7,SOL,0)),U,2)
107 ... I DRUG="" Q
108 ... S NE=NE+1
109 Q NE
110 ;
111 ;===============================================================
112NEPSRX() ;Return number of entries in PSRX
113 N DA,DA1,DATE,DSUP,DFN,DRUG,NE,RDATE,TEMP
114 ;DBIA #4182
115 S (DA,NE)=0
116 F S DA=+$O(^PSRX(DA)) Q:DA=0 D
117 . S TEMP=$G(^PSRX(DA,0))
118 . S DFN=$P(TEMP,U,2)
119 . I DFN="" Q
120 . S DRUG=$P(TEMP,U,6)
121 . I DRUG="" Q
122 . S DSUP=$P(TEMP,U,8)
123 . I DSUP="" Q
124 . S RDATE=+$P($G(^PSRX(DA,2)),U,13)
125 . I RDATE>0 S NE=NE+1
126 .;Process the refill mutiple.
127 . S DA1=0
128 . F S DA1=+$O(^PSRX(DA,1,DA1)) Q:DA1=0 D
129 .. S TEMP=$G(^PSRX(DA,1,DA1,0))
130 .. S DSUP=+$P(TEMP,U,10)
131 .. S RDATE=+$P(TEMP,U,18)
132 .. I RDATE>0 S NE=NE+1
133 .;Process the partial fill multiple.
134 . S DA1=0
135 . F S DA1=+$O(^PSRX(DA,"P",DA1)) Q:DA1=0 D
136 .. S TEMP=$G(^PSRX(DA,"P",DA1,0))
137 .. S DSUP=+$P(TEMP,U,10)
138 .. S RDATE=+$P(TEMP,U,19)
139 .. I RDATE>0 S NE=NE+1
140 Q NE
141 ;
142 ;===============================================================
143NEPTF() ;Return number of entries in PTF.
144 N D1,DA,DATE,DFN,ICD0,ICD9,JND,NE0,NE9,TEMP70,TEMP0,TEMPP,TEMPS
145 ;DBIA #4177
146 S (DA,NE0,NE9)=0
147 F S DA=+$O(^DGPT(DA)) Q:DA=0 D
148 . S TEMP0=$G(^DGPT(DA,0))
149 . S DFN=$P(TEMP0,U,1)
150 . I DFN="" Q
151 . S D1=0
152 . F S D1=+$O(^DGPT(DA,"S",D1)) Q:D1=0 D
153 .. S TEMPS=$G(^DGPT(DA,"S",D1,0))
154 .. S DATE=$P(TEMPS,U,1)
155 .. I DATE="" Q
156 .. F JND=8,9,10,11,12 D
157 ... S ICD0=$P(TEMPS,U,JND)
158 ... I (ICD0'=""),$D(^ICD0(ICD0)) S NE0=NE0+1
159 .;
160 . S D1=0
161 . F S D1=+$O(^DGPT(DA,"P",D1)) Q:D1=0 D
162 .. S TEMPP=$G(^DGPT(DA,"P",D1,0))
163 .. S DATE=$P(TEMPP,U,1)
164 .. I DATE="" Q
165 .. F JND=5,6,7,8,9 D
166 ... S ICD0=$P(TEMPP,U,JND)
167 ... I (ICD0'=""),$D(^ICD0(ICD0)) S NE0=NE0+1
168 .;
169 .;Discharge ICD9 codes
170 . I $D(^DGPT(DA,70)) D
171 .. S TEMP70=$G(^DGPT(DA,70))
172 .. F JND=10,11,16,17,18,19,20,21,22,23,24 D
173 ... S ICD9=$P(TEMP70,U,JND)
174 ... I (ICD9'=""),$D(^ICD9(ICD9)) S NE9=NE9+1
175 .;
176 .;Movement ICD9 codes
177 . I '$D(^DGPT(DA,"M")) Q
178 . S D1=0
179 . F S D1=$O(^DGPT(DA,"M",D1)) Q:+D1=0 D
180 .. S TEMPS=$G(^DGPT(DA,"M",D1,0))
181 .. S DATE=$P(TEMPS,U,10)
182 .. I DATE="" Q
183 .. F JND=5,6,7,8,9,11,12,13,14,15 D
184 ... S ICD9=$P(TEMPS,U,JND)
185 ... I (ICD9'=""),$D(^ICD9(ICD9)) S NE9=NE9+1
186 Q NE0+NE9
187 ;
188 ;===============================================================
189NERAD() ;Return number of entries in RAD/NUC MED PATIENT.
190 N IEN,NE
191 ;DBIA #4183
192 S (IEN,NE)=0
193 F S IEN=$O(^RADPT(IEN)) Q:+IEN=0 S NE=NE+$P($G(^RADPT(IEN,"DT",0)),U,4)
194 Q NE
195 ;
196 ;===============================================================
197NEVCPT() ;Return number of entries in V CPT.
198 ;DBIA #4176
199 Q $P(^AUPNVCPT(0),U,4)
200 ;
201 ;===============================================================
202NEVHF() ;Return number of entries in V HEALTH FACTORS.
203 ;DBIA #4176
204 Q $P(^AUPNVHF(0),U,4)
205 ;
206 ;===============================================================
207NEVIMM() ;Return number of entries in V IMMUNIZATION
208 ;DBIA #4176
209 Q $P(^AUPNVIMM(0),U,4)
210 ;
211 ;===============================================================
212NEVIT() ;Return number of entries in GMRV VITAL MEASUREMENT
213 ;DBIA #4178
214 Q $P(^GMR(120.5,0),U,4)
215 ;
216 ;===============================================================
217NEVPED() ;Return number of entries in V PATIENT ED.
218 ;DBIA #4176
219 Q $P(^AUPNVPED(0),U,4)
220 ;
221 ;===============================================================
222NEVPOV() ;Return number of entries in V POV.
223 ;DBIA #4176
224 Q $P(^AUPNVPOV(0),U,4)
225 ;
226 ;===============================================================
227NEVSK() ;Return number of entries in V SKIN TEST.
228 ;DBIA #4176
229 Q $P(^AUPNVSK(0),U,4)
230 ;
231 ;===============================================================
232NEVXAM() ;Return number of entries in V EXAM.
233 ;DBIA #4176
234 Q $P(^AUPNVXAM(0),U,4)
235 ;
236 ;===============================================================
237NEYTD() ;Return number of entries in PSYCH INSTRUMENT PATIENT
238 N DATE,DFN,NE,TEST
239 ;DBIA #4184
240 S (DFN,NE)=0
241 F S DFN=$O(^YTD(601.2,DFN)) Q:+DFN=0 D
242 . S TEST=0
243 . F S TEST=$O(^YTD(601.2,DFN,1,TEST)) Q:+TEST=0 D
244 .. S DATE=0
245 .. F S DATE=$O(^YTD(601.2,DFN,1,TEST,1,DATE)) Q:+DATE=0 S NE=NE+1
246 Q NE
247 ;
248 ;===============================================================
249SETDATA(GBL,GLIST,NUMGBL,RTN,SF) ;
250 S NUMGBL=16
251 S GLIST(1)="LABORATORY TEST (CH, Anatomic Path, Micro)",GBL(1)=63
252 S GLIST(2)="MENTAL HEALTH",GBL(2)=601.2
253 S GLIST(3)="ORDER",GBL(3)=100
254 S GLIST(4)="PTF",GBL(4)=45
255 S GLIST(5)="PHARMACY PATIENT",GBL(5)=55
256 S GLIST(6)="PRESCRIPTION",GBL(6)=52
257 S GLIST(7)="PROBLEM LIST",GBL(7)=9000011
258 S GLIST(8)="RADIOLOGY",GBL(8)=70
259 S GLIST(9)="V CPT",GBL(9)=9000010.18
260 S GLIST(10)="V EXAM",GBL(10)=9000010.13
261 S GLIST(11)="V HEALTH FACTORS",GBL(11)=9000010.23
262 S GLIST(12)="V IMMUNIZATION",GBL(12)=9000010.11
263 S GLIST(13)="V PATIENT ED",GBL(13)=9000010.16
264 S GLIST(14)="V POV",GBL(14)=9000010.07
265 S GLIST(15)="V SKIN TEST",GBL(15)=9000010.12
266 S GLIST(16)="VITAL MEASUREMENT",GBL(16)=120.5
267 S RTN(45)="NEPTF^PXRMISE"
268 S RTN(52)="NEPSRX^PXRMISE"
269 S RTN(55)="NEPS^PXRMISE"
270 S RTN(63)="NELR^PXRMLABS"
271 S RTN(70)="NERAD^PXRMISE"
272 S RTN(100)="NEOR^PXRMISE"
273 S RTN(120.5)="NEVIT^PXRMISE"
274 S RTN(601.2)="NEYTD^PXRMISE"
275 S RTN(9000011)="NEPROB^PXRMISE"
276 S RTN(9000010.07)="NEVPOV^PXRMISE"
277 S RTN(9000010.11)="NEVIMM^PXRMISE"
278 S RTN(9000010.12)="NEVSK^PXRMISE"
279 S RTN(9000010.13)="NEVXAM^PXRMISE"
280 S RTN(9000010.16)="NEVPED^PXRMISE"
281 S RTN(9000010.18)="NEVCPT^PXRMISE"
282 S RTN(9000010.23)="NEVHF^PXRMISE"
283 D LSF^PXRMISF(.SF)
284 Q
285 ;
Note: See TracBrowser for help on using the repository browser.