| 1 | IVMCME1 ;ALB/SEK - CHECK INCOME RELATION DATA ; 02-MAY-95
 | 
|---|
| 2 |  ;;2.0;INCOME VERIFICATION MATCH;**17**;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 | ZIR(STRING,DEPIEN) ; check validity of ZIR segment
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 |  ; Input:  STRING as ZIR segment
 | 
|---|
| 10 |  ;         DEPIEN as the IEN of the dependent in the array, if applicable
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 |  ; Output: ERROR message or null
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 |  N ERROR,I,X
 | 
|---|
| 15 |  S ERROR=""
 | 
|---|
| 16 |  F I=2,3,5:1:9 D  I ERROR]"" G ZIRQ
 | 
|---|
| 17 |  . S X=$P(STRING,HLFS,I)
 | 
|---|
| 18 |  . I X]"",(X'=0),(X'=1) S ERROR=$P($T(ZIRFLD+I),";;",2)_" contains unacceptable value" Q
 | 
|---|
| 19 |  I $$NUM^IVMCME2($P(STRING,HLFS,4),5,2) S ERROR="Invalid number for Amount Contributed to Spouse" G ZIRQ
 | 
|---|
| 20 |  S X=$P(STRING,HLFS,10) I X]""&((X>30)!(X<0)!(+X'=X)) S ERROR="Invalid number in Number of Dependent Children field" G ZIRQ
 | 
|---|
| 21 |  I X]"",(X'=DEP-SPOUSE) S ERROR="Number of Dependent Children does not match dependents transmitted" G ZIRQ
 | 
|---|
| 22 |  I '$G(DEPIEN) D  I ERROR]"" G ZIRQ ; if veteran ZIR segment
 | 
|---|
| 23 |  . I $P(STRING,HLFS,2)']"" S ERROR="Must have Married Last Calendar Year for veteran" Q
 | 
|---|
| 24 |  . I SPOUSE,'$P(STRING,HLFS,2) S ERROR="Spouse transmitted, but Married Last Calendar Year is NO" Q
 | 
|---|
| 25 |  . I 'SPOUSE,$P(STRING,HLFS,2) S ERROR="No spouse transmitted, but Married Last Calendar Year is YES" Q
 | 
|---|
| 26 |  . I '$P(STRING,HLFS,2),($P(STRING,HLFS,3)]"") S ERROR="Can't have Lived with Patient if not Married" Q
 | 
|---|
| 27 |  . I $P(STRING,HLFS,2),($P(STRING,HLFS,3)']"") S ERROR="Must have Living with Patient if Married" Q
 | 
|---|
| 28 |  . I $P(STRING,HLFS,3),($P(STRING,HLFS,4)]"") S ERROR="Should not have Amount contributed to spouse if living w/patient" Q
 | 
|---|
| 29 |  . I $P(STRING,HLFS,3)=0,($P(STRING,HLFS,4)']"") S ERROR="Need amount contributed to spouse if not living w/patient" Q
 | 
|---|
| 30 |  . F I=6:1:9 I $P(STRING,HLFS,I)]"" S ERROR=$P($T(ZIRFLD+I),";;",2)_" should not be filled in for veteran" Q
 | 
|---|
| 31 |  . I '$P(STRING,HLFS,3),SPOUSE,($P(STRING,HLFS,4)<600) F I=3:1:20 I $P(ARRAY(SPOUSE,"ZIC"),HLFS,I) S ERROR="No income data allowed if spouse didn't live w/vet & amt contributed <$600" Q
 | 
|---|
| 32 |  I $G(DEPIEN)=SPOUSE D  I ERROR]"" G ZIRQ ; if spouse ZIR segment
 | 
|---|
| 33 |  . F I=2:1:10 I $P(STRING,HLFS,I)]"" S ERROR=$P($T(ZIRFLD+I),";;",2)_" should not be filled in for spouse ZIR" Q
 | 
|---|
| 34 |  I $G(DEPIEN),(DEPIEN'=SPOUSE) D  I ERROR]"" G ZIRQ ; if child ZIR segment
 | 
|---|
| 35 |  . I $P(STRING,HLFS,3)']"" S ERROR="Dependents must have Lived With Patient field" Q
 | 
|---|
| 36 |  . I '$P(STRING,HLFS,8),($P(STRING,HLFS,9)]"") S ERROR="Shouldn't have Income Available answered if Child had no income" Q
 | 
|---|
| 37 |  . I $P(STRING,HLFS,3),($P(STRING,HLFS,7)]"") S ERROR="Shouldn't have Contributed to Support if living w/patient" Q
 | 
|---|
| 38 |  . I '$P(STRING,HLFS,8) F I=3:1:20 I $P(ARRAY(DEPIEN,"ZIC"),HLFS,I) S ERROR="Shouldn't have income data if Child Had Income is NO" Q
 | 
|---|
| 39 | ZIRQ Q ERROR
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | ZIRFLD ; ZIR field names
 | 
|---|
| 43 |  ;;
 | 
|---|
| 44 |  ;;MARRIED LAST CALENDAR YEAR
 | 
|---|
| 45 |  ;;LIVED WITH PATIENT
 | 
|---|
| 46 |  ;;AMOUNT CONTRIBUTED TO SPOUSE
 | 
|---|
| 47 |  ;;DEPENDENT CHILDREN
 | 
|---|
| 48 |  ;;INCAPABLE OF SELF SUPPORT
 | 
|---|
| 49 |  ;;CONTRIBUTED TO SUPPORT
 | 
|---|
| 50 |  ;;CHILD HAD INCOME
 | 
|---|
| 51 |  ;;INCOME AVAILABLE TO YOU
 | 
|---|
| 52 |  ;;NUMBER OF DEPENDENT CHILDREN
 | 
|---|