IVMUCHK4 ;ALB/CAW - Filter routine to validate IVM Center Transmission, Con't ; September 19, 1994
;;Version 2.0 ; INCOME VERIFICATION MATCH ;**1**; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine is a continuation of IVMUCHK. It performs checks on incoming means test
; transmissions to ensure they are accurate prior to their upload into DHCP.
;
;
ZMT(STRING) ; check ZMT segment
;
; Input: STRING as ZMT segment
;
; Output: ERROR message or null
;
N ERROR,I,X
S ERROR=""
S X=$P(STRING,HLFS,2) I $E(X,1,4)<1993!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Date of Test" G ZMTQ
S X=$$FMDATE^HLFNC(X),%DT="X" D ^%DT I Y<0 S ERROR="Invalid Date of Test" G ZMTQ
;
; Status Checks
D MT^IVMUCHK5(STRING,ARRAY("ZIC")) I ERROR]"" G ZMTQ
;
; Field content/lenght
F I=4,5 I $$NUM^IVMUCHK2($P(STRING,HLFS,I),10,2) S ERROR=$S(I=4:"INCOME",1:"NET WORTH")_" field content/length error"
I ERROR]"" G ZMTQ
;
; gather income totals
D INC^IVMUCHK5 I ERROR]"" G ZMTQ
;
; Adjudicate Date/Time
S X=$P(STRING,HLFS,6) I X]"" D I ERROR]"" G ZMTQ
. I $E(X,1,4)<1993!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Adjudication Date/Time" Q
. S X=$$FMDATE^HLFNC(X),%DT="TX" D ^%DT I Y<0 S ERROR="Invalid Adjudication Date/Time" Q
;
; Agree to Pay Deductible
S X=$P(STRING,HLFS,7) I X]"",(X'=0),(X'=1) S ERROR="Invalid Agreed To Pay Deductible Value" G ZMTQ
I $P(STRING,HLFS,3)="A",X'="" S ERROR="Cat A veteran-Agree to Pay Deductible should be null" G ZMTQ
;
; Threshold A value
S X=$P(STRING,HLFS,8) I X']"" S ERROR="Invalid Threshold A value" G ZMTQ
I (X'>0)!(X'<99001) S ERROR="Invalid Threshold A value" G ZMTQ
;
; Deductibe Expenses
I $$NUM^IVMUCHK2($P(STRING,HLFS,9),10,2) S ERROR="Deductible Expenses field content/length error" G ZMTQ
I $P(STRING,HLFS,4)<($P(STRING,HLFS,9)) S ERROR="Deductible Expenses cannot exceed income" G ZMTQ
;
; Means Test Completion Date/Time
S X=$P(STRING,HLFS,10) I $E(X,1,4)<1992!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Completion Date/Time" G ZMTQ
S X=$$FMDATE^HLFNC(X),%DT="TX" D ^%DT I Y<0 S ERROR="Invalid Completion Date/Time" G ZMTQ
;
; Previous Year Threshold
S X=$P(STRING,HLFS,11) I X]"" S ERROR="Previous year threshold value must be null" G ZMTQ
;
; Dependents
I $P(STRING,HLFS,12)'=DEP S ERROR="Number of Dependents does not match dependents transmitted" G ZMTQ
;
; Hardship
S X=$P(STRING,HLFS,13) I X]"",X'=0 S ERROR="Can't accept Hardship transmissions" G ZMTQ
I $P(STRING,HLFS,14)]"" S ERROR="Hardship Review Date should be null" G ZMTQ
;
; Date Veteran Signed/Refused to Sign
D SIGN^IVMUCHK5 I ERROR]"" G ZMTQ
;
; Date IVM Verif. MT Complete
I $P(STRING,HLFS,20)]"" S X=$$FMDATE^HLFNC($P(STRING,HLFS,20)),%DT="X" D ^%DT I Y<0 S ERROR="Invalid Date IVM Verif. MT Complete Test" G ZMTQ
;
; Declines to Give Info
S X=$P(STRING,HLFS,16) I X]"" S ERROR="Declines to give Income Info must be null" G ZMTQ
;
; Type of Test/Source of Test/Primary Income Test
S X=$P(STRING,HLFS,17) I X'=1 S ERROR="Type of Test must be set to 1 for Means Test" G ZMTQ
S X=$P(STRING,HLFS,18) I X'=2 S ERROR="Source of Test must be set to 2 for IVM" G ZMTQ
S X=$P(STRING,HLFS,19) I 'X S ERROR="Primary Income Test should be set to 1 if returned" G ZMTQ
;
;Refused to Sign
S X=$P(STRING,HLFS,21) I X]"",(X'=0),(X'=1) S ERROR="Refused to Sign has invalid value" G ZMTQ
I $P(STRING,HLFS,21)]"",X=1,$P(STRING,HLFS,7)'=0 S ERROR="Veteran Refused To Sign-Agreed to Pay Deductible set to yes"
ZMTQ Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMUCHK4 3612 printed Dec 13, 2024@02:02:47 Page 2
IVMUCHK4 ;ALB/CAW - Filter routine to validate IVM Center Transmission, Con't ; September 19, 1994
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**1**; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; This routine is a continuation of IVMUCHK. It performs checks on incoming means test
+5 ; transmissions to ensure they are accurate prior to their upload into DHCP.
+6 ;
+7 ;
ZMT(STRING) ; check ZMT segment
+1 ;
+2 ; Input: STRING as ZMT segment
+3 ;
+4 ; Output: ERROR message or null
+5 ;
+6 NEW ERROR,I,X
+7 SET ERROR=""
+8 SET X=$PIECE(STRING,HLFS,2)
IF $EXTRACT(X,1,4)<1993!($EXTRACT(X,1,4)>($EXTRACT(DT,1,3)+1700))
SET ERROR="Invalid Date of Test"
GOTO ZMTQ
+9 SET X=$$FMDATE^HLFNC(X)
SET %DT="X"
DO ^%DT
IF Y<0
SET ERROR="Invalid Date of Test"
GOTO ZMTQ
+10 ;
+11 ; Status Checks
+12 DO MT^IVMUCHK5(STRING,ARRAY("ZIC"))
IF ERROR]""
GOTO ZMTQ
+13 ;
+14 ; Field content/lenght
+15 FOR I=4,5
IF $$NUM^IVMUCHK2($PIECE(STRING,HLFS,I),10,2)
SET ERROR=$SELECT(I=4:"INCOME",1:"NET WORTH")_" field content/length error"
+16 IF ERROR]""
GOTO ZMTQ
+17 ;
+18 ; gather income totals
+19 DO INC^IVMUCHK5
IF ERROR]""
GOTO ZMTQ
+20 ;
+21 ; Adjudicate Date/Time
+22 SET X=$PIECE(STRING,HLFS,6)
IF X]""
Begin DoDot:1
+23 IF $EXTRACT(X,1,4)<1993!($EXTRACT(X,1,4)>($EXTRACT(DT,1,3)+1700))
SET ERROR="Invalid Adjudication Date/Time"
QUIT
+24 SET X=$$FMDATE^HLFNC(X)
SET %DT="TX"
DO ^%DT
IF Y<0
SET ERROR="Invalid Adjudication Date/Time"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZMTQ
+25 ;
+26 ; Agree to Pay Deductible
+27 SET X=$PIECE(STRING,HLFS,7)
IF X]""
IF (X'=0)
IF (X'=1)
SET ERROR="Invalid Agreed To Pay Deductible Value"
GOTO ZMTQ
+28 IF $PIECE(STRING,HLFS,3)="A"
IF X'=""
SET ERROR="Cat A veteran-Agree to Pay Deductible should be null"
GOTO ZMTQ
+29 ;
+30 ; Threshold A value
+31 SET X=$PIECE(STRING,HLFS,8)
IF X']""
SET ERROR="Invalid Threshold A value"
GOTO ZMTQ
+32 IF (X'>0)!(X'<99001)
SET ERROR="Invalid Threshold A value"
GOTO ZMTQ
+33 ;
+34 ; Deductibe Expenses
+35 IF $$NUM^IVMUCHK2($PIECE(STRING,HLFS,9),10,2)
SET ERROR="Deductible Expenses field content/length error"
GOTO ZMTQ
+36 IF $PIECE(STRING,HLFS,4)<($PIECE(STRING,HLFS,9))
SET ERROR="Deductible Expenses cannot exceed income"
GOTO ZMTQ
+37 ;
+38 ; Means Test Completion Date/Time
+39 SET X=$PIECE(STRING,HLFS,10)
IF $EXTRACT(X,1,4)<1992!($EXTRACT(X,1,4)>($EXTRACT(DT,1,3)+1700))
SET ERROR="Invalid Completion Date/Time"
GOTO ZMTQ
+40 SET X=$$FMDATE^HLFNC(X)
SET %DT="TX"
DO ^%DT
IF Y<0
SET ERROR="Invalid Completion Date/Time"
GOTO ZMTQ
+41 ;
+42 ; Previous Year Threshold
+43 SET X=$PIECE(STRING,HLFS,11)
IF X]""
SET ERROR="Previous year threshold value must be null"
GOTO ZMTQ
+44 ;
+45 ; Dependents
+46 IF $PIECE(STRING,HLFS,12)'=DEP
SET ERROR="Number of Dependents does not match dependents transmitted"
GOTO ZMTQ
+47 ;
+48 ; Hardship
+49 SET X=$PIECE(STRING,HLFS,13)
IF X]""
IF X'=0
SET ERROR="Can't accept Hardship transmissions"
GOTO ZMTQ
+50 IF $PIECE(STRING,HLFS,14)]""
SET ERROR="Hardship Review Date should be null"
GOTO ZMTQ
+51 ;
+52 ; Date Veteran Signed/Refused to Sign
+53 DO SIGN^IVMUCHK5
IF ERROR]""
GOTO ZMTQ
+54 ;
+55 ; Date IVM Verif. MT Complete
+56 IF $PIECE(STRING,HLFS,20)]""
SET X=$$FMDATE^HLFNC($PIECE(STRING,HLFS,20))
SET %DT="X"
DO ^%DT
IF Y<0
SET ERROR="Invalid Date IVM Verif. MT Complete Test"
GOTO ZMTQ
+57 ;
+58 ; Declines to Give Info
+59 SET X=$PIECE(STRING,HLFS,16)
IF X]""
SET ERROR="Declines to give Income Info must be null"
GOTO ZMTQ
+60 ;
+61 ; Type of Test/Source of Test/Primary Income Test
+62 SET X=$PIECE(STRING,HLFS,17)
IF X'=1
SET ERROR="Type of Test must be set to 1 for Means Test"
GOTO ZMTQ
+63 SET X=$PIECE(STRING,HLFS,18)
IF X'=2
SET ERROR="Source of Test must be set to 2 for IVM"
GOTO ZMTQ
+64 SET X=$PIECE(STRING,HLFS,19)
IF 'X
SET ERROR="Primary Income Test should be set to 1 if returned"
GOTO ZMTQ
+65 ;
+66 ;Refused to Sign
+67 SET X=$PIECE(STRING,HLFS,21)
IF X]""
IF (X'=0)
IF (X'=1)
SET ERROR="Refused to Sign has invalid value"
GOTO ZMTQ
+68 IF $PIECE(STRING,HLFS,21)]""
IF X=1
IF $PIECE(STRING,HLFS,7)'=0
SET ERROR="Veteran Refused To Sign-Agreed to Pay Deductible set to yes"
ZMTQ QUIT ERROR
