Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSL2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXSL2.m
r613 r623 1 PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 08/16/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 APPTS ; 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 ; 34 GETHFAC(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 ; 42 SDAM301(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 ; 76 LOOP ; 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 110 VISITS ; 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 ; 164 VISITSO ; 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 1 PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 06/07/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 APPTS ; 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 ; 33 GETHFAC(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 ; 41 SDAM301(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 ; 73 LOOP ; 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 105 VISITS ; 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 TracChangeset
for help on using the changeset viewer.
