SCRPW42 ;RENO/KEITH - Veterans Without Activity Since a Specified Date Range (cont.) ; 5/25/2004
 ;;5.3;Scheduling;**144,176,375**;AUG 13, 1993
 D:$E(IOST)="C" DISP0^SCRPW23 D HDR G:SDOUT EXIT D PRT0 G:SDOUT EXIT W !!,"REPORT TOTAL: ",SDT(0)
 I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
EXIT D END^SCRPW50,KVA^VADPT K %,%H,%I,%DT,D0,DFN,DG1,DGA1,DGT,DGXFR0,DIR,DTOUT,DUOUT,S1,S2,S3,S4,S5,S6,SD,SD0,SDACR,SDUI
 K SDACT,SDBD,SDDT,SDED,SDI,SDL,SDLINE,SDMTS,SDNOW,SDNUL,SDOE0,SDOUT,SDPAGE,SDPG,SDPNAM,SDPNOW,SDS,SDSSN,SDSTOP,SDT,SDTOT,SDX,SDY,SDZ,T,X,Y,SDFEE Q
 ;
HDR ;Print report header
 I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
 D STOP Q:SDOUT  W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0)
 W:$X $$XY^SCRPW50("",0,0)
 W SDLINE,!?34,"<*>  VETERANS WITHOUT ACTIVITY SINCE A SPECIFIED DATE RANGE  <*>",!,SDLINE
 W:SDFEE'="" !,?40,"****",SDFEE,"****"
 W !,"Last activity date range: ",SD("PBDT")," to ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(126-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
 ;
HD2 Q:SDOUT  D:$Y>(IOSL-4) HDR Q:SDOUT  W !,"Patient:",?26,"SSN:",?38,"Last activity:",?57,"Location:",?86,"Means Test:",?102,"Primary eligibility:" Q
 ;
STOP ;Check for stop task request
 S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
 ;
DSV(S1,S2,S3,S4) ;Produce detail sort value
 ;Required input: S1, S2, S3, S4=subscript values
 N SDX S SDX=$G(^TMP("SCRPW",$J,3,S1,S2,S3,S4)) Q:SDX SDX
 S (SDX,^TMP("SCRPW",$J,3,0))=$G(^TMP("SCRPW",$J,3,0))+1
 S ^TMP("SCRPW",$J,3,S1,S2,S3,S4)=SDX Q SDX
 ;
PRT0 ;Print 0 sorts
 I '$D(^TMP("SCRPW",$J,1)) W !!,"No patients found that meet the report criteria!" S SDOUT=1 Q
 S SDT(0)=0 I SD("SORT") D PRT1 Q
 D SHD(0),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,1,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,1,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,1,SDPNAM,DFN) D PLINE(0)
 Q
 ;
PRT1 ;Print 1 sort
 S S1="" F  S S1=$O(^TMP("SCRPW",$J,1,S1)) Q:S1=""!SDOUT  D
 .S SDT(1)=0 D:SD("PAGE")=1&SDPG HDR Q:SDOUT
 .I SD("SORT")=1 D PRT11 Q
 .D PRT2,SST(1) Q
 Q
 ;
PRT2 ;Print 2 sorts
 S S2="" F  S S2=$O(^TMP("SCRPW",$J,1,S1,S2)) Q:S2=""!SDOUT  D
 .S SDT(2)=0 D:SD("PAGE")=2&SDPG HDR Q:SDOUT
 .I SD("SORT")=2 D PRT21 Q
 .D PRT3,SST(2) Q
 Q
 ;
PRT3 ;Print 3 sorts
 S S3="" F  S S3=$O(^TMP("SCRPW",$J,1,S1,S2,S3)) Q:S3=""!SDOUT  D
 .S SDT(3)=0 D:SD("PAGE")=3&SDPG HDR Q:SDOUT
 .I SD("SORT")=3 D PRT31 Q
 .D PRT4,SST(3) Q
 Q
 ;
