source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSL1.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: 8.8 KB
Line 
1PXRMXSL1 ; SLC/PJH - Process Visits/Appts Reminder Due report;02/07/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4 ; Called from PXRMXSE
5 ;
6TMP(DFN,NAM,FACILITY,INP) ;Update ^TMP("PXRMX"
7 I PXRMFCMB="Y" S FACILITY="COMBINED FACILITIES"
8 I PXRMLCMB="Y" S NAM="COMBINED LOCATIONS"
9 S ^TMP("PXRMX",$J,FACILITY,NAM,DFN)=INP
10 Q
11 ;
12 ;Mark location as found
13MARK(IC) ;
14 S ^XTMP(PXRMXTMP,"MARKED AS FOUND",IC)=""
15 Q
16 ;
17 ;Check if facility is on list, PXMRFACN.
18HFAC(HLOCIEN) ;
19 N DIV,HFAC
20 ;DBIA #2804
21 S HFAC=$P(^SC(HLOCIEN,0),U,4)
22 I HFAC="" S DIV=$P($G(^SC(HLOCIEN,0)),U,15) S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)
23 I HFAC="" S HFAC=+$P($$SITE^VASITE,U,3)
24 I HFAC="" Q ""
25 I '$D(PXRMFACN(HFAC)) Q ""
26 Q HFAC
27 ;
28INACTCL(HLIEN,PXRMBDT) ;
29 ;Check to see if clinic is inactivated before the start of
30 ;the reporting period
31 N INACT,REACT
32 S INACT=+$P($G(^SC(HLIEN,"I")),U) I INACT=0 Q 0
33 S REACT=+$P($G(^SC(HLIEN,"I")),U,2)
34 I REACT'<INACT Q 0
35 I INACT<PXRMBDT Q 1
36 Q 0
37 ;
38INPADM ;
39 ;Build list of inpatients admissions and current patients on a ward
40 N BD,DFN,ED,FACILITY,HIEN,NAM
41 S NAM="All Locations"
42 S HIEN=0
43 F S HIEN=$O(^XTMP(PXRMXTMP,"HLOC",HIEN)) Q:HIEN'>0 D
44 .S FACILITY=$P(^XTMP(PXRMXTMP,"HLOC",HIEN),U,1)
45 .;Get WARDIEN,WARDNAM and return DFN's in PATS
46 .N PATS
47 .I PXRMFD="C" D WARD^PXRMXAP(HIEN,.PATS)
48 .I PXRMFD="A" D
49 ..; Get admissions from patient movements and return DFN's in PATS
50 ..S BD=PXRMBDT-.0001
51 ..S ED=PXRMEDT+.2359
52 ..D ADM^PXRMXAP(HIEN,.PATS,BD,ED)
53 .;Split report by location
54 .I PXRMLCMB="N" S NAM=$P(^XTMP(PXRMXTMP,"HLOC",HIEN),U,2)
55 .;Build ^TMP for selected patients
56 .S DFN="",FOUND=0
57 .F S DFN=$O(PATS(DFN)) Q:DFN="" D
58 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
59 ..D TMP(DFN,NAM,FACILITY,HIEN) D MARK(HIEN)
60 Q
61 ;
62BHLOC ;
63 N CLINIEN,END,FACILITY,NAM,HLIEN,I,START,TEXT
64 N INACT,REACT
65 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
66 ;All inpatient, outpatient all location credit stop and encounter
67 S START=$H
68 I $P(PXRMLCSC,U)["HA"!($P(PXRMLCSC,U)="CA") D
69 .S HLIEN=0 F S HLIEN=$O(^SC(HLIEN)) Q:HLIEN'>0 D
70 ..S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
71 ..I $$INACTCL(HLIEN,PXRMBDT)=1 Q
72 ..S NAM=$P(^SC(HLIEN,0),U)
73 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Hospital Locations List",.BUSY)
74 ..;All inpatient location
75 ..I $P(PXRMLCSC,U)="HAI",$D(^SC(HLIEN,42)) S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
76 ..;All outpatient locations
77 ..I $P(PXRMLCSC,U)="HA",'$D(^SC(HLIEN,42)) S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
78 ..;All encounters with a credit stop
79 ..I $P(PXRMLCSC,U)="CA",$P($G(^SC(HLIEN,0)),U,7)>0 S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM Q
80 ;Select hosiptal locations
81 I $P(PXRMLCSC,U,1)="HS" D
82 .S HLIEN=0 F S HLIEN=$O(PXRMLOCN(HLIEN)) Q:HLIEN'>0 D
83 ..S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
84 ..I $$INACTCL(HLIEN,PXRMBDT)=1 Q
85 ..S NAM=$P(^SC(HLIEN,0),U)
86 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Hospital Locations List",.BUSY)
87 ..S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM
88 ;Select Credit Stops
89 I PXRMSEL="L",$P(PXRMLCSC,U)="CS" D
90 .S CLINIEN=0 F S CLINIEN=$O(PXRMCSN(CLINIEN)) Q:CLINIEN'>0 D
91 ..S HLIEN=0 F S HLIEN=$O(^SC("AST",CLINIEN,HLIEN)) Q:HLIEN'>0 D
92 ...S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
93 ...I $$INACTCL(HLIEN,PXRMBDT)=1 Q
94 ...S NAM=$P(^DIC(40.7,CLINIEN,0),U)_" "_$P(PXRMCS($G(PXRMCSN(CLINIEN))),U,3)
95 ...I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Hospital Locations List",.BUSY)
96 ...S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_NAM_U_$P(PXRMCS($G(PXRMCSN(CLINIEN))),U,3)
97 ;Selected Clinic Groups
98 I PXRMSEL="L",$E(PXRMLCSC)="G" D
99 .S CGRPIEN=0 F S CGRPIEN=$O(PXRMCGRN(CGRPIEN)) Q:CGRPIEN'>0 D
100 ..S HLIEN=0 F S HLIEN=$O(^SC("ASCRPW",CGRPIEN,HLIEN)) Q:HLIEN'>0 D
101 ...S FACILITY=$$HFAC(HLIEN) I FACILITY'>0 Q
102 ...I $$INACTCL(HLIEN,PXRMBDT)=1 Q
103 ...I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Hospital Locations List",.BUSY)
104 ...S ^XTMP(PXRMXTMP,"HLOC",HLIEN)=FACILITY_U_$P(^SC(HLIEN,0),U)_U_CGRPIEN
105 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
106 S END=$H
107 S TEXT="Elapsed time for building hospital locations: "_$$DETIME^PXRMXSL1(START,END)
108 S ^XTMP(PXRMXTMP,"TIMING","BUILDING HOSPITAL LOCATIONS")=TEXT
109 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
110 Q
111 ;
112DETIME(START,END) ;
113 N ETIME,TEXT
114 S ETIME=$$HDIFF^XLFDT(END,START,2)
115 I ETIME>90 D
116 . S ETIME=$$HDIFF^XLFDT(END,START,3)
117 . S TEXT=ETIME
118 E S TEXT=ETIME_" secs"
119 Q TEXT
120 ;
121OERR ;
122 N CNT,II,NAM,OTM
123 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
124 S II=""
125 ;Get patient list for each team
126 F S II=$O(PXRMOTM(II)) Q:II="" D
127 .S OTM=$P(PXRMOTM(II),U),NAM=$P(PXRMOTM(II),U,2)
128 .;Build list of patients for OE/RR team ; DBIA #2692
129 .K ^TMP($J,"OTM")
130 .D TEAMPTS^ORQPTQ1("^TMP($J,""OTM"",",OTM,1)
131 .I $G(^TMP($J,"OTM",1))["No patients found" Q
132 .I PXRMTCMB="Y" N OTM,NAM S OTM="COMBINED",NAM="COMBINED TEAMS"
133 .S CNT=0 F S CNT=$O(^TMP($J,"OTM",CNT)) Q:CNT'>0 D
134 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Collecting patients from OE/RR List",.BUSY)
135 ..S DFN=$P(^TMP($J,"OTM",CNT),U)
136 ..D UPD1(DFN,NAM,"FACILITY",II)
137 .D MARK(OTM)
138 K ^TMP($J,"OTM")
139 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
140 I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
141 Q
142 ;
143 ;PCMM provider selected
144PCMMP ;
145 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
146 N CNT,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,PXRM,OK
147 N FACILITY,NAM
148 S SCDT("BEGIN")=PXRMSDT,SCDT("END")=PXRMSDT
149 ;Include patient if in team on any day in range
150 S SCDT("INCL")=0
151 S II=""
152 ;Get patient list for each PROVIDER
153 F S II=$O(PXRMPRV(II)) Q:II="" D
154 .S PCM=$P(PXRMPRV(II),U),NAM=$P(PXRMPRV(II),U,2)
155 .;Get patients for practs. roles - excluding assoc clinics
156 .K ^TMP($J,"PCM")
157 .N SCTEAM D PTPR^PXRMXAP(PCM,PXRMREP)
158 .I $O(^TMP($J,"PCM",0))="" Q
159 .;Save in ^TMP in alpha order within team number (internal)
160 .S CNT=0 F S CNT=$O(^TMP($J,"PCM",CNT)) Q:CNT'>0 D
161 ..S DFN=$P(^TMP($J,"PCM",CNT),U)
162 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Collecting patients from Primary Provider List",.BUSY)
163 ..I PXRMPRIM="P",($$PCASSIGN^PXRMXAP(DFN)'=1) Q
164 ..;For detailed provider report get assoc clinic
165 ..I PXRMREP="D" S DCLN=$P(^TMP($J,"PCM",CNT),U,7) I +$G(DCLN)>0 D
166 ...S FACILITY=$$HFAC(DCLN)
167 ...S NAM=$P(^SC(DCLN,0),U)
168 ...S ^XTMP(PXRMXTMP,"HLOC",DCLN)=FACILITY_U_NAM
169 ..I $G(DCLN)'="" S PXRMDCLN(DCLN)=""
170 ..D UPD1(DFN,NAM,"FACILITY",+$G(DCLN))
171 .D MARK(PCM)
172 K ^TMP($J,"PCM")
173 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
174 I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
175 Q
176 ;
177 ;PCMM team selected
178PCMMT ;
179 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
180 N CNT,SCDT,LIST,SCERR,SCLIST,II,PCM,NAM,PNAM,OK
181 S SCDT("BEGIN")=PXRMSDT,SCDT("END")=PXRMSDT
182 ;Include patient if in team on any day in range
183 S SCDT("INCL")=0
184 S II=""
185 ;Get patient list for each team
186 F S II=$O(PXRMPCM(II)) Q:II="" D
187 .S PCM=$P(PXRMPCM(II),U),NAM=$P(PXRMPCM(II),U,2)
188 .K ^TMP($J,"PCM")
189 .S OK=$$PTTM^PXRMXAP(PCM,.SCERR) Q:'OK
190 .I $O(^TMP($J,"PCM",0))="" Q
191 .S FACILITY=$$FAC^PXRMXAP(PCM)
192 .S CNT=0 F S CNT=$O(^TMP($J,"PCM",CNT)) Q:CNT'>0 D
193 ..S DFN=$P(^TMP($J,"PCM",CNT),U)
194 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Collecting patients from PCMM Team List",.BUSY)
195 ..D UPD1(DFN,NAM,FACILITY,II)
196 .D MARK(PCM)
197 K ^TMP($J,"PCM")
198 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
199 I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
200 Q
201 ;
202 ;Individual Patients selected
203IND ;
204 N CNT,DFN,DUMMY,LIST,NAM
205 S (DUMMY,NAM)="PATIENT"
206 S CNT=0 F S CNT=$O(PXRMPAT(CNT)) Q:CNT'>0 D
207 .S DFN=$P(PXRMPAT(CNT),U)
208 .D UPD1(DFN,"INDIVIDUAL PATIENTS","FACILITY",DFN)
209 I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
210 Q
211 ;
212 ;Patient lists selected
213LIST ;
214 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
215 N DFN,DSUB,DUMMY,LCNT,LIEN,LIST,NAM
216 S (DUMMY,NAM)="PATIENT",LCNT=0
217 F S LCNT=$O(PXRMLIST(LCNT)) Q:'LCNT D
218 .S LIEN=$P(PXRMLIST(LCNT),U) Q:'LIEN
219 .S NAM=$P(^PXRMXP(810.5,LIEN,0),U)
220 .S DSUB=0
221 .F S DSUB=$O(^PXRMXP(810.5,LIEN,30,DSUB)) Q:'DSUB D
222 ..S DFN=$P($G(^PXRMXP(810.5,LIEN,30,DSUB,0)),U) Q:'DFN
223 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Collecting patients from Reminder Patient List",.BUSY)
224 ..D UPD1(DFN,NAM,"FACILITY",LIEN)
225 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
226 I PXRMREP="D",$D(^TMP($J,"PXRM PATIENT EVAL"))>0 D SDAM301^PXRMXSL2(DT,"",PXRMSEL,PXRMFD,PXRMREP)
227 Q
228 ;
229UPD1(DFN,NAM,FACILITY,INP) ;
230 ;Remove test patients.
231 I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
232 ;Remove patients that are deceased.
233 I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
234 S ^TMP($J,"PXRM PATIENT LIST",DFN)=""
235 S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
236 D TMP(DFN,NAM,FACILITY,INP)
237 Q
238 ;
Note: See TracBrowser for help on using the repository browser.