| 1 | IVMUCHK2 ;ALB/MLI - Filter Routine to Validate IVM Center Tranmissions, Cont ; September 3, 1994
|
|---|
| 2 | ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**1**; 21-OCT-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; This routine is a continuation of IVMUCHK. It performs checks on incoming means test
|
|---|
| 6 | ; transmissions to ensure they are accurate prior to their upload into DHCP.
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | ZIC(STRING,DEPIEN) ; check validity of ZIC segment
|
|---|
| 10 | ;
|
|---|
| 11 | ; Input: STRING as ZIC segment
|
|---|
| 12 | ; DEPIEN as the IEN of the dependent in the array, if applicable
|
|---|
| 13 | ;
|
|---|
| 14 | ; Output: ERROR message or null
|
|---|
| 15 | ;
|
|---|
| 16 | N ERROR,FLAG
|
|---|
| 17 | S ERROR="",X=$P(STRING,HLFS,2),FLAG=0
|
|---|
| 18 | I $E(X,1,4)<1992!($E(X,1,2)>20)!($E(X,5,8)'="0000") S ERROR="Invalid Income Year in ZIC" G ZICQ
|
|---|
| 19 | F I=3:1:20 I $$NUM($P(STRING,HLFS,I),7,2) S ERROR=$P($T(ZICFLD+I),";;",2)_" field content/length error" G:ERROR ZICQ
|
|---|
| 20 | I ERROR]"" G ZICQ
|
|---|
| 21 | I $G(DEPIEN) D I ERROR]"" G ZICQ
|
|---|
| 22 | . F I=13,14 I $P(STRING,HLFS,I)]"" S ERROR="Dependents can't have medical or funeral expenses" Q
|
|---|
| 23 | . I DEPIEN=SPOUSE,($P(STRING,HLFS,15)]"") S ERROR="No educational expenses for spouse" Q
|
|---|
| 24 | . I DEPIEN'=SPOUSE D Q:ERROR]""
|
|---|
| 25 | . . I $P(STRING,HLFS,15)&('$P(ARRAY(DEPIEN,"ZIR"),U,9)) S ERROR="Dependent Educational Exp. error-income not avail. to vet" Q
|
|---|
| 26 | . . S X=$E($P(STRING,HLFS,2),1,4) D ^%DT S X=Y
|
|---|
| 27 | . . 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
|
|---|
| 28 | . . F I=16:1:20 I $P(STRING,HLFS,I)]"" S ERROR="No net worth figures allowed for dependent children"
|
|---|
| 29 | I $P(STRING,HLFS,20)>$P(STRING,HLFS,19) S ERROR="Debts can't be greater than Other Property or Assets" G ZICQ
|
|---|
| 30 | I 'DEP,$P(STRING,HLFS,14) S ERROR="Can't have funeral/burial expenses w/out dependents" G ZICQ
|
|---|
| 31 | I '$G(DEPIEN) D I ERROR]"" G ZICQ
|
|---|
| 32 | . I $P(ARRAY("ZMT"),HLFS,3)="C" Q
|
|---|
| 33 | . S FLAG=0 F I=16:1:20 I $P(STRING,HLFS,I)]"" S FLAG=1 Q
|
|---|
| 34 | . I 'FLAG,SPOUSE F I=16:1:20 I $P(ARRAY(SPOUSE,"ZIC"),HLFS,I)]"" S FLAG=1 Q
|
|---|
| 35 | . I 'FLAG S ERROR="No property information exists for this test"
|
|---|
| 36 | ZICQ Q ERROR
|
|---|
| 37 | ;
|
|---|
| 38 | ;
|
|---|
| 39 | NUM(NUMBER,DIGIT,DECIMAL) ; function to determine if valid numeric value
|
|---|
| 40 | ;
|
|---|
| 41 | ; Input: NUMBER as data element to evaluate
|
|---|
| 42 | ; DIGIT as number of digits allowed
|
|---|
| 43 | ; DECIMAL as number of decimal places
|
|---|
| 44 | ;
|
|---|
| 45 | N ERROR
|
|---|
| 46 | S ERROR=0
|
|---|
| 47 | I NUMBER'?.N.1".".2N S ERROR=1 G NUMQ
|
|---|
| 48 | I $L($P(NUMBER,".",1))>DIGIT S ERROR=1 G NUMQ
|
|---|
| 49 | I NUMBER<0 S ERROR=1
|
|---|
| 50 | NUMQ Q ERROR
|
|---|
| 51 | ;
|
|---|
| 52 | ;
|
|---|
| 53 | ZICFLD ; ZIC field names
|
|---|
| 54 | ;;
|
|---|
| 55 | ;;INCOME YEAR
|
|---|
| 56 | ;;SOCIAL SECURITY
|
|---|
| 57 | ;;US CIVIL SERVICE
|
|---|
| 58 | ;;US RAILROAD RETIREMENT
|
|---|
| 59 | ;;MILITARY RETIREMENT
|
|---|
| 60 | ;;UNEMPLOYMENT COMPENSATION
|
|---|
| 61 | ;;OTHER RETIREMENT
|
|---|
| 62 | ;;EMPLOYMENT INCOME
|
|---|
| 63 | ;;INTEREST, DIVIDEND, ANNUITY
|
|---|
| 64 | ;;WORKERS COMP/BLACK LUNG
|
|---|
| 65 | ;;OTHER INCOME
|
|---|
| 66 | ;;MEDICAL EXPENSES
|
|---|
| 67 | ;;FUNERAL AND BURIAL EXPENSES
|
|---|
| 68 | ;;EDUCATIONAL EXPENSES
|
|---|
| 69 | ;;CASH AMOUNT IN BANK ACCOUNTS
|
|---|
| 70 | ;;STOCKS AND BONDS
|
|---|
| 71 | ;;REAL PROPERTY
|
|---|
| 72 | ;;OTHER PROPERTY OR ASSETS
|
|---|
| 73 | ;;DEBTS
|
|---|
