EASECDP4 ;ALB/LBD - Dependents Utilities (con't) ;19 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
; NOTE: This routine was modified from DGDEP4 for LTC Copay
;
EN ; Spouse Demographics
N BEG,CNT,END,FLAG,QUIT,DGERR S CNT=0
I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ENQ
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ENQ
F S CNT=$O(DGDEP(CNT)) Q:'CNT D
.I $P(DGDEP(CNT),U,2)="SPOUSE" S FLAG=$G(FLAG)+1
I '$G(FLAG) W !,"There is no spouse to choose from." H 2 G ENQ
I $G(FLAG)>1 D G:'$G(DGERR) EN1
.S BEG=2,END=FLAG+1 D SEL^DGDEPU Q:$G(DGERR)
.S DGREL("S")=$P(DGDEP(DGW),U,20)_U_$P(^DGPR(408.12,+$P(DGDEP(DGW),U,20),0),U,3)
I $G(DGERR) G ENQ
I '$G(DGREL("S")) S DGREL("S")=$P(DGDEP(2),U,20)_U_$P(^DGPR(408.12,+$P(DGDEP(2),U,20),0),U,3)
EN1 S DGPRI=$P(DGDEP(1),U,20),DGIRI=$P(DGDEP(1),U,22) D SPOUSE1^EASECSC3
ENQ D INIT^EASECDEP
Q
;
;
ADDEP ; Add a new dependent
;
N DGANS
S VALMBCK=""
I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G ADDEPQ
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G ADDEPQ
S DIR(0)="S^S:Spouse;D:Dependent",DIR("A")="Do you want to add (S)pouse or (D)ependent"
D ^DIR S DGANS=Y K DIR,Y I DGANS="D",$G(DGMTI) S DGANS="C"
I $D(DIRUT) G ADDEPQ
D GETREL^DGMTU11(DFN,"S",$S($G(DGMTD):DGMTD,1:DT))
I DGANS="S",$G(DGREL("S")) W !,"An active spouse is currently on file. Use the 'ES - Edit Spouse'",!,"action to edit." H 3 G ADDEPQ
I DGANS="S",$G(DGMTI) S CNT=0 F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,2)="SPOUSE" D REMOVE^EASECDP2(DFN,DGDEP(CNT),DGMTI)
D CLEAR^VALM1
D ADD^EASECED(DFN,DGANS,$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT))
S PERSON=DGPRI
I DGFL=-1!(DGFL=-2) G ADDEPQ
D INIT^EASECDEP
I $G(DGMTI) D
.N CNT
.S CNT=0
.F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,20)=PERSON D
..D ADD^EASECDP2(DFN,DGDEP(CNT),DGMTI)
..D EDITD^EASECDP2(DFN,DGDEP(CNT),CNT,DGMTI)
ADDEPQ S VALMBCK="R"
D INIT^EASECDEP
K DGFL Q
;
EDITDEP ; Edit dependent demo
;
S VALMBCK=""
N DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G EDITDEPQ
I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G EDITDEPQ
S I=0 F S I=$O(DGDEP(I)) Q:'I!($G(DGBEG)) I $P(DGDEP(I),U,2)'="SELF",$P(DGDEP(I),U,2)'="SPOUSE" S DGBEG=I
S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=$S($G(DGBEG):DGBEG,1:0)
S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EDITDEPQ:'$O(VALMY(0))
N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
.D EDITC(DFN,DGDEP(CTR),CTR,$G(DGMTI))
EDITDEPQ S VALMBCK="R"
K DGDEP D INIT^EASECDEP
Q
;
EDITC(DFN,DGDEP,DGW,DGMTI) ; Edit
N DA,DR,DIE,DGMTDT,DEP,DGSAVE
S DGMTDT=$S($G(DGMTI):$P(^DGMT(408.31,+DGMTI,0),U),1:DT)
I $G(DGMTI),$G(DGMTACT)="VEW" W !,"Cannot edit when viewing a LTC copay test." H 2 G EDITCQ
S DEP=$S($G(DGMTI):"C",1:"D"),DGSAVE=DGDEP
D GETREL^DGMTU11(DFN,DEP,$S($G(DGMTDT):DGMTDT,1:DT),$G(DGMTI))
S DGDEP=DGSAVE
N CNTR
S CNTR=0
F S CNTR=$O(DGREL(DEP,CNTR)) Q:'CNTR I $P(DGDEP,U,20)=+DGREL(DEP,CNTR) D
.D EDIT^EASECED(DGREL(DEP,CNTR),DEP)
EDITCQ ;
K ^TMP("DGMTEP",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECDP4 3248 printed Dec 13, 2024@01:53:56 Page 2
EASECDP4 ;ALB/LBD - Dependents Utilities (con't) ;19 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7**;Mar 15, 2001
+2 ; NOTE: This routine was modified from DGDEP4 for LTC Copay
+3 ;
EN ; Spouse Demographics
+1 NEW BEG,CNT,END,FLAG,QUIT,DGERR
SET CNT=0
+2 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO ENQ
+3 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO ENQ
+4 FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
Begin DoDot:1
+5 IF $PIECE(DGDEP(CNT),U,2)="SPOUSE"
SET FLAG=$GET(FLAG)+1
End DoDot:1
+6 IF '$GET(FLAG)
WRITE !,"There is no spouse to choose from."
HANG 2
GOTO ENQ
+7 IF $GET(FLAG)>1
Begin DoDot:1
+8 SET BEG=2
SET END=FLAG+1
DO SEL^DGDEPU
if $GET(DGERR)
QUIT
+9 SET DGREL("S")=$PIECE(DGDEP(DGW),U,20)_U_$PIECE(^DGPR(408.12,+$PIECE(DGDEP(DGW),U,20),0),U,3)
End DoDot:1
if '$GET(DGERR)
GOTO EN1
+10 IF $GET(DGERR)
GOTO ENQ
+11 IF '$GET(DGREL("S"))
SET DGREL("S")=$PIECE(DGDEP(2),U,20)_U_$PIECE(^DGPR(408.12,+$PIECE(DGDEP(2),U,20),0),U,3)
EN1 SET DGPRI=$PIECE(DGDEP(1),U,20)
SET DGIRI=$PIECE(DGDEP(1),U,22)
DO SPOUSE1^EASECSC3
ENQ DO INIT^EASECDEP
+1 QUIT
+2 ;
+3 ;
ADDEP ; Add a new dependent
+1 ;
+2 NEW DGANS
+3 SET VALMBCK=""
+4 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO ADDEPQ
+5 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO ADDEPQ
+6 SET DIR(0)="S^S:Spouse;D:Dependent"
SET DIR("A")="Do you want to add (S)pouse or (D)ependent"
+7 DO ^DIR
SET DGANS=Y
KILL DIR,Y
IF DGANS="D"
IF $GET(DGMTI)
SET DGANS="C"
+8 IF $DATA(DIRUT)
GOTO ADDEPQ
+9 DO GETREL^DGMTU11(DFN,"S",$SELECT($GET(DGMTD):DGMTD,1:DT))
+10 IF DGANS="S"
IF $GET(DGREL("S"))
WRITE !,"An active spouse is currently on file. Use the 'ES - Edit Spouse'",!,"action to edit."
HANG 3
GOTO ADDEPQ
+11 IF DGANS="S"
IF $GET(DGMTI)
SET CNT=0
FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
IF $PIECE(DGDEP(CNT),U,2)="SPOUSE"
DO REMOVE^EASECDP2(DFN,DGDEP(CNT),DGMTI)
+12 DO CLEAR^VALM1
+13 DO ADD^EASECED(DFN,DGANS,$SELECT($GET(DGMTI):$PIECE(^DGMT(408.31,DGMTI,0),U),1:DT))
+14 SET PERSON=DGPRI
+15 IF DGFL=-1!(DGFL=-2)
GOTO ADDEPQ
+16 DO INIT^EASECDEP
+17 IF $GET(DGMTI)
Begin DoDot:1
+18 NEW CNT
+19 SET CNT=0
+20 FOR
SET CNT=$ORDER(DGDEP(CNT))
if 'CNT
QUIT
IF $PIECE(DGDEP(CNT),U,20)=PERSON
Begin DoDot:2
+21 DO ADD^EASECDP2(DFN,DGDEP(CNT),DGMTI)
+22 DO EDITD^EASECDP2(DFN,DGDEP(CNT),CNT,DGMTI)
End DoDot:2
End DoDot:1
ADDEPQ SET VALMBCK="R"
+1 DO INIT^EASECDEP
+2 KILL DGFL
QUIT
+3 ;
EDITDEP ; Edit dependent demo
+1 ;
+2 SET VALMBCK=""
+3 NEW DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
+4 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO EDITDEPQ
+5 IF '$DATA(DGMTI)
IF $GET(DGRPV)=1
WRITE !,"Not while viewing"
HANG 2
GOTO EDITDEPQ
+6 SET I=0
FOR
SET I=$ORDER(DGDEP(I))
if 'I!($GET(DGBEG))
QUIT
IF $PIECE(DGDEP(I),U,2)'="SELF"
IF $PIECE(DGDEP(I),U,2)'="SPOUSE"
SET DGBEG=I
+7 SET VALMBCK=""
SET DGSAVE1=VALMBG
SET DGSAVE2=VALMLST
SET VALMBG=$SELECT($GET(DGBEG):DGBEG,1:0)
+8 SET VALMLST=DGCNT
DO SEL^VALM2
SET VALMBG=DGSAVE1
SET VALMLST=DGSAVE2
if '$ORDER(VALMY(0))
GOTO EDITDEPQ
+9 NEW CTR
SET CTR=0
FOR
SET CTR=$ORDER(VALMY(CTR))
if 'CTR
QUIT
Begin DoDot:1
+10 DO EDITC(DFN,DGDEP(CTR),CTR,$GET(DGMTI))
End DoDot:1
EDITDEPQ SET VALMBCK="R"
+1 KILL DGDEP
DO INIT^EASECDEP
+2 QUIT
+3 ;
EDITC(DFN,DGDEP,DGW,DGMTI) ; Edit
+1 NEW DA,DR,DIE,DGMTDT,DEP,DGSAVE
+2 SET DGMTDT=$SELECT($GET(DGMTI):$PIECE(^DGMT(408.31,+DGMTI,0),U),1:DT)
+3 IF $GET(DGMTI)
IF $GET(DGMTACT)="VEW"
WRITE !,"Cannot edit when viewing a LTC copay test."
HANG 2
GOTO EDITCQ
+4 SET DEP=$SELECT($GET(DGMTI):"C",1:"D")
SET DGSAVE=DGDEP
+5 DO GETREL^DGMTU11(DFN,DEP,$SELECT($GET(DGMTDT):DGMTDT,1:DT),$GET(DGMTI))
+6 SET DGDEP=DGSAVE
+7 NEW CNTR
+8 SET CNTR=0
+9 FOR
SET CNTR=$ORDER(DGREL(DEP,CNTR))
if 'CNTR
QUIT
IF $PIECE(DGDEP,U,20)=+DGREL(DEP,CNTR)
Begin DoDot:1
+10 DO EDIT^EASECED(DGREL(DEP,CNTR),DEP)
End DoDot:1
EDITCQ ;
+1 KILL ^TMP("DGMTEP",$JOB)
+2 QUIT
