PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;10/13/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61,211**;Aug 12, 1996;Build 454
MAIN ;
N PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
S PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRWL")
S ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Encounter Summary"
;
;Establish the selection criteria.
FAC ;Get the facility list.
N NFAC,PXRRFAC,PXRRFACN
D FACILITY^PXRRLCSC
I $D(DTOUT)!$D(DUOUT) G EXIT
;
LORP ;See if the report is to be by location or provider.
N PXRRWLSC
D WHICH("L")
I $D(DTOUT) G EXIT
I $D(DUOUT) G FAC
;
LOC ;Get the location(s) for the report.
N NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
I $P(PXRRWLSC,U,1)="L" D
. S PXRRLCSC=""
. D LOC^PXRRLCSC("Select ENCOUNTER LOCATION CRITERIA","HS")
. I $P(PXRRLCSC,U,1)["C" D BYLOC^PXRRLCSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G LORP
;
PRV ;Get the provider(s) for the report.
N NCL,NPL,PXRRPECL,PXRRPRLL,PXRRPRPL,PXRRPRSC
N PXRRMPR
S PXRRMPR=0
I $P(PXRRWLSC,U,1)="P" D
. D PRV^PXRRPRSC
. I ('$D(DTOUT))&('$D(DUOUT)) D
.. K DIRUT,DTOUT,DUOUT
.. S DIR(0)="YA"
.. S DIR("A",1)="Do you want providers broken out by location?"
.. S DIR("A")="Enter Y (YES) or N (NO) "
.. S DIR("B")="N"
.. W !
.. D ^DIR K DIR
.. I $D(DIROUT) S DTOUT=1
.. S PXRRPRLL=Y
I $D(DTOUT) G EXIT
I $D(DUOUT) G LORP
;
DR ;Get the date range.
N PXRRBDT,PXRREDT
D PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
I $D(DTOUT) G EXIT
I $D(DUOUT) G LORP
;
SCAT ;Get the service categories.
N PXRRSCAT
D SCAT^PXRRECSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G DR
;
ENTY ;Get the encounter types.
N PXRRENTY
D ENTYPE^PXRRECSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G SCAT
;
;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="Encounter Summary Report - sort encounters"
. S IODEV=""
. S ROUTINE="SORT^PXRRWLSE"
. S ^XTMP(PXRRXTMP,"SEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
.;
. S DESC="Encounter Summary Report - sort appointments"
. S IODEV=""
. S ROUTINE="SORT^PXRRWLSA"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"SAZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
.;
. S DESC="Encounter Summary Report - print"
. S IODEV=PXRRIOD
. S ROUTINE="PXRRWLPR"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
;
E D SORT^PXRRWLSE
Q
;
;====================
EXIT ;
D EXIT^PXRRGUT
Q
;
;====================
SAVE ;Save the variables.
S ZTSAVE("PXRRBDT")="",ZTSAVE("PXRREDT")=""
S ZTSAVE("PXRRCS(")="",ZTSAVE("NCS")=""
S ZTSAVE("PXRRENTY")=""
S ZTSAVE("PXRRFAC(")="",ZTSAVE("NFAC")=""
S ZTSAVE("PXRRFACN(")=""
S ZTSAVE("PXRRIOD")=""
S ZTSAVE("PXRRLCHL(")="",ZTSAVE("NHL")=""
S ZTSAVE("PXRRLCSC")=""
S ZTSAVE("PXRRPECL(")="",ZTSAVE("NCL")=""
S ZTSAVE("PXRRPRLL")=""
S ZTSAVE("PXRRPRPL(")="",ZTSAVE("NPL")=""
S ZTSAVE("PXRRPRSC")=""
S ZTSAVE("PXRRQUE")=""
S ZTSAVE("PXRRSCAT")=""
S ZTSAVE("PXRRXTMP")=""
S ZTSAVE("PXRRWLSC")=""
S ZTSAVE("PXRRMPR")=""
Q
;
;====================
WHICH(DEFAULT) ;Find out if the report is to be by location or provider.
N X,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="S"_U_"L:Location;"
S DIR(0)=DIR(0)_"P:Provider"
S DIR("A")="Do the report by"
S DIR("B")=DEFAULT
W !!,"This report may be done by location or provider"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S PXRRWLSC=Y_U_Y(0)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRWLD 3649 printed Nov 22, 2024@17:41:16 Page 2
PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;10/13/2017
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61,211**;Aug 12, 1996;Build 454
MAIN ;
+1 NEW PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
+2 SET PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRWL")
+3 SET ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Encounter Summary"
+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 ;
LORP ;See if the report is to be by location or provider.
+1 NEW PXRRWLSC
+2 DO WHICH("L")
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO FAC
+5 ;
LOC ;Get the location(s) for the report.
+1 NEW NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
+2 IF $PIECE(PXRRWLSC,U,1)="L"
Begin DoDot:1
+3 SET PXRRLCSC=""
+4 DO LOC^PXRRLCSC("Select ENCOUNTER LOCATION CRITERIA","HS")
+5 IF $PIECE(PXRRLCSC,U,1)["C"
DO BYLOC^PXRRLCSC
End DoDot:1
+6 IF $DATA(DTOUT)
GOTO EXIT
+7 IF $DATA(DUOUT)
GOTO LORP
+8 ;
PRV ;Get the provider(s) for the report.
+1 NEW NCL,NPL,PXRRPECL,PXRRPRLL,PXRRPRPL,PXRRPRSC
+2 NEW PXRRMPR
+3 SET PXRRMPR=0
+4 IF $PIECE(PXRRWLSC,U,1)="P"
Begin DoDot:1
+5 DO PRV^PXRRPRSC
+6 IF ('$DATA(DTOUT))&('$DATA(DUOUT))
Begin DoDot:2
+7 KILL DIRUT,DTOUT,DUOUT
+8 SET DIR(0)="YA"
+9 SET DIR("A",1)="Do you want providers broken out by location?"
+10 SET DIR("A")="Enter Y (YES) or N (NO) "
+11 SET DIR("B")="N"
+12 WRITE !
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DIROUT)
SET DTOUT=1
+15 SET PXRRPRLL=Y
End DoDot:2
End DoDot:1
+16 IF $DATA(DTOUT)
GOTO EXIT
+17 IF $DATA(DUOUT)
GOTO LORP
+18 ;
DR ;Get the date range.
+1 NEW PXRRBDT,PXRREDT
+2 DO PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO LORP
+5 ;
SCAT ;Get the service categories.
+1 NEW PXRRSCAT
+2 DO SCAT^PXRRECSC
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO DR
+5 ;
ENTY ;Get the encounter types.
+1 NEW PXRRENTY
+2 DO ENTYPE^PXRRECSC
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO SCAT
+5 ;
+6 ;Determine whether the report should be queued.
+7 SET %ZIS="QM"
+8 WRITE !
+9 DO ^%ZIS
+10 IF POP
GOTO EXIT
+11 SET PXRRIOD=ION_";"_IOST_";"_IOM_";"_IOSL
+12 SET PXRRQUE=$GET(IO("Q"))
+13 ;
+14 IF PXRRQUE
Begin DoDot:1
+15 ;Queue the report.
+16 NEW DESC,IODEV,ROUTINE
+17 SET DESC="Encounter Summary Report - sort encounters"
+18 SET IODEV=""
+19 SET ROUTINE="SORT^PXRRWLSE"
+20 SET ^XTMP(PXRRXTMP,"SEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
+21 ;
+22 SET DESC="Encounter Summary Report - sort appointments"
+23 SET IODEV=""
+24 SET ROUTINE="SORT^PXRRWLSA"
+25 SET ZTDTH="@"
+26 SET ^XTMP(PXRRXTMP,"SAZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
+27 ;
+28 SET DESC="Encounter Summary Report - print"
+29 SET IODEV=PXRRIOD
+30 SET ROUTINE="PXRRWLPR"
+31 SET ZTDTH="@"
+32 SET ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRWLD")
End DoDot:1
+33 ;
+34 IF '$TEST
DO SORT^PXRRWLSE
+35 QUIT
+36 ;
+37 ;====================
EXIT ;
+1 DO EXIT^PXRRGUT
+2 QUIT
+3 ;
+4 ;====================
SAVE ;Save the variables.
+1 SET ZTSAVE("PXRRBDT")=""
SET ZTSAVE("PXRREDT")=""
+2 SET ZTSAVE("PXRRCS(")=""
SET ZTSAVE("NCS")=""
+3 SET ZTSAVE("PXRRENTY")=""
+4 SET ZTSAVE("PXRRFAC(")=""
SET ZTSAVE("NFAC")=""
+5 SET ZTSAVE("PXRRFACN(")=""
+6 SET ZTSAVE("PXRRIOD")=""
+7 SET ZTSAVE("PXRRLCHL(")=""
SET ZTSAVE("NHL")=""
+8 SET ZTSAVE("PXRRLCSC")=""
+9 SET ZTSAVE("PXRRPECL(")=""
SET ZTSAVE("NCL")=""
+10 SET ZTSAVE("PXRRPRLL")=""
+11 SET ZTSAVE("PXRRPRPL(")=""
SET ZTSAVE("NPL")=""
+12 SET ZTSAVE("PXRRPRSC")=""
+13 SET ZTSAVE("PXRRQUE")=""
+14 SET ZTSAVE("PXRRSCAT")=""
+15 SET ZTSAVE("PXRRXTMP")=""
+16 SET ZTSAVE("PXRRWLSC")=""
+17 SET ZTSAVE("PXRRMPR")=""
+18 QUIT
+19 ;
+20 ;====================
WHICH(DEFAULT) ;Find out if the report is to be by location or provider.
+1 NEW X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="S"_U_"L:Location;"
+4 SET DIR(0)=DIR(0)_"P:Provider"
+5 SET DIR("A")="Do the report by"
+6 SET DIR("B")=DEFAULT
+7 WRITE !!,"This report may be done by location or provider"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET PXRRWLSC=Y_U_Y(0)
+12 QUIT
+13 ;