PXRRPAD ;ISL/PKR,ALB/Zoltan - Driver for PCE Patient Activity Reports.;10/13/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**18,61,211**;Aug 12, 1996;Build 454
MAIN ;
N PXRRPAJB,PXRRPAST,PXRRIOD,PXRROPT,PXRRQUE,PXRRXTMP
S PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRPA")
S ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Patient Activity"
;
;Establish the selection criteria.
FAC ;Get the facility list.
N NFAC,PXRRFAC,PXRRFACN
D FACILITY^PXRRLCSC
I $D(DTOUT)!$D(DUOUT) G EXIT
;
LOC ;Get the location list.
N NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
D LOC^PXRRLCSC("Determine patient activity for","HS")
I $D(DTOUT) G EXIT
I $D(DUOUT) G FAC
;
NEWPAGE ;See if the user wants each location to start a new page.
N PXRRLCNP
S PXRRLCNP=0
I (+$G(NCS)>1)!(+$G(NHL)>1)!($P(PXRRLCSC,U,1)="CA")!($P(PXRRLCSC,U,1)="HA") D
. D NEWPAGE^PXRRLCSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G LOC
;
APDR ;Get the appointment date range.
N BHT,EHT,PXRRBADT,PXRREADT
S BHT(1)="Enter the beginning date to use for identifying patients"
S BHT(2)="with appointments for a location. This date can be a past"
S BHT(3)="or future date. For example, if you want to include patients"
S BHT(4)="you'll be seeing next week, the date"
S BHT(5)="range might be next Monday's date for the APPOINTMENT"
S BHT(6)="BEGINNING DATE and next Friday's date for the APPOINTMENT"
S BHT(7)="ENDING DATE."
S EHT(1)="Enter the ending date to use for identifying patients"
S EHT(2)=BHT(2)
S EHT(3)=BHT(3)
S EHT(4)=BHT(4)
S EHT(5)=BHT(5)
S EHT(6)=BHT(6)
S EHT(7)=BHT(7)
D GDR^PXRRADUT(.PXRRBADT,.PXRREADT,"PATIENT APPOINTMENT",.BHT,.EHT)
I $D(DTOUT) G EXIT
I $D(DUOUT) G NEWPAGE
;
ACDR ;Get the activity date range.
N PXRRBCDT,PXRRECDT
K BHT,EHT
S BHT(1)="Enter the beginning date for reporting patient activities."
S BHT(2)="This date cannot be a future date. Patient activities include"
S BHT(3)="inpatient activities, emergency room visits, and critical"
S BHT(4)="lab values. For example, if you want to see the last 90"
S BHT(5)="days of patient activity for patients with appointments"
S BHT(6)="within the appointment date range then this date would be"
S BHT(7)="T-90 and the PATIENT ACTIVITY ENDING DATE would be T (today)."
S EHT(1)="Enter the ending date for reporting patient activities."
S EHT(2)="This date cannot be future date or previous to the beginning"
S EHT(3)="date. For example, if you want to see the last 90"
S EHT(4)="days of patient activity for patients with appointments"
S EHT(5)="within the appointment date range then then the PATIENT"
S EHT(6)="PATIENT ACTIVITY BEGINNING DATE would be T-90"
S EHT(7)="and this date T (today), the default."
D PDR^PXRRADUT(.PXRRBCDT,.PXRRECDT,"PATIENT ACTIVITY",.BHT,.EHT)
I $D(DTOUT) G EXIT
I $D(DUOUT) G APDR
;
FUTDR ;Get the future appointment date range.
N PXRRBFDT,PXRREFDT
K BHT,EHT
S BHT(1)="Enter the beginning date for searching for future"
S BHT(2)="patient appointments. This cannot be a past date, the"
S BHT(3)="default is T (today)."
S EHT(1)="Enter the ending date for searching for future"
S EHT(2)="patient appointments."
D FDR^PXRRADUT(.PXRRBFDT,.PXRREFDT,"FUTURE APPOINTMENT",.BHT,.EHT)
I $D(DTOUT) G EXIT
I $D(DUOUT) G ACDR
;
;Determine whether the report should be queued.
S %ZIS="QM"
W !
D ^%ZIS
I POP G EXIT
S PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
S PXRRQUE=$G(IO("Q"))
;
I PXRRQUE D
. ;Queue the report.
. N DESC,IODEV,ROUTINE
. S DESC="Patient Activity Report - sort appointments"
. S IODEV=""
. S ROUTINE="SORT^PXRRPASA"
. S ^XTMP(PXRRXTMP,"SORTZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
.;
. S DESC="Patient Activity Report - patient activities"
. S IODEV=""
. S ROUTINE="PAT^PXRRPAPI"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"PATZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
.;
. S DESC="Patient Activity Report - print"
. S IODEV=PXRRIOD
. S ROUTINE="PXRRPAPR"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
E D SORT^PXRRPASA
Q
;
;====================
EXIT ;
D EXIT^PXRRGUT
Q
;
;====================
SAVE ;Save the variables for queing.
S ZTSAVE("PXRRBADT")="",ZTSAVE("PXRREADT")=""
S ZTSAVE("PXRRBCDT")="",ZTSAVE("PXRRECDT")=""
S ZTSAVE("PXRRBFDT")="",ZTSAVE("PXRREFDT")=""
S ZTSAVE("PXRRCS(")="",ZTSAVE("NCS")=""
S ZTSAVE("PXRRFAC(")="",ZTSAVE("NFAC")=""
S ZTSAVE("PXRRFACN(")=""
S ZTSAVE("PXRRIOD")=""
S ZTSAVE("PXRRLCHL(")="",ZTSAVE("NHL")=""
S ZTSAVE("PXRRLCNP")=""
S ZTSAVE("PXRRLCSC")=""
S ZTSAVE("PXRRQUE")=""
S ZTSAVE("PXRRXTMP")=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRPAD 4674 printed Dec 13, 2024@02:30:52 Page 2
PXRRPAD ;ISL/PKR,ALB/Zoltan - Driver for PCE Patient Activity Reports.;10/13/2017
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**18,61,211**;Aug 12, 1996;Build 454
MAIN ;
+1 NEW PXRRPAJB,PXRRPAST,PXRRIOD,PXRROPT,PXRRQUE,PXRRXTMP
+2 SET PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRPA")
+3 SET ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Patient Activity"
+4 ;
+5 ;Establish the selection criteria.
FAC ;Get the facility list.
+1 NEW NFAC,PXRRFAC,PXRRFACN
+2 DO FACILITY^PXRRLCSC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+4 ;
LOC ;Get the location list.
+1 NEW NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
+2 DO LOC^PXRRLCSC("Determine patient activity for","HS")
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO FAC
+5 ;
NEWPAGE ;See if the user wants each location to start a new page.
+1 NEW PXRRLCNP
+2 SET PXRRLCNP=0
+3 IF (+$GET(NCS)>1)!(+$GET(NHL)>1)!($PIECE(PXRRLCSC,U,1)="CA")!($PIECE(PXRRLCSC,U,1)="HA")
Begin DoDot:1
+4 DO NEWPAGE^PXRRLCSC
End DoDot:1
+5 IF $DATA(DTOUT)
GOTO EXIT
+6 IF $DATA(DUOUT)
GOTO LOC
+7 ;
APDR ;Get the appointment date range.
+1 NEW BHT,EHT,PXRRBADT,PXRREADT
+2 SET BHT(1)="Enter the beginning date to use for identifying patients"
+3 SET BHT(2)="with appointments for a location. This date can be a past"
+4 SET BHT(3)="or future date. For example, if you want to include patients"
+5 SET BHT(4)="you'll be seeing next week, the date"
+6 SET BHT(5)="range might be next Monday's date for the APPOINTMENT"
+7 SET BHT(6)="BEGINNING DATE and next Friday's date for the APPOINTMENT"
+8 SET BHT(7)="ENDING DATE."
+9 SET EHT(1)="Enter the ending date to use for identifying patients"
+10 SET EHT(2)=BHT(2)
+11 SET EHT(3)=BHT(3)
+12 SET EHT(4)=BHT(4)
+13 SET EHT(5)=BHT(5)
+14 SET EHT(6)=BHT(6)
+15 SET EHT(7)=BHT(7)
+16 DO GDR^PXRRADUT(.PXRRBADT,.PXRREADT,"PATIENT APPOINTMENT",.BHT,.EHT)
+17 IF $DATA(DTOUT)
GOTO EXIT
+18 IF $DATA(DUOUT)
GOTO NEWPAGE
+19 ;
ACDR ;Get the activity date range.
+1 NEW PXRRBCDT,PXRRECDT
+2 KILL BHT,EHT
+3 SET BHT(1)="Enter the beginning date for reporting patient activities."
+4 SET BHT(2)="This date cannot be a future date. Patient activities include"
+5 SET BHT(3)="inpatient activities, emergency room visits, and critical"
+6 SET BHT(4)="lab values. For example, if you want to see the last 90"
+7 SET BHT(5)="days of patient activity for patients with appointments"
+8 SET BHT(6)="within the appointment date range then this date would be"
+9 SET BHT(7)="T-90 and the PATIENT ACTIVITY ENDING DATE would be T (today)."
+10 SET EHT(1)="Enter the ending date for reporting patient activities."
+11 SET EHT(2)="This date cannot be future date or previous to the beginning"
+12 SET EHT(3)="date. For example, if you want to see the last 90"
+13 SET EHT(4)="days of patient activity for patients with appointments"
+14 SET EHT(5)="within the appointment date range then then the PATIENT"
+15 SET EHT(6)="PATIENT ACTIVITY BEGINNING DATE would be T-90"
+16 SET EHT(7)="and this date T (today), the default."
+17 DO PDR^PXRRADUT(.PXRRBCDT,.PXRRECDT,"PATIENT ACTIVITY",.BHT,.EHT)
+18 IF $DATA(DTOUT)
GOTO EXIT
+19 IF $DATA(DUOUT)
GOTO APDR
+20 ;
FUTDR ;Get the future appointment date range.
+1 NEW PXRRBFDT,PXRREFDT
+2 KILL BHT,EHT
+3 SET BHT(1)="Enter the beginning date for searching for future"
+4 SET BHT(2)="patient appointments. This cannot be a past date, the"
+5 SET BHT(3)="default is T (today)."
+6 SET EHT(1)="Enter the ending date for searching for future"
+7 SET EHT(2)="patient appointments."
+8 DO FDR^PXRRADUT(.PXRRBFDT,.PXRREFDT,"FUTURE APPOINTMENT",.BHT,.EHT)
+9 IF $DATA(DTOUT)
GOTO EXIT
+10 IF $DATA(DUOUT)
GOTO ACDR
+11 ;
+12 ;Determine whether the report should be queued.
+13 SET %ZIS="QM"
+14 WRITE !
+15 DO ^%ZIS
+16 IF POP
GOTO EXIT
+17 SET PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
+18 SET PXRRQUE=$GET(IO("Q"))
+19 ;
+20 IF PXRRQUE
Begin DoDot:1
+21 ;Queue the report.
+22 NEW DESC,IODEV,ROUTINE
+23 SET DESC="Patient Activity Report - sort appointments"
+24 SET IODEV=""
+25 SET ROUTINE="SORT^PXRRPASA"
+26 SET ^XTMP(PXRRXTMP,"SORTZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
+27 ;
+28 SET DESC="Patient Activity Report - patient activities"
+29 SET IODEV=""
+30 SET ROUTINE="PAT^PXRRPAPI"
+31 SET ZTDTH="@"
+32 SET ^XTMP(PXRRXTMP,"PATZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
+33 ;
+34 SET DESC="Patient Activity Report - print"
+35 SET IODEV=PXRRIOD
+36 SET ROUTINE="PXRRPAPR"
+37 SET ZTDTH="@"
+38 SET ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRPAD")
End DoDot:1
+39 IF '$TEST
DO SORT^PXRRPASA
+40 QUIT
+41 ;
+42 ;====================
EXIT ;
+1 DO EXIT^PXRRGUT
+2 QUIT
+3 ;
+4 ;====================
SAVE ;Save the variables for queing.
+1 SET ZTSAVE("PXRRBADT")=""
SET ZTSAVE("PXRREADT")=""
+2 SET ZTSAVE("PXRRBCDT")=""
SET ZTSAVE("PXRRECDT")=""
+3 SET ZTSAVE("PXRRBFDT")=""
SET ZTSAVE("PXRREFDT")=""
+4 SET ZTSAVE("PXRRCS(")=""
SET ZTSAVE("NCS")=""
+5 SET ZTSAVE("PXRRFAC(")=""
SET ZTSAVE("NFAC")=""
+6 SET ZTSAVE("PXRRFACN(")=""
+7 SET ZTSAVE("PXRRIOD")=""
+8 SET ZTSAVE("PXRRLCHL(")=""
SET ZTSAVE("NHL")=""
+9 SET ZTSAVE("PXRRLCNP")=""
+10 SET ZTSAVE("PXRRLCSC")=""
+11 SET ZTSAVE("PXRRQUE")=""
+12 SET ZTSAVE("PXRRXTMP")=""
+13 QUIT
+14 ;
