source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMISE.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

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