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  Sep 23, 2025@20:07:17                                                                                                                                                                                                     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      ;