- DGDEP2 ;ALB/CAW,JAN - Dependent Utilities ; 4/4/06 9:30am
- ;;5.3;PIMS;**45,60,395,624,688,1015,1016**;JUN 30, 2012;Build 20
- ;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
- DGDEP2 ;ALB/CAW,JAN - Dependent Utilities ; 4/4/06 9:30am
- +1 ;;5.3;PIMS;**45,60,395,624,688,1015,1016**;JUN 30, 2012;Build 20
- +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
