source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSL2.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 8.8 KB
Line 
1PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 08/16/2007
2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
3 ;
4APPTS ;
5 ;Call to SDAMA301 for future appointments
6 N APPTDT,BDT,EDT,NODE,DFN,FACILITY,HLIEN,NAM
7 S NAM="All Locations"
8 S BDT=PXRMBDT
9 ;I PXRMBDT["." S BDT=PXRMBDT
10 ;E S BDT=PXRMBDT-.0001
11 I PXRMEDT["." S EDT=PXRMEDT
12 E S EDT=PXRMEDT+.2359
13 D SDAM301(BDT,EDT,PXRMSEL,PXRMFD,PXRMREP)
14 I DBDOWN=1 Q
15 S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0!(ZTSTOP=1) D
16 .;Remove test patients.
17 .I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
18 .;Remove patients that are deceased.
19 .I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
20 .S APPTDT=0 F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,APPTDT)) Q:APPTDT'>0!(ZTSTOP=1) D
21 ..S NODE=$G(^TMP($J,"SDAMA301",DFN,APPTDT))
22 ..S HLIEN=$P($P(NODE,U,2),";")
23 ..S FACILITY=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,1)
24 ..S NAM=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,2)
25 ..I PXRMREP="D" D
26 ...S ^TMP($J,"PXRM FUTURE APPT",DFN,HLIEN,APPTDT)=NODE
27 ...S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,APPTDT)=NODE
28 ..I $$S^%ZTLOAD S ZTSTOP=1 Q
29 ..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN),MARK^PXRMXSL1(HLIEN)
30 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
31 K ^TMP($J,"SDAMA301")
32 Q
33 ;
34GETHFAC(HLOCIEN) ;
35 N DIV,HFAC
36 ;DBIA #2804
37 S HFAC=$P(^SC(HLOCIEN,0),U,4)
38 I HFAC="" S DIV=$P($G(^SC(HLOCIEN,0)),U,15) S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)
39 I HFAC="" S HFAC=+$P($$SITE^VASITE,U,3)
40 Q +HFAC
41 ;
42SDAM301(BD,ED,PXRMSEL,PXRMFD,PXRMREP) ;
43 N ARRAY,BUSY,FACILITY,NAM,OPIEN,STATUS,TEXT
44 K ^TMP($J,"PXRM FUTURE APPT")
45 K ^TMP($J,"PXRM FACILITY FUTURE APPT")
46 ;
47 I ED'>0 S ARRAY(1)=BD
48 I ED>0 S ARRAY(1)=BD_";"_ED
49 I PXRMREP="D",PXRMSEL="L",PXRMFD="P" S ARRAY(1)=BD
50 ;
51 I $D(^XTMP(PXRMXTMP,"HLOC"))>0 S ARRAY(2)="^XTMP(PXRMXTMP,""HLOC"","
52 ;S ARRAY(3)=$S(PXRMFD="P":"R;I;NS;NSR;CP;CPR;CC;CCR;NT",1:"R;I")
53 S ARRAY(3)=$S(PXRMFD="P":"R;I",1:"R;I;NT")
54 I $D(^TMP($J,"PXRM PATIENT LIST"))>0 S ARRAY(4)="^TMP($J,""PXRM PATIENT LIST"""
55 S ARRAY("FLDS")="1;2;3;10;12;13;14;22"
56 I $D(^TMP($J,"PXRM PATIENT LIST"))=0 S ARRAY("SORT")="P"
57 ;
58 N END,START,BUSY
59 S START=$H
60 S BUSY=0
61 ;DBIA #4433
62 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
63 I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y"))) D SPIN^PXRMXBSY("Calling the scheduling package to gather appointment data",.BUSY)
64 S COUNT=$$SDAPI^SDAMA301(.ARRAY)
65 S END=$H
66 S TEXT="Elapsed time for call to the Scheduling Package: "_$$DETIME^PXRMXSL1(START,END)
67 S ^XTMP(PXRMXTMP,"TIMING","SCHEDULING")=TEXT
68 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
69 I COUNT<0 D Q
70 .N CNT
71 .S DBDOWN=1,CNT=0
72 .F S CNT=$O(^TMP($J,"SDAMA301",CNT)) Q:CNT'>0 D
73 ..S DBERR(CNT)=$G(^TMP($J,"SDAMA301",CNT))
74 .D ERRMSG^PXRMXDT1("E")
75 ;
76LOOP ;
77 I PXRMFD'="P"!(PXRMSEL'="L") Q
78 N APPTDT,CIEN,DFN,FUTDT,NODE,TEXT,VIEN
79 ;LOOP THROUGH PATIENT
80 S START=$H
81 S BUSY=0
82 S FUTDT=$S(DT>$P(ED,"."):DT,1:$P(ED,"."))
83 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D SPIN^PXRMXBSY("Sorting SDAMA301 Output",.BUSY)
84 S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0 D
85 .;
86 .;LOOP THROUGH CLINICS
87 .S CIEN=0
88 .F S CIEN=$O(^TMP($J,"SDAMA301",DFN,CIEN)) Q:CIEN'>0 D
89 ..S APPTDT=0
90 ..F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT)) Q:APPTDT'>0 D
91 ...I PXRMREP="S",$P(APPTDT,".")>$P(ED,".") Q
92 ...S NODE=$G(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT))
93 ...;S STATUS=$P($P(NODE,U,3),";")
94 ...;I ($P(ED,".")+1)>($P(APPTDT,".")),STATUS'="I",STATUS'="R",STATUS'="NT" D
95 ...;.K ^TMP($J,"PXRM PATIENT LIST",DFN,CIEN,APPTDT)
96 ...;
97 ...;if report is detailed report store future appointment
98 ...I $P(APPTDT,".")>FUTDT D
99 ....S ^TMP($J,"PXRM FUTURE APPT",DFN,CIEN,APPTDT)=NODE
100 ....S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,$$GETHFAC(CIEN),APPTDT)=NODE
101 K ^TMP($J,"SDAMA301")
102 S END=$H
103 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
104 S TEXT="Elapsed time for sorting SDAMA301 output: "_$$DETIME^PXRMXSL1(START,END)
105 S ^XTMP(PXRMXTMP,"TIMING","SCHEDULE SORT")=TEXT
106 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
107 Q
108 ;
109 ;Scan visit file to build list of patients
110VISITS ;
111 N BUSY,DAS,DATE,DFN,DS,END,ETIME,HLOC,NF
112 N SC,START,TEMP,TEXT,TGLIST,TIME
113 S START=$H
114 K ^TMP($J,"PXRM PATIENT LIST")
115 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
116 W !,"Building patient list "
117 K ^TMP($J,"HLOCL"),^TMP($J,"PLIST")
118 M ^TMP($J,"HLOCL")=^XTMP(PXRMXTMP,"HLOC")
119 D FPLIST^PXRMLOCL(9000010,"HLOCL",-1,PXRMBDT,PXRMEDT,"PLIST")
120 K ^TMP($J,"HLOCL")
121 S DFN=""
122 F S DFN=$O(^TMP($J,"PLIST",DFN)) Q:DFN="" D
123 . S NF=0
124 . F S NF=$O(^TMP($J,"PLIST",DFN,NF)) Q:NF="" D
125 .. S TEMP=^TMP($J,"PLIST",DFN,NF)
126 .. S SC=$P(TEMP,U,4)
127 .. I '$D(PXRMSCAT(SC)) Q
128 .. ;Remove test Patients
129 .. I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
130 .. ;Remove deceased patients
131 .. I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
132 .. S DAS=$P(TEMP,U,1),DATE=$P(TEMP,U,2),HLOC=$P(TEMP,U,3)
133 .. S ^TMP($J,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
134 K ^TMP($J,"PLIST")
135 S END=$H
136 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
137 S TEXT="Elapsed time for building patient list: "_$$DETIME^PXRMXSL1(START,END)
138 S ^XTMP(PXRMXTMP,"TIMING","PATIENT LIST")=TEXT
139 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
140 I PXRMREP="D" D SDAM301(PXRMBDT,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
141 I DBDOWN=1 Q
142 S START=$H
143 S BUSY=0
144 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
145 N HLIEN,NAM,FACILITY,LSEL,NODE
146 S DFN=0 F S DFN=$O(^TMP($J,"PXRM PATIENT LIST",DFN)) Q:DFN'>0 D
147 .S HLIEN=0
148 .F S HLIEN=$O(^TMP($J,"PXRM PATIENT LIST",DFN,HLIEN)) Q:HLIEN'>0 D
149 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Removing Invalid Encounter(s)",.BUSY)
150 ..S NODE=$G(^XTMP(PXRMXTMP,"HLOC",HLIEN))
151 ..S FACILITY=$P(NODE,U),NAM=$P(NODE,U,2)
152 ..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
153 ..S TEMP=$P(PXRMLCSC,U,1)
154 ..S LSEL=$S(TEMP="CS":$P(NODE,U,3),TEMP="GS":$P(NODE,U,3),1:HLIEN)
155 ..D MARK^PXRMXSL1(LSEL)
156 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
157 S END=$H
158 S TEXT="Elapsed time for removing invalid encounter(s): "_$$DETIME^PXRMXSL1(START,END)
159 S ^XTMP(PXRMXTMP,"TIMING","REMOVING INVALID ENCOUNTER(S)")=TEXT
160 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
161 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
162 Q
163 ;
164VISITSO ; Old entry point
165 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
166 N NFOUND,SC,TEMP,TEXT,TGLIST,TIME
167 N DOD,START,END
168 S START=$H
169 K ^TMP($J,"PXRM PATIENT LIST")
170 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
171 S DEND=$S(PXRMEDT[".":PXRMEDT,1:PXRMEDT+.240001)
172 ;"AHL" in Visit file is inverse date_.time instead of a full inverse
173 ;date and time. For example if the date/time is 3030704.104449 then
174 ;"AHL" has 6969295.104449 instead of 6969295.89555
175 S INVBD=9999999-$P(PXRMBDT,".",1),BTIME=+("."_$P(PXRMBDT,".",2))
176 S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2))
177 S DS=INVED-.000001
178 S HLOC=""
179 F S HLOC=$O(^XTMP(PXRMXTMP,"HLOC",HLOC)) Q:HLOC="" D
180 . S INVDT=DS,DONE=0
181 . F S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="") D
182 ..I $$S^%ZTLOAD S ZTSTOP=1 Q
183 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Patient List",.BUSY)
184 .. S INVDATE=$P(INVDT,".",1)
185 .. I INVDATE>INVBD S DONE=1 Q
186 .. S TIME=+("."_$P(INVDT,".",2))
187 .. I INVDATE=INVED,TIME>ETIME Q
188 .. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q
189 .. S DAS=0
190 .. F S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS="" D
191 ... S TEMP=^AUPNVSIT(DAS,0)
192 ... I $$VAPSTAT^PXRMVSIT(DAS)=0 Q
193 ... S SC=$P(TEMP,U,7)
194 ... I SC="" Q
195 ... I '$D(PXRMSCAT(SC)) Q
196 ... S DFN=$P(TEMP,U,5)
197 ... ;Remove Test Patients
198 ... I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
199 ... ;Remove Patient that are deceased
200 ... I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
201 ... S DATE=$P(TEMP,U,1)
202 ... S ^TMP($J,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
203 S END=$H
204 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
205 S TEXT="Elapsed time for building patient list: "_$$DETIME^PXRMXSL1(START,END)
206 S ^XTMP(PXRMXTMP,"TIMING","PATIENT LIST")=TEXT
207 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
208 I PXRMREP="D" D SDAM301(PXRMBDT,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
209 ;D SDAM301(PXRMBDT-.0001,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
210 ;
211 I DBDOWN=1 Q
212 S START=$H
213 S BUSY=0
214 N NODE
215 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
216 N DFN,HLIEN,NAM,FACILITY,LSEL,TEMP
217 S DFN=0 F S DFN=$O(^TMP($J,"PXRM PATIENT LIST",DFN)) Q:DFN'>0 D
218 .S HLIEN=0
219 .F S HLIEN=$O(^TMP($J,"PXRM PATIENT LIST",DFN,HLIEN)) Q:HLIEN'>0 D
220 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Removing Invalid Encounter(s)",.BUSY)
221 ..S NODE=$G(^XTMP(PXRMXTMP,"HLOC",HLIEN))
222 ..S FACILITY=$P(NODE,U),NAM=$P(NODE,U,2)
223 ..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
224 ..S TEMP=$P(PXRMLCSC,U,1)
225 ..S LSEL=$S(TEMP="CS":$P(NODE,U,3),TEMP="GS":$P(NODE,U,3),1:HLIEN)
226 ..D MARK^PXRMXSL1(LSEL)
227 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
228 S END=$H
229 S TEXT="Elapsed time for removing invalid encounter(s): "_$$DETIME^PXRMXSL1(START,END)
230 S ^XTMP(PXRMXTMP,"TIMING","REMOVING INVALID ENCOUNTER(S)")=TEXT
231 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
232 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
233 Q
Note: See TracBrowser for help on using the repository browser.