PXRMXSL2	; SLC/AGP - Process Visits/Appts Reminder Due report; 08/16/2007
	;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
	;
APPTS	;
	;Call to SDAMA301 for future appointments
	N APPTDT,BDT,EDT,NODE,DFN,FACILITY,HLIEN,NAM
	S NAM="All Locations"
	S BDT=PXRMBDT
	;I PXRMBDT["." S BDT=PXRMBDT
	;E  S BDT=PXRMBDT-.0001
	I PXRMEDT["." S EDT=PXRMEDT
	E  S EDT=PXRMEDT+.2359
	D SDAM301(BDT,EDT,PXRMSEL,PXRMFD,PXRMREP)
	I DBDOWN=1 Q
	S DFN=0 F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0!(ZTSTOP=1)  D
	.;Remove test patients.
	.I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
	.;Remove patients that are deceased.
	.I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
	.S APPTDT=0 F  S APPTDT=$O(^TMP($J,"SDAMA301",DFN,APPTDT)) Q:APPTDT'>0!(ZTSTOP=1)  D
	..S NODE=$G(^TMP($J,"SDAMA301",DFN,APPTDT))
	..S HLIEN=$P($P(NODE,U,2),";")
	..S FACILITY=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,1)
	..S NAM=$P(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,2)
	..I PXRMREP="D" D
	...S ^TMP($J,"PXRM FUTURE APPT",DFN,HLIEN,APPTDT)=NODE
	...S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,APPTDT)=NODE
	..I $$S^%ZTLOAD S ZTSTOP=1 Q
	..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN),MARK^PXRMXSL1(HLIEN)
	..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
	K ^TMP($J,"SDAMA301")
	Q
	;
GETHFAC(HLOCIEN)	;
	N DIV,HFAC
	;DBIA #2804
	S HFAC=$P(^SC(HLOCIEN,0),U,4)
	I HFAC="" S DIV=$P($G(^SC(HLOCIEN,0)),U,15) S:DIV'="" HFAC=$P($G(^DG(40.8,DIV,0)),U,7)
	I HFAC="" S HFAC=+$P($$SITE^VASITE,U,3)
	Q +HFAC
	;
SDAM301(BD,ED,PXRMSEL,PXRMFD,PXRMREP)	;
	N ARRAY,BUSY,FACILITY,NAM,OPIEN,STATUS,TEXT
	K ^TMP($J,"PXRM FUTURE APPT")
	K ^TMP($J,"PXRM FACILITY FUTURE APPT")
	;
	I ED'>0 S ARRAY(1)=BD
	I ED>0 S ARRAY(1)=BD_";"_ED
	I PXRMREP="D",PXRMSEL="L",PXRMFD="P" S ARRAY(1)=BD
	;
	I $D(^XTMP(PXRMXTMP,"HLOC"))>0 S ARRAY(2)="^XTMP(PXRMXTMP,""HLOC"","
	;S ARRAY(3)=$S(PXRMFD="P":"R;I;NS;NSR;CP;CPR;CC;CCR;NT",1:"R;I")
	S ARRAY(3)=$S(PXRMFD="P":"R;I",1:"R;I;NT")
	I $D(^TMP($J,"PXRM PATIENT LIST"))>0 S ARRAY(4)="^TMP($J,""PXRM PATIENT LIST"""
	S ARRAY("FLDS")="1;2;3;10;12;13;14;22"
	I $D(^TMP($J,"PXRM PATIENT LIST"))=0 S ARRAY("SORT")="P"
	;
	N END,START,BUSY
	S START=$H
	S BUSY=0
	;DBIA #4433
	I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
	I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y"))) D SPIN^PXRMXBSY("Calling the scheduling package to gather appointment data",.BUSY)
	S COUNT=$$SDAPI^SDAMA301(.ARRAY)
	S END=$H
	S TEXT="Elapsed time for call to the Scheduling Package: "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","SCHEDULING")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	I COUNT<0 D  Q
	.N CNT
	.S DBDOWN=1,CNT=0
	.F  S CNT=$O(^TMP($J,"SDAMA301",CNT)) Q:CNT'>0  D
	..S DBERR(CNT)=$G(^TMP($J,"SDAMA301",CNT))
	.D ERRMSG^PXRMXDT1("E")
	;
