source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM6.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1IVMCM6 ;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 ;
8EN ; 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 ;
169MTBULL ; 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 ;
172CLEANUP ; 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 ;
178OPEN ; 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
185OPEN1 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"
189OPEN2 D ^DIE K DD,DO,DIC,DLAYGO,X,Y,DIE,DR
190 Q
191 ;
192MTDRIVER ; 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 ;
206CHKTST ; 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 ;
223TRNSMT ; 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
Note: See TracBrowser for help on using the repository browser.