IVMCME3 ;ALB/SEK - CHECK INCOME DEPENDENT 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 a called from IVMCME.
;
ZDP(STRING,DEPIEN) ; check validity of ZDP segment
;
; Input: STRING as ZDP segment
; DEPIEN as the IEN of the dependent in the array
;
; Output: ERROR message or null
;
N ERROR,IVMZDP5,IVMZDP7,X,Y
S ERROR=""
S X=$P(STRING,HLFS,2) I $L(X)>30!($L(X)<3)!(X?.N)!(X?1P.E)!(X'?1U.ANP)!(X[",")!(X?.L)!(X?." ") S ERROR="Invalid dependent name content/length" G ZDPQ
S X=$P(STRING,HLFS,3) I X'="M",(X'="F") S ERROR="Invalid sex transmitted for dependent" G ZDPQ
S X=$$FMDATE^HLFNC($P(STRING,HLFS,4)),%DT="P" D ^%DT I Y<0!(1701231>Y) S ERROR="Unacceptable DOB for dependent" G ZDPQ
I IVMTYPE'=3,(($E($P(ARRAY("ZMT"),HLFS,2),1,4)-1_1231)<$P(STRING,HLFS,4)) S ERROR="Unacceptable DOB for dependent" G ZDPQ
S X=$P(STRING,HLFS,5) I X]"",(X'?9N),(X'?3N1"-"2N1"-"4N) S ERROR="Invalid dependent SSN transmitted" G ZDPQ
I $E(X)=9!($E(X,1,3)="000") S ERROR="SSA-invalid SSN transmitted for a dependent" G ZDPQ
S X=$G(^DG(408.11,$P(STRING,HLFS,6),0))
I '$P(X,"^",4) S ERROR="Invalid relationship for means test dependent" G ZDPQ
I $P(X,"^",3)'="E",($P(X,"^",3)'=$P(STRING,HLFS,3)) S ERROR="Dependent relationship/sex are inconsistent" G ZDPQ
I IVMTYPE'=3,($P(STRING,HLFS,9)>($E($P(ARRAY("ZMT"),HLFS,2),1,4)-1_1231)) S ERROR="Invalid Dependent Date...must be before MT year"
S IVMZDP5=$P(STRING,HLFS,5) I IVMZDP5']"" G ZDP7
I $D(IVMAR2(IVMZDP5)) S ERROR="Two dependents transmitted with same SSN" G ZDPQ
S IVMAR2(IVMZDP5)=""
ZDP7 S IVMZDP7=$P(STRING,HLFS,7) I IVMZDP7']"" G ZDPQ
I $D(IVMAR(IVMZDP7)) S ERROR="Two dependents transmitted with same 408.12 IEN" G ZDPQ
S IVMAR(IVMZDP7)=""
ZDPQ Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCME3 1867 printed Oct 16, 2024@18:02:09 Page 2
IVMCME3 ;ALB/SEK - CHECK INCOME DEPENDENT 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 a called from IVMCME.
+5 ;
ZDP(STRING,DEPIEN) ; check validity of ZDP segment
+1 ;
+2 ; Input: STRING as ZDP segment
+3 ; DEPIEN as the IEN of the dependent in the array
+4 ;
+5 ; Output: ERROR message or null
+6 ;
+7 NEW ERROR,IVMZDP5,IVMZDP7,X,Y
+8 SET ERROR=""
+9 SET X=$PIECE(STRING,HLFS,2)
IF $LENGTH(X)>30!($LENGTH(X)<3)!(X?.N)!(X?1P.E)!(X'?1U.ANP)!(X[",")!(X?.L)!(X?." ")
SET ERROR="Invalid dependent name content/length"
GOTO ZDPQ
+10 SET X=$PIECE(STRING,HLFS,3)
IF X'="M"
IF (X'="F")
SET ERROR="Invalid sex transmitted for dependent"
GOTO ZDPQ
+11 SET X=$$FMDATE^HLFNC($PIECE(STRING,HLFS,4))
SET %DT="P"
DO ^%DT
IF Y<0!(1701231>Y)
SET ERROR="Unacceptable DOB for dependent"
GOTO ZDPQ
+12 IF IVMTYPE'=3
IF (($EXTRACT($PIECE(ARRAY("ZMT"),HLFS,2),1,4)-1_1231)<$PIECE(STRING,HLFS,4))
SET ERROR="Unacceptable DOB for dependent"
GOTO ZDPQ
+13 SET X=$PIECE(STRING,HLFS,5)
IF X]""
IF (X'?9N)
IF (X'?3N1"-"2N1"-"4N)
SET ERROR="Invalid dependent SSN transmitted"
GOTO ZDPQ
+14 IF $EXTRACT(X)=9!($EXTRACT(X,1,3)="000")
SET ERROR="SSA-invalid SSN transmitted for a dependent"
GOTO ZDPQ
+15 SET X=$GET(^DG(408.11,$PIECE(STRING,HLFS,6),0))
+16 IF '$PIECE(X,"^",4)
SET ERROR="Invalid relationship for means test dependent"
GOTO ZDPQ
+17 IF $PIECE(X,"^",3)'="E"
IF ($PIECE(X,"^",3)'=$PIECE(STRING,HLFS,3))
SET ERROR="Dependent relationship/sex are inconsistent"
GOTO ZDPQ
+18 IF IVMTYPE'=3
IF ($PIECE(STRING,HLFS,9)>($EXTRACT($PIECE(ARRAY("ZMT"),HLFS,2),1,4)-1_1231))
SET ERROR="Invalid Dependent Date...must be before MT year"
+19 SET IVMZDP5=$PIECE(STRING,HLFS,5)
IF IVMZDP5']""
GOTO ZDP7
+20 IF $DATA(IVMAR2(IVMZDP5))
SET ERROR="Two dependents transmitted with same SSN"
GOTO ZDPQ
+21 SET IVMAR2(IVMZDP5)=""
ZDP7 SET IVMZDP7=$PIECE(STRING,HLFS,7)
IF IVMZDP7']""
GOTO ZDPQ
+1 IF $DATA(IVMAR(IVMZDP7))
SET ERROR="Two dependents transmitted with same 408.12 IEN"
GOTO ZDPQ
+2 SET IVMAR(IVMZDP7)=""
ZDPQ QUIT ERROR
