source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCME4.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.4 KB
RevLine 
[613]1IVMCME4 ;ALB/SEK,BRM,TDM - CHECK INCOME TEST DATA ; 8/28/02 2:19pm
2 ;;2.0;INCOME VERIFICATION MATCH;**17,49,58,62**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine is called from IVMCME.
6 ;
7ZMT(STRING) ; check ZMT segment
8 ;
9 ; Input: STRING as ZMT segment
10 ;
11 ; Output: ERROR message or null
12 ;
13 N ERROR,I,X,Y
14 S ERROR=""
15 S X=$P(STRING,HLFS,2) I $E(X,1,4)<1993 S ERROR="Invalid Date of Test" G ZMTQ
16 S X=$$FMDATE^HLFNC(X),%DT="X" D ^%DT I Y<0 S ERROR="Invalid Date of Test" G ZMTQ
17 ;
18 ; Means Test Status Checks
19 I IVMTYPE=1 D MT^IVMCME5(STRING,ARRAY("ZIC")) I ERROR]"" G ZMTQ
20 ;
21 ; Copay Test Status Checks
22 I IVMTYPE=2 D CO^IVMCME5(STRING) I ERROR]"" G ZMTQ
23 ;
24 ; Long Term Care Status Checks
25 I IVMTYPE=4 D LTC^IVMCME5(STRING) I ERROR]"" G ZMTQ
26 ;
27 ; Field content/length
28 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
29 I ERROR]"" G ZMTQ
30 ;
31 ; gather income totals
32 D INC^IVMCME5 I ERROR]"" G ZMTQ
33 ;
34 ; Adjudicate Date/Time
35 S X=$P(STRING,HLFS,6) I X]"" D I ERROR]"" G ZMTQ
36 . I $E(X,1,4)<1993!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Adjudication Date/Time" Q
37 . S X=$$FMDATE^HLFNC(X),%DT="TX" D ^%DT I Y<0 S ERROR="Invalid Adjudication Date/Time" Q
38 ;
39 ; Agree to Pay Deductible
40 S X=$P(STRING,HLFS,7) I X]"",(X'=0),(X'=1) S ERROR="Invalid Agreed To Pay Deductible Value" G ZMTQ
41 I $P(STRING,HLFS,26)="A",X'="" S ERROR="MT Copay Exempt veteran-Agree to Pay Deductible should be null" G ZMTQ
42 ;
43 ; Threshold A value
44 I IVMTYPE=1 D I ERROR]"" G ZMTQ
45 .S X=$P(STRING,HLFS,8) I X']"" S ERROR="Invalid Threshold A value"
46 .I (X'>0)!(X'<99001) S ERROR="Invalid Threshold A value"
47 ;
48 ; GMT Threshold Value
49 I IVMTYPE=1 D I ERROR]"" G ZMTQ
50 .S X=$P(STRING,HLFS,28)
51 .I ((X'="")&(X'=0))&((X'>0)!(X'<100000)) S ERROR="Invalid GMT Threshold"
52 ;
53 ; Deductibe Expenses
54 I $$NUM^IVMCME2($P(STRING,HLFS,9),10,2) S ERROR="Deductible Expenses field content/length error" G ZMTQ
55 I $P(STRING,HLFS,4)<($P(STRING,HLFS,9)) S ERROR="Deductible Expenses cannot exceed income" G ZMTQ
56 ;
57 ; Means Test Completion Date/Time
58 S X=$P(STRING,HLFS,10) I $E(X,1,4)<1992 S ERROR="Invalid Completion Date/Time" G ZMTQ
59 S X=$$FMDATE^HLFNC(X),%DT="TX" D ^%DT I Y<0 S ERROR="Invalid Completion Date/Time" G ZMTQ
60 ;
61 ; Hardship consistency checks
62 N HARDSHIP K HARDSHIP
63 S HARDSHIP("Y/N")=$P(STRING,HLFS,13)
64 S HARDSHIP("SITE")=$P(STRING,HLFS,23)
65 S HARDSHIP("EFFDATE")=$P(STRING,HLFS,24)
66 ;
67 I (IVMTYPE'=4),(HARDSHIP("Y/N"))!(+HARDSHIP("SITE"))!(HARDSHIP("EFFDATE")) D I ERROR]"" G ZMTQ
68 .I HARDSHIP("Y/N")="" S ERROR="Missing Hardship Indicator" Q
69 .I HARDSHIP("SITE")="" S ERROR="Missing Site Granting Hardship" Q
70 .;starting in year 2000, all hardships should have an effective date
71 .I $E($P(STRING,HLFS,2),1,4)'<2000,(HARDSHIP("EFFDATE")="") S ERROR="Missing Hardship Effective Date" Q
72 .I $L(HARDSHIP("EFFDATE")) S X=$$FMDATE^HLFNC(HARDSHIP("EFFDATE")),%DT=X D ^%DT I Y<0 S ERROR="Invalid Hardship Effective Date" Q
73 .I HARDSHIP("EFFDATE"),(HARDSHIP("EFFDATE")<$P(STRING,HLFS,2)) S ERROR="Hardship Effective Date earlier than Means Test Date" Q
74 ;
75 ; Date Veteran Signed/Refused to Sign
76 D SIGN^IVMCME5 I ERROR]"" G ZMTQ
77 ;
78 ; Source of Test
79 S X=$P(STRING,HLFS,18)
80 I X'=1,X'=2,X'=3,X'=4 S ERROR="Source of Test must be identified" G ZMTQ
81 I X=4,$P(STRING,HLFS,22)="" S ERROR="Site Conducting Test must be identified" G ZMTQ
82 ;
83ZMTQ Q ERROR
Note: See TracBrowser for help on using the repository browser.