- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFMON 3530 printed Feb 19, 2025@00:29:55 Page 2
- VAFMON ;ALB/CAW/GN - Returns income/dependents ; 2/19/03 3:35pm
- +1 ;;5.3;Registration;**45,67,499**;Aug 13, 1993
- +2 ;
- INCOME(DFN,VADT,VASOURCE) ;
- +1 ; Returns Income (veterans+spouse+dependents)
- +2 ; First from the means test
- +3 ; (Income+Net Worth-Deductible Expenses)
- +4 ; If no means test then co-pay test
- +5 ; (Income-Deductible Expenses)
- +6 ; If no co-pay test then income screening
- +7 ; (Income)
- +8 ; If none of the above then total VA check amount
- +9 ;
- +10 ; INPUT: DFN = Patient IEN
- +11 ; VADT = Date income calculated for
- +12 ; VASOURCE = [optional] income type requested
- +13 ; 1 = returns income (veteran,spouse,children)
- +14 ; minus deductibe expenses - this excludes net worth
- +15 ; OUTPUT: VAINCM = Income^source flag
- +16 ; (2nd piece is only used when VASOURCE is used and is equal to 1)
- +17 ;
- +18 NEW I,VAINCM,VAMT,DGREL,DGINR,DGINC,DGDEP,VAX,X
- +19 IF '$DATA(VADT)
- SET VAINCM=""
- GOTO INCQ
- +20 SET VAINCM=""
- SET VADT=$PIECE(VADT,".")
- +21 SET VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
- +22 IF VAMT
- IF $PIECE(VAMT,U,4)'="N"
- IF $PIECE(VAMT,U,4)'="L"
- SET X=$GET(^DGMT(408.31,+VAMT,0))
- if $LENGTH($PIECE(X,U,4))!$LENGTH($PIECE(X,U,15))
- SET VAINCM=$PIECE(X,U,4)-$PIECE(X,U,15)
- Begin DoDot:1
- +23 ; includes net worth
- IF $GET(VASOURCE)'=1
- IF $LENGTH($PIECE(X,U,5))
- SET VAINCM=VAINCM+$PIECE(X,U,5)
- QUIT
- +24 ;bt source flag
- IF VAINCM]""
- SET VAINCM=VAINCM_$SELECT($PIECE(VAMT,U,5)=1:"^M",1:"^C")
- End DoDot:1
- +25 IF VAINCM']""
- Begin DoDot:1
- +26 NEW VADX
- SET VADX=$SELECT($GET(VASOURCE)=1:"C",1:"D")
- +27 ; DG*5.3*499 pass ien of Means/Co-pay test via 5th parameter
- +28 DO ALL^DGMTU21(DFN,"VS"_VADX,VADT,"I",+VAMT)
- +29 SET VAX=$GET(^DGMT(408.21,+$GET(DGINC("V")),0))
- IF VAX]""
- FOR I=8:1:17
- if $LENGTH($PIECE(VAX,"^",I))
- SET VAINCM=VAINCM+$PIECE(VAX,"^",I)
- +30 SET VAX=$GET(^DGMT(408.21,+$GET(DGINC("S")),0))
- IF VAX]""
- FOR I=8:1:17
- if $LENGTH($PIECE(VAX,"^",I))
- SET VAINCM=VAINCM+$PIECE(VAX,"^",I)
- +31 SET VACNT=0
- FOR
- SET VACNT=$ORDER(DGINC(VADX,VACNT))
- if 'VACNT
- QUIT
- SET VAX=$GET(^DGMT(408.21,+$GET(DGINC(VADX,VACNT)),0))
- IF VAX]""
- FOR I=8:1:17
- if $LENGTH($PIECE(VAX,"^",I))
- SET VAINCM=VAINCM+$PIECE(VAX,"^",I)
- +32 IF $GET(VASOURCE)=1
- IF VAINCM]""
- SET VAINCM=VAINCM_"^I"
- End DoDot:1
- +33 IF VAINCM']""
- SET VAINCM=$PIECE($GET(^DPT(DFN,.362)),U,20)
- IF $GET(VASOURCE)=1
- IF VAINCM]""
- SET VAINCM=VAINCM_"^V"
- +34 ;
- INCQ QUIT VAINCM
- +1 ;
- DEP(DFN,VADT) ;Total dependents for a patient
- +1 ;Input: DFN = Internal Entry Number of Patient file
- +2 ; VADT = Date (Optional - default today)
- +3 ;Output Number of dependents
- +4 NEW VAMT,VAMTDEP,VAVIR0,VAVIRI,DGDEP,DGINR,DGREL,VADEP
- +5 IF 'VADT
- SET VADT=DT
- +6 SET VADEP=""
- +7 SET VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
- +8 IF VAMT
- IF $PIECE(VAMT,U,4)'="N"
- IF $PIECE(VAMT,U,4)'="L"
- IF $DATA(^DGMT(408.31,+VAMT,0))
- SET VADEP=$PIECE(^(0),U,18)
- +9 IF VADEP']""
- Begin DoDot:1
- +10 DO ALL^DGMTU21(DFN,"DSV",VADT)
- IF '$DATA(DGREL)
- QUIT
- +11 SET VAVIRI=+$GET(DGINR("V"))
- SET VAVIR0=$GET(^DGMT(408.22,VAVIRI,0))
- SET VADEP=$PIECE(VAVIR0,U,13)
- +12 IF 'VADEP&($PIECE(VAVIR0,U,8))
- if VADEP=0
- SET VAMTDEP=""
- QUIT
- +13 ; Questions: piece 5=married last calender year
- +14 ; piece 6=lived with patient
- +15 ; piece 7=amount contributed to spouse
- +16 ;
- +17 ; If no spouse, and questions not answered, set dep=null
- +18 ;
- +19 IF '$DATA(DGREL("S"))&($PIECE(VAVIR0,U,5,7)']"")
- SET VADEP=""
- QUIT
- +20 ;
- +21 ; If no spouse, but questions answered, set dep=$S
- +22 ;
- +23 IF '$DATA(DGREL("S"))
- IF $PIECE(VAVIR0,U,5,7)]""
- SET VADEP=VADEP+$SELECT('$PIECE(VAVIR0,U,5):0,$PIECE(VAVIR0,U,6)'=0:1,$PIECE(VAVIR0,U,7)>49:1,1:0)
- QUIT
- +24 ;
- +25 ; If spouse and no questions answered, set dep+1
- +26 ;
- +27 IF $DATA(DGREL("S"))
- IF $PIECE(VAVIR0,U,5,7)']""
- SET VADEP=VADEP+1
- QUIT
- +28 ;
- +29 ; If spouse and questions answered, set dep=$S
- +30 ;
- +31 IF $DATA(DGREL("S"))
- SET VADEP=VADEP+$SELECT($PIECE(VAVIR0,U,6):1,$PIECE(VAVIR0,U,7)>49:1,$PIECE(VAVIR0,U,5)&($PIECE(VAVIR0,U,6)=""):1,1:0)
- End DoDot:1
- IF VADEP]""
- GOTO DEPQ
- +32 ;
- DEPQ QUIT VADEP
