source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSL2.m@ 949

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

revised back to 6/30/08 version

File size: 6.3 KB
Line 
1PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 06/07/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
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 I PXRMBDT["." S BDT=PXRMBDT
9 E S BDT=PXRMBDT-.0001
10 I PXRMEDT["." S EDT=PXRMEDT
11 E S EDT=PXRMEDT+.2359
12 D SDAM301(BDT,EDT,PXRMSEL,PXRMFD,PXRMREP)
13 I DBDOWN=1 Q
14 S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0!(ZTSTOP=1) D
15 .;Remove test patients.
16 .I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
17 .;Remove patients that are deceased.
18 .I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
19 .S APPTDT=0 F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,APPTDT)) Q:APPTDT'>0!(ZTSTOP=1) D
20 ..S NODE=$G(^TMP($J,"SDAMA301",DFN,APPTDT))
21 ..S HLIEN=$P($P(NODE,U,2),";")
22 ..S FACILITY=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,1)
23 ..S NAM=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,2)
24 ..I PXRMREP="D" D
25 ...S ^TMP($J,"PXRM FUTURE APPT",DFN,HLIEN,APPTDT)=NODE
26 ...S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,APPTDT)=NODE
27 ..I $$S^%ZTLOAD S ZTSTOP=1 Q
28 ..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN),MARK^PXRMXSL1(HLIEN)
29 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
30 K ^TMP($J,"SDAMA301")
31 Q
32 ;
33GETHFAC(HLOCIEN) ;
34 N DIV,HFAC
35 ;DBIA #2804
36 S HFAC=$P(^SC(HLOCIEN,0),U,4)
37 I HFAC="" S DIV=$P($G(^SC(HLOCIEN,0)),U,15) S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)
38 I HFAC="" S HFAC=+$P($$SITE^VASITE,U,3)
39 Q +HFAC
40 ;
41SDAM301(BD,ED,PXRMSEL,PXRMFD,PXRMREP) ;
42 N ARRAY,BUSY,FACILITY,NAM,OPIEN,STATUS
43 K ^TMP($J,"PXRM FUTURE APPT")
44 K ^TMP($J,"PXRM FACILITY FUTURE APPT")
45 ;
46 I ED'>0 S ARRAY(1)=BD
47 I ED>0 S ARRAY(1)=BD_";"_ED
48 I PXRMREP="D",PXRMSEL="L",PXRMFD="P" S ARRAY(1)=BD
49 ;
50 I $D(^XTMP(PXRMXTMP,"HLOC"))>0 S ARRAY(2)="^XTMP(PXRMXTMP,""HLOC"","
51 ;S ARRAY(3)=$S(PXRMFD="P":"R;I;NS;NSR;CP;CPR;CC;CCR;NT",1:"R;I")
52 S ARRAY(3)=$S(PXRMFD="P":"R;I",1:"R;I;NT")
53 I $D(^TMP($J,"PXRM PATIENT LIST"))>0 S ARRAY(4)="^TMP($J,""PXRM PATIENT LIST"""
54 S ARRAY("FLDS")="1;2;3;10;12;13;14;22"
55 I $D(^TMP($J,"PXRM PATIENT LIST"))=0 S ARRAY("SORT")="P"
56 ;
57 N END,START,BUSY
58 S START=$H
59 S BUSY=0
60 ;DBIA #4433
61 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
62 I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y"))) D SPIN^PXRMXBSY("Calling the scheduling package to gather appointment data",.BUSY)
63 S COUNT=$$SDAPI^SDAMA301(.ARRAY)
64 S END=$H
65 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DETIME^PXRMXSL1(START,END,"Total amount of time to call the Scheduling Package")
66 I COUNT<0 D Q
67 .N CNT
68 .S DBDOWN=1,CNT=0
69 .F S CNT=$O(^TMP($J,"SDAMA301",CNT)) Q:CNT'>0 D
70 ..S DBERR(CNT)=$G(^TMP($J,"SDAMA301",CNT))
71 .D DBDOWN^PXRMXDT1("E")
72 ;
73LOOP ;
74 I PXRMFD'="P"!(PXRMSEL'="L") Q
75 N APPTDT,CIEN,DFN,FUTDT,NODE,VIEN
76 ;LOOP THROUGH PATIENT
77 S START=$H
78 S BUSY=0
79 S FUTDT=$S(DT>$P(ED,"."):DT,1:$P(ED,"."))
80 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D SPIN^PXRMXBSY("Sorting SDAMA301 Output",.BUSY)
81 S DFN=0 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0 D
82 .;
83 .;LOOP THROUGH CLINICS
84 .S CIEN=0
85 .F S CIEN=$O(^TMP($J,"SDAMA301",DFN,CIEN)) Q:CIEN'>0 D
86 ..S APPTDT=0
87 ..F S APPTDT=$O(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT)) Q:APPTDT'>0 D
88 ...I PXRMREP="S",$P(APPTDT,".")>$P(ED,".") Q
89 ...S NODE=$G(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT))
90 ...;S STATUS=$P($P(NODE,U,3),";")
91 ...;I ($P(ED,".")+1)>($P(APPTDT,".")),STATUS'="I",STATUS'="R",STATUS'="NT" D
92 ...;.K ^TMP($J,"PXRM PATIENT LIST",DFN,CIEN,APPTDT)
93 ...;
94 ...;if report is detailed report store future appointment
95 ...I $P(APPTDT,".")>FUTDT D
96 ....S ^TMP($J,"PXRM FUTURE APPT",DFN,CIEN,APPTDT)=NODE
97 ....S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,$$GETHFAC(CIEN),APPTDT)=NODE
98 K ^TMP($J,"SDAMA301")
99 S END=$H
100 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
101 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DETIME^PXRMXSL1(START,END,"Sorting SDAMA301 Output")
102 Q
103 ;
104 ;Scan visit file to build list of patients
105VISITS ;
106 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
107 N NFOUND,SC,TEMP,TGLIST,TIME
108 N DOD,START,END
109 S START=$H
110 K ^TMP($J,"PXRM PATIENT LIST")
111 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
112 S DEND=$S(PXRMEDT[".":PXRMEDT,1:PXRMEDT+.240001)
113 ;"AHL" in Visit file is inverse date_.time instead of a full inverse
114 ;date and time. For example if the date/time is 3030704.104449 then
115 ;"AHL" has 6969295.104449 instead of 6969295.89555
116 S INVBD=9999999-$P(PXRMBDT,".",1),BTIME=+("."_$P(PXRMBDT,".",2))
117 S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2))
118 S DS=INVED-1
119 S HLOC=""
120 F S HLOC=$O(^XTMP(PXRMXTMP,"HLOC",HLOC)) Q:HLOC="" D
121 . S INVDT=DS,DONE=0
122 . F S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="") D
123 ..I $$S^%ZTLOAD S ZTSTOP=1 Q
124 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Patient List",.BUSY)
125 .. S INVDATE=$P(INVDT,".",1)
126 .. I INVDATE>INVBD S DONE=1 Q
127 .. S TIME=+("."_$P(INVDT,".",2))
128 .. I INVDATE=INVED,TIME>ETIME Q
129 .. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q
130 .. S DAS=0
131 .. F S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS="" D
132 ... S TEMP=^AUPNVSIT(DAS,0)
133 ... I $$VAPSTAT^PXRMVSIT(DAS)=0 Q
134 ... S SC=$P(TEMP,U,7)
135 ... I SC="" Q
136 ... I '$D(PXRMSCAT(SC)) Q
137 ... S DFN=$P(TEMP,U,5)
138 ... ;Remove Test Patients
139 ... I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
140 ... ;Remove Patient that are deceased
141 ... I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
142 ... S DATE=$P(TEMP,U,1)
143 ... S ^TMP($J,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
144 S END=$H
145 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
146 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DETIME^PXRMXSL1(START,END,"Building Patient List")
147 D SDAM301(PXRMBDT-.0001,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
148 ;
149 I DBDOWN=1 Q
150 S START=$H
151 S BUSY=0
152 I DBDOWN=1 Q
153 N NODE
154 I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
155 N DFN,HLIEN,NAM,FACILITY,LSEL,TEMP
156 S DFN=0 F S DFN=$O(^TMP($J,"PXRM PATIENT LIST",DFN)) Q:DFN'>0 D
157 .S HLIEN=0
158 .F S HLIEN=$O(^TMP($J,"PXRM PATIENT LIST",DFN,HLIEN)) Q:HLIEN'>0 D
159 ..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Removing Invalid Encounter(s)",.BUSY)
160 ..S NODE=$G(^XTMP(PXRMXTMP,"HLOC",HLIEN))
161 ..S FACILITY=$P(NODE,U),NAM=$P(NODE,U,2)
162 ..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
163 ..S TEMP=$P(PXRMLCSC,U,1)
164 ..S LSEL=$S(TEMP="CS":$P(NODE,U,3),TEMP="GS":$P(NODE,U,3),1:HLIEN)
165 ..D MARK^PXRMXSL1(LSEL)
166 ..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
167 S END=$H
168 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
169 I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DETIME^PXRMXSL1(START,END,"Removing Invalid Encounter(s)")
170 Q
Note: See TracBrowser for help on using the repository browser.