DGDEP2 ;ALB/CAW,JAN - Dependent Utilities ; 4/4/06 9:30am
;;5.3;Registration;**45,60,395,624,688**;Aug 13, 1993;Build 29
;624: DGMTDPCH=flag to force recalc of adj med exp when deps change
;
EN1 ; Add dependent to means test
;
N DGSAVE,DGMTD,DGSAVE1
I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G EN1Q
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN1Q
S VALMBCK="",DGSAVE=VALMLST,DGSAVE1=VALMBG
S VALMBG=1,VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE G EN1Q:'$O(VALMY(0))
N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
. D ADD(DFN,DGDEP(CTR),$G(DGMTI))
S DGMTD=$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT)
D ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
K DGDEP D INIT^DGDEP
S DGMTDPCH=1
EN1Q S VALMBCK="R" Q
;
ADD(DFN,DGDEP,DGMTI) ;Add
N DA,DR,DIE,DGMTD,DGIRI
I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G ADDQ
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." G ADDQ
S DGMTR=$O(^DG(408.11,"B",$P(DGDEP,U,2),"")) I '$P(^DG(408.11,DGMTR,0),U,4) D G ADDQ
. W !,"Cannot add a "_$P(DGDEP,U,2)_" as a dependent to the means test." H 2
S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
D GETIENS^DGMTU2(DFN,$P(DGDEP,U,20),DGMTD)
S DA=DGIRI
S DIE="^DGMT(408.22,",DR="31////"_DGMTI
D ^DIE
S DGMTDPCH=1
ADDQ Q
;
EN2 ; Remove dependent from means test
;
N DGSAVE1,DGSAVE2,DGMTD
I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G EN2Q
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN2Q
S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=2
S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EN1Q:'$O(VALMY(0))
N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
. D REMOVE(DFN,DGDEP(CTR),$G(DGMTI))
S DGMTD=$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT)
D ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
S DGMTDPCH=1
EN2Q S VALMBCK="R" Q
;
REMOVE(DFN,DGDEP,DGMTI) ;Remove
N DA,DR,DIE,DGMTD
I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G REMOVEQ
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN2Q
S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
D GETIENS^DGMTU2(DFN,$P(DGDEP,U,20),DGMTD)
S DA=DGIRI
S DIE="^DGMT(408.22,",DR="31////@"
D ^DIE S DGREMOVE=1
K DGDEP D INIT^DGDEP
S DGMTDPCH=1
REMOVEQ K DGREMOVE Q
;
EN3 ; Edit dependent demo
;
S VALMBCK=""
N DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN3Q
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G EN3Q
S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=1
S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EN1Q:'$O(VALMY(0))
N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
. D EDITD(DFN,DGDEP(CTR),CTR,$G(DGMTI))
S VALMBCK="R"
K DGDEP D INIT^DGDEP
EN3Q Q
;
EDITD(DFN,DGDEP,DGW,DGMTI) ; Edit
N DA,DR,DIE,DGMTDT,SPOUSE,DGREL,DGDR,CNT,RELATION,MTVER
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EDITDQ
W !!,$P(DGDEP,U)
I '$G(DGMTI),$P(DGDEP,U,2)="SELF" D G EDITDQ
. S DGREL("V")=$P(DGDEP,U,20) D SPOUSE^DGRPEIS2
I '$G(DGMTI) W !,"Can only input information for veteran." H 2 G EN3Q
S DGMTDT=$P(^DGMT(408.31,DGMTI,0),U)
S MTVER=$P($G(^DGMT(408.31,DGMTI,2)),U,11)
I $P(DGDEP,U,2)="SPOUSE" W !,"Married information is entered under the veteran." H 2 G EDITDQ
I $P(DGDEP,U,2)="SELF" D G EDITDQ
. S DGDR=101
. D GETREL^DGMTU11(DFN,"S",$$LYR^DGMTSCU1($S($G(DGMTDT):DGMTDT,1:DT)))
. D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) S DGVIRI=DGIRI
. I DGVIRI<0 W !,"No information in Income Relation file." H 2 G EDITDQ
. S DA=DGVIRI,DIE="^DGMT(408.22,",DR="[DGMT ENTER/EDIT MARITAL STATUS]" D ^DIE K DA,DIE,DR
. I $G(DGMTI),$G(DGREL("S")) D
. . S SPOUSE=+DGREL("S")
. . D INIT^DGDEP
. . S CNT=0 F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,20)=SPOUSE D ADD(DFN,DGDEP(CNT),DGMTI)
S RELATION=$O(^DG(408.11,"B",$P(DGDEP,U,2),""))
I '$P(^DG(408.11,+RELATION,0),U,4) W !,"Not applicable for means test" H 2 G EDITDQ
S DGPRI=$P(DGDEP,U,20)
D EDTV1^DGMTSC11(MTVER)
I $G(DGFL)'<0 D ADD(DFN,DGDEP,DGMTI)
EDITDQ ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGDEP2 4227 printed Apr 09, 2024@21:46:51 Page 2
DGDEP2 ;ALB/CAW,JAN - Dependent Utilities ; 4/4/06 9:30am
+1 ;;5.3;Registration;**45,60,395,624,688**;Aug 13, 1993;Build 29
+2 ;624: DGMTDPCH=flag to force recalc of adj med exp when deps change
+3 ;
EN1 ; Add dependent to means test
+1 ;
+2 NEW DGSAVE,DGMTD,DGSAVE1
+3 IF '$GET(DGMTI)
WRITE !,"Not a means test - use means test options."
HANG 2
GOTO EN1Q
+4 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO EN1Q
+5 SET VALMBCK=""
SET DGSAVE=VALMLST
SET DGSAVE1=VALMBG
+6 SET VALMBG=1
SET VALMLST=DGCNT
DO SEL^VALM2
SET VALMBG=DGSAVE1
SET VALMLST=DGSAVE
if '$ORDER(VALMY(0))
GOTO EN1Q
+7 NEW CTR
SET CTR=0
FOR
SET CTR=$ORDER(VALMY(CTR))
if 'CTR
QUIT
Begin DoDot:1
+8 DO ADD(DFN,DGDEP(CTR),$GET(DGMTI))
End DoDot:1
+9 SET DGMTD=$SELECT($GET(DGMTI):$PIECE(^DGMT(408.31,DGMTI,0),U),1:DT)
+10 DO ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
+11 KILL DGDEP
DO INIT^DGDEP
+12 SET DGMTDPCH=1
EN1Q SET VALMBCK="R"
QUIT
+1 ;
ADD(DFN,DGDEP,DGMTI) ;Add
+1 NEW DA,DR,DIE,DGMTD,DGIRI
+2 IF '$GET(DGMTI)
WRITE !,"Not a means test - use means test options."
HANG 2
GOTO ADDQ
+3 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
GOTO ADDQ
+4 SET DGMTR=$ORDER(^DG(408.11,"B",$PIECE(DGDEP,U,2),""))
IF '$PIECE(^DG(408.11,DGMTR,0),U,4)
Begin DoDot:1
+5 WRITE !,"Cannot add a "_$PIECE(DGDEP,U,2)_" as a dependent to the means test."
HANG 2
End DoDot:1
GOTO ADDQ
+6 SET DGMTD=$SELECT($GET(DGMTI):$PIECE($GET(^DGMT(408.31,DGMTI,0)),U),1:DT)
+7 DO GETIENS^DGMTU2(DFN,$PIECE(DGDEP,U,20),DGMTD)
+8 SET DA=DGIRI
+9 SET DIE="^DGMT(408.22,"
SET DR="31////"_DGMTI
+10 DO ^DIE
+11 SET DGMTDPCH=1
ADDQ QUIT
+1 ;
EN2 ; Remove dependent from means test
+1 ;
+2 NEW DGSAVE1,DGSAVE2,DGMTD
+3 IF '$GET(DGMTI)
WRITE !,"Not a means test - use means test options."
HANG 2
GOTO EN2Q
+4 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO EN2Q
+5 SET VALMBCK=""
SET DGSAVE1=VALMBG
SET DGSAVE2=VALMLST
SET VALMBG=2
+6 SET VALMLST=DGCNT
DO SEL^VALM2
SET VALMBG=DGSAVE1
SET VALMLST=DGSAVE2
if '$ORDER(VALMY(0))
GOTO EN1Q
+7 NEW CTR
SET CTR=0
FOR
SET CTR=$ORDER(VALMY(CTR))
if 'CTR
QUIT
Begin DoDot:1
+8 DO REMOVE(DFN,DGDEP(CTR),$GET(DGMTI))
End DoDot:1
+9 SET DGMTD=$SELECT($GET(DGMTI):$PIECE(^DGMT(408.31,DGMTI,0),U),1:DT)
+10 DO ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
+11 SET DGMTDPCH=1
EN2Q SET VALMBCK="R"
QUIT
+1 ;
REMOVE(DFN,DGDEP,DGMTI) ;Remove
+1 NEW DA,DR,DIE,DGMTD
+2 IF '$GET(DGMTI)
WRITE !,"Not a means test - use means test options."
HANG 2
GOTO REMOVEQ
+3 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO EN2Q
+4 SET DGMTD=$SELECT($GET(DGMTI):$PIECE($GET(^DGMT(408.31,DGMTI,0)),U),1:DT)
+5 DO GETIENS^DGMTU2(DFN,$PIECE(DGDEP,U,20),DGMTD)
+6 SET DA=DGIRI
+7 SET DIE="^DGMT(408.22,"
SET DR="31////@"
+8 DO ^DIE
SET DGREMOVE=1
+9 KILL DGDEP
DO INIT^DGDEP
+10 SET DGMTDPCH=1
REMOVEQ KILL DGREMOVE
QUIT
+1 ;
EN3 ; Edit dependent demo
+1 ;
+2 SET VALMBCK=""
+3 NEW DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
+4 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO EN3Q
+5 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO EN3Q
+6 SET VALMBCK=""
SET DGSAVE1=VALMBG
SET DGSAVE2=VALMLST
SET VALMBG=1
+7 SET VALMLST=DGCNT
DO SEL^VALM2
SET VALMBG=DGSAVE1
SET VALMLST=DGSAVE2
if '$ORDER(VALMY(0))
GOTO EN1Q
+8 NEW CTR
SET CTR=0
FOR
SET CTR=$ORDER(VALMY(CTR))
if 'CTR
QUIT
Begin DoDot:1
+9 DO EDITD(DFN,DGDEP(CTR),CTR,$GET(DGMTI))
End DoDot:1
+10 SET VALMBCK="R"
+11 KILL DGDEP
DO INIT^DGDEP
EN3Q QUIT
+1 ;
EDITD(DFN,DGDEP,DGW,DGMTI) ; Edit
+1 NEW DA,DR,DIE,DGMTDT,SPOUSE,DGREL,DGDR,CNT,RELATION,MTVER
+2 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a means test."
HANG 2
GOTO EDITDQ
+3 WRITE !!,$PIECE(DGDEP,U)
+4 IF '$GET(DGMTI)
IF $PIECE(DGDEP,U,2)="SELF"
Begin DoDot:1
+5 SET DGREL("V")=$PIECE(DGDEP,U,20)
DO SPOUSE^DGRPEIS2
End DoDot:1
GOTO EDITDQ
+6 IF '$GET(DGMTI)
WRITE !,"Can only input information for veteran."
HANG 2
GOTO EN3Q
+7 SET DGMTDT=$PIECE(^DGMT(408.31,DGMTI,0),U)
+8 SET MTVER=$PIECE($GET(^DGMT(408.31,DGMTI,2)),U,11)
+9 IF $PIECE(DGDEP,U,2)="SPOUSE"
WRITE !,"Married information is entered under the veteran."
HANG 2
GOTO EDITDQ
+10 IF $PIECE(DGDEP,U,2)="SELF"
Begin DoDot:1
+11 SET DGDR=101
+12 DO GETREL^DGMTU11(DFN,"S",$$LYR^DGMTSCU1($SELECT($GET(DGMTDT):DGMTDT,1:DT)))
+13 DO GETIENS^DGMTU2(DFN,DGPRI,DGMTDT)
SET DGVIRI=DGIRI
+14 IF DGVIRI<0
WRITE !,"No information in Income Relation file."
HANG 2
GOTO EDITDQ
+15 SET DA=DGVIRI
SET DIE="^DGMT(408.22,"
SET DR="[DGMT ENTER/EDIT MARITAL STATUS]"
DO ^DIE
KILL DA,DIE,DR
+16 IF $GET(DGMTI)
IF $GET(DGREL("S"))
Begin DoDot:2
+17 SET SPOUSE=+DGREL("S")
+18 DO INIT^DGDEP
+19 SET CNT=0
FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
IF $PIECE(DGDEP(CNT),U,20)=SPOUSE
DO ADD(DFN,DGDEP(CNT),DGMTI)
End DoDot:2
End DoDot:1
GOTO EDITDQ
+20 SET RELATION=$ORDER(^DG(408.11,"B",$PIECE(DGDEP,U,2),""))
+21 IF '$PIECE(^DG(408.11,+RELATION,0),U,4)
WRITE !,"Not applicable for means test"
HANG 2
GOTO EDITDQ
+22 SET DGPRI=$PIECE(DGDEP,U,20)
+23 DO EDTV1^DGMTSC11(MTVER)
+24 IF $GET(DGFL)'<0
DO ADD(DFN,DGDEP,DGMTI)
EDITDQ ;
+1 QUIT
