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