EASECDP2 ;ALB/LBD Dependent Utilities ;19 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
;
; NOTE: This routine was modified from DGDEP2 for LTC Co-pay
;
EN1 ; Add dependent to means test
;
N DGSAVE,DGMTD,DGSAVE1
I '$G(DGMTI),$G(DGMTYPT)'=3 W !,"Not a LTC copay test - use LTC copay test options." H 2 G EN1Q
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay 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^EASECU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
K DGDEP D INIT^EASECDEP
EN1Q S VALMBCK="R" Q
;
ADD(DFN,DGDEP,DGMTI) ;Add
N DA,DR,DIE,DGMTD,DGIRI
I '$G(DGMTI),$G(DGMTYPT)'=3 W !,"Not a LTC copay test - use LTC copay test options." H 2 G ADDQ
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay 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 LTC copay test." H 2
S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
D GETIENS^EASECU2(DFN,$P(DGDEP,U,20),DGMTD)
S DA=DGIRI
S DIE="^DGMT(408.22,",DR="31////"_DGMTI
D ^DIE
ADDQ Q
;
EN2 ; Remove dependent from means test
;
N DGSAVE1,DGSAVE2,DGMTD
I '$G(DGMTI),$G(DGMTYPT)'=3 W !,"Not a LTC copay test - use LTC copay test options." H 2 G EN2Q
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay 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^EASECU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
EN2Q S VALMBCK="R" Q
;
REMOVE(DFN,DGDEP,DGMTI) ;Remove
N DA,DR,DIE,DGMTD
I '$G(DGMTI),$G(DGMTYPT)'=3 W !,"Not a LTC copay test - use LTC copay test options." H 2 G REMOVEQ
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G EN2Q
S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
D GETIENS^EASECU2(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^EASECDEP
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 LTC copay 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^EASECDEP
EN3Q Q
;
EDITD(DFN,DGDEP,DGW,DGMTI) ; Edit
N DA,DR,DIE,DGMTDT,SPOUSE,DGREL,DGDR,CNT,RELATION
I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay 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^EASECED2
I '$G(DGMTI) W !,"Can only input information for veteran." H 2 G EN3Q
S DGMTDT=$P(^DGMT(408.31,DGMTI,0),U)
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",$S($G(DGMTDT):DGMTDT,1:DT))
.S DA=DGVIRI,DIE="^DGMT(408.22,",DR="[EASEC EDIT MARITAL STATUS]" D ^DIE K DA,DIE,DR
.I $G(DGMTI),$G(DGREL("S")) D
..S SPOUSE=+DGREL("S")
..D INIT^EASECDEP
..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 LTC copay test" H 2 G EDITDQ
S DGPRI=$P(DGDEP,U,20)
D EDT
I $G(DGFL)'<0 D ADD(DFN,DGDEP,DGMTI)
EDITDQ ;
Q
;
EDT ;Edit dependent child data
; NOTE: this code was modified from DGMTSC11
N DA,DGERR,DGFIN,DGINI,DGIRI,DIE,DR
D GETIENS^EASECU2(DFN,+DGPRI,DGMTDT) G EDTQ:DGERR
S DA=DGIRI,DIE="^DGMT(408.22,",DR="[EASEC EDIT DEPENDENTS]" D ^DIE
S:'$D(DGFIN) DGFL=$S($D(DTOUT):-2,$D(DUOUT):-1,($D(Y))=10:-1,1:0)
EDTQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECDP2 4376 printed Dec 13, 2024@01:53:54 Page 2
EASECDP2 ;ALB/LBD Dependent Utilities ;19 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
+2 ;
+3 ; NOTE: This routine was modified from DGDEP2 for LTC Co-pay
+4 ;
EN1 ; Add dependent to means test
+1 ;
+2 NEW DGSAVE,DGMTD,DGSAVE1
+3 IF '$GET(DGMTI)
IF $GET(DGMTYPT)'=3
WRITE !,"Not a LTC copay test - use LTC copay test options."
HANG 2
GOTO EN1Q
+4 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay 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^EASECU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
+11 KILL DGDEP
DO INIT^EASECDEP
EN1Q SET VALMBCK="R"
QUIT
+1 ;
ADD(DFN,DGDEP,DGMTI) ;Add
+1 NEW DA,DR,DIE,DGMTD,DGIRI
+2 IF '$GET(DGMTI)
IF $GET(DGMTYPT)'=3
WRITE !,"Not a LTC copay test - use LTC copay test options."
HANG 2
GOTO ADDQ
+3 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay 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 LTC copay 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^EASECU2(DFN,$PIECE(DGDEP,U,20),DGMTD)
+8 SET DA=DGIRI
+9 SET DIE="^DGMT(408.22,"
SET DR="31////"_DGMTI
+10 DO ^DIE
ADDQ QUIT
+1 ;
EN2 ; Remove dependent from means test
+1 ;
+2 NEW DGSAVE1,DGSAVE2,DGMTD
+3 IF '$GET(DGMTI)
IF $GET(DGMTYPT)'=3
WRITE !,"Not a LTC copay test - use LTC copay test options."
HANG 2
GOTO EN2Q
+4 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay 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^EASECU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
EN2Q SET VALMBCK="R"
QUIT
+1 ;
REMOVE(DFN,DGDEP,DGMTI) ;Remove
+1 NEW DA,DR,DIE,DGMTD
+2 IF '$GET(DGMTI)
IF $GET(DGMTYPT)'=3
WRITE !,"Not a LTC copay test - use LTC copay test options."
HANG 2
GOTO REMOVEQ
+3 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO EN2Q
+4 SET DGMTD=$SELECT($GET(DGMTI):$PIECE($GET(^DGMT(408.31,DGMTI,0)),U),1:DT)
+5 DO GETIENS^EASECU2(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^EASECDEP
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 LTC copay 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^EASECDEP
EN3Q QUIT
+1 ;
EDITD(DFN,DGDEP,DGW,DGMTI) ; Edit
+1 NEW DA,DR,DIE,DGMTDT,SPOUSE,DGREL,DGDR,CNT,RELATION
+2 IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay 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^EASECED2
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 IF $PIECE(DGDEP,U,2)="SPOUSE"
WRITE !,"Married information is entered under the veteran."
HANG 2
GOTO EDITDQ
+9 IF $PIECE(DGDEP,U,2)="SELF"
Begin DoDot:1
+10 SET DGDR=101
+11 DO GETREL^DGMTU11(DFN,"S",$SELECT($GET(DGMTDT):DGMTDT,1:DT))
+12 SET DA=DGVIRI
SET DIE="^DGMT(408.22,"
SET DR="[EASEC EDIT MARITAL STATUS]"
DO ^DIE
KILL DA,DIE,DR
+13 IF $GET(DGMTI)
IF $GET(DGREL("S"))
Begin DoDot:2
+14 SET SPOUSE=+DGREL("S")
+15 DO INIT^EASECDEP
+16 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
+17 SET RELATION=$ORDER(^DG(408.11,"B",$PIECE(DGDEP,U,2),""))
+18 IF '$PIECE(^DG(408.11,+RELATION,0),U,4)
WRITE !,"Not applicable for LTC copay test"
HANG 2
GOTO EDITDQ
+19 SET DGPRI=$PIECE(DGDEP,U,20)
+20 DO EDT
+21 IF $GET(DGFL)'<0
DO ADD(DFN,DGDEP,DGMTI)
EDITDQ ;
+1 QUIT
+2 ;
EDT ;Edit dependent child data
+1 ; NOTE: this code was modified from DGMTSC11
+2 NEW DA,DGERR,DGFIN,DGINI,DGIRI,DIE,DR
+3 DO GETIENS^EASECU2(DFN,+DGPRI,DGMTDT)
if DGERR
GOTO EDTQ
+4 SET DA=DGIRI
SET DIE="^DGMT(408.22,"
SET DR="[EASEC EDIT DEPENDENTS]"
DO ^DIE
+5 if '$DATA(DGFIN)
SET DGFL=$SELECT($DATA(DTOUT):-2,$DATA(DUOUT):-1,($DATA(Y))=10:-1,1:0)
EDTQ QUIT
