SCRPW54 ;RENO/KEITH - Means Test Summary of Visits & Uniques (OP3, OP4, OP5) or (IP3, IP4, IP5) ; 5/21/01 3:32pm
;;5.3;Scheduling;**144,258,466**;AUG 13, 1993;Build 2
S SDSTA=$G(SDSTA,2)
D RQUE^SCRPW50("START^SCRPW54","Means Test Summary of Visits & Uniques "_$S(SDSTA=8:"(IP3, IP4, IP5)",1:"(OP3, OP4, OP5)"),1) Q
;
START ;Print report
K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT,DFN)=0
F S DFN=$O(^SCE("ADFN",DFN)) Q:'DFN!SDOUT S SDT=SD("FYD") F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!SDOUT!(SDT>SD("EDT")) S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE!SDOUT D
.S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) I $$VALID() D SET(SDIV) D:SDMD SET(0)
G:SDOUT EXIT S (SDVCT,SDIV)=""
F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV="" D DLIST,STOP Q:SDOUT D
.F SDMT="N","C","G","X","AN","AS" D
..S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,SDMT,DFN)) Q:'DFN D
...S SDT=0 F S SDT=$O(^TMP("SCRPW",$J,SDIV,SDMT,DFN,SDT)) Q:'SDT S ^TMP("SCRPW",$J,SDIV,0,DFN,SDT)=SDMT
...Q
..Q
.S DFN=0 F S DFN=$O(^TMP("SCRPW",$J,SDIV,0,DFN)) Q:'DFN S SDFV=1,SDT="" F S SDT=$O(^TMP("SCRPW",$J,SDIV,0,DFN,SDT),-1) Q:SDT="" S SDMT=^TMP("SCRPW",$J,SDIV,0,DFN,SDT) D S1(SDMT) S SDFV=0
.S SDMT=0 F S SDMT=$O(^TMP("SCRPW",$J,SDIV,SDMT)) Q:SDMT="" D
..I '$G(^TMP("SCRPW",$J,SDIV,SDMT,"TOTAL")) S (^TMP("SCRPW",$J,SDIV,SDMT,"TOTAL"),^TMP("SCRPW",$J,SDIV,SDMT,"AVERAGE AGE"))=0 Q
..S ^TMP("SCRPW",$J,SDIV,SDMT,"AVERAGE AGE")=^TMP("SCRPW",$J,SDIV,SDMT,"AVERAGE AGE")\^TMP("SCRPW",$J,SDIV,SDMT,"TOTAL")
..Q
.D AA(SDIV) Q
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)="<*> MEANS TEST SUMMARY OF VISITS & UNIQUES "_$S(SDSTA=8:"(IP3, IP4, IP5)",1:"(OP3, OP4, OP5)")_" <*>",SDPG=0
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
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,DFN,DIR,SD,SDAGE,SDDIV,SDFAA,SDFTOT,SDFV,SDH,SDI,SDIV,SDIVN,SDLAB,SDLINE,SDLT,SDMD,SDMO,SDMOTO,SDMT,SDOE,SDOE0,SDSTA
K SDPAGE,SDOUT,SDPATE,SDPG,SDPNOW,SDPT0,SDR,SDSC,SDSTOP,SDT,SDTIT,SDTOT,SDV,SDVCT,SDX,SDYR,SDYRTO,X,Y Q
;
AA(SDIV) ;Average age
I '$G(SDFTOT(SDIV)) S (SDFAA(SDIV),SDFTOT(SDIV))=0 Q
S SDFAA(SDIV)=SDFAA(SDIV)\SDFTOT(SDIV) 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(1) Q:SDOUT S SDSC=0 D PLINE1(1) Q:SDOUT
W ! D:$Y>(IOSL-8) HDR Q:SDOUT D HD1(2) D PLINE1(2) Q:SDOUT
W ! D:$Y>(IOSL-8) HDR Q:SDOUT D HD2
F SDLT="MALE","FEMALE","TOTAL","POW STATUS","AVERAGE AGE","UNDER 24","25 - 34","35 - 44","45 - 54","55 - 64","65 - 74","75 - 84","85 - 94","95 & ABOVE" D PLINE2(SDLT) Q:SDOUT
Q
;
PLINE1(SDH) ;Print output line
;Required input: SDH=subheader number
S (SDMOTO,SDYRTO)=0
;D PL("CATEGORY A SERVICE CONNECTED","AS") Q:SDOUT
D PL("SC - MT COPAY EXEMPT","AS") Q:SDOUT
;D PL("CATEGORY A NON-SERVICE CONNECTED","AN") Q:SDOUT
D PL("NSC - MT COPAY EXEMPT","AN") Q:SDOUT
;D PL("TOTAL CATEGORY A MEANS TEST","TA") Q:SDOUT
D PL("TOTAL MT COPAY EXEMPT","TA") Q:SDOUT
;D PL("CATEGORY C","C") Q:SDOUT
D PL("MT COPAY REQUIRED","C") Q:SDOUT
D PL("GMT COPAY REQUIRED","G") Q:SDOUT
D PL("NON VETERAN","N") Q:SDOUT
D PL("NON APPLICABLE","X") Q:SDOUT
S SDX="CURRENT MONTH % OF YEAR TO DATE TOTALS: "_$S('SDYRTO:0,1:SDMOTO*100\SDYRTO)_"%" W !!?(132-$L(SDX)\2),SDX
Q
;
PL(SDLAB,SDMT) ;Print line
I $Y>(IOSL-4) D HDR Q:SDOUT D HD1(SDH)
S SDMO=+$G(^TMP("SCRPW",$J,SDV,SDMT,$S(SDH=1:"MOVIS",1:"MOTOT")))
S SDYR=+$G(^TMP("SCRPW",$J,SDV,SDMT,$S(SDH=1:"VIS",1:"TOTAL")))
S SDMOTO=SDMOTO+SDMO,SDYRTO=SDYRTO+SDYR
W !?18,$J(SDLAB_":",33),?54,$J(SDMO,9,0),?69,$J(SDLAB_":",33),?105,$J(SDYR,9,0)
Q
;
PLINE2(SDLT) ;Print output line
;Required input: SDLT=output line tag
I $Y>(IOSL-4) D HDR Q:SDOUT D HD2
W !?6,$J(SDLT_":",12) S (SDTOT,SDI)=0 F SDMT="AS","AN","TA","C","G","N","X" S SDX=+$G(^TMP("SCRPW",$J,SDV,SDMT,SDLT)) W ?(20+(12*SDI)),$J(SDX,10,0) S SDI=SDI+1 S:SDI'=3 SDTOT=SDTOT+SDX
S:SDLT="AVERAGE AGE" SDTOT=SDFAA(SDV) W ?104,$J(SDTOT,10,0) Q
;
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(SDR) ;Print subheader
Q:SDOUT S SDX="**** MEANS TEST VISIT SUMMARY"_$S(SDR=2:" (UNIQUE SSNS BASED ON LATEST VISIT)",1:"")_" ****" W !!?(132-$L(SDX)\2),$E(SDLINE,1,$L(SDX)),!?(132-$L(SDX)\2),SDX,!?(132-$L(SDX)\2),$E(SDLINE,1,$L(SDX))
S SDX="CURRENT MONTH MEANS TEST "_$S(SDR=1:"VISITS",1:"UNIQUES") W !!?18,$J(SDX_":",33),?58,"TOTAL"
S SDX="YEAR TO DATE MEANS TEST "_$S(SDR=1:"VISITS",1:"UNIQUES") W ?69,$J(SDX_":",33),?109,"TOTAL",!?18,$E(SDLINE,1,45),?69,$E(SDLINE,1,45)
Q
;
HD2 ;Print subheader
Q:SDOUT S SDX="**** MEANS TEST UNIQUES BY GENDER, POW STATUS AND AGE ****" W !!?(132-$L(SDX)\2),$E(SDLINE,1,$L(SDX)),!?(132-$L(SDX)\2),SDX,!?(132-$L(SDX)\2),$E(SDLINE,1,$L(SDX))
W !?24,"SC",?35,"NSC",?45,"TOTAL"
W !?20,"MT COPAY",?32,"MT COPAY",?44,"MT COPAY",?56,"MT COPAY",?68,"GMT COPAY",?87,"NON",?99,"NOT",?109,"GRAND"
W !?10,"UNIQUES:",?21,"EXEMPT",?33,"EXEMPT",?45,"EXEMPT",?56,"REQUIRED",?68,"REQUIRED",?83,"VETERAN",?92,"APPLICABLE",?109,"TOTAL"
W !?6,$E(SDLINE,1,12) F SDI=0:1:7 W ?(20+(12*SDI)),$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
;
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),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA,$P(SDOE0,U,10),$P(SDOE0,U,13) 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#3000=0 D STOP^SCRPW40 Q:SDOUT
S SDMT=$$MTI^SCDXUTL0(DFN,$P(SDOE0,U),$P(SDOE0,U,13),$P(SDOE0,U,10),SDOE) Q:SDMT="U" S ^TMP("SCRPW",$J,SDIV,SDMT,DFN,$P(SDT,"."))=""
Q
;
S1(SDMT) S ^TMP("SCRPW",$J,SDIV,SDMT,"VIS")=$G(^TMP("SCRPW",$J,SDIV,SDMT,"VIS"))+1
S:SDT>SD("MOD") ^TMP("SCRPW",$J,SDIV,SDMT,"MOVIS")=$G(^TMP("SCRPW",$J,SDIV,SDMT,"MOVIS"))+1
D:(SDMT="AN"!(SDMT="AS")) S1("TA") Q:'SDFV
S SDPT0=$G(^DPT(DFN,0)) S SDX=$$SEX()_U_"TOTAL"_U_$$AGE()_$$POW()_$$MOT()
F SDI=1:1:$L(SDX,U) S ^TMP("SCRPW",$J,SDIV,SDMT,$P(SDX,U,SDI))=$G(^TMP("SCRPW",$J,SDIV,SDMT,$P(SDX,U,SDI)))+1
Q
;
MOT() Q $S(SDT>SD("MOD"):"^MOTOT",1:"")
;
SEX() Q $S($P(SDPT0,U,2)="M":"MALE",1:"FEMALE")
;
POW() Q $S($P($G(^DPT(DFN,.52)),U,5)="Y":"^POW STATUS",1:"")
;
AGE() S SDAGE=$P(SDPT0,U,3),SDAGE=$E(SDT,1,3)-$E(SDAGE,1,3)-($E(SDT,4,7)<$E(SDAGE,4,7)),^TMP("SCRPW",$J,SDIV,SDMT,"AVERAGE AGE")=$G(^TMP("SCRPW",$J,SDIV,SDMT,"AVERAGE AGE"))+SDAGE
I SDMT'="TA" S SDFAA(SDIV)=$G(SDFAA(SDIV))+SDAGE,SDFTOT(SDIV)=$G(SDFTOT(SDIV))+1
Q $S(SDAGE<25:"UNDER 24",SDAGE<35:"25 - 34",SDAGE<45:"35 - 44",SDAGE<55:"45 - 54",SDAGE<65:"55 - 64",SDAGE<75:"65 - 74",SDAGE<85:"75 - 84",SDAGE<95:"85 - 94",1:"95 & ABOVE")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW54 7943 printed Dec 13, 2024@02:43:51 Page 2
SCRPW54 ;RENO/KEITH - Means Test Summary of Visits & Uniques (OP3, OP4, OP5) or (IP3, IP4, IP5) ; 5/21/01 3:32pm
+1 ;;5.3;Scheduling;**144,258,466**;AUG 13, 1993;Build 2
+2 SET SDSTA=$GET(SDSTA,2)
+3 DO RQUE^SCRPW50("START^SCRPW54","Means Test Summary of Visits & Uniques "_$SELECT(SDSTA=8:"(IP3, IP4, IP5)",1:"(OP3, OP4, OP5)"),1)
QUIT
+4 ;
START ;Print report
+1 KILL ^TMP("SCRPW",$JOB)
SET (SDSTOP,SDOUT,DFN)=0
+2 FOR
SET DFN=$ORDER(^SCE("ADFN",DFN))
if 'DFN!SDOUT
QUIT
SET SDT=SD("FYD")
FOR
SET SDT=$ORDER(^SCE("ADFN",DFN,SDT))
if 'SDT!SDOUT!(SDT>SD("EDT"))
QUIT
SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("ADFN",DFN,SDT,SDOE))
if 'SDOE!SDOUT
QUIT
Begin DoDot:1
+3 SET SDOE0=$$GETOE^SDOE(SDOE)
SET SDIV=$PIECE(SDOE0,U,11)
IF $$VALID()
DO SET(SDIV)
if SDMD
DO SET(0)
End DoDot:1
+4 if SDOUT
GOTO EXIT
SET (SDVCT,SDIV)=""
+5 FOR
SET SDIV=$ORDER(^TMP("SCRPW",$JOB,SDIV))
if SDIV=""
QUIT
DO DLIST
DO STOP
if SDOUT
QUIT
Begin DoDot:1
+6 FOR SDMT="N","C","G","X","AN","AS"
Begin DoDot:2
+7 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDMT,DFN))
if 'DFN
QUIT
Begin DoDot:3
+8 SET SDT=0
FOR
SET SDT=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDMT,DFN,SDT))
if 'SDT
QUIT
SET ^TMP("SCRPW",$JOB,SDIV,0,DFN,SDT)=SDMT
+9 QUIT
End DoDot:3
+10 QUIT
End DoDot:2
+11 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("SCRPW",$JOB,SDIV,0,DFN))
if 'DFN
QUIT
SET SDFV=1
SET SDT=""
FOR
SET SDT=$ORDER(^TMP("SCRPW",$JOB,SDIV,0,DFN,SDT),-1)
if SDT=""
QUIT
SET SDMT=^TMP("SCRPW",$JOB,SDIV,0,DFN,SDT)
DO S1(SDMT)
SET SDFV=0
+12 SET SDMT=0
FOR
SET SDMT=$ORDER(^TMP("SCRPW",$JOB,SDIV,SDMT))
if SDMT=""
QUIT
Begin DoDot:2
+13 IF '$GET(^TMP("SCRPW",$JOB,SDIV,SDMT,"TOTAL"))
SET (^TMP("SCRPW",$JOB,SDIV,SDMT,"TOTAL"),^TMP("SCRPW",$JOB,SDIV,SDMT,"AVERAGE AGE"))=0
QUIT
+14 SET ^TMP("SCRPW",$JOB,SDIV,SDMT,"AVERAGE AGE")=^TMP("SCRPW",$JOB,SDIV,SDMT,"AVERAGE AGE")\^TMP("SCRPW",$JOB,SDIV,SDMT,"TOTAL")
+15 QUIT
End DoDot:2
+16 DO AA(SDIV)
QUIT
End DoDot:1
+17 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)="<*> MEANS TEST SUMMARY OF VISITS & UNIQUES "_$SELECT(SDSTA=8:"(IP3, IP4, IP5)",1:"(OP3, OP4, OP5)")_" <*>"
SET SDPG=0
+18 if $EXTRACT(IOST)="C"
DO DISP0^SCRPW23
+19 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
+20 if SDOUT
GOTO EXIT
SET SDIVN=""
FOR
SET SDIVN=$ORDER(SDIV(SDIVN))
if SDIVN=""!SDOUT
QUIT
DO DPRT(SDIV(SDIVN))
+21 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,DFN,DIR,SD,SDAGE,SDDIV,SDFAA,SDFTOT,SDFV,SDH,SDI,SDIV,SDIVN,SDLAB,SDLINE,SDLT,SDMD,SDMO,SDMOTO,SDMT,SDOE,SDOE0,SDSTA
+2 KILL SDPAGE,SDOUT,SDPATE,SDPG,SDPNOW,SDPT0,SDR,SDSC,SDSTOP,SDT,SDTIT,SDTOT,SDV,SDVCT,SDX,SDYR,SDYRTO,X,Y
QUIT
+3 ;
AA(SDIV) ;Average age
+1 IF '$GET(SDFTOT(SDIV))
SET (SDFAA(SDIV),SDFTOT(SDIV))=0
QUIT
+2 SET SDFAA(SDIV)=SDFAA(SDIV)\SDFTOT(SDIV)
QUIT
+3 ;
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(1)
if SDOUT
QUIT
SET SDSC=0
DO PLINE1(1)
if SDOUT
QUIT
+7 WRITE !
if $Y>(IOSL-8)
DO HDR
if SDOUT
QUIT
DO HD1(2)
DO PLINE1(2)
if SDOUT
QUIT
+8 WRITE !
if $Y>(IOSL-8)
DO HDR
if SDOUT
QUIT
DO HD2
+9 FOR SDLT="MALE","FEMALE","TOTAL","POW STATUS","AVERAGE AGE","UNDER 24","25 - 34","35 - 44","45 - 54","55 - 64","65 - 74","75 - 84","85 - 94","95 & ABOVE"
DO PLINE2(SDLT)
if SDOUT
QUIT
+10 QUIT
+11 ;
PLINE1(SDH) ;Print output line
+1 ;Required input: SDH=subheader number
+2 SET (SDMOTO,SDYRTO)=0
+3 ;D PL("CATEGORY A SERVICE CONNECTED","AS") Q:SDOUT
+4 DO PL("SC - MT COPAY EXEMPT","AS")
if SDOUT
QUIT
+5 ;D PL("CATEGORY A NON-SERVICE CONNECTED","AN") Q:SDOUT
+6 DO PL("NSC - MT COPAY EXEMPT","AN")
if SDOUT
QUIT
+7 ;D PL("TOTAL CATEGORY A MEANS TEST","TA") Q:SDOUT
+8 DO PL("TOTAL MT COPAY EXEMPT","TA")
if SDOUT
QUIT
+9 ;D PL("CATEGORY C","C") Q:SDOUT
+10 DO PL("MT COPAY REQUIRED","C")
if SDOUT
QUIT
+11 DO PL("GMT COPAY REQUIRED","G")
if SDOUT
QUIT
+12 DO PL("NON VETERAN","N")
if SDOUT
QUIT
+13 DO PL("NON APPLICABLE","X")
if SDOUT
QUIT
+14 SET SDX="CURRENT MONTH % OF YEAR TO DATE TOTALS: "_$SELECT('SDYRTO:0,1:SDMOTO*100\SDYRTO)_"%"
WRITE !!?(132-$LENGTH(SDX)\2),SDX
+15 QUIT
+16 ;
PL(SDLAB,SDMT) ;Print line
+1 IF $Y>(IOSL-4)
DO HDR
if SDOUT
QUIT
DO HD1(SDH)
+2 SET SDMO=+$GET(^TMP("SCRPW",$JOB,SDV,SDMT,$SELECT(SDH=1:"MOVIS",1:"MOTOT")))
+3 SET SDYR=+$GET(^TMP("SCRPW",$JOB,SDV,SDMT,$SELECT(SDH=1:"VIS",1:"TOTAL")))
+4 SET SDMOTO=SDMOTO+SDMO
SET SDYRTO=SDYRTO+SDYR
+5 WRITE !?18,$JUSTIFY(SDLAB_":",33),?54,$JUSTIFY(SDMO,9,0),?69,$JUSTIFY(SDLAB_":",33),?105,$JUSTIFY(SDYR,9,0)
+6 QUIT
+7 ;
PLINE2(SDLT) ;Print output line
+1 ;Required input: SDLT=output line tag
+2 IF $Y>(IOSL-4)
DO HDR
if SDOUT
QUIT
DO HD2
+3 WRITE !?6,$JUSTIFY(SDLT_":",12)
SET (SDTOT,SDI)=0
FOR SDMT="AS","AN","TA","C","G","N","X"
SET SDX=+$GET(^TMP("SCRPW",$JOB,SDV,SDMT,SDLT))
WRITE ?(20+(12*SDI)),$JUSTIFY(SDX,10,0)
SET SDI=SDI+1
if SDI'=3
SET SDTOT=SDTOT+SDX
+4 if SDLT="AVERAGE AGE"
SET SDTOT=SDFAA(SDV)
WRITE ?104,$JUSTIFY(SDTOT,10,0)
QUIT
+5 ;
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(SDR) ;Print subheader
+1 if SDOUT
QUIT
SET SDX="**** MEANS TEST VISIT SUMMARY"_$SELECT(SDR=2:" (UNIQUE SSNS BASED ON LATEST VISIT)",1:"")_" ****"
WRITE !!?(132-$LENGTH(SDX)\2),$EXTRACT(SDLINE,1,$LENGTH(SDX)),!?(132-$LENGTH(SDX)\2),SDX,!?(132-$LENGTH(SDX)\2),$EXTRACT(SDLINE,1,$LENGTH(SDX))
+2 SET SDX="CURRENT MONTH MEANS TEST "_$SELECT(SDR=1:"VISITS",1:"UNIQUES")
WRITE !!?18,$JUSTIFY(SDX_":",33),?58,"TOTAL"
+3 SET SDX="YEAR TO DATE MEANS TEST "_$SELECT(SDR=1:"VISITS",1:"UNIQUES")
WRITE ?69,$JUSTIFY(SDX_":",33),?109,"TOTAL",!?18,$EXTRACT(SDLINE,1,45),?69,$EXTRACT(SDLINE,1,45)
+4 QUIT
+5 ;
HD2 ;Print subheader
+1 if SDOUT
QUIT
SET SDX="**** MEANS TEST UNIQUES BY GENDER, POW STATUS AND AGE ****"
WRITE !!?(132-$LENGTH(SDX)\2),$EXTRACT(SDLINE,1,$LENGTH(SDX)),!?(132-$LENGTH(SDX)\2),SDX,!?(132-$LENGTH(SDX)\2),$EXTRACT(SDLINE,1,$LENGTH(SDX))
+2 WRITE !?24,"SC",?35,"NSC",?45,"TOTAL"
+3 WRITE !?20,"MT COPAY",?32,"MT COPAY",?44,"MT COPAY",?56,"MT COPAY",?68,"GMT COPAY",?87,"NON",?99,"NOT",?109,"GRAND"
+4 WRITE !?10,"UNIQUES:",?21,"EXEMPT",?33,"EXEMPT",?45,"EXEMPT",?56,"REQUIRED",?68,"REQUIRED",?83,"VETERAN",?92,"APPLICABLE",?109,"TOTAL"
+5 WRITE !?6,$EXTRACT(SDLINE,1,12)
FOR SDI=0:1:7
WRITE ?(20+(12*SDI)),$EXTRACT(SDLINE,1,10)
+6 QUIT
+7 ;
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 ;
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)
IF $PIECE(SDOE0,U,2)
IF '$PIECE(SDOE0,U,6)
IF $PIECE(SDOE0,U,7)
IF $PIECE(SDOE0,U,12)=SDSTA
IF $PIECE(SDOE0,U,10)
IF $PIECE(SDOE0,U,13)
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#3000=0
DO STOP^SCRPW40
if SDOUT
QUIT
+3 SET SDMT=$$MTI^SCDXUTL0(DFN,$PIECE(SDOE0,U),$PIECE(SDOE0,U,13),$PIECE(SDOE0,U,10),SDOE)
if SDMT="U"
QUIT
SET ^TMP("SCRPW",$JOB,SDIV,SDMT,DFN,$PIECE(SDT,"."))=""
+4 QUIT
+5 ;
S1(SDMT) SET ^TMP("SCRPW",$JOB,SDIV,SDMT,"VIS")=$GET(^TMP("SCRPW",$JOB,SDIV,SDMT,"VIS"))+1
+1 if SDT>SD("MOD")
SET ^TMP("SCRPW",$JOB,SDIV,SDMT,"MOVIS")=$GET(^TMP("SCRPW",$JOB,SDIV,SDMT,"MOVIS"))+1
+2 if (SDMT="AN"!(SDMT="AS"))
DO S1("TA")
if 'SDFV
QUIT
+3 SET SDPT0=$GET(^DPT(DFN,0))
SET SDX=$$SEX()_U_"TOTAL"_U_$$AGE()_$$POW()_$$MOT()
+4 FOR SDI=1:1:$LENGTH(SDX,U)
SET ^TMP("SCRPW",$JOB,SDIV,SDMT,$PIECE(SDX,U,SDI))=$GET(^TMP("SCRPW",$JOB,SDIV,SDMT,$PIECE(SDX,U,SDI)))+1
+5 QUIT
+6 ;
MOT() QUIT $SELECT(SDT>SD("MOD"):"^MOTOT",1:"")
+1 ;
SEX() QUIT $SELECT($PIECE(SDPT0,U,2)="M":"MALE",1:"FEMALE")
+1 ;
POW() QUIT $SELECT($PIECE($GET(^DPT(DFN,.52)),U,5)="Y":"^POW STATUS",1:"")
+1 ;
AGE() SET SDAGE=$PIECE(SDPT0,U,3)
SET SDAGE=$EXTRACT(SDT,1,3)-$EXTRACT(SDAGE,1,3)-($EXTRACT(SDT,4,7)<$EXTRACT(SDAGE,4,7))
SET ^TMP("SCRPW",$JOB,SDIV,SDMT,"AVERAGE AGE")=$GET(^TMP("SCRPW",$JOB,SDIV,SDMT,"AVERAGE AGE"))+SDAGE
+1 IF SDMT'="TA"
SET SDFAA(SDIV)=$GET(SDFAA(SDIV))+SDAGE
SET SDFTOT(SDIV)=$GET(SDFTOT(SDIV))+1
+2 QUIT $SELECT(SDAGE<25:"UNDER 24",SDAGE<35:"25 - 34",SDAGE<45:"35 - 44",SDAGE<55:"45 - 54",SDAGE<65:"55 - 64",SDAGE<75:"65 - 74",SDAGE<85:"75 - 84",SDAGE<95:"85 - 94",1:"95 & ABOVE")
