source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPLOG.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: 9.2 KB
Line 
1IVMPLOG ;ALB/CJM,RTK - API for IVM PATIENT file; ; 12/6/00 5:28pm
2 ;;2.0;INCOME VERIFICATION MATCH;**9,19,12,21,17,28,36,40,49,68**; 21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;
6FIND(DFN,YEAR) ;
7 ;Description: Looks up an entry in the IVM PATIENT file (#301.5).
8 ;Input:
9 ; DFN - IEN in the PATIENT file.
10 ; YEAR - value for the INCOME YEAR field, a year in FM format.
11 ;Output:
12 ; Function Value - returns IEN of record if found, NULL otherwise.
13 ;
14 Q:('$G(DFN)!'$G(YEAR)) ""
15 ;
16 N YR
17 S YR=$E(YEAR,1,3)_"0000"
18 Q $O(^IVM(301.5,"APT",DFN,YR,0))
19 ;
20LOCK(IEN) ;
21 ;Description: Locks a record in the IVM PATIENT file.
22 ;Input:
23 ; IEN - ien of record in IVM PATIENT file.
24 ;Output:
25 ; Function Value - 1 if successful, 0 otherwise.
26 ;
27 I $G(IEN) L +^IVM(301.5,IEN):3
28 Q $T
29 ;
30UNLOCK(IEN) ;
31 ;Description: Unlocks a record in the IVM PATIENT file.
32 ;Input:
33 ; IEN - ien of record in the IVM PATIENT file.
34 ;Output: None
35 ;
36 I $G(IEN) L -^IVM(301.5,IEN)
37 Q
38 ;
39STATUS(IEN,EVENTS) ;
40 ;Description: Returns the value of the TRANSMISSION STATUS field of the
41 ; IVM PATIENT file.
42 ;
43 ;Input:
44 ; IEN - internal entry number of a record in the IVM PATIENT file
45 ;Output:
46 ; Function Value -returns the value of the TRANSMISSION STATUS field
47 ; EVENTS - optional, pass by reference. Will return the types of events logged.
48 ; EVENTS("IVM") - value of IVM EVENT field
49 ; EVENTS("DCD") - value of DCD EVENT field
50 ; EVENTS("ENROLL") - value of ENROLLMENT EVENT field
51 ;
52 ;
53 S EVENTS("IVM")=""
54 S EVENTS("DCD")=""
55 S EVENTS("ENROLL")=""
56 ;
57 Q:'$G(IEN) ""
58 ;
59 N NODE
60 S NODE=$G(^IVM(301.5,IEN,"E"))
61 S EVENTS("IVM")=$P(NODE,"^")
62 S EVENTS("DCD")=$P(NODE,"^",2)
63 S EVENTS("ENROLL")=$P(NODE,"^",3)
64 Q $P($G(^IVM(301.5,IEN,0)),"^",3)
65 ;
66SETSTAT(IEN,EVENTS,ERRMSG) ;
67 ;Description: Sets the value of the TRANSMISSION STATUS field of the
68 ; IVM PATIENT file for a particular record to 0, meaning transmission
69 ; is requested. If the case is closed, depending on the event types,
70 ; the TRANSMISSION STATUS may not be set.
71 ;Input:
72 ; IEN - internal entry number of a record in the IVM PATIENT file.
73 ; EVENTS () - an array of reasons for transmission, pass by reference.
74 ; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
75 ; EVENTS("DCD")=1 if transmission due to DCD criteria, 0 otherwise
76 ; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
77 ;Output:
78 ; Function Value - 1 on success, 0 on failure.
79 ; ERRMSG - optional, pass by reference if needed, returns message on failure
80 ;
81 N DATA,CLOSED,SUCCESS
82 ;
83 I ($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") S ERRMSG="ENROLLMENT UPLOAD IN PROGRESS" Q 0
84 ;
85 I '$$LOCK($G(IEN)) S ERRMSG="UNABLE TO OBTAIN LOCK ON IVM PATIENT, TRY AGAIN LATTER" Q 0
86 S CLOSED=$$CLOSED(IEN)
87 S SUCCESS=0
88 I ('CLOSED)!(1=$G(EVENTS("ENROLL"))) D
89 .S DATA(.03)=0
90 .I 'CLOSED D
91 ..I $G(EVENTS("IVM"))=1 S DATA(30.01)=1
92 ..I $G(EVENTS("DCD"))=1 S DATA(30.02)=1
93 .I $G(EVENTS("ENROLL"))=1 S DATA(30.03)=1
94 .S SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA,.ERRMSG)
95 E S SUCCESS=0,ERRMSG="CASE IS CLOSED"
96 D UNLOCK(IEN)
97 Q SUCCESS
98 ;
99CLEAR(IEN,WHEN) ;
100 ; Description: Sets the value of the TRANSMISSION STATUS field of the
101 ;IVM PATIENT file for a particular record to 1, meaning transmission
102 ;already occurred.
103 ;
104 ;Input:
105 ; IEN - internal entry number of record in IVM PATIENT file
106 ; WHEN - optional, date/time in FM format that transmission occurred
107 ;Output:
108 ; Function Value - 1 on success, 0 on failure
109 ;
110 N SUCCESS,PLOG,DATA
111 Q:'$$LOCK($G(IEN)) 0
112 Q:'$$GET(IEN,.PLOG) 0
113 S DATA(.03)=1
114 I PLOG("EVENTS","IVM")=1 S DATA(30.01)=2
115 I PLOG("EVENTS","DCD")=1 S DATA(30.02)=2
116 I PLOG("EVENTS","ENROLL")=1 S DATA(30.03)=2
117 I $G(WHEN),((PLOG("FIRST")'>0)!(WHEN<PLOG("FIRST"))) S DATA(.05)=WHEN
118 S SUCCESS=$$UPD^DGENDBS(301.5,IEN,.DATA)
119 D UNLOCK(IEN)
120 Q SUCCESS
121 ;
122GET(IEN,PLOG) ;
123 ;Description: Used to obtain a record in the IVM PATIENT file. The
124 ;values are returned in the PLOG() array.
125 ;Input:
126 ; IEN - internal entry number of a record in the IVM PATIENT file.
127 ;Output:
128 ; Function Value - 1 on success, 0 on failure.
129 ; PLOG() array, pass by reference. Subscripts are
130 ; "DFN" - value of the PATIENT field (#.01) which is the ien of record in the PATIENT file.
131 ; "YEAR" - value of the INCOME YEAR field (#.02)
132 ; "STATUS" - value from the TRANSMISSIONS STATUS field (#.03)
133 ; "FIRST" - value from the QUERY TRANSMISSION DATE/TIME field (#.05)
134 ; "CLOSE" - value from the STOP FLAG field (#.04)
135 ; "CLOSE","REASON" - value from the CLOSURE REASON field (#301.93)
136 ; "CLOSE","SOURCE" - value of the CLOSURE SOURCE field (#1.02)
137 ; "CLOSE","TIME" - value of the CLOSURE DATE/TIME field (#1.03)
138 ; "EVENTS","IVM" - value of the IVM EVENT field
139 ; "EVENTS","DCD" - value of the DCD EVENT field
140 ; "EVENTS","ENROLL" - value of the ENROLLMENT EVENT field
141 ;
142 N NODE
143 Q:'$G(IEN) 0
144 S NODE=$G(^IVM(301.5,IEN,0))
145 Q:(NODE="") 0
146 S PLOG("DFN")=$P(NODE,"^")
147 S PLOG("YEAR")=$P(NODE,"^",2)
148 S PLOG("STATUS")=$P(NODE,"^",3)
149 S PLOG("FIRST")=$P(NODE,"^",5)
150 S PLOG("CLOSE")=$P(NODE,"^",4)
151 S NODE=$G(^IVM(301.5,IEN,1))
152 S PLOG("CLOSE","REASON")=$P(NODE,"^")
153 S PLOG("CLOSE","SOURCE")=$P(NODE,"^",2)
154 S PLOG("CLOSE","TIME")=$P(NODE,"^",3)
155 S NODE=$G(^IVM(301.5,IEN,"E"))
156 S PLOG("EVENTS","IVM")=$P(NODE,"^")
157 S PLOG("EVENTS","DCD")=$P(NODE,"^",2)
158 S PLOG("EVENTS","ENROLL")=$P(NODE,"^",3)
159 Q 1
160 ;
161CLOSED(IEN) ;
162 ;Description: Returns the value of the STOP FLAG field of the
163 ;IVM PATIENT file for a particular record, which indicates whether
164 ;transmissions for certain events (but not enrollment events) should
165 ;take place.
166 ;
167 ;Input:
168 ; IEN - internal entry number of a record in the IVM PATIENT file.
169 ;Output:
170 ; Function Value - The value of the STOP FLAG field.
171 ;
172 Q:'$G(IEN) ""
173 Q $P($G(^IVM(301.5,IEN,0)),"^",4)
174 ;
175LOG(DFN,YEAR,EVENTS) ;
176 ;Description: Used to queue a patient for the nightly full transmission
177 ;for a particular income year. If EVENTS is not passed, an entry in the
178 ;IVM PATIENT file will be created if it does not already exist, but
179 ;the flag for transmission will not be set.
180 ;
181 ;Input:
182 ; DFN - ien of record in the PATIENT file.
183 ; YEAR - income year in FM format. This is the year that is to be
184 ; used when creating the full transmission message.
185 ; EVENTS () - an array of reasons for transmission, pass by reference.
186 ; EVENTS("IVM") = 1 if transmission due to IVM criteria, 0 otherwise
187 ; EVENTS(" "DCD")=1 if transmission due to DCD criteria, 0 otherwise
188 ; EVENTS("ENROLL")=1 if transmission due to enrollment criteria, 0 otherwise
189 ;Output:
190 ; Function Value - internal entry number of the IVM PATIENT file record, or NULL if record could not be found or created.
191 ;
192 N IEN
193 ;
194 ;if the eligibility/enrollment upload is in progess, do nothing
195 Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS") ""
196 ;
197 ;to be compatable with current software - in some places,
198 ;YEAR passed is just 3 digits
199 S:YEAR YEAR=$E(YEAR,1,3)_"0000"
200 ;
201 Q:'$$TESTVAL^DGENDBS(301.5,.01,DFN) ""
202 Q:'$$TESTVAL^DGENDBS(301.5,.02,YEAR) ""
203 ;
204 ; check for an existing record in 301.5 for this income year...
205 S IEN=$$FIND(DFN,YEAR)
206 I 'IEN D
207 .;need to create a new record
208 .N DATA
209 .L +^IVM(301.5,0):3
210 .Q:'$T
211 .S IEN=$$FIND(DFN,YEAR)
212 .I IEN L -^IVM(301.5,0) Q
213 .S DATA(.01)=DFN,DATA(.02)=YEAR,DATA(.04)=1,DATA(1.01)=5,DATA(1.02)=2,DATA(1.03)=$$NOW^XLFDT
214 .S IEN=$$ADD^DGENDBS(301.5,,.DATA)
215 .L -^IVM(301.5,0)
216 I IEN,$D(EVENTS),$$SETSTAT(IEN,.EVENTS)
217 Q IEN
218 ;
219DELETE(DFN,TESTDATE,MT,RX,HARDSHIP,LTC) ;
220 ;Description: Used to notify HEC that deletion of a MT,RX Copay test,
221 ;LTC copay exemption test or hardship has occurred
222 ;
223 ;Input:
224 ; DFN - ien of record in the PATIENT file.
225 ; TESTDATE - date of test
226 ; MT - if $D(MT),MT then a MT was deleted
227 ; RX - if $D(RX),RX then a RX copay test was deleted
228 ; HARDSHIP - if $D(HARDSHIP),HARDSHIP then a hardship was deleted
229 ; LTC - if $G(LTC) then a LTC copay exemption test was deleted
230 ;Output: none
231 ;
232 N YEAR,IEN,DATA
233 ;
234 S YEAR=($E(TESTDATE,1,3)-1)_"0000"
235 ;
236 ;
237 S IEN=$$FIND(DFN,YEAR)
238 Q:'IEN
239 I $D(HARDSHIP),HARDSHIP S DATA(.1)=TESTDATE
240 I $D(MT),MT S DATA(.08)=TESTDATE
241 I $D(RX),RX S DATA(.09)=TESTDATE
242 I $G(LTC) S DATA(.11)=TESTDATE
243 I $$UPD^DGENDBS(301.5,IEN,.DATA)
244 Q
245 ;
246EVENT(DFN) ;
247 ;Description: Called in response to enrollment events. Determines
248 ;whether for this patient transmission is appropriate, and if so the
249 ;patient is logged for transmission.
250 ;
251 ;Input: DFN
252 ;Output: none
253 ;
254 Q:'$G(DFN)
255 ;
256 Q:'$$ON^IVMUPAR1 ;quit if enrollment events turned off
257 ;
258 ;don't want to log event if called due to file re-indexing
259 I $D(DIU(0))!($D(DIK)&$D(DIKJ)&$D(DIKLK)&$D(DIKS)&$D(DIN)) Q
260 ;
261 ;if the eligibility/enrollment upload is in progess, or there is no enrollment, do nothing
262 Q:($G(DGENUPLD)="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS")
263 I ('$$FINDCUR^DGENA(DFN)),('$$VET^DGENPTA(DFN)) Q
264 N STATUS
265 S STATUS=$$STATUS^DGENA(DFN)
266 ; Purple Heart added status 21
267 I $$VET1^DGENPTA(DFN)!(STATUS=1)!(STATUS=2)!(STATUS=9)!(STATUS=15)!(STATUS=16)!(STATUS=17)!(STATUS=18)!(STATUS=19)!(STATUS=20)!(STATUS=21) D
268 .N EVENTS
269 .S EVENTS("ENROLL")=1
270 .I $$LOG(DFN,$$YEAR(DFN),.EVENTS) ;no need to inform on success or failure
271 Q
272 ;
273YEAR(DFN) ;
274 ;Determines the income year to be used in the transmission
275 ;
276 N YEAR
277 S YEAR=$$LD^IVMUFNC4(DFN)
278 S:YEAR YEAR=($E(YEAR,1,3)-1)_"0000"
279 S:'YEAR YEAR=($E(DT,1,3)-1)_"0000"
280 Q YEAR
Note: See TracBrowser for help on using the repository browser.