PXRRFDD ;ISL/PKR,ALB/Zoltan - PCE Frequency of Diagnosis report driver.;10/13/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,31,61,211**;Aug 12, 1996;Build 454
MAIN ;
N PXRRFDJB,PXRRFDST,PXRRIOD,PXRROPT,PXRRQUE,PXRRXTMP
S PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRFD")
S ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Frequency of Diagnosis"
;
;Establish the selection criteria.
FAC ;Get the facility list.
N NFAC,PXRRFAC,PXRRFACN
D FACILITY^PXRRLCSC
I $D(DTOUT)!$D(DUOUT) G EXIT
;
DR ;Get the encounter date range.
N PXRRBDT,PXRREDT
D PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
I $D(DTOUT) G EXIT
I $D(DUOUT) G FAC
;
DIAG ;Get the diagnosis screening criteria.
N PXRRFDDC
D DIAGSC^PXRRFDSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G DR
;
EATT ;Get a list of encounter screening attributes.
N PXRRECAT
D ECAT^PXRRECSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G DIAG
;
;Process the screening attributes
;
SCAT ;Get the service categories.
N PXRRSCAT
I PXRRECAT["1" D
. D SCAT^PXRRECSC
E S PXRRSCAT="AI"
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
ETYPE ;Get the encounter types.
;This section is commented out so it can be easily restored if encounter
;types are used later. The part of ECAT^PXRRECSC relating to this should
;also be restored.
;N PXRRETYP
;I PXRRECAT["2" D
;. D ETYPE^PXRRECSC
;I $D(DTOUT) G EXIT
;I $D(DUOUT) G EATT
;
LOC ;Get the locations.
N NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
I PXRRECAT["2" D
. D LOC^PXRRLCSC("Determine frequency of diagnosis for","HS")
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
PRV ;Get the provider list.
N NCL,NPL,PXRRPECL,PXRRPRPL,PXRRPRSC
I PXRRECAT["3" D
. D PRV^PXRRPRSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
DOB ;Get the patient age range.
N PXRRDOB,PXRRDOBE,PXRRDOBS,PXRRMAXA,PXRRMINA
I PXRRECAT["4" D
. S PXRRMINA=$$AGE^PXRRADUT("MINIMUM",1)
. I '$D(DTOUT)&'$D(DUOUT) D
.. S PXRRMAXA=$$AGE^PXRRADUT("MAXIMUM",0)
.;Convert the ages into dates of birth.
. I +$G(PXRRMAXA)>0 S PXRRDOBS=$$DOBFA^PXRRADUT(PXRRMAXA)
. I +$G(PXRRMINA)>0 S PXRRDOBE=$$DOBFA^PXRRADUT(PXRRMINA)
. I ($D(PXRRDOBS))!($D(PXRRDOBE)) S PXRRDOB=1
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
RACE ;Get the patient race.
N NRACE,PXRRRACE
I PXRRECAT["5" D
. D RACE^PXRRFDSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
PSEX ;Get the patient sex.
N PXRRSEX
I PXRRECAT["6" D
. D SEX^PXRRFDSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
MAX ;Get the maximum number of diagnosis counts to include in the report.
N PXRRDMAX
D DMAX^PXRRFDSC
I $D(DTOUT) G EXIT
I $D(DUOUT) G EATT
;
;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="Frequency of Diagnosis Report - sort encounters"
. S IODEV=""
. S ROUTINE="SORT^PXRRFDSE"
. S ^XTMP(PXRRXTMP,"SORTEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
.;
. S DESC="Frequency of Diagnosis Report - sort diagnosis data"
. S IODEV=""
. S ROUTINE="SORT^PXRRFDSD"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"SORTDZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
.;
. S DESC="Frequency of diagnosis report - print"
. S IODEV=PXRRIOD
. S ROUTINE="PXRRFDP"
. S ZTDTH="@"
. S ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
E D SORT^PXRRFDSE
Q
;
;====================
EXIT ;
D EXIT^PXRRGUT
Q
;
;====================
SAVE ;Save the variables.
S ZTSAVE("PXRRBDT")="",ZTSAVE("PXRREDT")=""
S ZTSAVE("PXRRDOB")=""
S ZTSAVE("PXRRDOBE")=""
S ZTSAVE("PXRRDOBS")=""
S ZTSAVE("PXRRCS(")="",ZTSAVE("NCS")=""
S ZTSAVE("PXRRDMAX")=""
S ZTSAVE("PXRRECAT")=""
S ZTSAVE("PXRRETYP")=""
S ZTSAVE("PXRRFAC(")="",ZTSAVE("NFAC")=""
S ZTSAVE("PXRRFACN(")=""
S ZTSAVE("PXRRFDDC")=""
S ZTSAVE("PXRRIOD")=""
S ZTSAVE("PXRRLCHL(")="",ZTSAVE("NHL")=""
S ZTSAVE("PXRRLCSC")=""
S ZTSAVE("PXRRMAXA")=""
S ZTSAVE("PXRRMINA")=""
S ZTSAVE("PXRRPECL(")="",ZTSAVE("NCL")=""
S ZTSAVE("PXRRPRPL(")="",ZTSAVE("NPL")=""
S ZTSAVE("PXRRPRSC")=""
S ZTSAVE("PXRRQUE")=""
S ZTSAVE("PXRRSCAT")=""
S ZTSAVE("PXRRRACE(")="",ZTSAVE("NRACE")=""
S ZTSAVE("PXRRSEX")=""
S ZTSAVE("PXRRXTMP")=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRFDD 4350 printed Nov 22, 2024@17:40:39 Page 2
PXRRFDD ;ISL/PKR,ALB/Zoltan - PCE Frequency of Diagnosis report driver.;10/13/2017
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,18,31,61,211**;Aug 12, 1996;Build 454
MAIN ;
+1 NEW PXRRFDJB,PXRRFDST,PXRRIOD,PXRROPT,PXRRQUE,PXRRXTMP
+2 SET PXRRXTMP=$$XTMPSUB^PXRRGUT("PXRRFD")
+3 SET ^XTMP(PXRRXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRR Frequency of Diagnosis"
+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 ;
DR ;Get the encounter date range.
+1 NEW PXRRBDT,PXRREDT
+2 DO PDR^PXRRADUT(.PXRRBDT,.PXRREDT,"ENCOUNTER")
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO FAC
+5 ;
DIAG ;Get the diagnosis screening criteria.
+1 NEW PXRRFDDC
+2 DO DIAGSC^PXRRFDSC
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO DR
+5 ;
EATT ;Get a list of encounter screening attributes.
+1 NEW PXRRECAT
+2 DO ECAT^PXRRECSC
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO DIAG
+5 ;
+6 ;Process the screening attributes
+7 ;
SCAT ;Get the service categories.
+1 NEW PXRRSCAT
+2 IF PXRRECAT["1"
Begin DoDot:1
+3 DO SCAT^PXRRECSC
End DoDot:1
+4 IF '$TEST
SET PXRRSCAT="AI"
+5 IF $DATA(DTOUT)
GOTO EXIT
+6 IF $DATA(DUOUT)
GOTO EATT
+7 ;
ETYPE ;Get the encounter types.
+1 ;This section is commented out so it can be easily restored if encounter
+2 ;types are used later. The part of ECAT^PXRRECSC relating to this should
+3 ;also be restored.
+4 ;N PXRRETYP
+5 ;I PXRRECAT["2" D
+6 ;. D ETYPE^PXRRECSC
+7 ;I $D(DTOUT) G EXIT
+8 ;I $D(DUOUT) G EATT
+9 ;
LOC ;Get the locations.
+1 NEW NCS,NHL,PXRRCS,PXRRLCHL,PXRRLCSC
+2 IF PXRRECAT["2"
Begin DoDot:1
+3 DO LOC^PXRRLCSC("Determine frequency of diagnosis for","HS")
End DoDot:1
+4 IF $DATA(DTOUT)
GOTO EXIT
+5 IF $DATA(DUOUT)
GOTO EATT
+6 ;
PRV ;Get the provider list.
+1 NEW NCL,NPL,PXRRPECL,PXRRPRPL,PXRRPRSC
+2 IF PXRRECAT["3"
Begin DoDot:1
+3 DO PRV^PXRRPRSC
End DoDot:1
+4 IF $DATA(DTOUT)
GOTO EXIT
+5 IF $DATA(DUOUT)
GOTO EATT
+6 ;
DOB ;Get the patient age range.
+1 NEW PXRRDOB,PXRRDOBE,PXRRDOBS,PXRRMAXA,PXRRMINA
+2 IF PXRRECAT["4"
Begin DoDot:1
+3 SET PXRRMINA=$$AGE^PXRRADUT("MINIMUM",1)
+4 IF '$DATA(DTOUT)&'$DATA(DUOUT)
Begin DoDot:2
+5 SET PXRRMAXA=$$AGE^PXRRADUT("MAXIMUM",0)
End DoDot:2
+6 ;Convert the ages into dates of birth.
+7 IF +$GET(PXRRMAXA)>0
SET PXRRDOBS=$$DOBFA^PXRRADUT(PXRRMAXA)
+8 IF +$GET(PXRRMINA)>0
SET PXRRDOBE=$$DOBFA^PXRRADUT(PXRRMINA)
+9 IF ($DATA(PXRRDOBS))!($DATA(PXRRDOBE))
SET PXRRDOB=1
End DoDot:1
+10 IF $DATA(DTOUT)
GOTO EXIT
+11 IF $DATA(DUOUT)
GOTO EATT
+12 ;
RACE ;Get the patient race.
+1 NEW NRACE,PXRRRACE
+2 IF PXRRECAT["5"
Begin DoDot:1
+3 DO RACE^PXRRFDSC
End DoDot:1
+4 IF $DATA(DTOUT)
GOTO EXIT
+5 IF $DATA(DUOUT)
GOTO EATT
+6 ;
PSEX ;Get the patient sex.
+1 NEW PXRRSEX
+2 IF PXRRECAT["6"
Begin DoDot:1
+3 DO SEX^PXRRFDSC
End DoDot:1
+4 IF $DATA(DTOUT)
GOTO EXIT
+5 IF $DATA(DUOUT)
GOTO EATT
+6 ;
MAX ;Get the maximum number of diagnosis counts to include in the report.
+1 NEW PXRRDMAX
+2 DO DMAX^PXRRFDSC
+3 IF $DATA(DTOUT)
GOTO EXIT
+4 IF $DATA(DUOUT)
GOTO EATT
+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="Frequency of Diagnosis Report - sort encounters"
+18 SET IODEV=""
+19 SET ROUTINE="SORT^PXRRFDSE"
+20 SET ^XTMP(PXRRXTMP,"SORTEZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
+21 ;
+22 SET DESC="Frequency of Diagnosis Report - sort diagnosis data"
+23 SET IODEV=""
+24 SET ROUTINE="SORT^PXRRFDSD"
+25 SET ZTDTH="@"
+26 SET ^XTMP(PXRRXTMP,"SORTDZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
+27 ;
+28 SET DESC="Frequency of diagnosis report - print"
+29 SET IODEV=PXRRIOD
+30 SET ROUTINE="PXRRFDP"
+31 SET ZTDTH="@"
+32 SET ^XTMP(PXRRXTMP,"PRZTSK")=$$QUE^PXRRQUE(DESC,IODEV,ROUTINE,"SAVE^PXRRFDD")
End DoDot:1
+33 IF '$TEST
DO SORT^PXRRFDSE
+34 QUIT
+35 ;
+36 ;====================
EXIT ;
+1 DO EXIT^PXRRGUT
+2 QUIT
+3 ;
+4 ;====================
SAVE ;Save the variables.
+1 SET ZTSAVE("PXRRBDT")=""
SET ZTSAVE("PXRREDT")=""
+2 SET ZTSAVE("PXRRDOB")=""
+3 SET ZTSAVE("PXRRDOBE")=""
+4 SET ZTSAVE("PXRRDOBS")=""
+5 SET ZTSAVE("PXRRCS(")=""
SET ZTSAVE("NCS")=""
+6 SET ZTSAVE("PXRRDMAX")=""
+7 SET ZTSAVE("PXRRECAT")=""
+8 SET ZTSAVE("PXRRETYP")=""
+9 SET ZTSAVE("PXRRFAC(")=""
SET ZTSAVE("NFAC")=""
+10 SET ZTSAVE("PXRRFACN(")=""
+11 SET ZTSAVE("PXRRFDDC")=""
+12 SET ZTSAVE("PXRRIOD")=""
+13 SET ZTSAVE("PXRRLCHL(")=""
SET ZTSAVE("NHL")=""
+14 SET ZTSAVE("PXRRLCSC")=""
+15 SET ZTSAVE("PXRRMAXA")=""
+16 SET ZTSAVE("PXRRMINA")=""
+17 SET ZTSAVE("PXRRPECL(")=""
SET ZTSAVE("NCL")=""
+18 SET ZTSAVE("PXRRPRPL(")=""
SET ZTSAVE("NPL")=""
+19 SET ZTSAVE("PXRRPRSC")=""
+20 SET ZTSAVE("PXRRQUE")=""
+21 SET ZTSAVE("PXRRSCAT")=""
+22 SET ZTSAVE("PXRRRACE(")=""
SET ZTSAVE("NRACE")=""
+23 SET ZTSAVE("PXRRSEX")=""
+24 SET ZTSAVE("PXRRXTMP")=""
+25 QUIT
+26 ;
