- 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 Feb 19, 2025@00:10:18 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")