LOOP	;
	I PXRMFD'="P"!(PXRMSEL'="L") Q
	N APPTDT,CIEN,DFN,FUTDT,NODE,TEXT,VIEN
	;LOOP THROUGH PATIENT
	S START=$H
	S BUSY=0
	S FUTDT=$S(DT>$P(ED,"."):DT,1:$P(ED,"."))
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D SPIN^PXRMXBSY("Sorting SDAMA301 Output",.BUSY)
	S DFN=0 F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN'>0  D
	.;
	.;LOOP THROUGH CLINICS
	.S CIEN=0
	.F  S CIEN=$O(^TMP($J,"SDAMA301",DFN,CIEN)) Q:CIEN'>0  D
	..S APPTDT=0
	..F  S APPTDT=$O(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT)) Q:APPTDT'>0  D
	...I PXRMREP="S",$P(APPTDT,".")>$P(ED,".") Q
	...S NODE=$G(^TMP($J,"SDAMA301",DFN,CIEN,APPTDT))
	...;S STATUS=$P($P(NODE,U,3),";")
	...;I ($P(ED,".")+1)>($P(APPTDT,".")),STATUS'="I",STATUS'="R",STATUS'="NT" D
	...;.K ^TMP($J,"PXRM PATIENT LIST",DFN,CIEN,APPTDT)
	...;
	...;if report is detailed report store future appointment
	...I $P(APPTDT,".")>FUTDT D
	....S ^TMP($J,"PXRM FUTURE APPT",DFN,CIEN,APPTDT)=NODE
	....S ^TMP($J,"PXRM FACILITY FUTURE APPT",DFN,$$GETHFAC(CIEN),APPTDT)=NODE
	K ^TMP($J,"SDAMA301")
	S END=$H
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
	S TEXT="Elapsed time for sorting SDAMA301 output: "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","SCHEDULE SORT")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	Q
	;
	;Scan visit file to build list of patients
