- EASECSU3 ;ALB/LBD - LTC Co-Pay Test Screen Variable Utilities Cont. ;14 AUG 2001
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
- ;
- INC ;Determine income, expense and net worth
- ; Input -- DFN Patient file IEN
- ; DGCOMF LTC Co-Pay Test Completion Flag (Optional)
- ; (1 if completing LTC co-pay test)
- ; DGMTDT Date of Test
- ; DGMTI Annual Means Test IEN
- ; DGVINI Veteran Individual Annual Income IEN
- ; DGSP Spouse 1=YES and 0=NO (mt income)
- ; DGDC Dependent children 1=YES and 0=NO (mt income)
- ; DGMTPAR Annual Means Test Parameters
- ; Output -- DGIN0 Annual Income 0th node array (income)
- ; DGIN1 Annual Income 1 node array (expense)
- ; DGIN2 Annual Income 2 node array (net worth)
- ; DGINT Total income
- ; DGDET Total deductible expenses
- ; DGNWT Total net worth
- ; DGINTF Income flag
- ; DGNWTF Net worth flag
- N DGCNT,DGINC,DGINR,I,J,Y
- D ALL^EASECU21(DFN,"VCS",DGMTDT,"IR",$S($G(DGMTI):DGMTI,1:""))
- S DGIN0("V")=$G(^DGMT(408.21,DGVINI,0)),DGIN1("V")=$G(^(1)),DGIN2("V")=$G(^(2))
- S DGINT=$$TOT^DGMTSCU1(DGIN0("V"),6,17)+$$TOT^DGMTSCU1(DGIN0("V"),19,20)
- S DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,10)
- S DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)+$$TOT^DGMTSCU1(DGIN2("V"),6,9)
- I $G(DGCOMF) D MT(DGINR("V"),DGMTI)
- I DGSP S (DGIN0("S"),DGIN1("S"),DGIN2("S"))="" D SPOUSE:$D(DGINC("S"))
- ; dependent child income is not included for LTC co-pay test
- ;I DGDC S (DGIN0("C"),DGIN1("C"))="",DGCNT=0 F S DGCNT=$O(DGINC("C",DGCNT)) Q:'DGCNT D CHK^DGMTSCU2,CHILD:Y
- S DGINTF=$S(DGINT:1,1:0)
- S DGNWTF=$S(DGNWT:1,1:0)
- Q
- ;
- SPOUSE ;Determine spouse income and net worth
- S DGIN0("S")=$G(^DGMT(408.21,DGINC("S"),0)),DGIN1("S")=$G(^(1)),DGIN2("S")=$G(^(2))
- S DGINT=DGINT+$$TOT^DGMTSCU1(DGIN0("S"),6,17)+$$TOT^DGMTSCU1(DGIN0("S"),19,20)
- ; Added next line for LTC Phase IV (EAS*1*40)
- S DGNWT=DGNWT+$$TOT^DGMTSCU1(DGIN2("S"),1,4)+$$TOT^DGMTSCU1(DGIN2("S"),6,9)
- I $G(DGCOMF) D MT(DGINR("S"),DGMTI)
- SPOUSEQ Q
- ;
- CHILD ;Determine total dependent children(s) income and expense
- N DGCE,DGEMP,I,X
- 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)
- S DGEMP=$P(X,"^",14),DGINT=DGINT+$$TOT^DGMTSCU1(X,8,17)
- 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)
- S DGCE=(DGEMP-$P(DGMTPAR,"^",17))-$P(X,"^",3)
- S DGDET=DGDET+DGEMP-$S($G(DGCE)>0:DGCE,1:0)
- I $G(DGCOMF) D MT(DGINR("C",DGCNT),DGMTI)
- CHILDQ Q
- ;
- MT(DGINR,DGMTI) ;Update Income Relation file with Means Test IEN
- ; Input -- DGINR Income Relation IEN
- ; DGMTI Annual Means Test IEN
- ; Output -- Update Means Test IEN
- N DA,DIE,DR
- S DA=DGINR,DIE="^DGMT(408.22,",DR="31////^S X="_DGMTI D ^DIE
- Q
- ;
- DEP ;Determine dependent data
- ; Input -- DFN Patient file IEN
- ; DGMTDT Date of Test
- ; DGVIRI Veteran Income Relation IEN
- ; Output -- DGVIR0 Veteran Income Relation 0th node
- ; DGSP Spouse 1=YES and 0=NO (mt income)
- ; DGDC Dependent children 1=YES and 0=NO (mt income)
- ; DGNC Number of dependent children
- ; DGND Total number of dependents
- N DGCNT,DGDEP,DGINR,DGREL,Y
- S DGVIR0=$G(^DGMT(408.22,DGVIRI,0)) D ALL^EASECU21(DFN,"SC",DGMTDT,"PR",$S($G(DGMTI):DGMTI,1:""))
- ;Include spouse's income for LTC co-pay if vet is married
- ;If vet is legally separated, do not include spouse's income. Added for
- ;LTC Phase IV (EAS*1*40)
- S DGSP=$S('$P(DGVIR0,U,14):0,$P(DGVIR0,U,17):0,'$G(DGREL("S")):0,1:1)
- ;Child's income is not included for LTC co-pay test
- S DGDC=0
- S DGNC=+$P(DGVIR0,"^",13)
- S DGND=DGSP+DGNC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECSU3 3907 printed Jan 18, 2025@02:55:32 Page 2
- EASECSU3 ;ALB/LBD - LTC Co-Pay Test Screen Variable Utilities Cont. ;14 AUG 2001
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,40**;Mar 15, 2001
- +2 ;
- INC ;Determine income, expense and net worth
- +1 ; Input -- DFN Patient file IEN
- +2 ; DGCOMF LTC Co-Pay Test Completion Flag (Optional)
- +3 ; (1 if completing LTC co-pay test)
- +4 ; DGMTDT Date of Test
- +5 ; DGMTI Annual Means Test IEN
- +6 ; DGVINI Veteran Individual Annual Income IEN
- +7 ; DGSP Spouse 1=YES and 0=NO (mt income)
- +8 ; DGDC Dependent children 1=YES and 0=NO (mt income)
- +9 ; DGMTPAR Annual Means Test Parameters
- +10 ; Output -- DGIN0 Annual Income 0th node array (income)
- +11 ; DGIN1 Annual Income 1 node array (expense)
- +12 ; DGIN2 Annual Income 2 node array (net worth)
- +13 ; DGINT Total income
- +14 ; DGDET Total deductible expenses
- +15 ; DGNWT Total net worth
- +16 ; DGINTF Income flag
- +17 ; DGNWTF Net worth flag
- +18 NEW DGCNT,DGINC,DGINR,I,J,Y
- +19 DO ALL^EASECU21(DFN,"VCS",DGMTDT,"IR",$SELECT($GET(DGMTI):DGMTI,1:""))
- +20 SET DGIN0("V")=$GET(^DGMT(408.21,DGVINI,0))
- SET DGIN1("V")=$GET(^(1))
- SET DGIN2("V")=$GET(^(2))
- +21 SET DGINT=$$TOT^DGMTSCU1(DGIN0("V"),6,17)+$$TOT^DGMTSCU1(DGIN0("V"),19,20)
- +22 SET DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,10)
- +23 SET DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)+$$TOT^DGMTSCU1(DGIN2("V"),6,9)
- +24 IF $GET(DGCOMF)
- DO MT(DGINR("V"),DGMTI)
- +25 IF DGSP
- SET (DGIN0("S"),DGIN1("S"),DGIN2("S"))=""
- if $DATA(DGINC("S"))
- DO SPOUSE
- +26 ; dependent child income is not included for LTC co-pay test
- +27 ;I DGDC S (DGIN0("C"),DGIN1("C"))="",DGCNT=0 F S DGCNT=$O(DGINC("C",DGCNT)) Q:'DGCNT D CHK^DGMTSCU2,CHILD:Y
- +28 SET DGINTF=$SELECT(DGINT:1,1:0)
- +29 SET DGNWTF=$SELECT(DGNWT:1,1:0)
- +30 QUIT
- +31 ;
- SPOUSE ;Determine spouse income and net worth
- +1 SET DGIN0("S")=$GET(^DGMT(408.21,DGINC("S"),0))
- SET DGIN1("S")=$GET(^(1))
- SET DGIN2("S")=$GET(^(2))
- +2 SET DGINT=DGINT+$$TOT^DGMTSCU1(DGIN0("S"),6,17)+$$TOT^DGMTSCU1(DGIN0("S"),19,20)
- +3 ; Added next line for LTC Phase IV (EAS*1*40)
- +4 SET DGNWT=DGNWT+$$TOT^DGMTSCU1(DGIN2("S"),1,4)+$$TOT^DGMTSCU1(DGIN2("S"),6,9)
- +5 IF $GET(DGCOMF)
- DO MT(DGINR("S"),DGMTI)
- SPOUSEQ QUIT
- +1 ;
- CHILD ;Determine total dependent children(s) income and expense
- +1 NEW DGCE,DGEMP,I,X
- +2 SET X=$GET(^DGMT(408.21,DGINC("C",DGCNT),0))
- FOR I=8:1:17
- IF $PIECE(X,"^",I)]""
- SET $PIECE(DGIN0("C"),"^",I)=$PIECE(DGIN0("C"),"^",I)+$PIECE(X,"^",I)
- +3 SET DGEMP=$PIECE(X,"^",14)
- SET DGINT=DGINT+$$TOT^DGMTSCU1(X,8,17)
- +4 SET X=$GET(^DGMT(408.21,DGINC("C",DGCNT),1))
- IF $PIECE(X,"^",3)]""
- SET $PIECE(DGIN1("C"),"^",3)=$PIECE(DGIN1("C"),"^",3)+$PIECE(X,"^",3)
- +5 SET DGCE=(DGEMP-$PIECE(DGMTPAR,"^",17))-$PIECE(X,"^",3)
- +6 SET DGDET=DGDET+DGEMP-$SELECT($GET(DGCE)>0:DGCE,1:0)
- +7 IF $GET(DGCOMF)
- DO MT(DGINR("C",DGCNT),DGMTI)
- CHILDQ QUIT
- +1 ;
- MT(DGINR,DGMTI) ;Update Income Relation file with Means Test IEN
- +1 ; Input -- DGINR Income Relation IEN
- +2 ; DGMTI Annual Means Test IEN
- +3 ; Output -- Update Means Test IEN
- +4 NEW DA,DIE,DR
- +5 SET DA=DGINR
- SET DIE="^DGMT(408.22,"
- SET DR="31////^S X="_DGMTI
- DO ^DIE
- +6 QUIT
- +7 ;
- DEP ;Determine dependent data
- +1 ; Input -- DFN Patient file IEN
- +2 ; DGMTDT Date of Test
- +3 ; DGVIRI Veteran Income Relation IEN
- +4 ; Output -- DGVIR0 Veteran Income Relation 0th node
- +5 ; DGSP Spouse 1=YES and 0=NO (mt income)
- +6 ; DGDC Dependent children 1=YES and 0=NO (mt income)
- +7 ; DGNC Number of dependent children
- +8 ; DGND Total number of dependents
- +9 NEW DGCNT,DGDEP,DGINR,DGREL,Y
- +10 SET DGVIR0=$GET(^DGMT(408.22,DGVIRI,0))
- DO ALL^EASECU21(DFN,"SC",DGMTDT,"PR",$SELECT($GET(DGMTI):DGMTI,1:""))
- +11 ;Include spouse's income for LTC co-pay if vet is married
- +12 ;If vet is legally separated, do not include spouse's income. Added for
- +13 ;LTC Phase IV (EAS*1*40)
- +14 SET DGSP=$SELECT('$PIECE(DGVIR0,U,14):0,$PIECE(DGVIR0,U,17):0,'$GET(DGREL("S")):0,1:1)
- +15 ;Child's income is not included for LTC co-pay test
- +16 SET DGDC=0
- +17 SET DGNC=+$PIECE(DGVIR0,"^",13)
- +18 SET DGND=DGSP+DGNC
- +19 QUIT