Routine: SCRPW59

SCRPW59 ;RENO/KEITH - Visits and Unique SSNs by County (OP9) or (IP9) ; 15 Jul 98  02:38PM

 ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2

 S SDSTA=$G(SDSTA,2)

 D RQUE^SCRPW50("START^SCRPW59","Visits and Unique SSNs by County "_$S(SDSTA=2:"(OP9)",1:"(IP9)")) Q

START ;Print report

 K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")

 F  S SDT=$O(^SCE("B",SDT)) Q:'SDT!SDOUT!(SDT>SD("EDT"))  S SDOE=0 F  S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT  S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) I $$VALID() D SET(SDIV) D:SDMD SET(0)

 G:SDOUT EXIT S SDLINE="",$P(SDLINE,"-",(IOM+1))="" D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDTIT(1)="<*>  VISITS AND UNIQUE SSNS BY COUNTY "_$S(SDSTA=2:"(OP9)",1:"(IP9)")_"  <*>",SDPG=0,C=(IOM-80\2) D:$E(IOST)="C" DISP0^SCRPW23

 I '$D(^TMP("SCRPW",$J)) S SDPAGE=1,SDX="No activity found within report parameters." D HDR G:SDOUT EXIT W !!?(IOM-$L(SDX)\2),SDX G EXIT

 S (SDVCT,SDIV)="" F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT  D STOP D DLIST S SDX="" F  S SDX=$O(^TMP("SCRPW",$J,SDIV,SDX)) Q:SDX=""!SDOUT  D SUBT

 G:SDOUT EXIT S SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  D DPRT(SDIV(SDIVN))

 G:SDOUT EXIT D:SDVCT>1 DPRT(0)

EXIT I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR

 K ^TMP("SCRPW",$J),%,%H,%I,C,DFN,DIR,SD,SDDIV,SDE,SDI,SDIV,SDIVN,SDLINE,SDMD,SDOE,SDOE0,SDOUT,SDPAGE,SDPG,SDPNOW,SDSTOP,SDT,SDTIT,SDU,SDV,SDVCT,SDX,SDY,X,Y,SDSTA Q

DPRT(SDV) ;Print division

 ;Required input: SDV=division ifn or '0' for combined divisions

 I SDV S SDTIT(2)="For "_$S(SDDIV["DIVISIONS":"division",1:"facility")_": "_SDIVN

 I 'SDV S SDTIT(2)="Report for: "_$P(SDDIV,U,2) D

 .S SDI=2,SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""  S SDI=SDI+1,SDTIT(SDI)=$J("Division: ",$L(SDIVN))_SDIVN

.Q

 S SDPAGE=1 D HDR,HD1 Q:SDOUT  S SDX="" F  S SDX=$O(^TMP("SCRPW",$J,SDV,SDX)) Q:SDX=""!SDOUT  S SDY=^TMP("SCRPW",$J,SDV,SDX,"STAT") D PLINE

PLINE ;Print output line

 D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT

 W !?(C),$E($P(SDX," / ",2),1,22),?(C+24),$E($P(SDX," / "),1,20) F SDI=0:1:2 W ?(C+46+(12*SDI)),$J($P(SDY,U,(SDI+1)),10,0)

HDR ;Print header

 I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT

 D STOP Q:SDOUT  W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)

 N SDI S SDI=0 W SDLINE F  S SDI=$O(SDTIT(SDI)) Q:'SDI  W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)

 W !,SDLINE,!,"For Fiscal Year activity through ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1,SDPG=1 Q

HD1 ;Print subheader

 Q:SDOUT  W !?(C),"County",?(C+24),"State",?(C+50),"Visits",?(C+58),"Encounters",?(C+73),"Uniques",!?(C),$E(SDLINE,1,22),?(C+24),$E(SDLINE,1,20),?(C+46),$E(SDLINE,1,10),?(C+58),$E(SDLINE,1,10),?(C+70),$E(SDLINE,1,10) Q

DLIST ;Create alphabetic list of divisions found

 Q:'SDIV  S SDX=$P($G(^DG(40.8,SDIV,0)),U) S:'$L(SDX) SDX="*** UNKNOWN ***" S SDIV(SDX)=SDIV,SDVCT=SDVCT+1 Q

SUBT ;Count uniques and visits

 S (SDU,SDV,DFN)=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDX,DFN)) Q:'DFN  S SDU=SDU+1,SDT=0 F  S SDT=$O(^TMP("SCRPW",$J,SDIV,SDX,DFN,SDT)) Q:'SDT  S SDV=SDV+1

 S SDE=^TMP("SCRPW",$J,SDIV,SDX,"STAT"),^TMP("SCRPW",$J,SDIV,SDX,"STAT")=SDV_U_SDE_U_SDU

VALID() ;Check encounter record

 I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0

 I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1

Q 0

DIV() ;Check division

 Q:'SDDIV 1  Q $D(SDDIV(SDIV))

STOP ;Check for stop task request

 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q

