1 | IVMCM6 ;ALB/SEK,JAN,RTK,CKN,TDM,GN - COMPLETE DCD INCOME TEST ; 7/21/03 1:13pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**17,25,39,44,50,53,49,58,62,67,84**;21-OCT-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;IVM*2*84 - insure DGMTP is defined by LTC test prior to calling
|
---|
6 | ; audit
|
---|
7 | ;
|
---|
8 | EN ; This routine will update annual means test file (#408.31):
|
---|
9 | ;
|
---|
10 | ; Note: There is no entry in 408.31 for income screening.
|
---|
11 | ;
|
---|
12 | ;
|
---|
13 | ;Input:
|
---|
14 | ; DGMTI - ien of new Annual Means Test which requires completion
|
---|
15 | ; IVMMTIEN - ien of replaced test (may not exist)
|
---|
16 | ;
|
---|
17 | ; - open case record in (#301.5) file
|
---|
18 | N DGREF,DATA,CODE,FIELD,RET,NODE0,NODE2,OK2SND
|
---|
19 | D CHKTST,OPEN
|
---|
20 | ;
|
---|
21 | ; - if income screening goto MTBULL
|
---|
22 | I IVMTYPE=3 G MTBULL
|
---|
23 | ;
|
---|
24 | ; - setup variables for (#408.31) file
|
---|
25 | ;get the ZMT segment, translate HLQ's to NULLS
|
---|
26 | S IVMSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE)) ; get mt/copay ZMT segment
|
---|
27 | F FIELD=4:1:29 I FIELD'=24,$P(IVMSEG,HLFS,FIELD)=HLQ S $P(IVMSEG,HLFS,FIELD)=""
|
---|
28 | ;
|
---|
29 | S IVM1=$$FMDATE^HLFNC($P(IVMSEG,"^",10)) ; dt/time completed
|
---|
30 | S IVM2=$P(IVMSEG,"^",7) ; agree to pay deductible
|
---|
31 | S IVM3=$$FMDATE^HLFNC($P(IVMSEG,"^",15)) ; dt vet signed test
|
---|
32 | S IVM4=$P(IVMSEG,"^",16) ; declines to give income info field
|
---|
33 | S:IVM4 DGREF=""
|
---|
34 | S IVM5=$$FMDATE^HLFNC($P(IVMSEG,"^",6)) ; dt/time of adjudication
|
---|
35 | S IVM6=$P(IVMSEG,"^",3) ;status
|
---|
36 | S IVM7=$P(IVMSEG,"^",13) ; hardship
|
---|
37 | S:$G(IVMHADJ) IVMCAT=$P(IVMSEG,"^",3) ; test status
|
---|
38 | S IVM8=$P(IVMSEG,"^",22) ; site conducting test
|
---|
39 | S IVM9=$P(IVMSEG,"^",23) ; site granting hardship
|
---|
40 | S IVM10=$P(IVMSEG,"^",11) ; prev years threshold
|
---|
41 | S IVM11=$P(IVMSEG,"^",18) ; source of test
|
---|
42 | S IVM12=$$FMDATE^HLFNC($P(IVMSEG,"^",24)) ; hardship effective date
|
---|
43 | S IVM13=$$FMDATE^HLFNC($P(IVMSEG,"^",25)) ; date/time last edited
|
---|
44 | S IVM14=$P(IVMSEG,"^",26) ; test determined status
|
---|
45 | S IVM15=$P(IVMSEG,"^",4) ; income
|
---|
46 | S IVM16=$P(IVMSEG,"^",5) ; net worth
|
---|
47 | S IVM17=$P(IVMSEG,"^",8) ; threshold A
|
---|
48 | S IVM18=$P(IVMSEG,"^",9) ; deductible expenses
|
---|
49 | S IVM19=$P(IVMSEG,"^",12) ; total dependents
|
---|
50 | S IVM20=$P(IVMSEG,"^",27) ; signature valid?
|
---|
51 | S IVM21=$$FMDATE^HLFNC($P(IVMSEG,"^",14)) ; hardship review date
|
---|
52 | S IVM22=$P(IVMSEG,"^",28) ; GMT threshold
|
---|
53 | S IVM23=$P(IVMSEG,"^",29) ; hardship reason
|
---|
54 | ;
|
---|
55 | ;old tests may not have the field Test-Determined Status
|
---|
56 | I IVM14="" D
|
---|
57 | .I IVMTYPE=1,IVM7,"AG"[IVM6 D Q
|
---|
58 | ..I IVM6="A",(IVM15'>IVM22) S IVM14="G" Q ;Income <= GMT Threshold
|
---|
59 | ..S IVM14="C"
|
---|
60 | .S IVM14=IVM6
|
---|
61 | ;
|
---|
62 | ; - fields for means test, copay test and Long Term Care Test
|
---|
63 | S DATA(.14)=IVM4,DATA(.18)=IVM19,DATA(.23)=IVM11,DATA(2.05)=IVM8,DATA(.06)=DUZ,DATA(.07)=IVM1,DATA(2.02)=IVM13,DATA(2.03)=$$GETSTAT^DGMTH(IVM14,IVMTYPE)
|
---|
64 | ;
|
---|
65 | I IVM7 S DATA(.08)=.5,DATA(.09)=$$NOW^XLFDT
|
---|
66 | ;
|
---|
67 | I 'IVM4 S DATA(.04)=IVM15,DATA(.15)=IVM18
|
---|
68 | ;
|
---|
69 | ; - means test fields
|
---|
70 | I IVMTYPE=1 D
|
---|
71 | .S DATA(.11)=IVM2,DATA(.12)=IVM17,DATA(.2)=IVM7,DATA(.24)=IVM3,DATA(.29)=IVM20,DATA(2.04)=IVM9,DATA(.1)=IVM5,DATA(2.01)=IVM12
|
---|
72 | .I 'IVM4 S DATA(.05)=IVM16
|
---|
73 | .S DATA(.16)=IVM10,DATA(.21)=IVM21,DATA(.27)=IVM22,DATA(2.09)=IVM23
|
---|
74 | ;
|
---|
75 | ; - Long Term Care fields
|
---|
76 | I IVMTYPE=4 D
|
---|
77 | .N DATE,TYPE
|
---|
78 | .;set pointer to associated means test or RX copay test if there is one
|
---|
79 | .I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT1"),HLFS,2),TYPE=1
|
---|
80 | .E I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S DATE=$P(^TMP($J,"IVMCM","ZMT2"),HLFS,2),TYPE=2
|
---|
81 | .I $G(DATE) S DATA(2.08)=$P($$LST^DGMTU(DFN,DATE,TYPE),"^")
|
---|
82 | .S DATA(.11)=IVM2
|
---|
83 | .I 'IVM4 S DATA(.05)=IVM16
|
---|
84 | .K DATA(2.03) ;test determined status is not used in LTC test
|
---|
85 | ;
|
---|
86 | I $G(IVMMTIEN) D
|
---|
87 | .; Get record data to compare with HL7 Message data
|
---|
88 | .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
|
---|
89 | .S NODE2=$G(^DGMT(408.31,IVMMTIEN,2))
|
---|
90 | .;
|
---|
91 | .; If Site Conducting Test is the same, get Completed By from record.
|
---|
92 | .I $P(NODE2,"^",5)=IVM8 S DATA(.06)=$P(NODE0,"^",6)
|
---|
93 | .;
|
---|
94 | .; If there are Comments, copy them into new record
|
---|
95 | .I $D(^DGMT(408.31,IVMMTIEN,"C")) S DATA(50)="^DGMT(408.31,"_IVMMTIEN_",""C"")"
|
---|
96 | .;
|
---|
97 | .I IVMTYPE=1 D
|
---|
98 | ..; Hardship is YES in msg and record, and the Site Granting Hardship
|
---|
99 | ..; is the same as the site receiving the msg, keep the record data
|
---|
100 | ..I IVM7,$P(NODE0,"^",20),IVM9=$P($$SITE^VASITE,"^",3) S DATA(.21)=$P(NODE0,"^",21),DATA(.22)=$P(NODE0,"^",22),DATA(2.01)=$P(NODE2,"^",1),DATA(.08)=$P(NODE0,"^",8),DATA(.09)=$P(NODE0,"^",9)
|
---|
101 | ..;
|
---|
102 | ..; Hardship is YES in msg and record, and the Site Granting Hardship
|
---|
103 | ..; is NOT the same in both the msg and record, keep the message data
|
---|
104 | ..I IVM7,$P(NODE0,"^",20),$P(NODE2,"^",4)'=IVM9 S DATA(.22)=DATA(.06)
|
---|
105 | ..;
|
---|
106 | ..; Hardship is YES in msg and NO in record, keep the message data
|
---|
107 | ..I IVM7,'$P(NODE0,"^",20) S DATA(.22)=DATA(.06)
|
---|
108 | ..;
|
---|
109 | ..; Hardship is set to delete in msg, delete the Hardship
|
---|
110 | ..I IVM12=HLQ!('IVM7&($P(NODE0,"^",20))) D
|
---|
111 | ...S (DATA(.08),DATA(.09),DATA(.2),DATA(.21),DATA(.22),DATA(2.01),DATA(2.04),DATA(2.09))=""
|
---|
112 | ...I $P(NODE0,"^",20) D BULL2^IVMCMB(DFN,$P(NODE2,"^"),$P(NODE2,"^",4))
|
---|
113 | ..;
|
---|
114 | ..; Hardship is NO in msg and in record, keep the message data
|
---|
115 | ..I 'IVM7,'$P(NODE0,"^",20) S DATA(.22)=""
|
---|
116 | ..;
|
---|
117 | ..; Notify site of hardship?
|
---|
118 | ..I IVM12'=HLQ,IVM7,((IVM12'=$P(NODE2,"^"))!('$P(NODE0,"^",20))) D BULL1^IVMCMB(DFN,IVM12,IVM9)
|
---|
119 | ..;
|
---|
120 | ..; Notify site to discontinue net-worth development?
|
---|
121 | ..I IVM11=3,$P(NODE0,"^",23)=1,$$GETCODE^DGMTH($P(NODE0,"^",3))="P" D BULL3^IVMCMB(DFN)
|
---|
122 | ;
|
---|
123 | ;determine status based on test-determined status and hardship
|
---|
124 | S CODE=IVM14
|
---|
125 | I IVMTYPE=1,DATA(.2) S CODE=IVM6
|
---|
126 | S DATA(.03)=$$GETSTAT^DGMTH(CODE,IVMTYPE)
|
---|
127 | ;
|
---|
128 | I $$UPD^DGENDBS(408.31,DGMTI,.DATA) D
|
---|
129 | .; can't call MT Events protocol for Long Term Care Copay Exemption
|
---|
130 | .; Tests as it triggers an IB and Enrollment update
|
---|
131 | .; so manually call needed protocols to trigger audit, date stamp
|
---|
132 | .; and transmission (if necessary)
|
---|
133 | .I IVMTYPE=4 D Q
|
---|
134 | ..S:$G(DGMTACT)="" DGMTACT="ADD"
|
---|
135 | ..S DGMTP=$G(DGMTP) ;IVM*2*84
|
---|
136 | ..S DGMTINF=1 ;Means Test Interactive/Non-interactive flag
|
---|
137 | ..D AFTER^DGMTEVT
|
---|
138 | ..D EN^DGMTAUD ;means test audit event
|
---|
139 | ..D ^IVMPMTE ;IVM means test event
|
---|
140 | ..D DATETIME^DGMTU4($G(DGMTI)) ;date stamp
|
---|
141 | .;
|
---|
142 | .; - call means test event driver if not future test
|
---|
143 | .I 'IVMFUTR D
|
---|
144 | ..D:(IVMTYPE=1) MTPRIME^DGMTU4(DGMTI)
|
---|
145 | ..D:(IVMTYPE=2) RXPRIME^DGMTU4(DGMTI)
|
---|
146 | ..S CODE=$$GETCODE^DGMTH($P($G(^DGMT(408.31,DGMTI,0)),"^",3))
|
---|
147 | .E D
|
---|
148 | ..;enter to list of future tests kept in the IVM Patient file
|
---|
149 | ..D ADDFUTR^IVMPLOG2(DGMTI)
|
---|
150 | ..;also, if HEC changed the test to a future date, there could be
|
---|
151 | ..;a test on file for the same income year marked as primary
|
---|
152 | ..I $G(IVMMTIEN),$P(NODE2,"^",5)=IVM8 D
|
---|
153 | ...N DATA,ERROR,DGMTI,DGMTACT,DGMTYPT,DGMTA
|
---|
154 | ...S DATA(2)=0
|
---|
155 | ...I $$UPD^DGENDBS(408.31,IVMMTIEN,.DATA,.ERROR)
|
---|
156 | ...; if the test being replaced by the uploaded future test
|
---|
157 | ...; becomes non-primary and the site conducted both tests
|
---|
158 | ...; then call Means Test event driver (non interactively)
|
---|
159 | ...S DGMTACT="EDT",DGMTI=IVMMTIEN,DGMTYPT=IVMTYPE,DGMTINF=1
|
---|
160 | ...D AFTER^DGMTEVT
|
---|
161 | ...D EN^DGMTEVT
|
---|
162 | ...D
|
---|
163 | ....N DGMSGF,DGADDF
|
---|
164 | ....S DGMSGF=1,DGADDF=0
|
---|
165 | ....D EN^DGMTR
|
---|
166 | .D:OK2SND TRNSMT
|
---|
167 | ;
|
---|
168 | ;
|
---|
169 | MTBULL ; Build results array
|
---|
170 | D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"Future Test",1:"New Test"),$G(IVMMTDT),$S($G(IVMMTIEN):$$GETCODE^DGMTH($P($G(^DGMT(408.31,IVMMTIEN,0)),"^",3)),1:""),CODE)
|
---|
171 | ;
|
---|
172 | CLEANUP ; cleanup
|
---|
173 | K DGCAT,DGCOMF,DGMTACT,DGMTI,DGMTINF,DGMTPAR,DGTHB,IVMBU45,IVMOP,IVMOP1
|
---|
174 | K IVM1,IVM2,IVM3,IVM4,IVM5,IVM6,IVM7,IVM8,IVM9,IVM10,IVM11,IVM12,IVM13,IVM14,IVMCAT,IVMCEA,IVMCEB,IVMMTA,IVM15,IVM16,IVM17,IVM18,IVM19,IVM20,IVM21
|
---|
175 | K IVM22,IVM23
|
---|
176 | Q
|
---|
177 | ;
|
---|
178 | OPEN ; open case record for uploaded test
|
---|
179 | S IVMOP="",IVMOP=$O(^IVM(301.5,"AYR",DGLY,DFN,IVMOP)) I 'IVMOP D OPEN1 Q
|
---|
180 | S IVMOP1=$G(^IVM(301.5,IVMOP,0)) I 'IVMOP1 D OPEN1 Q
|
---|
181 | I $P(IVMOP1,"^",4)=1 S DA=+IVMOP D Q
|
---|
182 | .S DIE="^IVM(301.5,",DR=".03////1;.04////0"
|
---|
183 | .D OPEN2
|
---|
184 | Q
|
---|
185 | OPEN1 K DD,DO
|
---|
186 | S DIC="^IVM(301.5,",DIC(0)="LMNZ",X=DFN,DLAYGO=301.5
|
---|
187 | D FILE^DICN Q:Y'>0 S DA=+Y
|
---|
188 | S DIE="^IVM(301.5,",DR=".02////^S X=DGLY;.03////1;.04////0"
|
---|
189 | OPEN2 D ^DIE K DD,DO,DIC,DLAYGO,X,Y,DIE,DR
|
---|
190 | Q
|
---|
191 | ;
|
---|
192 | MTDRIVER ; call means test event driver
|
---|
193 | ; dgmtact
|
---|
194 | ; adj adjudicated mt
|
---|
195 | ; cat hardship mt
|
---|
196 | ; add new mt or copay
|
---|
197 | ; edit corrected mt or copay
|
---|
198 | ;
|
---|
199 | N IVMDA,IVMDT,IVMFLG,IVMMTDT,IVMNEW
|
---|
200 | S DGMTACT=$S($G(IVMHADJ)=1:"ADJ",$G(IVMHADJ)=2:"CAT",'$G(DGMTP):"ADD",1:"EDT")
|
---|
201 | D AFTER^DGMTEVT
|
---|
202 | S DGMTINF=1 ; non-interactive flag
|
---|
203 | D EN^DGMTEVT
|
---|
204 | Q
|
---|
205 | ;
|
---|
206 | CHKTST ; Verify if the incoming Income Test requires a Z07 transmission.
|
---|
207 | ;
|
---|
208 | N MTREC,REC01,ZMTSEG
|
---|
209 | S OK2SND=0
|
---|
210 | S MTREC=$G(^DGMT(408.31,DGMTI,0))
|
---|
211 | Q:'$D(^DGMT(408.31,DGMTI,0))
|
---|
212 | ; Check if the Source of the Test is DCD
|
---|
213 | S ZMTSEG=$G(^TMP($J,"IVMCM","ZMT"_IVMTYPE))
|
---|
214 | Q:$P($G(^DG(408.34,+$P(ZMTSEG,U,18),0)),U)'="DCD"
|
---|
215 | ;Check if the DCD software has been installed
|
---|
216 | Q:'$$VERSION^XPDUTL("IVMC")
|
---|
217 | ;
|
---|
218 | ; If the source of the test is DCD, and the site receiving the test
|
---|
219 | ; is a DCD site, set the record to transmit.
|
---|
220 | S OK2SND=1
|
---|
221 | Q
|
---|
222 | ;
|
---|
223 | TRNSMT ; Set the record to transmit due to DCD Criteria
|
---|
224 | N REC01,DCDDATA,DCDIEN,EVENTS,ERROR
|
---|
225 | S REC01=$O(^IVM(301.5,"AYR",DGLY,DFN,""))
|
---|
226 | S DCDDATA(.04)=0,DCDIEN=REC01
|
---|
227 | I $$UPD^DGENDBS(301.5,DCDIEN,.DCDDATA,.ERROR)
|
---|
228 | S EVENTS("DCD")=1
|
---|
229 | I $$SETSTAT^IVMPLOG(REC01,.EVENTS)
|
---|
230 | ;
|
---|
231 | Q
|
---|