| [613] | 1 | DGMTSCU3 ;ALB/RMO - Means Test Screen Variable Utilities Cont. ;4 MAY 1992 7:45 am
|
|---|
| 2 | ;;5.3;Registration;**45**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | INC ;Determine income, expense and net worth
|
|---|
| 5 | ; Input -- DFN Patient file IEN
|
|---|
| 6 | ; DGCOMF Means Test Completion Flag (Optional)
|
|---|
| 7 | ; (1 if completing means 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^DGMTU21(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"),8,17)
|
|---|
| 26 | S DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,3)
|
|---|
| 27 | S DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)-$P(DGIN2("V"),"^",5)
|
|---|
| 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 | I DGDC S (DGIN0("C"),DGIN1("C"))="",DGCNT=0 F S DGCNT=$O(DGINC("C",DGCNT)) Q:'DGCNT D CHK^DGMTSCU2,CHILD:Y
|
|---|
| 31 | S DGINTF=$S(DGINT:1,1:0) I 'DGINTF S J="" F S J=$O(DGIN0(J)) Q:J=""!(DGINTF) F I=8:1:17 Q:DGINTF S:$P(DGIN0(J),"^",I)]"" DGINTF=1
|
|---|
| 32 | S DGNWTF=$S(DGNWT:1,1:0) I 'DGNWTF S J="" F S J=$O(DGIN2(J)) Q:J=""!(DGNWTF) F I=1:1:5 Q:DGNWTF S:$P(DGIN2(J),"^",I)]"" DGNWTF=1
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SPOUSE ;Determine spouse income and net worth
|
|---|
| 36 | S DGIN0("S")=$G(^DGMT(408.21,DGINC("S"),0)),DGIN1("S")=$G(^(1)),DGIN2("S")=$G(^(2))
|
|---|
| 37 | S DGINT=DGINT+$$TOT^DGMTSCU1(DGIN0("S"),8,17)
|
|---|
| 38 | S DGNWT=DGNWT+($$TOT^DGMTSCU1(DGIN2("S"),1,4)-$P(DGIN2("S"),"^",5))
|
|---|
| 39 | I $G(DGCOMF) D MT(DGINR("S"),DGMTI)
|
|---|
| 40 | SPOUSEQ Q
|
|---|
| 41 | ;
|
|---|
| 42 | CHILD ;Determine total dependent children(s) income and expense
|
|---|
| 43 | N DGCE,DGEMP,I,X
|
|---|
| 44 | 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)
|
|---|
| 45 | S DGEMP=$P(X,"^",14),DGINT=DGINT+$$TOT^DGMTSCU1(X,8,17)
|
|---|
| 46 | 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)
|
|---|
| 47 | S DGCE=(DGEMP-$P(DGMTPAR,"^",17))-$P(X,"^",3)
|
|---|
| 48 | S DGDET=DGDET+DGEMP-$S($G(DGCE)>0:DGCE,1:0)
|
|---|
| 49 | I $G(DGCOMF) D MT(DGINR("C",DGCNT),DGMTI)
|
|---|
| 50 | CHILDQ Q
|
|---|
| 51 | ;
|
|---|
| 52 | MT(DGINR,DGMTI) ;Update Means Test IEN in Individual Annual Income file
|
|---|
| 53 | ; Input -- DGINR Income Relation IEN
|
|---|
| 54 | ; DGMTI Annual Means Test IEN
|
|---|
| 55 | ; Output -- Update Means Test IEN
|
|---|
| 56 | N DA,DIE,DR
|
|---|
| 57 | S DA=DGINR,DIE="^DGMT(408.22,",DR="31////^S X="_DGMTI D ^DIE
|
|---|
| 58 | Q
|
|---|
