IVMCME1 ;ALB/SEK - CHECK INCOME RELATION DATA ; 02-MAY-95
;;2.0;INCOME VERIFICATION MATCH;**17**;21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine is called from IVMCME.
;
ZIR(STRING,DEPIEN) ; check validity of ZIR segment
;
; Input: STRING as ZIR segment
; DEPIEN as the IEN of the dependent in the array, if applicable
;
; Output: ERROR message or null
;
N ERROR,I,X
S ERROR=""
F I=2,3,5:1:9 D I ERROR]"" G ZIRQ
. S X=$P(STRING,HLFS,I)
. I X]"",(X'=0),(X'=1) S ERROR=$P($T(ZIRFLD+I),";;",2)_" contains unacceptable value" Q
I $$NUM^IVMCME2($P(STRING,HLFS,4),5,2) S ERROR="Invalid number for Amount Contributed to Spouse" G ZIRQ
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
I X]"",(X'=DEP-SPOUSE) S ERROR="Number of Dependent Children does not match dependents transmitted" G ZIRQ
I '$G(DEPIEN) D I ERROR]"" G ZIRQ ; if veteran ZIR segment
. I $P(STRING,HLFS,2)']"" S ERROR="Must have Married Last Calendar Year for veteran" Q
. I SPOUSE,'$P(STRING,HLFS,2) S ERROR="Spouse transmitted, but Married Last Calendar Year is NO" Q
. I 'SPOUSE,$P(STRING,HLFS,2) S ERROR="No spouse transmitted, but Married Last Calendar Year is YES" Q
. I '$P(STRING,HLFS,2),($P(STRING,HLFS,3)]"") S ERROR="Can't have Lived with Patient if not Married" Q
. I $P(STRING,HLFS,2),($P(STRING,HLFS,3)']"") S ERROR="Must have Living with Patient if Married" Q
. I $P(STRING,HLFS,3),($P(STRING,HLFS,4)]"") S ERROR="Should not have Amount contributed to spouse if living w/patient" Q
. I $P(STRING,HLFS,3)=0,($P(STRING,HLFS,4)']"") S ERROR="Need amount contributed to spouse if not living w/patient" Q
. 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
. 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
I $G(DEPIEN)=SPOUSE D I ERROR]"" G ZIRQ ; if spouse ZIR segment
. 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
I $G(DEPIEN),(DEPIEN'=SPOUSE) D I ERROR]"" G ZIRQ ; if child ZIR segment
. I $P(STRING,HLFS,3)']"" S ERROR="Dependents must have Lived With Patient field" Q
. I '$P(STRING,HLFS,8),($P(STRING,HLFS,9)]"") S ERROR="Shouldn't have Income Available answered if Child had no income" Q
. I $P(STRING,HLFS,3),($P(STRING,HLFS,7)]"") S ERROR="Shouldn't have Contributed to Support if living w/patient" Q
. 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
ZIRQ Q ERROR
;
;
ZIRFLD ; ZIR field names
;;
;;MARRIED LAST CALENDAR YEAR
;;LIVED WITH PATIENT
;;AMOUNT CONTRIBUTED TO SPOUSE
;;DEPENDENT CHILDREN
;;INCAPABLE OF SELF SUPPORT
;;CONTRIBUTED TO SUPPORT
;;CHILD HAD INCOME
;;INCOME AVAILABLE TO YOU
;;NUMBER OF DEPENDENT CHILDREN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCME1 3079 printed Oct 16, 2024@18:02:08 Page 2
IVMCME1 ;ALB/SEK - CHECK INCOME RELATION DATA ; 02-MAY-95
+1 ;;2.0;INCOME VERIFICATION MATCH;**17**;21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine is called from IVMCME.
+5 ;
ZIR(STRING,DEPIEN) ; check validity of ZIR segment
+1 ;
+2 ; Input: STRING as ZIR segment
+3 ; DEPIEN as the IEN of the dependent in the array, if applicable
+4 ;
+5 ; Output: ERROR message or null
+6 ;
+7 NEW ERROR,I,X
+8 SET ERROR=""
+9 FOR I=2,3,5:1:9
Begin DoDot:1
+10 SET X=$PIECE(STRING,HLFS,I)
+11 IF X]""
IF (X'=0)
IF (X'=1)
SET ERROR=$PIECE($TEXT(ZIRFLD+I),";;",2)_" contains unacceptable value"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZIRQ
+12 IF $$NUM^IVMCME2($PIECE(STRING,HLFS,4),5,2)
SET ERROR="Invalid number for Amount Contributed to Spouse"
GOTO ZIRQ
+13 SET X=$PIECE(STRING,HLFS,10)
IF X]""&((X>30)!(X<0)!(+X'=X))
SET ERROR="Invalid number in Number of Dependent Children field"
GOTO ZIRQ
+14 IF X]""
IF (X'=DEP-SPOUSE)
SET ERROR="Number of Dependent Children does not match dependents transmitted"
GOTO ZIRQ
+15 ; if veteran ZIR segment
IF '$GET(DEPIEN)
Begin DoDot:1
+16 IF $PIECE(STRING,HLFS,2)']""
SET ERROR="Must have Married Last Calendar Year for veteran"
QUIT
+17 IF SPOUSE
IF '$PIECE(STRING,HLFS,2)
SET ERROR="Spouse transmitted, but Married Last Calendar Year is NO"
QUIT
+18 IF 'SPOUSE
IF $PIECE(STRING,HLFS,2)
SET ERROR="No spouse transmitted, but Married Last Calendar Year is YES"
QUIT
+19 IF '$PIECE(STRING,HLFS,2)
IF ($PIECE(STRING,HLFS,3)]"")
SET ERROR="Can't have Lived with Patient if not Married"
QUIT
+20 IF $PIECE(STRING,HLFS,2)
IF ($PIECE(STRING,HLFS,3)']"")
SET ERROR="Must have Living with Patient if Married"
QUIT
+21 IF $PIECE(STRING,HLFS,3)
IF ($PIECE(STRING,HLFS,4)]"")
SET ERROR="Should not have Amount contributed to spouse if living w/patient"
QUIT
+22 IF $PIECE(STRING,HLFS,3)=0
IF ($PIECE(STRING,HLFS,4)']"")
SET ERROR="Need amount contributed to spouse if not living w/patient"
QUIT
+23 FOR I=6:1:9
IF $PIECE(STRING,HLFS,I)]""
SET ERROR=$PIECE($TEXT(ZIRFLD+I),";;",2)_" should not be filled in for veteran"
QUIT
+24 IF '$PIECE(STRING,HLFS,3)
IF SPOUSE
IF ($PIECE(STRING,HLFS,4)<600)
FOR I=3:1:20
IF $PIECE(ARRAY(SPOUSE,"ZIC"),HLFS,I)
SET ERROR="No income data allowed if spouse didn't live w/vet & amt contributed <$600"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZIRQ
+25 ; if spouse ZIR segment
IF $GET(DEPIEN)=SPOUSE
Begin DoDot:1
+26 FOR I=2:1:10
IF $PIECE(STRING,HLFS,I)]""
SET ERROR=$PIECE($TEXT(ZIRFLD+I),";;",2)_" should not be filled in for spouse ZIR"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZIRQ
+27 ; if child ZIR segment
IF $GET(DEPIEN)
IF (DEPIEN'=SPOUSE)
Begin DoDot:1
+28 IF $PIECE(STRING,HLFS,3)']""
SET ERROR="Dependents must have Lived With Patient field"
QUIT
+29 IF '$PIECE(STRING,HLFS,8)
IF ($PIECE(STRING,HLFS,9)]"")
SET ERROR="Shouldn't have Income Available answered if Child had no income"
QUIT
+30 IF $PIECE(STRING,HLFS,3)
IF ($PIECE(STRING,HLFS,7)]"")
SET ERROR="Shouldn't have Contributed to Support if living w/patient"
QUIT
+31 IF '$PIECE(STRING,HLFS,8)
FOR I=3:1:20
IF $PIECE(ARRAY(DEPIEN,"ZIC"),HLFS,I)
SET ERROR="Shouldn't have income data if Child Had Income is NO"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZIRQ
ZIRQ QUIT ERROR
+1 ;
+2 ;
ZIRFLD ; ZIR field names
+1 ;;
+2 ;;MARRIED LAST CALENDAR YEAR
+3 ;;LIVED WITH PATIENT
+4 ;;AMOUNT CONTRIBUTED TO SPOUSE
+5 ;;DEPENDENT CHILDREN
+6 ;;INCAPABLE OF SELF SUPPORT
+7 ;;CONTRIBUTED TO SUPPORT
+8 ;;CHILD HAD INCOME
+9 ;;INCOME AVAILABLE TO YOU
+10 ;;NUMBER OF DEPENDENT CHILDREN