SET(SDIV) ;Set division lists

 ;Required input: SDIV=division ifn or '0' for summary

 S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT

 K SDX D PDSC^SCRPW24(.SDX) S SDX=$O(SDX("")),SDX=$P(SDX(SDX),U,2)

 S ^TMP("SCRPW",$J,SDIV,SDX,"STAT")=$G(^TMP("SCRPW",$J,SDIV,SDX,"STAT"))+1,^TMP("SCRPW",$J,SDIV,SDX,$P(SDOE0,U,2),$P(SDT,"."))=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW59   3943     printed  Feb 19, 2025@00:10:22                                                                                                                                                                                                     Page 2

SCRPW59   ;RENO/KEITH - Visits and Unique SSNs by County (OP9) or (IP9) ; 15 Jul 98  02:38PM

 +1       ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2

 +2        SET SDSTA=$GET(SDSTA,2)

 +3        DO RQUE^SCRPW50("START^SCRPW59","Visits and Unique SSNs by County "_$SELECT(SDSTA=2:"(OP9)",1:"(IP9)"))

           QUIT

 +4       ;

START     ;Print report

 +1        KILL ^TMP("SCRPW",$JOB)

           SET (SDSTOP,SDOUT)=0

           SET SDT=SD("FYD")

 +2        FOR

               SET SDT=$ORDER(^SCE("B",SDT))

               if 'SDT!SDOUT!(SDT>SD("EDT"))

                   QUIT

               SET SDOE=0

FOR

                   SET SDOE=$ORDER(^SCE("B",SDT,SDOE))

                   if 'SDOE!SDOUT

                       QUIT

                   SET SDOE0=$$GETOE^SDOE(SDOE)

                   SET SDIV=$PIECE(SDOE0,U,11)

                   IF $$VALID()

                       DO SET(SDIV)

                       if SDMD

                           DO SET(0)

 +3        if SDOUT

               GOTO EXIT

           SET SDLINE=""

           SET $PIECE(SDLINE,"-",(IOM+1))=""

           DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET SDPNOW=$PIECE(Y,":",1,2)

           SET SDTIT(1)="<*>  VISITS AND UNIQUE SSNS BY COUNTY "_$SELECT(SDSTA=2:"(OP9)",1:"(IP9)")_"  <*>"

           SET SDPG=0

           SET C=(IOM-80\2)

           if $EXTRACT(IOST)="C"

               DO DISP0^SCRPW23

 +4        IF '$DATA(^TMP("SCRPW",$JOB))

               SET SDPAGE=1

               SET SDX="No activity found within report parameters."

               DO HDR

               if SDOUT

                   GOTO EXIT

               WRITE !!?(IOM-$LENGTH(SDX)\2),SDX

               GOTO EXIT

 +5        SET (SDVCT,SDIV)=""

FOR

               SET SDIV=$ORDER(^TMP("SCRPW",$JOB,SDIV))

               if SDIV=""!SDOUT

                   QUIT

               DO STOP

               DO DLIST

               SET SDX=""

FOR

                   SET SDX=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDX))

                   if SDX=""!SDOUT

                       QUIT

                   DO SUBT

 +6        if SDOUT

               GOTO EXIT

           SET SDIVN=""

FOR

               SET SDIVN=$ORDER(SDIV(SDIVN))

               if SDIVN=""!SDOUT

                   QUIT

               DO DPRT(SDIV(SDIVN))

 +7        if SDOUT

               GOTO EXIT

           if SDVCT>1

               DO DPRT(0)

EXIT       IF $EXTRACT(IOST)="C"

               IF 'SDOUT

                   NEW DIR

                   SET DIR(0)="E"

                   DO ^DIR

 +1        KILL ^TMP("SCRPW",$JOB),%,%H,%I,C,DFN,DIR,SD,SDDIV,SDE,SDI,SDIV,SDIVN,SDLINE,SDMD,SDOE,SDOE0,SDOUT,SDPAGE,SDPG,SDPNOW,SDSTOP,SDT,SDTIT,SDU,SDV,SDVCT,SDX,SDY,X,Y,SDSTA

           QUIT

 +2       ;

