1 | IVMCME2 ;ALB/SEK,BRM - CHECK ANNUAL INCOME DATA ; 12/18/01 2:19pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**17,49**;21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ; This routine is called from IVMCME.
|
---|
6 | ;
|
---|
7 | ;
|
---|
8 | ZIC(STRING,DEPIEN) ; check validity of ZIC segment
|
---|
9 | ;
|
---|
10 | ; Input: STRING as ZIC segment
|
---|
11 | ; DEPIEN as the IEN of the dependent in the array, if applicable
|
---|
12 | ;
|
---|
13 | ; Output: ERROR message or null
|
---|
14 | ;
|
---|
15 | N ERROR,FLAG,I,X,Y
|
---|
16 | S ERROR="",X=$P(STRING,HLFS,2),FLAG=0
|
---|
17 | I $E(X,1,4)<1992!($E(X,5,8)'="0000") S ERROR="Invalid Income Year in ZIC" G ZICQ
|
---|
18 | F I=3:1:20 I $$NUM($P(STRING,HLFS,I),7,2) S ERROR=$P($T(ZICFLD+I),";;",2)_" field content/length error" Q
|
---|
19 | I ERROR]"" G ZICQ
|
---|
20 | I $G(DEPIEN) D I ERROR]"" G ZICQ
|
---|
21 | . F I=13,14 I $P(STRING,HLFS,I)]"" S ERROR="Dependents can't have medical or funeral expenses" Q
|
---|
22 | . I DEPIEN=SPOUSE,($P(STRING,HLFS,15)]"") S ERROR="No educational expenses for spouse" Q
|
---|
23 | . I DEPIEN'=SPOUSE D Q:ERROR]""
|
---|
24 | . . I $P(STRING,HLFS,15)&('$P(ARRAY(DEPIEN,"ZIR"),U,9)) S ERROR="Dependent Educational Exp. error-income not avail. to vet" Q
|
---|
25 | . . S X=$E($P(STRING,HLFS,2),1,4) D ^%DT S X=Y
|
---|
26 | . . I $P(STRING,HLFS,15)]"" S X=$P(^DG(43,1,"MT",X,0),U,17) I X'<$P(STRING,HLFS,9) S ERROR="Income does not exceed child exclusion amount-educational expense not allowed" Q
|
---|
27 | . . F I=16:1:20 I $P(STRING,HLFS,I)]"" S ERROR="No net worth figures allowed for dependent children"
|
---|
28 | I $P(STRING,HLFS,20)>$P(STRING,HLFS,19) S ERROR="Debts can't be greater than Other Property or Assets" G ZICQ
|
---|
29 | I '$G(DEPIEN) D I ERROR]"" G ZICQ
|
---|
30 | . I IVMTYPE'=1 Q
|
---|
31 | . I $P(ARRAY("ZMT"),HLFS,3)="C" Q
|
---|
32 | . S FLAG=0 F I=16:1:20 I $P(STRING,HLFS,I)]"" S FLAG=1 Q
|
---|
33 | . I 'FLAG,SPOUSE F I=16:1:20 I $P(ARRAY(SPOUSE,"ZIC"),HLFS,I)]"" S FLAG=1 Q
|
---|
34 | ZICQ Q ERROR
|
---|
35 | ;
|
---|
36 | ;
|
---|
37 | NUM(NUMBER,DIGIT,DECIMAL) ; function to determine if valid numeric value
|
---|
38 | ;
|
---|
39 | ; Input: NUMBER as data element to evaluate
|
---|
40 | ; DIGIT as number of digits allowed
|
---|
41 | ; DECIMAL as number of decimal places
|
---|
42 | ;
|
---|
43 | N ERROR
|
---|
44 | S ERROR=0
|
---|
45 | I NUMBER'?.N.1".".2N S ERROR=1 G NUMQ
|
---|
46 | I $L($P(NUMBER,".",1))>DIGIT S ERROR=1 G NUMQ
|
---|
47 | I NUMBER<0 S ERROR=1
|
---|
48 | NUMQ Q ERROR
|
---|
49 | ;
|
---|
50 | ;
|
---|
51 | ZICFLD ; ZIC field names
|
---|
52 | ;;
|
---|
53 | ;;INCOME YEAR
|
---|
54 | ;;SOCIAL SECURITY
|
---|
55 | ;;US CIVIL SERVICE
|
---|
56 | ;;US RAILROAD RETIREMENT
|
---|
57 | ;;MILITARY RETIREMENT
|
---|
58 | ;;UNEMPLOYMENT COMPENSATION
|
---|
59 | ;;OTHER RETIREMENT
|
---|
60 | ;;EMPLOYMENT INCOME
|
---|
61 | ;;INTEREST, DIVIDEND, ANNUITY
|
---|
62 | ;;WORKERS COMP/BLACK LUNG
|
---|
63 | ;;OTHER INCOME
|
---|
64 | ;;MEDICAL EXPENSES
|
---|
65 | ;;FUNERAL AND BURIAL EXPENSES
|
---|
66 | ;;EDUCATIONAL EXPENSES
|
---|
67 | ;;CASH AMOUNT IN BANK ACCOUNTS
|
---|
68 | ;;STOCKS AND BONDS
|
---|
69 | ;;REAL PROPERTY
|
---|
70 | ;;OTHER PROPERTY OR ASSETS
|
---|
71 | ;;DEBTS
|
---|