PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 06/03/2009
;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
;
APPTS ;
;Call to SDAMA301 for future appointments
N APPTDT,BDT,EDT,NODE,DFN,FACILITY,HLIEN,NAM
S NAM="All Locations"
S BDT=PXRMBDT
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 COUNT,END,START,BUSY
S START=$H
;Initialize the busy counter.
S BUSY=0
D NOTIFY^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,"."))
D NOTIFY^PXRMXBSY("Sorting scheduling 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
S TEXT="Elapsed time for sorting scheduling 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")
;Initialize the busy counter.
S BUSY=0
D NOTIFY^PXRMXBSY("Building patient list",.BUSY)
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
. D NOTIFY^PXRMXBSY("Building patient list",.BUSY)
. 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
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
;Initialize the busy counter.
S BUSY=0
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
..D NOTIFY^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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXSL2 5919 printed Sep 23, 2025@19:26:22 Page 2
PXRMXSL2 ; SLC/AGP - Process Visits/Appts Reminder Due report; 06/03/2009
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
+2 ;
APPTS ;
+1 ;Call to SDAMA301 for future appointments
+2 NEW APPTDT,BDT,EDT,NODE,DFN,FACILITY,HLIEN,NAM
+3 SET NAM="All Locations"
+4 SET BDT=PXRMBDT
+5 IF PXRMEDT["."
SET EDT=PXRMEDT
+6 IF '$TEST
SET EDT=PXRMEDT+.2359
+7 DO SDAM301(BDT,EDT,PXRMSEL,PXRMFD,PXRMREP)
+8 IF DBDOWN=1
QUIT
+9 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if DFN'>0!(ZTSTOP=1)
QUIT
Begin DoDot:1
+10 ;Remove test patients.
+11 IF 'PXRMTPAT
IF $$TESTPAT^VADPT(DFN)=1
QUIT
+12 ;Remove patients that are deceased.
+13 IF 'PXRMDPAT
IF $PIECE($GET(^DPT(DFN,.35)),U,1)>0
QUIT
+14 SET APPTDT=0
FOR
SET APPTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,APPTDT))
if APPTDT'>0!(ZTSTOP=1)
QUIT
Begin DoDot:2
+15 SET NODE=$GET(^TMP($JOB,"SDAMA301",DFN,APPTDT))
+16 SET HLIEN=$PIECE($PIECE(NODE,U,2),";")
+17 SET FACILITY=$PIECE(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,1)
+18 SET NAM=$PIECE(^XTMP(PXRMXTMP,"HLOC",HLIEN),U,2)
+19 IF PXRMREP="D"
Begin DoDot:3
+20 SET ^TMP($JOB,"PXRM FUTURE APPT",DFN,HLIEN,APPTDT)=NODE
+21 SET ^TMP($JOB,"PXRM FACILITY FUTURE APPT",DFN,FACILITY,APPTDT)=NODE
End DoDot:3
+22 IF $$S^%ZTLOAD
SET ZTSTOP=1
QUIT
+23 DO TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
DO MARK^PXRMXSL1(HLIEN)
+24 SET ^TMP($JOB,"PXRM PATIENT EVAL",DFN)=""
End DoDot:2
End DoDot:1
+25 KILL ^TMP($JOB,"SDAMA301")
+26 QUIT
+27 ;
GETHFAC(HLOCIEN) ;
+1 NEW DIV,HFAC
+2 ;DBIA #2804
+3 SET HFAC=$PIECE(^SC(HLOCIEN,0),U,4)
+4 IF HFAC=""
SET DIV=$PIECE($GET(^SC(HLOCIEN,0)),U,15)
if DIV'=""
SET HFAC=$PIECE($GET(^DG(40.8,DIV,0)),U,7)
+5 IF HFAC=""
SET HFAC=+$PIECE($$SITE^VASITE,U,3)
+6 QUIT +HFAC
+7 ;
SDAM301(BD,ED,PXRMSEL,PXRMFD,PXRMREP) ;
+1 NEW ARRAY,BUSY,FACILITY,NAM,OPIEN,STATUS,TEXT
+2 KILL ^TMP($JOB,"PXRM FUTURE APPT")
+3 KILL ^TMP($JOB,"PXRM FACILITY FUTURE APPT")
+4 ;
+5 IF ED'>0
SET ARRAY(1)=BD
+6 IF ED>0
SET ARRAY(1)=BD_";"_ED
+7 IF PXRMREP="D"
IF PXRMSEL="L"
IF PXRMFD="P"
SET ARRAY(1)=BD
+8 ;
+9 IF $DATA(^XTMP(PXRMXTMP,"HLOC"))>0
SET ARRAY(2)="^XTMP(PXRMXTMP,""HLOC"","
+10 ;S ARRAY(3)=$S(PXRMFD="P":"R;I;NS;NSR;CP;CPR;CC;CCR;NT",1:"R;I")
+11 SET ARRAY(3)=$SELECT(PXRMFD="P":"R;I",1:"R;I;NT")
+12 IF $DATA(^TMP($JOB,"PXRM PATIENT LIST"))>0
SET ARRAY(4)="^TMP($J,""PXRM PATIENT LIST"""
+13 SET ARRAY("FLDS")="1;2;3;10;12;13;14;22"
+14 IF $DATA(^TMP($JOB,"PXRM PATIENT LIST"))=0
SET ARRAY("SORT")="P"
+15 ;
+16 NEW COUNT,END,START,BUSY
+17 SET START=$HOROLOG
+18 ;Initialize the busy counter.
+19 SET BUSY=0
+20 DO NOTIFY^PXRMXBSY("Calling the scheduling package to gather appointment data",.BUSY)
+21 SET COUNT=$$SDAPI^SDAMA301(.ARRAY)
+22 SET END=$HOROLOG
+23 SET TEXT="Elapsed time for call to the Scheduling Package: "_$$DETIME^PXRMXSL1(START,END)
+24 SET ^XTMP(PXRMXTMP,"TIMING","SCHEDULING")=TEXT
+25 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+26 IF COUNT<0
Begin DoDot:1
+27 NEW CNT
+28 SET DBDOWN=1
SET CNT=0
+29 FOR
SET CNT=$ORDER(^TMP($JOB,"SDAMA301",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+30 SET DBERR(CNT)=$GET(^TMP($JOB,"SDAMA301",CNT))
End DoDot:2
+31 DO ERRMSG^PXRMXDT1("E")
End DoDot:1
QUIT
+32 ;
LOOP ;
+1 IF PXRMFD'="P"!(PXRMSEL'="L")
QUIT
+2 NEW APPTDT,CIEN,DFN,FUTDT,NODE,TEXT,VIEN
+3 ;LOOP THROUGH PATIENT
+4 SET START=$HOROLOG
+5 SET BUSY=0
+6 SET FUTDT=$SELECT(DT>$PIECE(ED,"."):DT,1:$PIECE(ED,"."))
+7 DO NOTIFY^PXRMXBSY("Sorting scheduling output",.BUSY)
+8 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+9 ;
+10 ;LOOP THROUGH CLINICS
+11 SET CIEN=0
+12 FOR
SET CIEN=$ORDER(^TMP($JOB,"SDAMA301",DFN,CIEN))
if CIEN'>0
QUIT
Begin DoDot:2
+13 SET APPTDT=0
+14 FOR
SET APPTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,CIEN,APPTDT))
if APPTDT'>0
QUIT
Begin DoDot:3
+15 IF PXRMREP="S"
IF $PIECE(APPTDT,".")>$PIECE(ED,".")
QUIT
+16 SET NODE=$GET(^TMP($JOB,"SDAMA301",DFN,CIEN,APPTDT))
+17 ;S STATUS=$P($P(NODE,U,3),";")
+18 ;I ($P(ED,".")+1)>($P(APPTDT,".")),STATUS'="I",STATUS'="R",STATUS'="NT" D
+19 ;.K ^TMP($J,"PXRM PATIENT LIST",DFN,CIEN,APPTDT)
+20 ;
+21 ;if report is detailed report store future appointment
+22 IF $PIECE(APPTDT,".")>FUTDT
Begin DoDot:4
+23 SET ^TMP($JOB,"PXRM FUTURE APPT",DFN,CIEN,APPTDT)=NODE
+24 SET ^TMP($JOB,"PXRM FACILITY FUTURE APPT",DFN,$$GETHFAC(CIEN),APPTDT)=NODE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 KILL ^TMP($JOB,"SDAMA301")
+26 SET END=$HOROLOG
+27 SET TEXT="Elapsed time for sorting scheduling output: "_$$DETIME^PXRMXSL1(START,END)
+28 SET ^XTMP(PXRMXTMP,"TIMING","SCHEDULE SORT")=TEXT
+29 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+30 QUIT
+31 ;
+32 ;Scan visit file to build list of patients
VISITS ;
+1 NEW BUSY,DAS,DATE,DFN,DS,END,ETIME,HLOC,NF
+2 NEW SC,START,TEMP,TEXT,TGLIST,TIME
+3 SET START=$HOROLOG
+4 KILL ^TMP($JOB,"PXRM PATIENT LIST")
+5 ;Initialize the busy counter.
+6 SET BUSY=0
+7 DO NOTIFY^PXRMXBSY("Building patient list",.BUSY)
+8 KILL ^TMP($JOB,"HLOCL"),^TMP($JOB,"PLIST")
+9 MERGE ^TMP($JOB,"HLOCL")=^XTMP(PXRMXTMP,"HLOC")
+10 DO FPLIST^PXRMLOCL(9000010,"HLOCL",-1,PXRMBDT,PXRMEDT,"PLIST")
+11 KILL ^TMP($JOB,"HLOCL")
+12 SET DFN=""
+13 FOR
SET DFN=$ORDER(^TMP($JOB,"PLIST",DFN))
if DFN=""
QUIT
Begin DoDot:1
+14 DO NOTIFY^PXRMXBSY("Building patient list",.BUSY)
+15 SET NF=0
+16 FOR
SET NF=$ORDER(^TMP($JOB,"PLIST",DFN,NF))
if NF=""
QUIT
Begin DoDot:2
+17 SET TEMP=^TMP($JOB,"PLIST",DFN,NF)
+18 SET SC=$PIECE(TEMP,U,4)
+19 IF '$DATA(PXRMSCAT(SC))
QUIT
+20 ;Remove test Patients
+21 IF 'PXRMTPAT
IF $$TESTPAT^VADPT(DFN)=1
QUIT
+22 ;Remove deceased patients
+23 IF 'PXRMDPAT
IF $PIECE($GET(^DPT(DFN,.35)),U,1)>0
QUIT
+24 SET DAS=$PIECE(TEMP,U,1)
SET DATE=$PIECE(TEMP,U,2)
SET HLOC=$PIECE(TEMP,U,3)
+25 SET ^TMP($JOB,"PXRM PATIENT LIST",DFN,HLOC,DATE,DAS)=""
End DoDot:2
End DoDot:1
+26 KILL ^TMP($JOB,"PLIST")
+27 SET END=$HOROLOG
+28 SET TEXT="Elapsed time for building patient list: "_$$DETIME^PXRMXSL1(START,END)
+29 SET ^XTMP(PXRMXTMP,"TIMING","PATIENT LIST")=TEXT
+30 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+31 IF PXRMREP="D"
DO SDAM301(PXRMBDT,PXRMEDT,PXRMSEL,PXRMFD,PXRMREP)
+32 IF DBDOWN=1
QUIT
+33 SET START=$HOROLOG
+34 ;Initialize the busy counter.
+35 SET BUSY=0
+36 NEW HLIEN,NAM,FACILITY,LSEL,NODE
+37 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"PXRM PATIENT LIST",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+38 SET HLIEN=0
+39 FOR
SET HLIEN=$ORDER(^TMP($JOB,"PXRM PATIENT LIST",DFN,HLIEN))
if HLIEN'>0
QUIT
Begin DoDot:2
+40 DO NOTIFY^PXRMXBSY("Removing invalid encounter(s)",.BUSY)
+41 SET NODE=$GET(^XTMP(PXRMXTMP,"HLOC",HLIEN))
+42 SET FACILITY=$PIECE(NODE,U)
SET NAM=$PIECE(NODE,U,2)
+43 DO TMP^PXRMXSL1(DFN,NAM,FACILITY,HLIEN)
+44 SET TEMP=$PIECE(PXRMLCSC,U,1)
+45 SET LSEL=$SELECT(TEMP="CS":$PIECE(NODE,U,3),TEMP="GS":$PIECE(NODE,U,3),1:HLIEN)
+46 DO MARK^PXRMXSL1(LSEL)
+47 SET ^TMP($JOB,"PXRM PATIENT EVAL",DFN)=""
End DoDot:2
End DoDot:1
+48 SET END=$HOROLOG
+49 SET TEXT="Elapsed time for removing invalid encounter(s): "_$$DETIME^PXRMXSL1(START,END)
+50 SET ^XTMP(PXRMXTMP,"TIMING","REMOVING INVALID ENCOUNTER(S)")=TEXT
+51 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
WRITE !,TEXT
+52 QUIT
+53 ;