VISITS	;
	N BUSY,DAS,DATE,DFN,DS,END,ETIME,HLOC,NF
	N SC,START,TEMP,TEXT,TGLIST,TIME
	S START=$H
	K ^TMP($J,"PXRM PATIENT LIST")
	I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
	W !,"Building patient list "
	K ^TMP($J,"HLOCL"),^TMP($J,"PLIST")
	M ^TMP($J,"HLOCL")=^XTMP(PXRMXTMP,"HLOC")
	D FPLIST^PXRMLOCL(9000010,"HLOCL",-1,PXRMBDT,PXRMEDT,"PLIST")
	K ^TMP($J,"HLOCL")
	S DFN=""
	F  S DFN=$O(^TMP($J,"PLIST",DFN)) Q:DFN=""  D
	. S NF=0
	. F  S NF=$O(^TMP($J,"PLIST",DFN,NF)) Q:NF=""  D
	.. S TEMP=^TMP($J,"PLIST",DFN,NF)
	.. S SC=$P(TEMP,U,4)
	.. I '$D(PXRMSCAT(SC)) Q
	.. ;Remove test Patients
	.. I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
	.. ;Remove deceased patients
	.. I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
	.. S DAS=$P(TEMP,U,1),DATE=$P(TEMP,U,2),HLOC=$P(TEMP,U,3)
	.. S ^TMP($J,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
	K ^TMP($J,"PLIST")
	S END=$H
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
	S TEXT="Elapsed time for building patient list: "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","PATIENT LIST")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	I PXRMREP="D" D SDAM301(PXRMBDT,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
	I DBDOWN=1 Q
	S START=$H
	S BUSY=0
	I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
	N HLIEN,NAM,FACILITY,LSEL,NODE
	S DFN=0 F  S DFN=$O(^TMP($J,"PXRM PATIENT LIST",DFN)) Q:DFN'>0  D
	.S HLIEN=0
	.F  S HLIEN=$O(^TMP($J,"PXRM PATIENT LIST",DFN,HLIEN)) Q:HLIEN'>0  D
	..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Removing Invalid Encounter(s)",.BUSY)
	..S NODE=$G(^XTMP(PXRMXTMP,"HLOC",HLIEN))
	..S FACILITY=$P(NODE,U),NAM=$P(NODE,U,2)
	..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
	..S TEMP=$P(PXRMLCSC,U,1)
	..S LSEL=$S(TEMP="CS":$P(NODE,U,3),TEMP="GS":$P(NODE,U,3),1:HLIEN)
	..D MARK^PXRMXSL1(LSEL)
	..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
	S END=$H
	S TEXT="Elapsed time for removing invalid encounter(s): "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","REMOVING INVALID ENCOUNTER(S)")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
	Q
	;
VISITSO	; Old entry point
	N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
	N NFOUND,SC,TEMP,TEXT,TGLIST,TIME
	N DOD,START,END
	S START=$H
	K ^TMP($J,"PXRM PATIENT LIST")
	I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
	S DEND=$S(PXRMEDT[".":PXRMEDT,1:PXRMEDT+.240001)
	;"AHL" in Visit file is inverse date_.time instead of a full inverse
	;date and time. For example if the date/time is 3030704.104449 then
	;"AHL" has 6969295.104449 instead of 6969295.89555
	S INVBD=9999999-$P(PXRMBDT,".",1),BTIME=+("."_$P(PXRMBDT,".",2))
	S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2))
	S DS=INVED-.000001
	S HLOC=""
	F  S HLOC=$O(^XTMP(PXRMXTMP,"HLOC",HLOC)) Q:HLOC=""  D
	. S INVDT=DS,DONE=0
	. F  S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="")  D
	..I $$S^%ZTLOAD S ZTSTOP=1 Q
	..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Building Patient List",.BUSY)
	.. S INVDATE=$P(INVDT,".",1)
	.. I INVDATE>INVBD S DONE=1 Q
	.. S TIME=+("."_$P(INVDT,".",2))
	.. I INVDATE=INVED,TIME>ETIME Q
	.. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q
	.. S DAS=0
	.. F  S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS=""  D
	... S TEMP=^AUPNVSIT(DAS,0)
	... I $$VAPSTAT^PXRMVSIT(DAS)=0 Q
	... S SC=$P(TEMP,U,7)
	... I SC="" Q
	... I '$D(PXRMSCAT(SC)) Q
	... S DFN=$P(TEMP,U,5)
	... ;Remove Test Patients
	... I 'PXRMTPAT,$$TESTPAT^VADPT(DFN)=1 Q
	... ;Remove Patient that are deceased
	... I 'PXRMDPAT,$P($G(^DPT(DFN,.35)),U,1)>0 Q
	... S DATE=$P(TEMP,U,1)
	... S ^TMP($J,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
	S END=$H
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
	S TEXT="Elapsed time for building patient list: "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","PATIENT LIST")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	I PXRMREP="D" D SDAM301(PXRMBDT,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
	;D SDAM301(PXRMBDT-.0001,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
	;
	I DBDOWN=1 Q
	S START=$H
	S BUSY=0
	N NODE
	I '(PXRMQUE!$D(IO("S"))) D INIT^PXRMXBSY(.BUSY)
	N DFN,HLIEN,NAM,FACILITY,LSEL,TEMP
	S DFN=0 F  S DFN=$O(^TMP($J,"PXRM PATIENT LIST",DFN)) Q:DFN'>0  D
	.S HLIEN=0
	.F  S HLIEN=$O(^TMP($J,"PXRM PATIENT LIST",DFN,HLIEN)) Q:HLIEN'>0  D
	..I ('(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")))&(DBDOWN=0) D SPIN^PXRMXBSY("Removing Invalid Encounter(s)",.BUSY)
	..S NODE=$G(^XTMP(PXRMXTMP,"HLOC",HLIEN))
	..S FACILITY=$P(NODE,U),NAM=$P(NODE,U,2)
	..D TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
	..S TEMP=$P(PXRMLCSC,U,1)
	..S LSEL=$S(TEMP="CS":$P(NODE,U,3),TEMP="GS":$P(NODE,U,3),1:HLIEN)
	..D MARK^PXRMXSL1(LSEL)
	..S ^TMP($J,"PXRM PATIENT EVAL",DFN)=""
	S END=$H
	S TEXT="Elapsed time for removing invalid encounter(s): "_$$DETIME^PXRMXSL1(START,END)
	S ^XTMP(PXRMXTMP,"TIMING","REMOVING INVALID ENCOUNTER(S)")=TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
	I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) D DONE^PXRMXBSY("Done")
	Q
