PXRRFDD.m

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 ---PXRRFDD   4350     printed  Mar 13, 2025@21:35:22                                                                                                                                                                                                     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      ;