source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMUCHK2.m@ 724

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1IVMUCHK2 ;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 ;
9ZIC(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"
36ZICQ Q ERROR
37 ;
38 ;
39NUM(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
50NUMQ Q ERROR
51 ;
52 ;
53ZICFLD ; 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
Note: See TracBrowser for help on using the repository browser.