source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECSU3.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1EASECSU3 ;ALB/LBD - LTC Co-Pay Test Screen Variable Utilities Cont. ;14 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
3 ;
4INC ;Determine income, expense and net worth
5 ; Input -- DFN Patient file IEN
6 ; DGCOMF LTC Co-Pay Test Completion Flag (Optional)
7 ; (1 if completing LTC co-pay test)
8 ; DGMTDT Date of Test
9 ; DGMTI Annual Means Test IEN
10 ; DGVINI Veteran Individual Annual Income IEN
11 ; DGSP Spouse 1=YES and 0=NO (mt income)
12 ; DGDC Dependent children 1=YES and 0=NO (mt income)
13 ; DGMTPAR Annual Means Test Parameters
14 ; Output -- DGIN0 Annual Income 0th node array (income)
15 ; DGIN1 Annual Income 1 node array (expense)
16 ; DGIN2 Annual Income 2 node array (net worth)
17 ; DGINT Total income
18 ; DGDET Total deductible expenses
19 ; DGNWT Total net worth
20 ; DGINTF Income flag
21 ; DGNWTF Net worth flag
22 N DGCNT,DGINC,DGINR,I,J,Y
23 D ALL^EASECU21(DFN,"VCS",DGMTDT,"IR",$S($G(DGMTI):DGMTI,1:""))
24 S DGIN0("V")=$G(^DGMT(408.21,DGVINI,0)),DGIN1("V")=$G(^(1)),DGIN2("V")=$G(^(2))
25 S DGINT=$$TOT^DGMTSCU1(DGIN0("V"),6,17)+$$TOT^DGMTSCU1(DGIN0("V"),19,20)
26 S DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,10)
27 S DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)+$$TOT^DGMTSCU1(DGIN2("V"),6,9)
28 I $G(DGCOMF) D MT(DGINR("V"),DGMTI)
29 I DGSP S (DGIN0("S"),DGIN1("S"),DGIN2("S"))="" D SPOUSE:$D(DGINC("S"))
30 ; dependent child income is not included for LTC co-pay test
31 ;I DGDC S (DGIN0("C"),DGIN1("C"))="",DGCNT=0 F S DGCNT=$O(DGINC("C",DGCNT)) Q:'DGCNT D CHK^DGMTSCU2,CHILD:Y
32 S DGINTF=$S(DGINT:1,1:0)
33 S DGNWTF=$S(DGNWT:1,1:0)
34 Q
35 ;
36SPOUSE ;Determine spouse income and net worth
37 S DGIN0("S")=$G(^DGMT(408.21,DGINC("S"),0)),DGIN1("S")=$G(^(1)),DGIN2("S")=$G(^(2))
38 S DGINT=DGINT+$$TOT^DGMTSCU1(DGIN0("S"),6,17)+$$TOT^DGMTSCU1(DGIN0("S"),19,20)
39 ; Added next line for LTC Phase IV (EAS*1*40)
40 S DGNWT=DGNWT+$$TOT^DGMTSCU1(DGIN2("S"),1,4)+$$TOT^DGMTSCU1(DGIN2("S"),6,9)
41 I $G(DGCOMF) D MT(DGINR("S"),DGMTI)
42SPOUSEQ Q
43 ;
44CHILD ;Determine total dependent children(s) income and expense
45 N DGCE,DGEMP,I,X
46 S X=$G(^DGMT(408.21,DGINC("C",DGCNT),0)) F I=8:1:17 I $P(X,"^",I)]"" S $P(DGIN0("C"),"^",I)=$P(DGIN0("C"),"^",I)+$P(X,"^",I)
47 S DGEMP=$P(X,"^",14),DGINT=DGINT+$$TOT^DGMTSCU1(X,8,17)
48 S X=$G(^DGMT(408.21,DGINC("C",DGCNT),1)) I $P(X,"^",3)]"" S $P(DGIN1("C"),"^",3)=$P(DGIN1("C"),"^",3)+$P(X,"^",3)
49 S DGCE=(DGEMP-$P(DGMTPAR,"^",17))-$P(X,"^",3)
50 S DGDET=DGDET+DGEMP-$S($G(DGCE)>0:DGCE,1:0)
51 I $G(DGCOMF) D MT(DGINR("C",DGCNT),DGMTI)
52CHILDQ Q
53 ;
54MT(DGINR,DGMTI) ;Update Income Relation file with Means Test IEN
55 ; Input -- DGINR Income Relation IEN
56 ; DGMTI Annual Means Test IEN
57 ; Output -- Update Means Test IEN
58 N DA,DIE,DR
59 S DA=DGINR,DIE="^DGMT(408.22,",DR="31////^S X="_DGMTI D ^DIE
60 Q
61 ;
62DEP ;Determine dependent data
63 ; Input -- DFN Patient file IEN
64 ; DGMTDT Date of Test
65 ; DGVIRI Veteran Income Relation IEN
66 ; Output -- DGVIR0 Veteran Income Relation 0th node
67 ; DGSP Spouse 1=YES and 0=NO (mt income)
68 ; DGDC Dependent children 1=YES and 0=NO (mt income)
69 ; DGNC Number of dependent children
70 ; DGND Total number of dependents
71 N DGCNT,DGDEP,DGINR,DGREL,Y
72 S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)) D ALL^EASECU21(DFN,"SC",DGMTDT,"PR",$S($G(DGMTI):DGMTI,1:""))
73 ;Include spouse's income for LTC co-pay if vet is married
74 ;If vet is legally separated, do not include spouse's income. Added for
75 ;LTC Phase IV (EAS*1*40)
76 S DGSP=$S('$P(DGVIR0,U,14):0,$P(DGVIR0,U,17):0,'$G(DGREL("S")):0,1:1)
77 ;Child's income is not included for LTC co-pay test
78 S DGDC=0
79 S DGNC=+$P(DGVIR0,"^",13)
80 S DGND=DGSP+DGNC
81 Q
Note: See TracBrowser for help on using the repository browser.