PRT4 ;Print 4 sorts
 S S4="" F  S S4=$O(^TMP("SCRPW",$J,1,S1,S2,S3,S4)) Q:S4=""!SDOUT  D
 .S SDUI=$$DSV(S1,S2,S3,S4)
 .S SDT(4)=0 D:SD("PAGE")=4&SDPG HDR Q:SDOUT
 .I SD("SORT")=4 D PRT41 Q
 .D PRT5,SST(4) Q
 Q
 ;
PRT5 ;Print 5 sorts
 S S5="" F  S S5=$O(^TMP("SCRPW",$J,2,SDUI,S5)) Q:S5=""!SDOUT  D
 .S SDT(5)=0 D:SD("PAGE")=5&SDPG HDR Q:SDOUT
 .I SD("SORT")=5 D PRT51 Q
 .D PRT6,SST(5) Q
 Q
 ;
PRT6 ;Print 6 sorts
 S S6="" F  S S6=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6)) Q:S6=""!SDOUT  S SDT(6)=0 D:SD("PAGE")=6&SDPG HDR Q:SDOUT  D PRT61
 Q
 ;
PRT11 D SHD(1),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,1,S1,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,1,S1,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,1,S1,SDPNAM,DFN) D PLINE(1)
 W ! D SST(1) Q
 ;
PRT21 D SHD(2),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,1,S1,S2,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,1,S1,S2,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,1,S1,S2,SDPNAM,DFN) D PLINE(2)
 W ! D SST(2) Q
 ;
PRT31 D SHD(3),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,1,S1,S2,S3,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,1,S1,S2,S3,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,1,S1,S2,S3,SDPNAM,DFN) D PLINE(3)
 W ! D SST(3) Q
 ;
PRT41 D SHD(4),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN) D PLINE(4)
 W ! D SST(4) Q
 ;
PRT51 D SHD(5),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,2,SDUI,S5,SDPNAM,DFN) D PLINE(5)
 W ! D SST(5) Q
 ;
PRT61 D SHD(6),HD2 S SDPNAM=""
 F  S SDPNAM=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM)) Q:SDPNAM=""!SDOUT  S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM,DFN)) Q:'DFN!SDOUT  S SDX=^TMP("SCRPW",$J,2,SDUI,S5,S6,SDPNAM,DFN) D PLINE(6)
 W ! D SST(6) Q
 ;