DPRT(SDV) ;Print division

 +1       ;Required input: SDV=division ifn or '0' for combined divisions

 +2        IF SDV

               SET SDTIT(2)="For "_$SELECT(SDDIV["DIVISIONS":"division",1:"facility")_": "_SDIVN

 +3        IF 'SDV

               SET SDTIT(2)="Report for: "_$PIECE(SDDIV,U,2)

               Begin DoDot:1

 +4                SET SDI=2

                   SET SDIVN=""

FOR

                       SET SDIVN=$ORDER(SDIV(SDIVN))

                       if SDIVN=""

                           QUIT

                       SET SDI=SDI+1

                       SET SDTIT(SDI)=$JUSTIFY("Division: ",$LENGTH(SDIVN))_SDIVN

 +5                QUIT

               End DoDot:1

 +6        SET SDPAGE=1

           DO HDR

           DO HD1

           if SDOUT

               QUIT

           SET SDX=""

FOR

               SET SDX=$ORDER(^TMP("SCRPW",$JOB,SDV,SDX))

               if SDX=""!SDOUT

                   QUIT

               SET SDY=^TMP("SCRPW",$JOB,SDV,SDX,"STAT")

               DO PLINE

 +7        QUIT

PLINE     ;Print output line

 +1        if $Y>(IOSL-4)

               DO HDR

               DO HD1

           if SDOUT

               QUIT

 +2        WRITE !?(C),$EXTRACT($PIECE(SDX," / ",2),1,22),?(C+24),$EXTRACT($PIECE(SDX," / "),1,20)

           FOR SDI=0:1:2

               WRITE ?(C+46+(12*SDI)),$JUSTIFY($PIECE(SDY,U,(SDI+1)),10,0)

 +3        QUIT

 +4       ;

HDR       ;Print header

 +1        IF $EXTRACT(IOST)="C"

               IF SDPG

                   NEW DIR

                   SET DIR(0)="E"

                   WRITE !

                   DO ^DIR

                   SET SDOUT=Y'=1

                   if SDOUT

                       QUIT

 +2        DO STOP

           if SDOUT

               QUIT

           if SDPG!($EXTRACT(IOST)="C")

               WRITE $$XY^SCRPW50(IOF,1,0)

           if $X

               WRITE $$XY^SCRPW50("",0,0)

 +3        NEW SDI

           SET SDI=0

           WRITE SDLINE

FOR

               SET SDI=$ORDER(SDTIT(SDI))

               if 'SDI

                   QUIT

               WRITE !?(IOM-$LENGTH(SDTIT(SDI))\2),SDTIT(SDI)

 +4        WRITE !,SDLINE,!,"For Fiscal Year activity through ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(IOM-6-$LENGTH(SDPAGE)),"Page: ",SDPAGE,!,SDLINE

           SET SDPAGE=SDPAGE+1

           SET SDPG=1

           QUIT

 +5       ;

HD1       ;Print subheader

 +1        if SDOUT

               QUIT

           WRITE !?(C),"County",?(C+24),"State",?(C+50),"Visits",?(C+58),"Encounters",?(C+73),"Uniques",!?(C),$EXTRACT(SDLINE,1,22),?(C+24),$EXTRACT(SDLINE,1,20),?(C+46),$EXTRACT(SDLINE,1,10),?(C+58),$EXTRACT(SDLINE,1,10),?(C+70),$EXTRACT(SDLINE,1,10)

           QUIT

 +2       ;

DLIST     ;Create alphabetic list of divisions found

 +1        if 'SDIV

               QUIT

           SET SDX=$PIECE($GET(^DG(40.8,SDIV,0)),U)

           if '$LENGTH(SDX)

               SET SDX="*** UNKNOWN ***"

           SET SDIV(SDX)=SDIV

           SET SDVCT=SDVCT+1

           QUIT

 +2       ;

SUBT      ;Count uniques and visits

 +1        SET (SDU,SDV,DFN)=0

FOR

               SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDX,DFN))

               if 'DFN

                   QUIT

               SET SDU=SDU+1

               SET SDT=0

FOR

                   SET SDT=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDX,DFN,SDT))

                   if 'SDT

                       QUIT

                   SET SDV=SDV+1

 +2        SET SDE=^TMP("SCRPW",$JOB,SDIV,SDX,"STAT")

           SET ^TMP("SCRPW",$JOB,SDIV,SDX,"STAT")=SDV_U_SDE_U_SDU

 +3        QUIT

 +4       ;

VALID()   ;Check encounter record

 +1        IF $PIECE(SDOE0,U,4)

               IF $PIECE($GET(^SC($PIECE(SDOE0,U,4),0)),U,17)="Y"

                   QUIT 0

 +2        IF SDIV

               IF $$DIV()

                   IF $PIECE(SDOE0,U,2)

                       IF '$PIECE(SDOE0,U,6)

                           IF $PIECE(SDOE0,U,7)

                               IF $PIECE(SDOE0,U,12)=SDSTA

                                   QUIT 1

 +3        QUIT 0

 +4       ;

DIV()     ;Check division

 +1        if 'SDDIV

               QUIT 1

           QUIT $DATA(SDDIV(SDIV))

 +2       ;

STOP      ;Check for stop task request

 +1        if $DATA(ZTQUEUED)

               SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)

           QUIT

 +2       ;

SET(SDIV) ;Set division lists

 +1       ;Required input: SDIV=division ifn or '0' for summary

 +2        SET SDSTOP=SDSTOP+1

           IF SDSTOP#2000=0

               DO STOP^SCRPW40

               if SDOUT

                   QUIT

 +3        KILL SDX

           DO PDSC^SCRPW24(.SDX)

           SET SDX=$ORDER(SDX(""))

           SET SDX=$PIECE(SDX(SDX),U,2)

 +4        SET ^TMP("SCRPW",$JOB,SDIV,SDX,"STAT")=$GET(^TMP("SCRPW",$JOB,SDIV,SDX,"STAT"))+1

           SET ^TMP("SCRPW",$JOB,SDIV,SDX,$PIECE(SDOE0,U,2),$PIECE(SDT,"."))=""

 +5        QUIT

SCRPW59.m