- 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 Apr 23, 2025@18:16:26 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