SHD(SDLEV) ;Print sort subheaders
 ;Required input: SDLEV=number of sort levels
 Q:SDOUT
 I $Y>(IOSL-SDLEV-6) D HDR S SDPG=0 Q:SDOUT
 W:(SD("PAGE")'=SD("SORT")&SDPG) !!,SDLINE S SDPG=1
 I SD("SORT") W ! N SDI S SDI=0 D  W !
 .F  S SDI=$O(SD("SORT",SDI)) Q:'SDI  W !?(5*SDI),$P(SD("SORT",SDI),U,2),": ",@("S"_SDI)
 .Q
 Q
 ;
PLINE(SDLEV) ;Print detail line
 D:$Y>(IOSL-3) HDR,HD2 Q:SDOUT  D ELIG^VADPT S SDMTS=$P(VAEL(9),U,2),SDMTS=$S($L(SDMTS)>13:$E(SDMTS,1,13)_".",1:SDMTS)
 W !,$E(SDPNAM,1,24),?26,$P(SDX,U) S Y=$P(SDX,U,2) X ^DD("DD") W ?38,$P(Y,":",1,2),?57,$E($P(SDX,U,3),1,27),?86,SDMTS,?102,$P(VAEL(1),U,2)
 N SDI F SDI=0:1:SDLEV S SDT(SDI)=SDT(SDI)+1
 Q
 ;
SST(SDLEV) ;Print sort subtotal
 D:$Y>(IOSL-3) HDR Q:SDOUT
 W !?(5*SDLEV),"SUBTOTAL: ",SDT(SDLEV),"  " S SDX=$P(SD("SORT",SDLEV),U,2)_" = "_@("S"_SDLEV),SDX=$E(SDX,1,(130-$X)) W "(",SDX,")" Q
 ;
S44 ;Print 'Means Test/Eligibility/Enrollment Report'
 F SDX="MTP","EEP","EPP" S SDIV="" D
 .F  S SDIV=$O(^TMP("SCRPW",$J,0,SDIV)) Q:SDIV=""  S SDZ="" D
 ..F  S SDZ=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ)) Q:SDZ=""  S (SDTU,SDTV,DFN)=0 D
 ...F  S DFN=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ,DFN)) Q:'DFN  S SDTU=SDTU+1,SDT=0 D
 ....F  S SDT=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ,DFN,SDT)) Q:'SDT  S SDTV=SDTV+1
 ....Q
 ...S $P(^TMP("SCRPW",$J,0,SDIV,$E(SDX,1,2),SDZ,"ENC"),U,2)=SDTV_U_SDTU Q
 ..Q
 .Q
 S SDIV="" F  S SDIV=$O(^TMP("SCRPW",$J,0,SDIV)) Q:SDIV=""  S (SDTU,SDTV)=0 D
 .S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,0,SDIV,"RPT",DFN)) Q:'DFN  S SDTU=SDTU+1,SDT=0 F  S SDT=$O(^TMP("SCRPW",$J,0,SDIV,"RPT",DFN,SDT)) Q:'SDT  S SDTV=SDTV+1
 .S $P(^TMP("SCRPW",$J,0,SDIV,"RPT","ENC"),U,2)=SDTV_U_SDTU Q
 .Q
 D STOP G:SDOUT EXIT1
 S SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDPG=0 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDTIT(1)="<*>  MEANS TEST/ELIGIBILITY/ENROLLMENT REPORT  <*>" D
 .I $P(SDDIV,U,2)="SELECTED DIVISIONS" D  Q
 ..S SDI=0 F  S SDI=$O(SDDIV(SDI)) Q:'SDI  S SDIV(SDDIV(SDI))=SDI
 ..Q
 .I $P(SDDIV,U,2)="ALL DIVISIONS" D  Q
 ..S SDI=0 F  S SDI=$O(^TMP("SCRPW",$J,0,SDI)) Q:'SDI  S SDX=$P($G(^DG(40.8,SDI,0)),U) S:'$L(SDX) SDX="***UNKNOWN***" S SDIV(SDX)=SDI
 ..Q
 .S SDIV($P(SDDIV,U,2))=$P(SDDIV,U) Q
 I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
 D:$E(IOST)="C" DISP0^SCRPW23 S C=(IOM-80\2),SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  S SDIV=SDIV(SDIVN) D DPRT^SCRPW44(.SDIV)
 G:SDOUT EXIT1 S SDMD=$O(^TMP("SCRPW",$J,0,0)),SDMD=$O(^TMP("SCRPW",$J,0,SDMD)) I SDMD S SDIV=0 D DPRT^SCRPW44(.SDIV)
 I $E(IOST)="C",'SDOUT W ! N DIR S DIR(0)="E" D ^DIR
EXIT1 D END^SCRPW50,KVA^VADPT K %,%DT,C,DFN,DIC,DIR,DTOUT,DUOUT,I,S0,S1,S2,S3,S4,S5,S6,SD,SD0,SDACR,SDACT,SDDIV,SDE,SDEL,SDEP,SDUI
 K SDI,SDII,SDIV,SDIVN,SDL,SDL1,SDLEV,SDLF,SDLINE,SDMD,SDMT,SDMTS,SDNUL,SDOE,SDOE0,SDOUT,SDP,SDPAGE,SDPG,SDPGL,SDPNAM,SDPNOW,SDS,SDSSN,SDSTOP
 K SDT,SDTIT,SDTU,SDTV,SDU,SDV,SDX,SDY,SDZ,T,X,Y Q