IVMCME4 ;ALB/SEK,BRM,TDM - CHECK INCOME TEST DATA ; 8/28/02 2:19pm
;;2.0;INCOME VERIFICATION MATCH;**17,49,58,62**;21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; This routine is called from IVMCME.
;
ZMT(STRING) ; check ZMT segment
;
; Input: STRING as ZMT segment
;
; Output: ERROR message or null
;
N ERROR,I,X,Y
S ERROR=""
S X=$P(STRING,HLFS,2) I $E(X,1,4)<1993 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
;
; Means Test Status Checks
I IVMTYPE=1 D MT^IVMCME5(STRING,ARRAY("ZIC")) I ERROR]"" G ZMTQ
;
; Copay Test Status Checks
I IVMTYPE=2 D CO^IVMCME5(STRING) I ERROR]"" G ZMTQ
;
; Long Term Care Status Checks
I IVMTYPE=4 D LTC^IVMCME5(STRING) I ERROR]"" G ZMTQ
;
; Field content/length
F I=4,5 I $$NUM^IVMCME2($P(STRING,HLFS,I),10,2) S ERROR=$S(I=4:"INCOME",1:"NET WORTH")_" field content/length error" Q
I ERROR]"" G ZMTQ
;
; gather income totals
D INC^IVMCME5 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,26)="A",X'="" S ERROR="MT Copay Exempt veteran-Agree to Pay Deductible should be null" G ZMTQ
;
; Threshold A value
I IVMTYPE=1 D I ERROR]"" G ZMTQ
.S X=$P(STRING,HLFS,8) I X']"" S ERROR="Invalid Threshold A value"
.I (X'>0)!(X'<99001) S ERROR="Invalid Threshold A value"
;
; GMT Threshold Value
I IVMTYPE=1 D I ERROR]"" G ZMTQ
.S X=$P(STRING,HLFS,28)
.I ((X'="")&(X'=0))&((X'>0)!(X'<100000)) S ERROR="Invalid GMT Threshold"
;
; Deductibe Expenses
I $$NUM^IVMCME2($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 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
;
; Hardship consistency checks
N HARDSHIP K HARDSHIP
S HARDSHIP("Y/N")=$P(STRING,HLFS,13)
S HARDSHIP("SITE")=$P(STRING,HLFS,23)
S HARDSHIP("EFFDATE")=$P(STRING,HLFS,24)
;
I (IVMTYPE'=4),(HARDSHIP("Y/N"))!(+HARDSHIP("SITE"))!(HARDSHIP("EFFDATE")) D I ERROR]"" G ZMTQ
.I HARDSHIP("Y/N")="" S ERROR="Missing Hardship Indicator" Q
.I HARDSHIP("SITE")="" S ERROR="Missing Site Granting Hardship" Q
.;starting in year 2000, all hardships should have an effective date
.I $E($P(STRING,HLFS,2),1,4)'<2000,(HARDSHIP("EFFDATE")="") S ERROR="Missing Hardship Effective Date" Q
.I $L(HARDSHIP("EFFDATE")) S X=$$FMDATE^HLFNC(HARDSHIP("EFFDATE")),%DT=X D ^%DT I Y<0 S ERROR="Invalid Hardship Effective Date" Q
.I HARDSHIP("EFFDATE"),(HARDSHIP("EFFDATE")<$P(STRING,HLFS,2)) S ERROR="Hardship Effective Date earlier than Means Test Date" Q
;
; Date Veteran Signed/Refused to Sign
D SIGN^IVMCME5 I ERROR]"" G ZMTQ
;
; Source of Test
S X=$P(STRING,HLFS,18)
I X'=1,X'=2,X'=3,X'=4 S ERROR="Source of Test must be identified" G ZMTQ
I X=4,$P(STRING,HLFS,22)="" S ERROR="Site Conducting Test must be identified" G ZMTQ
;
ZMTQ Q ERROR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMCME4 3538 printed Dec 13, 2024@02:01:28 Page 2
IVMCME4 ;ALB/SEK,BRM,TDM - CHECK INCOME TEST DATA ; 8/28/02 2:19pm
+1 ;;2.0;INCOME VERIFICATION MATCH;**17,49,58,62**;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 ;
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,Y
+7 SET ERROR=""
+8 SET X=$PIECE(STRING,HLFS,2)
IF $EXTRACT(X,1,4)<1993
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 ; Means Test Status Checks
+12 IF IVMTYPE=1
DO MT^IVMCME5(STRING,ARRAY("ZIC"))
IF ERROR]""
GOTO ZMTQ
+13 ;
+14 ; Copay Test Status Checks
+15 IF IVMTYPE=2
DO CO^IVMCME5(STRING)
IF ERROR]""
GOTO ZMTQ
+16 ;
+17 ; Long Term Care Status Checks
+18 IF IVMTYPE=4
DO LTC^IVMCME5(STRING)
IF ERROR]""
GOTO ZMTQ
+19 ;
+20 ; Field content/length
+21 FOR I=4,5
IF $$NUM^IVMCME2($PIECE(STRING,HLFS,I),10,2)
SET ERROR=$SELECT(I=4:"INCOME",1:"NET WORTH")_" field content/length error"
QUIT
+22 IF ERROR]""
GOTO ZMTQ
+23 ;
+24 ; gather income totals
+25 DO INC^IVMCME5
IF ERROR]""
GOTO ZMTQ
+26 ;
+27 ; Adjudicate Date/Time
+28 SET X=$PIECE(STRING,HLFS,6)
IF X]""
Begin DoDot:1
+29 IF $EXTRACT(X,1,4)<1993!($EXTRACT(X,1,4)>($EXTRACT(DT,1,3)+1700))
SET ERROR="Invalid Adjudication Date/Time"
QUIT
+30 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
+31 ;
+32 ; Agree to Pay Deductible
+33 SET X=$PIECE(STRING,HLFS,7)
IF X]""
IF (X'=0)
IF (X'=1)
SET ERROR="Invalid Agreed To Pay Deductible Value"
GOTO ZMTQ
+34 IF $PIECE(STRING,HLFS,26)="A"
IF X'=""
SET ERROR="MT Copay Exempt veteran-Agree to Pay Deductible should be null"
GOTO ZMTQ
+35 ;
+36 ; Threshold A value
+37 IF IVMTYPE=1
Begin DoDot:1
+38 SET X=$PIECE(STRING,HLFS,8)
IF X']""
SET ERROR="Invalid Threshold A value"
+39 IF (X'>0)!(X'<99001)
SET ERROR="Invalid Threshold A value"
End DoDot:1
IF ERROR]""
GOTO ZMTQ
+40 ;
+41 ; GMT Threshold Value
+42 IF IVMTYPE=1
Begin DoDot:1
+43 SET X=$PIECE(STRING,HLFS,28)
+44 IF ((X'="")&(X'=0))&((X'>0)!(X'<100000))
SET ERROR="Invalid GMT Threshold"
End DoDot:1
IF ERROR]""
GOTO ZMTQ
+45 ;
+46 ; Deductibe Expenses
+47 IF $$NUM^IVMCME2($PIECE(STRING,HLFS,9),10,2)
SET ERROR="Deductible Expenses field content/length error"
GOTO ZMTQ
+48 IF $PIECE(STRING,HLFS,4)<($PIECE(STRING,HLFS,9))
SET ERROR="Deductible Expenses cannot exceed income"
GOTO ZMTQ
+49 ;
+50 ; Means Test Completion Date/Time
+51 SET X=$PIECE(STRING,HLFS,10)
IF $EXTRACT(X,1,4)<1992
SET ERROR="Invalid Completion Date/Time"
GOTO ZMTQ
+52 SET X=$$FMDATE^HLFNC(X)
SET %DT="TX"
DO ^%DT
IF Y<0
SET ERROR="Invalid Completion Date/Time"
GOTO ZMTQ
+53 ;
+54 ; Hardship consistency checks
+55 NEW HARDSHIP
KILL HARDSHIP
+56 SET HARDSHIP("Y/N")=$PIECE(STRING,HLFS,13)
+57 SET HARDSHIP("SITE")=$PIECE(STRING,HLFS,23)
+58 SET HARDSHIP("EFFDATE")=$PIECE(STRING,HLFS,24)
+59 ;
+60 IF (IVMTYPE'=4)
IF (HARDSHIP("Y/N"))!(+HARDSHIP("SITE"))!(HARDSHIP("EFFDATE"))
Begin DoDot:1
+61 IF HARDSHIP("Y/N")=""
SET ERROR="Missing Hardship Indicator"
QUIT
+62 IF HARDSHIP("SITE")=""
SET ERROR="Missing Site Granting Hardship"
QUIT
+63 ;starting in year 2000, all hardships should have an effective date
+64 IF $EXTRACT($PIECE(STRING,HLFS,2),1,4)'<2000
IF (HARDSHIP("EFFDATE")="")
SET ERROR="Missing Hardship Effective Date"
QUIT
+65 IF $LENGTH(HARDSHIP("EFFDATE"))
SET X=$$FMDATE^HLFNC(HARDSHIP("EFFDATE"))
SET %DT=X
DO ^%DT
IF Y<0
SET ERROR="Invalid Hardship Effective Date"
QUIT
+66 IF HARDSHIP("EFFDATE")
IF (HARDSHIP("EFFDATE")<$PIECE(STRING,HLFS,2))
SET ERROR="Hardship Effective Date earlier than Means Test Date"
QUIT
End DoDot:1
IF ERROR]""
GOTO ZMTQ
+67 ;
+68 ; Date Veteran Signed/Refused to Sign
+69 DO SIGN^IVMCME5
IF ERROR]""
GOTO ZMTQ
+70 ;
+71 ; Source of Test
+72 SET X=$PIECE(STRING,HLFS,18)
+73 IF X'=1
IF X'=2
IF X'=3
IF X'=4
SET ERROR="Source of Test must be identified"
GOTO ZMTQ
+74 IF X=4
IF $PIECE(STRING,HLFS,22)=""
SET ERROR="Site Conducting Test must be identified"
GOTO ZMTQ
+75 ;
ZMTQ QUIT ERROR
