Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFMON

VAFMON.m

Go to the documentation of this file.
VAFMON ;ALB/CAW/GN - Returns income/dependents ; 2/19/03 3:35pm
 ;;5.3;Registration;**45,67,499**;Aug 13, 1993
 ;
INCOME(DFN,VADT,VASOURCE) ; 
 ;  Returns Income (veterans+spouse+dependents)
 ;      First from the means test
 ;        (Income+Net Worth-Deductible Expenses)
 ;      If no means test then co-pay test
 ;        (Income-Deductible Expenses)
 ;      If no co-pay test then income screening
 ;        (Income)
 ;      If none of the above then total VA check amount
 ;
 ;      INPUT:  DFN = Patient IEN
 ;             VADT = Date income calculated for
 ;         VASOURCE = [optional] income type requested
 ;                    1 = returns income (veteran,spouse,children)
 ;                        minus deductibe expenses - this excludes net worth 
 ;     OUTPUT: VAINCM = Income^source flag 
 ;                        (2nd piece is only used when VASOURCE is used and is equal to 1)
 ;
 N I,VAINCM,VAMT,DGREL,DGINR,DGINC,DGDEP,VAX,X
 I '$D(VADT) S VAINCM="" G INCQ
 S VAINCM="",VADT=$P(VADT,".")
 S VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
 I VAMT,$P(VAMT,U,4)'="N",$P(VAMT,U,4)'="L" S X=$G(^DGMT(408.31,+VAMT,0)) S:$L($P(X,U,4))!$L($P(X,U,15)) VAINCM=$P(X,U,4)-$P(X,U,15) D
 .I $G(VASOURCE)'=1,$L($P(X,U,5)) S VAINCM=VAINCM+$P(X,U,5) Q  ; includes net worth
 .I VAINCM]"" S VAINCM=VAINCM_$S($P(VAMT,U,5)=1:"^M",1:"^C") ;bt source flag
 I VAINCM']"" D
 .N VADX S VADX=$S($G(VASOURCE)=1:"C",1:"D")
 .;    DG*5.3*499 pass ien of Means/Co-pay test via 5th parameter
 .D ALL^DGMTU21(DFN,"VS"_VADX,VADT,"I",+VAMT)
 .S VAX=$G(^DGMT(408.21,+$G(DGINC("V")),0)) I VAX]"" F I=8:1:17 S:$L($P(VAX,"^",I)) VAINCM=VAINCM+$P(VAX,"^",I)
 .S VAX=$G(^DGMT(408.21,+$G(DGINC("S")),0)) I VAX]"" F I=8:1:17 S:$L($P(VAX,"^",I)) VAINCM=VAINCM+$P(VAX,"^",I)
 .S VACNT=0 F  S VACNT=$O(DGINC(VADX,VACNT)) Q:'VACNT  S VAX=$G(^DGMT(408.21,+$G(DGINC(VADX,VACNT)),0)) I VAX]"" F I=8:1:17 S:$L($P(VAX,"^",I)) VAINCM=VAINCM+$P(VAX,"^",I)
 .I $G(VASOURCE)=1,VAINCM]"" S VAINCM=VAINCM_"^I"
 I VAINCM']"" S VAINCM=$P($G(^DPT(DFN,.362)),U,20) I $G(VASOURCE)=1,VAINCM]"" S VAINCM=VAINCM_"^V"
 ;
INCQ Q VAINCM
 ;
DEP(DFN,VADT) ;Total dependents for a patient
 ;Input:      DFN  = Internal Entry Number of Patient file
 ;            VADT = Date (Optional - default today)
 ;Output      Number of dependents
 N VAMT,VAMTDEP,VAVIR0,VAVIRI,DGDEP,DGINR,DGREL,VADEP
 I 'VADT S VADT=DT
 S VADEP=""
 S VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
 I VAMT,$P(VAMT,U,4)'="N",$P(VAMT,U,4)'="L",$D(^DGMT(408.31,+VAMT,0)) S VADEP=$P(^(0),U,18)
 I VADEP']"" D  I VADEP]"" G DEPQ
 .D ALL^DGMTU21(DFN,"DSV",VADT) I '$D(DGREL) Q
 .S VAVIRI=+$G(DGINR("V")),VAVIR0=$G(^DGMT(408.22,VAVIRI,0)),VADEP=$P(VAVIR0,U,13)
 .I 'VADEP&($P(VAVIR0,U,8)) S:VADEP=0 VAMTDEP="" Q
 .; Questions: piece 5=married last calender year
 .;            piece 6=lived with patient
 .;            piece 7=amount contributed to spouse
 .;
 .; If no spouse, and questions not answered, set dep=null
 .;
 .I '$D(DGREL("S"))&($P(VAVIR0,U,5,7)']"") S VADEP="" Q
 .;
 .; If no spouse, but questions answered, set dep=$S
 .;
 .I '$D(DGREL("S")),$P(VAVIR0,U,5,7)]"" S VADEP=VADEP+$S('$P(VAVIR0,U,5):0,$P(VAVIR0,U,6)'=0:1,$P(VAVIR0,U,7)>49:1,1:0) Q
 .;
 .; If spouse and no questions answered, set dep+1
 .;
 .I $D(DGREL("S")),$P(VAVIR0,U,5,7)']"" S VADEP=VADEP+1 Q
 .;
 .; If spouse and questions answered, set dep=$S
 .;
 .I $D(DGREL("S")) S VADEP=VADEP+$S($P(VAVIR0,U,6):1,$P(VAVIR0,U,7)>49:1,$P(VAVIR0,U,5)&($P(VAVIR0,U,6)=""):1,1:0)
 ;
DEPQ Q VADEP