- 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 Feb 18, 2025@23:20:21 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