PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;12/1/98
;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
MAIN ;
N PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
S PXRRXTMP=$$PXRRXTMP("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
;
PXRRXTMP(PXPFX) ; Extrinsic variable.
; Gets a unique PXRRXTMP value.
S PFPFX=$G(PXPFX,"PXRRXTMP") ; Unizue ^XTMP prefix.
N PXRRXTMP ; Value to return.
N PXDONE
I '$D(^XTMP("PXRRXTMP")) D
. N PXCREATE ; ^XTMP Creation date.
. N PXPURGE ; ^XTMP Purge date.
. L +^XTMP("PXRRXTMP",0):300
. S PXCREATE=$$DT^XLFDT ; Today's date.
. S PXPURGE=$$HTFM^XLFDT($H+365) ; Not more than one year from today.
. S ^XTMP("PXRRXTMP",0)=PXCREATE_"^"_PXPURGE_"^PXRR XTMP Coordination"
. L -^XTMP("PXRRXTMP",0)
L +^XTMP("PXRRXTMP",1):300
S PXDONE=0
F D Q:PXDONE
. S (^XTMP("PXRRXTMP",1),PXRRXTMP)=$G(^XTMP("PXRRXTMP",1),0)+1
. S PXRRXTMP=PXPFX_PXRRXTMP
. Q:$D(^XTMP(PXRRXTMP))
. Q:$D(^TMP(PXRRXTMP))
. Q:$D(^TMP($J,PXRRXTMP))
. S PXDONE=1
L -^XTMP("PXRRXTMP",1)
Q PXRRXTMP
PXRRWLD ;ISL/PKR,ALB/Zoltan - Driver for PCE encounter summary report.;12/1/98
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**20,61**;Aug 12, 1996
MAIN ;
+1 NEW PXRRIOD,PXRRWLJB,PXRRWLST,PXRROPT,PXRRQUE,PXRRXTMP
+2 SET PXRRXTMP=$$PXRRXTMP("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 ;=======================================================================
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 ;
PXRRXTMP(PXPFX) ; Extrinsic variable.
+1 ; Gets a unique PXRRXTMP value.
+2 ; Unizue ^XTMP prefix.
SET PFPFX=$GET(PXPFX,"PXRRXTMP")
+3 ; Value to return.
NEW PXRRXTMP
+4 NEW PXDONE
+5 IF '$DATA(^XTMP("PXRRXTMP"))
Begin DoDot:1
+6 ; ^XTMP Creation date.
NEW PXCREATE
+7 ; ^XTMP Purge date.
NEW PXPURGE
+8 LOCK +^XTMP("PXRRXTMP",0):300
+9 ; Today's date.
SET PXCREATE=$$DT^XLFDT
+10 ; Not more than one year from today.
SET PXPURGE=$$HTFM^XLFDT($HOROLOG+365)
+11 SET ^XTMP("PXRRXTMP",0)=PXCREATE_"^"_PXPURGE_"^PXRR XTMP Coordination"
+12 LOCK -^XTMP("PXRRXTMP",0)
End DoDot:1
+13 LOCK +^XTMP("PXRRXTMP",1):300
+14 SET PXDONE=0
+15 FOR
Begin DoDot:1
+16 SET (^XTMP("PXRRXTMP",1),PXRRXTMP)=$GET(^XTMP("PXRRXTMP",1),0)+1
+17 SET PXRRXTMP=PXPFX_PXRRXTMP
+18 IF $DATA(^XTMP(PXRRXTMP))
QUIT
+19 IF $DATA(^TMP(PXRRXTMP))
QUIT
+20 IF $DATA(^TMP($JOB,PXRRXTMP))
QUIT
+21 SET PXDONE=1
End DoDot:1
IF PXDONE
QUIT
+22 LOCK -^XTMP("PXRRXTMP",1)
+23 QUIT PXRRXTMP
