source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGDEP2.m@ 841

Last change on this file since 841 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
RevLine 
[613]1DGDEP2 ;ALB/CAW,JAN - Dependent Utilities ;11/3/94,7/30/01
2 ;;5.3;Registration;**45,60,395,624**;Aug 13, 1993
3 ;624: DGMTDPCH=flag to force recalc of adj med exp when deps change
4 ;
5EN1 ; Add dependent to means test
6 ;
7 N DGSAVE,DGMTD,DGSAVE1
8 I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G EN1Q
9 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN1Q
10 S VALMBCK="",DGSAVE=VALMLST,DGSAVE1=VALMBG
11 S VALMBG=1,VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE G EN1Q:'$O(VALMY(0))
12 N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
13 .D ADD(DFN,DGDEP(CTR),$G(DGMTI))
14 S DGMTD=$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT)
15 D ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
16 K DGDEP D INIT^DGDEP
17 S DGMTDPCH=1
18EN1Q S VALMBCK="R" Q
19 ;
20ADD(DFN,DGDEP,DGMTI) ;Add
21 N DA,DR,DIE,DGMTD,DGIRI
22 I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G ADDQ
23 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." G ADDQ
24 S DGMTR=$O(^DG(408.11,"B",$P(DGDEP,U,2),"")) I '$P(^DG(408.11,DGMTR,0),U,4) D G ADDQ
25 .W !,"Cannot add a "_$P(DGDEP,U,2)_" as a dependent to the means test." H 2
26 S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
27 D GETIENS^DGMTU2(DFN,$P(DGDEP,U,20),DGMTD)
28 S DA=DGIRI
29 S DIE="^DGMT(408.22,",DR="31////"_DGMTI
30 D ^DIE
31 S DGMTDPCH=1
32ADDQ Q
33 ;
34EN2 ; Remove dependent from means test
35 ;
36 N DGSAVE1,DGSAVE2,DGMTD
37 I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G EN2Q
38 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN2Q
39 S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=2
40 S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EN1Q:'$O(VALMY(0))
41 N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
42 .D REMOVE(DFN,DGDEP(CTR),$G(DGMTI))
43 S DGMTD=$S($G(DGMTI):$P(^DGMT(408.31,DGMTI,0),U),1:DT)
44 D ALL^DGMTU21(DFN,"VSC",DGMTD,"IPR",DGMTI)
45 S DGMTDPCH=1
46EN2Q S VALMBCK="R" Q
47 ;
48REMOVE(DFN,DGDEP,DGMTI) ;Remove
49 N DA,DR,DIE,DGMTD
50 I '$G(DGMTI) W !,"Not a means test - use means test options." H 2 G REMOVEQ
51 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN2Q
52 S DGMTD=$S($G(DGMTI):$P($G(^DGMT(408.31,DGMTI,0)),U),1:DT)
53 D GETIENS^DGMTU2(DFN,$P(DGDEP,U,20),DGMTD)
54 S DA=DGIRI
55 S DIE="^DGMT(408.22,",DR="31////@"
56 D ^DIE S DGREMOVE=1
57 K DGDEP D INIT^DGDEP
58 S DGMTDPCH=1
59REMOVEQ K DGREMOVE Q
60 ;
61EN3 ; Edit dependent demo
62 ;
63 S VALMBCK=""
64 N DGSAVE1,DGSAVE2,DGMTD,DGBEG,I
65 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EN3Q
66 I '$D(DGMTI),$G(DGRPV)=1 W !,"Not while viewing" H 2 G EN3Q
67 S VALMBCK="",DGSAVE1=VALMBG,DGSAVE2=VALMLST,VALMBG=1
68 S VALMLST=DGCNT D SEL^VALM2 S VALMBG=DGSAVE1,VALMLST=DGSAVE2 G EN1Q:'$O(VALMY(0))
69 N CTR S CTR=0 F S CTR=$O(VALMY(CTR)) Q:'CTR D
70 .D EDITD(DFN,DGDEP(CTR),CTR,$G(DGMTI))
71 S VALMBCK="R"
72 K DGDEP D INIT^DGDEP
73EN3Q Q
74 ;
75EDITD(DFN,DGDEP,DGW,DGMTI) ; Edit
76 N DA,DR,DIE,DGMTDT,SPOUSE,DGREL,DGDR,CNT,RELATION
77 I $G(DGMTACT)="VEW" W !,"Cannot edit when viewing a means test." H 2 G EDITDQ
78 W !!,$P(DGDEP,U)
79 I '$G(DGMTI),$P(DGDEP,U,2)="SELF" D G EDITDQ
80 .S DGREL("V")=$P(DGDEP,U,20) D SPOUSE^DGRPEIS2
81 I '$G(DGMTI) W !,"Can only input information for veteran." H 2 G EN3Q
82 S DGMTDT=$P(^DGMT(408.31,DGMTI,0),U)
83 I $P(DGDEP,U,2)="SPOUSE" W !,"Married information is entered under the veteran." H 2 G EDITDQ
84 I $P(DGDEP,U,2)="SELF" D G EDITDQ
85 .S DGDR=101
86 .D GETREL^DGMTU11(DFN,"S",$$LYR^DGMTSCU1($S($G(DGMTDT):DGMTDT,1:DT)))
87 .D GETIENS^DGMTU2(DFN,DGPRI,DGMTDT) S DGVIRI=DGIRI
88 .I DGVIRI<0 W !,"No information in Income Relation file." H 2 G EDITDQ
89 .S DA=DGVIRI,DIE="^DGMT(408.22,",DR="[DGMT ENTER/EDIT MARITAL STATUS]" D ^DIE K DA,DIE,DR
90 .I $G(DGMTI),$G(DGREL("S")) D
91 ..S SPOUSE=+DGREL("S")
92 ..D INIT^DGDEP
93 ..S CNT=0 F S CNT=$O(DGDEP(CNT)) Q:'CNT I $P(DGDEP(CNT),U,20)=SPOUSE D ADD(DFN,DGDEP(CNT),DGMTI)
94 S RELATION=$O(^DG(408.11,"B",$P(DGDEP,U,2),""))
95 I '$P(^DG(408.11,+RELATION,0),U,4) W !,"Not applicable for means test" H 2 G EDITDQ
96 S DGPRI=$P(DGDEP,U,20)
97 D EDT^DGMTSC11
98 I $G(DGFL)'<0 D ADD(DFN,DGDEP,DGMTI)
99EDITDQ ;
100 Q
Note: See TracBrowser for help on using the repository browser.