Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPW42

SCRPW42.m

Go to the documentation of this file. 
  1. SCRPW42 ;RENO/KEITH - Veterans Without Activity Since a Specified Date Range (cont.) ; 5/25/2004
  1.  ;;5.3;Scheduling;**144,176,375**;AUG 13, 1993
  1.  D:$E(IOST)="C" DISP0^SCRPW23 D HDR G:SDOUT EXIT D PRT0 G:SDOUT EXIT W !!,"REPORT TOTAL: ",SDT(0)
  1.  I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
  1. 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
  1.  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
  1.  ;
  1. HDR ;Print report header
  1.  I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT
  1.  D STOP Q:SDOUT  W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0)
  1.  W:$X $$XY^SCRPW50("",0,0)
  1.  W SDLINE,!?34,"<*>  VETERANS WITHOUT ACTIVITY SINCE A SPECIFIED DATE RANGE  <*>",!,SDLINE
  1.  W:SDFEE'="" !,?40,"****",SDFEE,"****"
  1.  W !,"Last activity date range: ",SD("PBDT")," to ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(126-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q
  1.  ;
  1. 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
  1.  ;
  1. STOP ;Check for stop task request
  1.  S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
  1.  ;
  1. DSV(S1,S2,S3,S4) ;Produce detail sort value
  1.  ;Required input: S1, S2, S3, S4=subscript values
  1.  N SDX S SDX=$G(^TMP("SCRPW",$J,3,S1,S2,S3,S4)) Q:SDX SDX
  1.  S (SDX,^TMP("SCRPW",$J,3,0))=$G(^TMP("SCRPW",$J,3,0))+1
  1.  S ^TMP("SCRPW",$J,3,S1,S2,S3,S4)=SDX Q SDX
  1.  ;
  1. PRT0 ;Print 0 sorts
  1.  I '$D(^TMP("SCRPW",$J,1)) W !!,"No patients found that meet the report criteria!" S SDOUT=1 Q
  1.  S SDT(0)=0 I SD("SORT") D PRT1 Q
  1.  D SHD(0),HD2 S SDPNAM=""
  1.  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)
  1.  Q
  1.  ;
  1. PRT1 ;Print 1 sort
  1.  S S1="" F  S S1=$O(^TMP("SCRPW",$J,1,S1)) Q:S1=""!SDOUT  D
  1.  .S SDT(1)=0 D:SD("PAGE")=1&SDPG HDR Q:SDOUT
  1.  .I SD("SORT")=1 D PRT11 Q
  1.  .D PRT2,SST(1) Q
  1.  Q
  1.  ;
  1. PRT2 ;Print 2 sorts
  1.  S S2="" F  S S2=$O(^TMP("SCRPW",$J,1,S1,S2)) Q:S2=""!SDOUT  D
  1.  .S SDT(2)=0 D:SD("PAGE")=2&SDPG HDR Q:SDOUT
  1.  .I SD("SORT")=2 D PRT21 Q
  1.  .D PRT3,SST(2) Q
  1.  Q
  1.  ;
  1. PRT3 ;Print 3 sorts
  1.  S S3="" F  S S3=$O(^TMP("SCRPW",$J,1,S1,S2,S3)) Q:S3=""!SDOUT  D
  1.  .S SDT(3)=0 D:SD("PAGE")=3&SDPG HDR Q:SDOUT
  1.  .I SD("SORT")=3 D PRT31 Q
  1.  .D PRT4,SST(3) Q
  1.  Q
  1.  ;
  1. PRT4 ;Print 4 sorts
  1.  S S4="" F  S S4=$O(^TMP("SCRPW",$J,1,S1,S2,S3,S4)) Q:S4=""!SDOUT  D
  1.  .S SDUI=$$DSV(S1,S2,S3,S4)
  1.  .S SDT(4)=0 D:SD("PAGE")=4&SDPG HDR Q:SDOUT
  1.  .I SD("SORT")=4 D PRT41 Q
  1.  .D PRT5,SST(4) Q
  1.  Q
  1.  ;
  1. PRT5 ;Print 5 sorts
  1.  S S5="" F  S S5=$O(^TMP("SCRPW",$J,2,SDUI,S5)) Q:S5=""!SDOUT  D
  1.  .S SDT(5)=0 D:SD("PAGE")=5&SDPG HDR Q:SDOUT
  1.  .I SD("SORT")=5 D PRT51 Q
  1.  .D PRT6,SST(5) Q
  1.  Q
  1.  ;
  1. PRT6 ;Print 6 sorts
  1.  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
  1.  Q
  1.  ;
  1. PRT11 D SHD(1),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(1) Q
  1.  ;
  1. PRT21 D SHD(2),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(2) Q
  1.  ;
  1. PRT31 D SHD(3),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(3) Q
  1.  ;
  1. PRT41 D SHD(4),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(4) Q
  1.  ;
  1. PRT51 D SHD(5),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(5) Q
  1.  ;
  1. PRT61 D SHD(6),HD2 S SDPNAM=""
  1.  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)
  1.  W ! D SST(6) Q
  1.  ;
  1. SHD(SDLEV) ;Print sort subheaders
  1.  ;Required input: SDLEV=number of sort levels
  1.  Q:SDOUT
  1.  I $Y>(IOSL-SDLEV-6) D HDR S SDPG=0 Q:SDOUT
  1.  W:(SD("PAGE")'=SD("SORT")&SDPG) !!,SDLINE S SDPG=1
  1.  I SD("SORT") W ! N SDI S SDI=0 D  W !
  1.  .F  S SDI=$O(SD("SORT",SDI)) Q:'SDI  W !?(5*SDI),$P(SD("SORT",SDI),U,2),": ",@("S"_SDI)
  1.  .Q
  1.  Q
  1.  ;
  1. PLINE(SDLEV) ;Print detail line
  1.  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)
  1.  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)
  1.  N SDI F SDI=0:1:SDLEV S SDT(SDI)=SDT(SDI)+1
  1.  Q
  1.  ;
  1. SST(SDLEV) ;Print sort subtotal
  1.  D:$Y>(IOSL-3) HDR Q:SDOUT
  1.  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
  1.  ;
  1. S44 ;Print 'Means Test/Eligibility/Enrollment Report'
  1.  F SDX="MTP","EEP","EPP" S SDIV="" D
  1.  .F  S SDIV=$O(^TMP("SCRPW",$J,0,SDIV)) Q:SDIV=""  S SDZ="" D
  1.  ..F  S SDZ=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ)) Q:SDZ=""  S (SDTU,SDTV,DFN)=0 D
  1.  ...F  S DFN=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ,DFN)) Q:'DFN  S SDTU=SDTU+1,SDT=0 D
  1.  ....F  S SDT=$O(^TMP("SCRPW",$J,0,SDIV,SDX,SDZ,DFN,SDT)) Q:'SDT  S SDTV=SDTV+1
  1.  ....Q
  1.  ...S $P(^TMP("SCRPW",$J,0,SDIV,$E(SDX,1,2),SDZ,"ENC"),U,2)=SDTV_U_SDTU Q
  1.  ..Q
  1.  .Q
  1.  S SDIV="" F  S SDIV=$O(^TMP("SCRPW",$J,0,SDIV)) Q:SDIV=""  S (SDTU,SDTV)=0 D
  1.  .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
  1.  .S $P(^TMP("SCRPW",$J,0,SDIV,"RPT","ENC"),U,2)=SDTV_U_SDTU Q
  1.  .Q
  1.  D STOP G:SDOUT EXIT1
  1.  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
  1.  .I $P(SDDIV,U,2)="SELECTED DIVISIONS" D  Q
  1.  ..S SDI=0 F  S SDI=$O(SDDIV(SDI)) Q:'SDI  S SDIV(SDDIV(SDI))=SDI
  1.  ..Q
  1.  .I $P(SDDIV,U,2)="ALL DIVISIONS" D  Q
  1.  ..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
  1.  ..Q
  1.  .S SDIV($P(SDDIV,U,2))=$P(SDDIV,U) Q
  1.  I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
  1.  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)
  1.  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)
  1.  I $E(IOST)="C",'SDOUT W ! N DIR S DIR(0)="E" D ^DIR
  1. 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
  1.  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
  1.  K SDT,SDTIT,SDTU,SDTV,SDU,SDV,SDX,SDY,SDZ,T,X,Y Q