source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFMON.m@ 1501

Last change on this file since 1501 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
Line 
1VAFMON ;ALB/CAW/GN - Returns income/dependents ; 2/19/03 3:35pm
2 ;;5.3;Registration;**45,67,499**;Aug 13, 1993
3 ;
4INCOME(DFN,VADT,VASOURCE) ;
5 ; Returns Income (veterans+spouse+dependents)
6 ; First from the means test
7 ; (Income+Net Worth-Deductible Expenses)
8 ; If no means test then co-pay test
9 ; (Income-Deductible Expenses)
10 ; If no co-pay test then income screening
11 ; (Income)
12 ; If none of the above then total VA check amount
13 ;
14 ; INPUT: DFN = Patient IEN
15 ; VADT = Date income calculated for
16 ; VASOURCE = [optional] income type requested
17 ; 1 = returns income (veteran,spouse,children)
18 ; minus deductibe expenses - this excludes net worth
19 ; OUTPUT: VAINCM = Income^source flag
20 ; (2nd piece is only used when VASOURCE is used and is equal to 1)
21 ;
22 N I,VAINCM,VAMT,DGREL,DGINR,DGINC,DGDEP,VAX,X
23 I '$D(VADT) S VAINCM="" G INCQ
24 S VAINCM="",VADT=$P(VADT,".")
25 S VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
26 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
27 .I $G(VASOURCE)'=1,$L($P(X,U,5)) S VAINCM=VAINCM+$P(X,U,5) Q ; includes net worth
28 .I VAINCM]"" S VAINCM=VAINCM_$S($P(VAMT,U,5)=1:"^M",1:"^C") ;bt source flag
29 I VAINCM']"" D
30 .N VADX S VADX=$S($G(VASOURCE)=1:"C",1:"D")
31 .; DG*5.3*499 pass ien of Means/Co-pay test via 5th parameter
32 .D ALL^DGMTU21(DFN,"VS"_VADX,VADT,"I",+VAMT)
33 .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)
34 .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)
35 .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)
36 .I $G(VASOURCE)=1,VAINCM]"" S VAINCM=VAINCM_"^I"
37 I VAINCM']"" S VAINCM=$P($G(^DPT(DFN,.362)),U,20) I $G(VASOURCE)=1,VAINCM]"" S VAINCM=VAINCM_"^V"
38 ;
39INCQ Q VAINCM
40 ;
41DEP(DFN,VADT) ;Total dependents for a patient
42 ;Input: DFN = Internal Entry Number of Patient file
43 ; VADT = Date (Optional - default today)
44 ;Output Number of dependents
45 N VAMT,VAMTDEP,VAVIR0,VAVIRI,DGDEP,DGINR,DGREL,VADEP
46 I 'VADT S VADT=DT
47 S VADEP=""
48 S VAMT=$$LST^DGMTCOU1(DFN,VADT,3)
49 I VAMT,$P(VAMT,U,4)'="N",$P(VAMT,U,4)'="L",$D(^DGMT(408.31,+VAMT,0)) S VADEP=$P(^(0),U,18)
50 I VADEP']"" D I VADEP]"" G DEPQ
51 .D ALL^DGMTU21(DFN,"DSV",VADT) I '$D(DGREL) Q
52 .S VAVIRI=+$G(DGINR("V")),VAVIR0=$G(^DGMT(408.22,VAVIRI,0)),VADEP=$P(VAVIR0,U,13)
53 .I 'VADEP&($P(VAVIR0,U,8)) S:VADEP=0 VAMTDEP="" Q
54 .; Questions: piece 5=married last calender year
55 .; piece 6=lived with patient
56 .; piece 7=amount contributed to spouse
57 .;
58 .; If no spouse, and questions not answered, set dep=null
59 .;
60 .I '$D(DGREL("S"))&($P(VAVIR0,U,5,7)']"") S VADEP="" Q
61 .;
62 .; If no spouse, but questions answered, set dep=$S
63 .;
64 .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
65 .;
66 .; If spouse and no questions answered, set dep+1
67 .;
68 .I $D(DGREL("S")),$P(VAVIR0,U,5,7)']"" S VADEP=VADEP+1 Q
69 .;
70 .; If spouse and questions answered, set dep=$S
71 .;
72 .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)
73 ;
74DEPQ Q VADEP
Note: See TracBrowser for help on using the repository browser.