DGMTSCU3 ;ALB/RMO - Means Test Screen Variable Utilities Cont. ;4 MAY 1992 7:45 am
;;5.3;Registration;**45,688**;Aug 13, 1993;Build 29
;
INC ;Determine income, expense and net worth
; Input -- DFN Patient file IEN
; DGCOMF Means Test Completion Flag (Optional)
; (1 if completing means 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^DGMTU21(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"),8,17)
S DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,3)
S DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)-$P(DGIN2("V"),"^",5)
I $G(DGCOMF) D MT(DGINR("V"),DGMTI)
I DGSP S (DGIN0("S"),DGIN1("S"),DGIN2("S"))="" D SPOUSE:$D(DGINC("S"))
I DGDC S (DGIN0("C"),DGIN1("C"))="",DGIN2("C")="",DGCNT=0 F S DGCNT=$O(DGINC("C",DGCNT)) Q:'DGCNT D CHK^DGMTSCU2,CHILD:Y
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
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
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"),8,17)
S DGNWT=DGNWT+($$TOT^DGMTSCU1(DGIN2("S"),1,4)-$P(DGIN2("S"),"^",5))
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)
S X=$G(^DGMT(408.21,DGINC("C",DGCNT),2))
F I=1:1:9 I $P(X,"^",I)]"" S $P(DGIN2("C"),"^",I)=$P(DGIN2("C"),"^",I)+$P(X,"^",I)
S DGNWT=DGNWT+($$TOT^DGMTSCU1(X,1,4)-$P(X,"^",5))
CHILDQ Q
;
MT(DGINR,DGMTI) ;Update Means Test IEN in Individual Annual Income file
; 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTSCU3 3192 printed Apr 09, 2024@21:39:47 Page 2
DGMTSCU3 ;ALB/RMO - Means Test Screen Variable Utilities Cont. ;4 MAY 1992 7:45 am
+1 ;;5.3;Registration;**45,688**;Aug 13, 1993;Build 29
+2 ;
INC ;Determine income, expense and net worth
+1 ; Input -- DFN Patient file IEN
+2 ; DGCOMF Means Test Completion Flag (Optional)
+3 ; (1 if completing means 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^DGMTU21(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"),8,17)
+22 SET DGDET=$$TOT^DGMTSCU1(DGIN1("V"),1,3)
+23 SET DGNWT=$$TOT^DGMTSCU1(DGIN2("V"),1,4)-$PIECE(DGIN2("V"),"^",5)
+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 IF DGDC
SET (DGIN0("C"),DGIN1("C"))=""
SET DGIN2("C")=""
SET DGCNT=0
FOR
SET DGCNT=$ORDER(DGINC("C",DGCNT))
if 'DGCNT
QUIT
DO CHK^DGMTSCU2
if Y
DO CHILD
+27 SET DGINTF=$SELECT(DGINT:1,1:0)
IF 'DGINTF
SET J=""
FOR
SET J=$ORDER(DGIN0(J))
if J=""!(DGINTF)
QUIT
FOR I=8:1:17
if DGINTF
QUIT
if $PIECE(DGIN0(J),"^",I)]""
SET DGINTF=1
+28 SET DGNWTF=$SELECT(DGNWT:1,1:0)
IF 'DGNWTF
SET J=""
FOR
SET J=$ORDER(DGIN2(J))
if J=""!(DGNWTF)
QUIT
FOR I=1:1:5
if DGNWTF
QUIT
if $PIECE(DGIN2(J),"^",I)]""
SET DGNWTF=1
+29 QUIT
+30 ;
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"),8,17)
+3 SET DGNWT=DGNWT+($$TOT^DGMTSCU1(DGIN2("S"),1,4)-$PIECE(DGIN2("S"),"^",5))
+4 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)
+8 SET X=$GET(^DGMT(408.21,DGINC("C",DGCNT),2))
+9 FOR I=1:1:9
IF $PIECE(X,"^",I)]""
SET $PIECE(DGIN2("C"),"^",I)=$PIECE(DGIN2("C"),"^",I)+$PIECE(X,"^",I)
+10 SET DGNWT=DGNWT+($$TOT^DGMTSCU1(X,1,4)-$PIECE(X,"^",5))
CHILDQ QUIT
+1 ;
MT(DGINR,DGMTI) ;Update Means Test IEN in Individual Annual Income file
+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
