| 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
|
|---|
