source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXD.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 9.1 KB
Line 
1PXRMXD ; SLC/PJH - Reminder Due reports DRIVER ;11/27/2006
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4START ; Arrays and strings
5 N PXRMIOD,PXRMXST,PXRMOPT,PXRMQUE,PXRMXTMP,PXRMSEL
6 N PXRMFAC,PXRMFACN,PXRMSCAT,PXRMSRT,PXRMTYP
7 N REMINDER,PXRMINP,PXRMFCMB,PXRMLCMB,PXRMTCMB,PXRMTOT
8 ; Addenda
9 N PXRMOTM,PXRMPAT,PXRMPCM,PXRMPRV,PXRMTMP,PXRMRCAT,PXRMREM
10 N PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMLCSC,PXRMCGRP,PXRMCGRN
11 N PXRMLIS
12 ; Counters
13 N NCAT,NFAC,NLOC,NPAT,NPCM,NOTM,NPRV,NREM,NCS,NHL,NCGRP
14 ; Flags and Dates
15 N PXRMFD,PXRMSDT,PXRMBDT,PXRMEDT,PXRMREP,PXRMPRIM,PXRMFUT,PXRMDLOC
16 N PXRMRT,PXRMSSN,PXRMTABC,PXRMTABS,PXRMTMP,TITLE,VALUE
17 N DBDOWN,DBDUZ,DBERR,PXRMLIST,PXRMLIS1,Y
18 N PLISTPUG
19 N PXRMTPAT,PXRMDPAT,PXRMPML
20 ;
21 S PXRMRT="PXRMX",PXRMTYP="X",PXRMFCMB="N",PXRMLCMB="N",PXRMTCMB="N"
22 ;
23 I '$D(PXRMUSER) N PXRMUSER S PXRMUSER=0
24 ;
25 ;Guarantee the timestamp is unique.
26 H 1
27 S PXRMXST=$$NOW^XLFDT
28 S PXRMXTMP=PXRMRT_PXRMXST
29 S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM Reminder Due Report"
30 ;
31 ;Check for existing report templates
32REP ;
33 S PXRMINP=0
34 D:PXRMUSER ^PXRMXTB D:'PXRMUSER ^PXRMXT I $D(DTOUT)!$D(DUOUT) G EXIT
35 ;Run report from template details
36 I PXRMTMP'="" D G:$D(DUOUT)&'$D(DTOUT) REP Q
37 .D START^PXRMXTA("JOB^PXRMXQUE") K DUOUT,DIRUT,DTOUT
38 ;
39 ;Select sample criteria
40SEL ;
41 D SELECT^PXRMXSD(.PXRMSEL) I $D(DTOUT) G EXIT
42 I $D(DUOUT) G:PXRMTMP="" EXIT G REP
43 ;
44FAC ;Get the facility list.
45 I "IRPO"'[PXRMSEL D G:$D(DTOUT) EXIT G:$D(DUOUT) SEL
46 .D FACILITY^PXRMXSU(.PXRMFAC) Q:$D(DTOUT)!$D(DUOUT)
47 ;
48 ;Check if combined facility report is required
49COMB I "IRPO"'[PXRMSEL,NFAC>1 D G:$D(DTOUT) EXIT G:$D(DUOUT) FAC
50 .D COMB^PXRMXSD(.PXRMFCMB,"Facilities","N")
51 ;
52OPT ;Variable prompts
53 ;
54 ;Get Individual Patient list
55 I PXRMSEL="I" K PXRMPAT D PAT^PXRMXSU(.PXRMPAT)
56 ;Get Patient list #810.5
57 I PXRMSEL="R" K PXRMLIST D LIST^PXRMXSU(.PXRMLIST)
58 ;Get OE/RRteam list
59 I PXRMSEL="O" K PXRMOTM D OERR^PXRMXSU(.PXRMOTM)
60 ;Get PCMM team
61 I PXRMSEL="T" K PXRMPCM D PCMM^PXRMXSU(.PXRMPCM)
62 ;Get provider list
63 I PXRMSEL="P" K PXRMPRV D PROV^PXRMXSU(.PXRMPRV)
64 ;Get the location list.
65 I PXRMSEL="L" K PXRMCS,PXRMCSN,PXRMLOCN,PXRMLCHL,PXRMCGRP,PXRMCGRN D
66 .D LOC^PXRMXSU("Determine encounter counts for","HS")
67 I $D(DTOUT) G EXIT
68 I $D(DUOUT) G:"IRPO"[PXRMSEL SEL G:NFAC>1 COMB G FAC
69 ;
70 ;Check if inpatient location report
71 S PXRMINP=$$INP
72 ;
73 ; Primary Provider or All (PCMM Provider only)
74PRIME I PXRMSEL="P" D G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
75 .D PRIME^PXRMXSD(.PXRMPRIM)
76 ;
77DR ; Get the date range.
78 S PXRMFD="P"
79 ; No prompt if individual patients selected
80 ; Single dates only if PCMM teams/providers and OE/RR teams selected
81 ; Choice of previous/future date range if location selected
82 ;
83 ; Prior encounters/future appointments (location only)
84PREV I PXRMSEL="L" D PREV^PXRMXSD(.PXRMFD) G:$D(DTOUT) EXIT G:$D(DUOUT) OPT
85 ; Date range input (location only)
86 I PXRMSEL="L" D G:$D(DTOUT) EXIT G:$D(DUOUT) PREV
87 .I PXRMFD="P" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ENCOUNTER")
88 .I PXRMFD="F" D FDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"APPOINTMENT")
89 .I PXRMFD="A" D PDR^PXRMXDUT(.PXRMBDT,.PXRMEDT,"ADMISSION")
90 .I PXRMFD="C" S PXRMBDT=DT,PXRMEDT=DT
91 ; Due Effective Date
92DUE D SDR^PXRMXDUT(.PXRMSDT) G:$D(DTOUT) EXIT
93 I $D(DUOUT) G:PXRMSEL="L" PREV G OPT
94 ;
95SCAT ;Get the service categories.
96 I PXRMSEL="L",PXRMFD="P" D
97 .D SCAT^PXRMXSC
98 .I $D(DTOUT)!$D(DUOUT) Q
99 I $D(DTOUT) G EXIT
100 I $D(DUOUT) G DUE
101 ;
102TYP ;Determine type of report (detail/summary)
103 S PXRMREP="S"
104 D REP^PXRMXSD(.PXRMREP) I $D(DTOUT) G EXIT
105 I $D(DUOUT) G SCAT
106 ;
107 ;Check if combined location report is required
108LCOMB S NLOC=0
109 I PXRMREP="D",PXRMSEL="L" D G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
110 .N DEFAULT,TEXT
111 .D NLOC
112 .I NLOC>1 D COMB^PXRMXSD(.PXRMLCMB,TEXT,DEFAULT)
113 ;
114 ;Check if combined OE/RR team report is required
115TCOMB I PXRMREP="D",PXRMSEL="O",$G(NOTM)>1 D G:$D(DTOUT) EXIT G:$D(DUOUT) TYP
116 .N DEFAULT,TEXT
117 .S DEFAULT="N",TEXT="OE/RR teams"
118 .D COMB^PXRMXSD(.PXRMTCMB,TEXT,DEFAULT)
119 ;
120FUT ;For detailed report give option to display future appointments
121 S PXRMFUT="N"
122 I PXRMREP="D",'PXRMINP D G:$D(DTOUT) EXIT I $D(DUOUT) G:(PXRMSEL="L")&(NLOC>1) LCOMB G:(PXRMSEL="O")&($G(NOTM)>1) TCOMB G TYP
123 .D FUTURE^PXRMXSD(.PXRMFUT,"Display All Future Appointments: ",5)
124 .I PXRMFUT="Y" D Q:$D(DTOUT)!$D(DUOUT)
125 ..D FUTURE^PXRMXSD(.PXRMDLOC,"Display Appointment Location: ",15)
126 ;
127SRT ;For detailed report give option to sort by appointment date
128 S PXRMSRT="N"
129 I PXRMREP="D",("RI"'[PXRMSEL) D G:$D(DTOUT) EXIT I $D(DUOUT) G:(PXRMSEL="L")&(PXRMINP)&(NLOC>1) LCOMB G:PXRMINP TYP G:(PXRMSEL="O")&($G(NOTM)>1) TCOMB G FUT
130 .;Option to sort by Bed for inpatients
131 .I PXRMSEL="L",PXRMINP D BED^PXRMXSD(.PXRMSRT) Q
132 .;Otherwise option to sort by appt. date
133 .D SRT^PXRMXSD(.PXRMSRT)
134 ;
135 ;Option to print full SSN
136SSN I PXRMREP="D" D G:$D(DTOUT) EXIT I $D(DUOUT) G:"IR"[PXRMSEL FUT G SRT
137 .D SSN^PXRMXSD(.PXRMSSN)
138 ;
139 ;Option to print without totals, with totals or totals only
140TOT I PXRMREP="S" D G:$D(DTOUT) EXIT I $D(DUOUT) G TYP
141 .;Default is normal report
142 .S PXRMTOT="I"
143 .;Ignore patient and patient list reports
144 .I "RI"[PXRMSEL Q
145 .;Only prompt if more than one location, team or provider is selected
146 .I PXRMSEL="P",NPRV<2 Q
147 .I "OT"[PXRMSEL,NOTM<2 Q
148 .;Ignore reports for all locations
149 .I PXRMSEL="L",PXRMLCMB="Y" Q
150 .I PXRMSEL="L" N DEFAULT,TEXT D NLOC Q:NLOC<2
151 .;Prompt for options
152 .N LIT1,LIT2,LIT3
153 .D LIT,TOTALS^PXRMXSD(.PXRMTOT,LIT1,LIT2,LIT3)
154 ;
155MLOC ;Print Locations empty location at the end of the report
156 W !
157 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Print locations with no patients"
158 D ^DIR
159 I Y="^^" G EXIT
160 I Y=U G:PXRMREP="D" SSN G TOT
161 S PXRMPML=Y
162 ;
163 ;Reminder Category/Individual Reminder Selection
164RCAT ;
165 D RCAT^PXRMXSU(.PXRMRCAT,.PXRMREM) I $D(DTOUT) G EXIT
166 ;I $D(DUOUT) G:PXRMREP="D" SSN G TOT
167 I $D(DUOUT) G MLOC
168 ;
169 ;Create combined reminder list
170 D MERGE^PXRMXS1
171 ;
172SAV ;Option to create a new report template
173 I PXRMTMP="" D ^PXRMXTU G:$D(DTOUT) EXIT I $D(DUOUT) G RCAT
174 ;
175 ;Option to print delimiter separated output
176TABS D G:$D(DTOUT) EXIT I $D(DUOUT) G SAV
177 .D TABS^PXRMXSD(.PXRMTABS)
178 ;Select chracter
179TCHAR I PXRMTABS="Y" D G:$D(DTOUT) EXIT G:$D(DUOUT) TABS
180 .S PXRMTABC=$$DELIMSEL^PXRMXSD
181 ;
182DPAT ;Ask whether to include deceased and test patients.
183 S PXRMDPAT=$$ASKYN^PXRMEUT("N","Include deceased patients on the list")
184 N PXRMIDOD I PXRMDPAT>0 S PXRMIDOD=1
185 Q:$D(DTOUT) G:$D(DUOUT) TABS
186TPAT ;
187 S PXRMTPAT=$$ASKYN^PXRMEUT("N","Include test patients on the list")
188 Q:$D(DTOUT) G:$D(DUOUT) DPAT
189PATLIST ;
190 K PATCREAT
191 N PATLST
192 I PXRMSEL'="I"&(PXRMUSER'="Y") D
193 . D ASK(.PATLST,"Save due patients to a patient list: ",3)
194 . I $G(PATLST)="" Q
195 . I $G(PATLST)="N" S PXRMLIS1="" Q
196 . I $G(PATLST)="Y" D
197 ..S PATCREAT="N"
198 ..D ASK(.PATCREAT,"Secure list?: ",3) I $D(DTOUT)!($D(DUOUT)) Q
199 ..K PLISTPUG
200 ..S PLISTPUG="N" D ASK^PXRMXD(.PLISTPUG,"Purge Patient List after 5 years?: ",5)
201 I $G(PATLST)="" G:$D(DTOUT) EXIT I $D(DUOUT) G TPAT
202 G:$D(DTOUT) EXIT I $D(DUOUT) G PATLIST
203 I $G(PATLST)="Y" S TEXT="Select PATIENT LIST name: " D PLIST^PXRMLCR(.PXRMLIS1,TEXT,"") Q:$D(DUOUT)!$D(DTOUT)
204 ;Determine whether the report should be queued.
205JOB ;
206 D JOB^PXRMXQUE
207 Q
208 ;
209 ;Option PXRM REMINDERS DUE (USER)
210USER N PXRMUSER
211 S PXRMUSER=+$G(DUZ)
212 G START
213 ;
214 ;
215EXIT ;Clean things up.
216 D EXIT^PXRMXGUT
217 Q
218 ;
219 ;Check if inpatient report
220INP() ;Applies to location reports only
221 I PXRMSEL'="L" Q 0
222 ;For all inpatient locations default is automatic
223 I $P(PXRMLCSC,U)="HAI" Q 1
224 ;For selected locations check if all locations are wards
225 I $P(PXRMLCSC,U)="HS" Q $$INP^PXRMXAP(PXRMLCSC,.PXRMLOCN)
226 ;Otherwise
227 Q 0
228 ;
229 ;Prompt text
230LIT N LIT
231 S LIT=$S(PXRMSEL="P":"Provider","OT"[PXRMSEL:"Team",1:"Location")
232 I PXRMFCMB="N" D
233 .S LIT1="Individual "_LIT_"s only"
234 .S LIT2="Individual "_LIT_"s plus Totals by Facility"
235 .S LIT3="Totals by Facility only"
236 I PXRMFCMB="Y" D
237 .S LIT1="Individual "_LIT_"s only"
238 .S LIT2="Individual "_LIT_"s plus Overall Total"
239 .S LIT3="Overall Total only"
240 Q
241 ;
242 ;Check if multiple locations
243NLOC S DEFAULT="N",NLOC=1,TEXT="Locations"
244 I $P(PXRMLCSC,U)["HA" S DEFAULT="Y",NLOC=999
245 I $P(PXRMLCSC,U)="CA" S DEFAULT="Y",NCS=999
246 I $E(PXRMLCSC)="C" S TEXT="Clinic Stops",NLOC=NCS
247 I $E(PXRMLCSC)="G" S TEXT="Clinic Groups",NLOC=NCGRP
248 I $P(PXRMLCSC,U)="HS" S NLOC=NHL S:$$INP TEXT="Inpatient Locations"
249 ;Special coding if more than one facility and location
250 I $P(PXRMLCSC,U)="HS",NFAC>1,NLOC>1 D
251 .N FAC,HLOCIEN,HLNAME,IC,MULT
252 .S IC=0 S:PXRMFCMB="Y" FAC="COMBINED"
253 .;Build list of locations by facility
254 .F S IC=$O(PXRMLCHL(IC)) Q:'IC D
255 ..S HLOCIEN=$P(PXRMLCHL(IC),U,2),FAC=$$FACL^PXRMXAP(HLOCIEN) Q:'FAC
256 ..S HLNAME=$P(PXRMLCHL(IC),U) Q:HLNAME=""
257 ..S MULT(FAC,HLNAME)=""
258 .S MULT=0,FAC=0
259 .;Count locations in each facility
260 .F S FAC=$O(MULT(FAC)) Q:'FAC D Q:MULT
261 ..S IC=0,HLNAME=""
262 ..F S HLNAME=$O(MULT(FAC,HLNAME)) Q:HLNAME="" S IC=IC+1
263 ..I IC>1 S MULT=1
264 .;If only one location per facility suppress combined location option
265 .I 'MULT S NLOC=1
266 Q
267 ;
268ASK(YESNO,PROMPT,NUM) ;
269 N X,Y,TEXT
270 K DIROUT,DIRUT,DTOUT,DUOUT
271 S DIR(0)="YA0"
272 S DIR("A")=PROMPT
273 S DIR("B")="N"
274 S DIR("?")="Enter Y or N. For detailed help type ??"
275 S DIR("??")=U_"D HELP^PXRMLCR("_NUM_")"
276 W !
277 D ^DIR K DIR
278 I $D(DIROUT) S DTOUT=1
279 I $D(DTOUT)!($D(DUOUT)) Q
280 S YESNO=$E(Y(0))
281 Q
282 ;
Note: See TracBrowser for help on using the repository browser.