source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASCM.m@ 1800

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

initial load of WorldVistAEHR
File size: 9.4 KB
RevLine 
[613]1EASCM ;ALB/PJH - PROCESS INCOME TEST (Z10) TRANSMISSIONS ; 9/4/07 4:46pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**71**; 15-MAR-01;Build 18
3 ;
4 ;CLONED FROM IVMCM (ESR EVENT DRIVER)
5 ;
6ORF ; Handler for ORF type HL7 messages received from HEC
7 ;
8 ; Make sure POSTMASTER DUZ instead of DUZ of Person who
9 ; started Incoming Logical Link.
10 S DUZ=.5
11 N CNT,IVMRTN,SEGCNT
12 S IVMRTN="IVMCMX" ;USE "IVMCMX" BECAUSE "IVMCM" ALREADY USED
13 K ^TMP($J,IVMRTN),DIC
14 S (DGMSGF,DGMTMSG)=1 ; HL7 rtn. Don't need DG interative messages.
15 S HLECH=HL("ECH"),HLQ=HL("Q"),HLMID=HL("MID")
16 K %,%H,%I D NOW^%DTC S HLDT=%
17 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0 D
18 . S CNT=0
19 . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE
20 . F S CNT=$O(HLNODE(CNT)) Q:'CNT D
21 . . S ^TMP($J,IVMRTN,SEGCNT,CNT)=HLNODE(CNT)
22 S HLDA=HLMTIEN
23 ;
24 N SEG,EVENT,MSGID
25 S:'$D(HLEVN) HLEVN=0
26 D NXTSEG^DGENUPL(HLDA,0,.SEG)
27 Q:(SEG("TYPE")'="MSH") ;would not have reached here if this happened!
28 S EVENT=$P(SEG(9),$E(HLECH),2)
29 ;
30 ; INITIALIZE HL7 VARIABLES
31 S HLEID="EAS ESR "_$P($$SITE^VASITE,"^",3)_" ORF-"_EVENT_" SERVER"
32 S HLEID=$O(^ORD(101,"B",HLEID,0))
33 D INIT^HLFNC2(HLEID,.HL)
34 S HLEIDS=$O(^ORD(101,HLEID,775,"B",0))
35 ;
36 ; Handle means test signature ORF (Z06) event
37 I EVENT="Z06" D ORF^IVMPREC7
38 ;
39 ; Handle income test ORF (Z10) event
40 I EVENT="Z10" D Z10
41 ;
42 ; Handle enrollment/elig. ORF (Z11) event
43 I EVENT="Z11" D
44 .S MSGID=SEG(10)
45 .D ORFZ11^DGENUPL(HLDA,MSGID)
46 ;
47 K ^TMP($J,IVMRTN)
48 Q
49 ;
50 ;
51Z10 ; Entry point for receipt of ORF~Z10 transmission
52 ; The Income Test (Z10) transmission has the following format:
53 ;
54 ; BHS ORF msgs do not include batch header or trailer.
55 ; {MSH
56 ; PID They will include the sequence: MSA
57 ; ZIC QRD
58 ; ZIR QRF
59 ; {ZDP These segments will follow the MSH segment.
60 ; ZIC
61 ; ZIR
62 ; }
63 ; {ZDP} Inactive Dependent Spouse Entries
64 ; {ZDP} Inactive Dependent Child Entries
65 ; {ZMT
66 ; }
67 ; ZBT
68 ; }
69 ; BTS
70 ;
71 S IVMORF=1 ; set ORF msg flag
72 S (HLEVN,IVMCT,IVMERROR,IVMCNTR)=0 ; init vars
73 ;
74ORU ; Entry point for receipt of ORU~Z10 trans (called by IVMPREC2)
75 S IVMTYPE=5,IVMZ10F=1
76 ;
77 ; - loop through the msg in (#772 file), and process (PROC) msgs
78 S IVMDA=0 F S IVMDA=$O(^TMP($J,IVMRTN,IVMDA)) Q:'IVMDA S IVMSEG=$G(^(IVMDA,0)) I $E(IVMSEG,1,3)="MSH" D PROC Q:'IVMDA
79 ;
80 ; - if ORF msg flag, update the Query Tran Log and send ACK
81 I $G(IVMORF) D
82 .I $G(DFN),$D(IVMMCI) D
83 ..N IVMCR
84 ..S IVMCR=$P("1^2^3^7^5^6^4","^",IVMTYPE) ;map reason to test type
85 ..D FIND^IVMCQ2(DFN,IVMMCI,HLDT,$S($D(HLERR):5,1:IVMCR),1)
86 .;D ACK^IVMPREC:'$D(HLERR)
87 .;N HLRESLTA,HLP
88 .;D GENACK^HLMA1(HLEID,HLMTIEN,HLEIDS,"LM",1,.HLRESLTA,"",.HLP)
89 ;
90 ; - if tests are uploaded, generate notification msg
91 I $D(^TMP($J,"IVMBULL")) D ^IVMCMB
92 ;
93ENQ ;
94 K IVMDA,IVMORF,IVMSEG,IVMFLGC,IVMTYPE,IVMMTIEN,IVMMTDT,IVMDGBT,IVMMCI
95 K ^TMP($J,"IVMCM"),^("IVMBULL"),DGMSGF,DGADDF,IVMCPAY,IVMBULL,DFN
96 K DGMTMSG,IVMZ10F
97 Q
98 ;
99PROC ; Process each HL7 message from (#772) file
100 ;
101 N IVMFUTR,TMSTAMP,SOURCE,NODE,HSDATE,IVMZ10,DGMTP,DGMTACT,DGMTI,DGMTA
102 S DGMTACT="ADD"
103 D PRIOR^DGMTEVT
104 S IVMZ10="UPLOAD IN PROGRESS"
105 S IVMFUTR=0 ;this flag will indicate whether or not a test with a future date is being uploaded
106 S IVMMTIEN=0
107 ;
108 S MSGID=$P(IVMSEG,HLFS,10) ; msg control id for ACK's
109 ; - check if DCD messaging is enabled
110 I '$$DCDON^IVMUPAR1() D PROB^IVMCMC("Facility has DCD messaging disabled") Q
111 ;
112 ; - check HL7 msg structure for errors
113 K HLERR,^TMP($J,"IVMCM")
114 D ^IVMCMC I $D(HLERR) K:HLERR="" HLERR Q
115 ;
116 ; Determine type of test/transmission
117 S IVMTYPE=0
118 ;
119 ; - was a means test sent?
120 I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2) S IVMTYPE=1 ; MT trans
121 ;
122 ; - if MT and CT transmitted, error - pt can't have both unless
123 ; one is a deletion, but HEC not currently handling that situation
124 I IVMTYPE,$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) D PROB^IVMCMC("Patient can not have both a Means Test and Copay Test") Q
125 I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2) S IVMTYPE=2 ; CT trans
126 ;
127 ; - if no MT or CT or LTC then Income Screening
128 I 'IVMTYPE,'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) S IVMTYPE=3 ; IS trans
129 ;
130 ;send an eligibility query if no eligibility code
131 I '$$ELIG^IVMCUF1(DFN),'$$PENDING^DGENQRY(DFN) I $$SEND^DGENQRY1(DFN)
132 ;
133 ; obtain locks used to sychronize upload with local income test options
134 D GETLOCKS^IVMCUPL(DFN)
135 ;
136 ;
137MT ; If transmission is a Means Test
138 N NODE0,RET,CODE,DATA,MTSIG,MTSIGDT
139 S HLQ=$G(HL("Q"))
140 S:HLQ="" HLQ=""""""
141 I IVMTYPE=1 D I $D(HLERR) G PROCQ
142 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2))
143 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,25))
144 .S HSDATE=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,24))
145 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,22)
146 .S MTSIG=$P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,27)
147 .S MTSIGDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,15))
148 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,1)
149 .Q:$$UPDMTSIG^IVMCMF(+IVMLAST,TMSTAMP,MTSIG,MTSIGDT)
150 .I $$Z06MT^EASPTRN1(+IVMLAST) Q
151 .I '$$ELIG^IVMUFNC5(DFN) S ERRMSG="Means Test upload not appropriate for current patient"
152 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D
153 ..N CATCZMT S CATCZMT=$G(^TMP($J,"IVMCM","ZMT1"))
154 ..S CATC=$$CATC^IVMUFNC5(CATCZMT)
155 ..I '+$G(CATC) S ERRMSG="Only Means Tests in current/previous income years are valid (not effective)"
156 .I $G(ERRMSG)'="" D PROB^IVMCMC(ERRMSG) K ERRMSG,CATC Q
157 .;
158 .; - perform edit checks and file MT
159 .D CHKDT
160 .;deletion indicator sent?
161 .I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,3)=HLQ D Q
162 ..D
163 ...;if there is a future test for that income year, delete that
164 ...N IEN,DATA,IVMPAT
165 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1,.IVMPAT)
166 ...I IEN S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
167 ...I IEN,$D(^DGMT(408.31,IEN,0)) D
168 ....S IVMMTIEN=IEN
169 ....S IVMFUTR=1
170 ...E D
171 ....S IVMFUTR=0
172 ..Q:('IVMMTIEN)
173 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
174 ..I $$EN^IVMCMD(IVMMTIEN) D
175 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
176 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
177 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
178 .;
179 .;check timestamp - if matches current primary test and hardship matches, then this is a duplicate and does not need to be uploaded
180 .I TMSTAMP D
181 ..S NODE=""
182 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),1)
183 ..Q:'IVMMTIEN
184 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
185 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
186 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5),(HSDATE=$P(NODE,"^")) Q
187 .;
188 .D DELTYPE^IVMCMD(DFN,IVMMTDT,2)
189 .D EN^IVMCM1
190 ;
191 ;
192CT ; If transmission is a Copay Test
193 N NODE0,RET,CODE,DATA
194 I IVMTYPE=2 D I $D(HLERR) G PROCQ
195 .S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2))
196 .S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,25))
197 .S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,22)
198 .S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,2)
199 .S IVMCPAY=$$RXST^IBARXEU(DFN)
200 .I $$AGE^IVMUFNC5(DT)>$$INCY^IVMUFNC5(IVMMTDT) D PROB^IVMCMC("Only Copay Tests in the current/previous income years are valid. (Not effective)") Q
201 .; - perform edit checks and file CT
202 .D CHKDT
203 .;deletion indicator sent?
204 .I $P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,3)=HLQ D Q
205 ..D
206 ...;if there is a future test for that income year, delete that
207 ...N IEN,DATA,IVMPAT
208 ...S IEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2,.IVMPAT)
209 ...I IEN S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
210 ...I IEN,$D(^DGMT(408.31,IEN,0)) D
211 ....S IVMMTIEN=IEN
212 ....S IVMFUTR=1
213 ...E D
214 ....S IVMFUTR=0
215 ..Q:('IVMMTIEN)
216 ..S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
217 ..I $$EN^IVMCMD(IVMMTIEN) D
218 ...S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
219 ...S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
220 ...D ADD^IVMCMB(DFN,IVMTYPE,$S(IVMFUTR:"DELETE FUTR TEST",1:"DELETE PRMRY TEST"),+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
221 .;
222 .;check timestamp - if matches current primary test, then this is a duplicate and does not need to be uploaded
223 .I TMSTAMP D
224 ..S NODE=""
225 ..I IVMFUTR N IVMMTIEN S IVMMTIEN=$$FUTURE(DFN,($E(IVMMTDT,1,3)-1),2)
226 ..Q:'IVMMTIEN
227 ..S NODE=$G(^DGMT(408.31,IVMMTIEN,2))
228 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
229 .I TMSTAMP,TMSTAMP=$P(NODE,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE,"^",5) Q
230 .;
231 .D DELTYPE^IVMCMD(DFN,IVMMTDT,1)
232 .D EN^IVMCM1
233 ;
234IS ; - If transmission is income screening info only then do not process
235 ; - outside of the scope of MTS
236 I IVMTYPE=3 S IVMMTDT=0
237 ;
238LTC ; If transmission contains a Long Term Care Test (TYPE 4 TEST)
239 I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2) D LTC^IVMCM1
240 ;
241PROCQ ;
242 ; release locks used to sychronize upload with local income test options
243 D RELLOCKS^IVMCUPL(DFN)
244 Q
245 ;
246CHKDT ; check date of income test being uploaded
247 ; Is it a future date? If so, set IVMFUTR=1
248 ;
249 ; IVMMTIEN is the IEN of current primary test for the year
250 ;
251 I $E($P(IVMLAST,"^",2),1,3)=$E(IVMMTDT,1,3) S IVMMTIEN=+IVMLAST
252 I IVMMTDT>DT S IVMFUTR=1
253 Q
254FUTURE(DFN,YEAR,TYPE,IVMPAT) ;
255 ;Returns the ien of the future test, if there is one
256 ;Inputs: DFN
257 ; YEAR - income year
258 ; TYPE - type of test
259 ;Output:
260 ; function value - ien of future means test, if there is one, "" otherwise
261 ; IVMPAT - Pointer to the IVM Patient file for the income year if there is an entry (pass by reference)
262 ;
263 N RET
264 S RET=""
265 S IVMPAT=$$FIND^IVMPLOG(DFN,YEAR)
266 I IVMPAT S RET=$P($G(^IVM(301.5,IVMPAT,0)),"^",$S(TYPE=1:6,1:7))
267 Q RET
Note: See TracBrowser for help on using the repository browser.