1 | IVMCME5 ;ALB/SEK,KCL,BRM,AEG,BRM,TDM - CHECK INCOME TEST DATA (CON'T.) ; 1/9/03 3:51pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**17,26,38,49,58,62,67**;21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;
|
---|
6 | ; This routine is called from IVMCME4.
|
---|
7 | ;
|
---|
8 | MT(STRING,INCOME) ; Calculate means test status
|
---|
9 | ;
|
---|
10 | ; - init vars
|
---|
11 | N X,Y,ADJ,HAR,INC,NET,THRESH,THRESHA,THRESHT,IVMTEXT,XMSUB,CAT,CAT1
|
---|
12 | N THRESHG,THRESHV,EXP,NWC,DGMTICYR
|
---|
13 | ;DGMTBS - BASE THRESHOLD VALUE FOR SITE
|
---|
14 | ;DGMTBH - BASE THRESHOLD VALUE SENT FROM HEC
|
---|
15 | ;DGTDEP - TOTAL # OF DEPENDENTS SENT BY HEC.
|
---|
16 | N VADM,DGMTBS,DGMTBH,DGTDEP,ECODE,DGMTICY ;BRM added for IVM*2*26
|
---|
17 | ;
|
---|
18 | ; - perform initial error checking
|
---|
19 | S CAT1=$P(STRING,HLFS,3)
|
---|
20 | I '$$GETSTAT^DGMTH(CAT1,1) S ERROR="Invalid Means Test Status" G MTQ
|
---|
21 | ;
|
---|
22 | S CAT=$P(STRING,HLFS,26)
|
---|
23 | ;
|
---|
24 | I CAT="" S CAT=CAT1
|
---|
25 | I CAT'="A",CAT'="C",CAT'="P",CAT'="G" S ERROR="Invalid Means Test Status for Test-Determined Status" G MTQ
|
---|
26 | ;
|
---|
27 | ; - if previous yr mt threshold flag is set use date of prev year
|
---|
28 | S X=$S($P(STRING,HLFS,11):($E($P(STRING,HLFS,2),1,4)-1),1:$E($P(STRING,HLFS,2),1,4)),DGMTICY=$P($G(STRING),HLFS,2)
|
---|
29 | N Y S Y=$$HL7TFM^XLFDT(DGMTICY,"1D") X ^DD("DD") S DGMTICY=Y
|
---|
30 | ;
|
---|
31 | S %DT="" D ^%DT S X=Y K %DT
|
---|
32 | ;
|
---|
33 | S THRESH=$G(^DG(43,1,"MT",X,0)),THRESHT=$P(THRESH,U,2),DGMTBS=THRESHT
|
---|
34 | I $P(STRING,HLFS,12) S THRESHT=THRESHT+$P(THRESH,U,3)+(($P(STRING,HLFS,12)-1)*$P(THRESH,U,4)),DGTDEP=$P($G(STRING),HLFS,12)
|
---|
35 | S DGMTICYR=$$LYR^DGMTSCU1($$HL7TFM^XLFDT($P(STRING,HLFS,2)))
|
---|
36 | S THRESHV=$$GMTT(DFN,DGMTICYR,$G(DGTDEP))
|
---|
37 | ;
|
---|
38 | S INC=$P(STRING,HLFS,4)
|
---|
39 | S EXP=$P(STRING,HLFS,9)
|
---|
40 | S NET=$P(STRING,HLFS,5)
|
---|
41 | S NWC=+$G(^DG(43,1,"GMT")) ; net worth calculation flag
|
---|
42 | S ADJ=$P(STRING,HLFS,6)
|
---|
43 | S THRESHA=$P(STRING,HLFS,8),DGMTBH=THRESHA
|
---|
44 | S THRESHG=$P(STRING,HLFS,28)
|
---|
45 | I $P(STRING,HLFS,12),(THRESHA'=THRESHT) S THRESHA=THRESHA+$P(THRESH,U,3)+(($P(STRING,HLFS,12)-1)*$P(THRESH,U,4))
|
---|
46 | S DECLINE=$P(STRING,HLFS,16)
|
---|
47 | S HAR=$P(STRING,HLFS,13)
|
---|
48 | ;
|
---|
49 | ; - perform error checking
|
---|
50 | I DECLINE,((CAT="A")!(CAT="G")) S ERROR="Declines to give income info-must be MT Copay Required" G MTQ
|
---|
51 | I DECLINE,CAT="C" G MTQ
|
---|
52 | ;
|
---|
53 | ; - if threshold A is incorrect, send message to sites's IVM MESSAGE
|
---|
54 | ; mail group and continue to process
|
---|
55 | I CAT'="G"&(THRESHT'=THRESHA) D
|
---|
56 | .;
|
---|
57 | .;brm;27apr00;code modifications below to add PID and Name to message
|
---|
58 | .D:$G(DFN)'=""
|
---|
59 | ..N VAHOW,VAROOT,VAPTYP
|
---|
60 | ..D DEM^VADPT
|
---|
61 | .S XMSUB="MT threshold discrepancy - "
|
---|
62 | .S XMSUB=XMSUB_"PID - "_$P($G(VADM(2)),U,2)
|
---|
63 | .S IVMTEXT(1)="While uploading the following income test from HEC a"
|
---|
64 | .S IVMTEXT(2)="discrepancy was found with the threshold values."
|
---|
65 | .S IVMTEXT(3)=" ",IVMTEXT(4)=" NAME: "_$G(VADM(1))
|
---|
66 | .S IVMTEXT(5)=" ",IVMTEXT(6)=" PID : "_$P($G(VADM(2)),"^",2)
|
---|
67 | .S IVMTEXT(8)=" ",IVMTEXT(9)="Date of Test sent from HEC: "_DGMTICY
|
---|
68 | .S IVMTEXT(10)=" "
|
---|
69 | .S IVMTEXT(11)="Site MT Threshold value: "_$J($FN($G(THRESHT),",",0),6)
|
---|
70 | .S IVMTEXT(12)=" "
|
---|
71 | .S IVMTEXT(13)="HEC Transmitted MT Threshold value: "_$J($FN($G(DGMTBH),",",0),6)
|
---|
72 | .S IVMTEXT(14)=" ",IVMTEXT(16)="Total number of dependents: "_$G(DGTDEP)
|
---|
73 | .S IVMTEXT(17)=" "
|
---|
74 | .;brm;27apr00;end of changes
|
---|
75 | .;
|
---|
76 | .D MAIL^IVMUFNC("DGMT MT/CT UPLOAD ALERTS")
|
---|
77 | .Q
|
---|
78 | I (INC-EXP)'>THRESHA D I ERROR]"" G MTQ
|
---|
79 | .I NET']"" S ERROR="This veteran requires net worth" Q
|
---|
80 | .I ((NET-EXP)+$S(NWC:0,1:INC)'>$P(THRESH,U,8))&((CAT="C")!(CAT="G")) S ERROR="Income plus net worth not greater than threshold value-incorrect status" Q
|
---|
81 | .I ((NET-EXP)+$S(NWC:0,1:INC)>$P(THRESH,U,8))&(CAT="A"),'$P(STRING,HLFS,6) S ERROR="Patient should be adjudicated-no adjudicated date/time" Q
|
---|
82 | I (INC-EXP)>THRESHA,CAT'="C",'HAR,'ADJ,CAT'="P",CAT'="G" S ERROR="Incorrect means test status for Test-Determined Status"
|
---|
83 | MTQ Q
|
---|
84 | ;
|
---|
85 | ;
|
---|
86 | CO(STRING) ; Calculate copay test status
|
---|
87 | ;
|
---|
88 | ; - init vars
|
---|
89 | N CAT,CAT1,COPDT,DECLINE,DEDEX,DEP,DGCAT,DGCOPS,DGCOST,INC
|
---|
90 | ;
|
---|
91 | ; - vars containing ZMT fields
|
---|
92 | S COPDT=$$FMDATE^HLFNC($P(STRING,HLFS,2))
|
---|
93 | S CAT1=$P(STRING,HLFS,3)
|
---|
94 | I '$$GETSTAT^DGMTH(CAT1,2) S ERROR="Invalid Copay Test Status" G COQ
|
---|
95 | ;
|
---|
96 | ;For the Test-Determined Status only
|
---|
97 | ; - a status of E or M or P should be transmitted
|
---|
98 | ; - P only is networth is used to determine exemption
|
---|
99 | S CAT=$P(STRING,HLFS,26)
|
---|
100 | I CAT="" S CAT=CAT1
|
---|
101 | I CAT'="E",CAT'="M",CAT'="P" S ERROR="Invalid Copay Test Status for Test-Determined Status" G COQ
|
---|
102 | I CAT="P",'$$NETW^IBARXEU1 S ERROR="Invalid Copay Test Status for Test-Determined Status" G COQ
|
---|
103 | ;
|
---|
104 | ; - a status of E or M or P should be transmitted
|
---|
105 | ; - P only is networth is used to determine exemption
|
---|
106 | I CAT'="E",CAT'="M",CAT'="P" S ERROR="Invalid Copay Test Status" G COQ
|
---|
107 | I CAT="P",'$$NETW^IBARXEU1 S ERROR="Invalid Copay Test Status" G COQ
|
---|
108 | S INC=$P(STRING,HLFS,4)
|
---|
109 | S DEDEX=$P(STRING,HLFS,9)
|
---|
110 | S DEP=$P(STRING,HLFS,12)
|
---|
111 | S DECLINE=$P(STRING,HLFS,16)
|
---|
112 | ;
|
---|
113 | S DGCOST=COPDT_U_DFN_U_U_INC,$P(DGCOST,U,14)=DECLINE,$P(DGCOST,U,15)=DEDEX,$P(DGCOST,U,18)=DEP,$P(DGCOST,U,19)=2
|
---|
114 | S DGCOPS=$$INCDT^IBARXEU1(DGCOST)
|
---|
115 | S DGCAT=$S(+DGCOPS=1:"E",+DGCOPS=2:"M",+DGCOPS=3:"P",1:"I")
|
---|
116 | I CAT'=DGCAT S ERROR="Copay Test Status should be "_DGCAT
|
---|
117 | COQ Q
|
---|
118 | ;
|
---|
119 | ;
|
---|
120 | INC ; Gather income totals
|
---|
121 | N DEBD,DEB,DEBT,DGX,EXCL,INC,INCYR,NET,X,Y
|
---|
122 | I $P(STRING,HLFS,4)']"",'$$IS^IVMCUC(DFN,DGLY),'$P(STRING,HLFS,16) S ERROR="No Income transmitted"
|
---|
123 | S INC=$P(ARRAY("ZIC"),HLFS,21),DEBT=$P(ARRAY("ZIC"),HLFS,22),NET=$P(ARRAY("ZIC"),HLFS,23)
|
---|
124 | S DGX=0 F S DGX=$O(ARRAY(DGX)) Q:'DGX D
|
---|
125 | .S INC=INC+($P(ARRAY(DGX,"ZIC"),HLFS,21))
|
---|
126 | .S NET=NET+($P(ARRAY(DGX,"ZIC"),HLFS,23))
|
---|
127 | .I $P(ARRAY(DGX,"ZDP"),U,6)'=2 D Q
|
---|
128 | ..S X=$E($P(ARRAY("ZMT"),U,2),1,4),%DT="" D ^%DT S INCYR=Y
|
---|
129 | ..S EXCL=$P($G(^DG(43,1,"MT",INCYR,0)),U,17)
|
---|
130 | ..S DEBD=($P(ARRAY(DGX,"ZIC"),HLFS,9)-EXCL-$P(ARRAY(DGX,"ZIC"),HLFS,15))
|
---|
131 | ..S DEBD=$S(DEBD>0:DEBD,1:0)
|
---|
132 | ..S DEB=($P(ARRAY(DGX,"ZIC"),HLFS,9)-DEBD)
|
---|
133 | ..S DEBT=DEBT+DEB
|
---|
134 | .S DEBT=DEBT+($P(ARRAY(DGX,"ZIC"),HLFS,22))
|
---|
135 | INCQ Q
|
---|
136 | ;
|
---|
137 | ;
|
---|
138 | SIGN ; Date Veteran Signed/Refused to Sign
|
---|
139 | I $P(STRING,HLFS,15)]"" D G:ERROR]"" SIGNQ
|
---|
140 | .S X=$P(STRING,HLFS,15) I $E(X,1,4)<1994!($E(X,1,4)>($E(DT,1,3)+1700)) S ERROR="Invalid Date Veteran Signed Test" Q
|
---|
141 | .S X=$$FMDATE^HLFNC($P(STRING,HLFS,15)),%DT="X" D ^%DT I Y<0 S ERROR="Invalid Date Veteran Signed Test" Q
|
---|
142 | SIGNQ Q
|
---|
143 | ;
|
---|
144 | LTC(STRING) ;calculate LTC test status
|
---|
145 | ;
|
---|
146 | N CAT1
|
---|
147 | S CAT1=$P(STRING,HLFS,3)
|
---|
148 | I '$$GETSTAT^DGMTH(CAT1,4) S ERROR="Invalid LTC Test Status"
|
---|
149 | Q
|
---|
150 | ;
|
---|
151 | GMTT(DFN,DGMTICY,DGTDEP) ;Get GMT Threshold values for veteran
|
---|
152 | ; Input: DFN = Patient IEN
|
---|
153 | ; DGMTICY = Last Income year
|
---|
154 | ; DGTDEP = Total number of dependents
|
---|
155 | ;Output: GMTT = GMT Thresholds for Veteran
|
---|
156 | ;
|
---|
157 | N DGMTGMT,GMT,GMTT,PCT
|
---|
158 | S GMTT=0
|
---|
159 | D GETFIPS^EASAILK(DFN,DGMTICY,.GMT)
|
---|
160 | I '$G(GMT("GMTIEN")) Q GMTT
|
---|
161 | S DGMTGMT=$G(^EAS(712.5,GMT("GMTIEN"),1))
|
---|
162 | I (DGTDEP+1)<9 S GMTT=$P(DGMTGMT,"^",(DGTDEP+1)) Q GMTT
|
---|
163 | S PCT=((DGTDEP+1)-8)*8+132,GMTT=$P(DGMTGMT,"^",4)*PCT/100
|
---|
164 | S GMTT=$S(GMTT#50=0:GMTT,1:GMTT+(50-(GMTT#50)))
|
---|
165 | Q GMTT
|
---|