source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEHL1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1IBCNEHL1 ;DAOU/ALA - HL7 Process Incoming RPI Messages ;26-JUN-2002 ; Compiled December 16, 2004 15:29:01
2 ;;2.0;INTEGRATED BILLING;**300,345**;21-MAR-94;Build 28
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program will process incoming IIV response messages.
7 ; This includes updating the record in the IIV Response File,
8 ; updating the Buffer record (if there is one and creating a new
9 ; one if there isn't) with the appropriate Buffer Symbol and data
10 ;
11 ; This routine is based on IBCNEHLR which was introduced with patch 184, and subsequently
12 ; patched with patches 252 and 271. IBCNEHLR is obsolete and deleted with patch 300.
13 ;
14 ;**Modified by Date Reason
15 ; DAOU/BHS 10/04/2002 Added logic to update the service date in
16 ; the TQ entry so long as the Error Action is
17 ; not Please submit original transaction.
18 ; DAOU/DB 03/11/2004 Added logic to utilize new status flag
19 ; transmitted to VistA from EC (IIVSTAT)
20 ; 03/15/2004 Update other retries to comm failure (if
21 ; not response rcvd)
22 ; DAOU/BEE 07/14/2004 Cleaned up routine - Made more readable
23 ; Cleaned up variables
24 ; PROXICOM/RTO 08/23/2006 Fixed logic issue when determining whether
25 ; to update a buffer entry
26 ;
27 ; Variables
28 ; SEG = HL7 Segment Name
29 ; MSGID = Original Message Control ID
30 ; ACK = Acknowledgment (AA=Accepted, AE=Error)
31 ; ERTXT = Error Message Text
32 ; ERFLG = Error quit flag
33 ; ERACT = Error Action
34 ; ERCON = Error Condition
35 ; RIEN = Response Record IEN
36 ; IIVSTAT = EC generated flag interpreting status of response
37 ; 1 = +
38 ; 6 = -
39 ; V = #
40 ; MAP = Array that maps EC's IIV status flag to IIV STATUS TABLE (#365.15) IEN
41 ;
42EN ; Entry Point
43 N EBDA,ERFLG,ERROR,HCT,IIVSTAT,IRIEN,MAP,MGRP,RIEN,RSUPDT,SEG,SUBID,TRACE,UP,ACK
44 S ERFLG=0,MGRP=$$MGRP^IBCNEUT5(),HCT=1,SUBID="",IIVSTAT=""
45 ;
46 ; Create map from EC to VistA
47 S MAP(1)=8,MAP(6)=9,MAP("V")=21
48 ;
49 ; Loop through the message and find each segment for processing
50 F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D Q:ERFLG
51 . D SPAR^IBCNEHLU
52 . S SEG=$G(IBSEG(1))
53 . ;
54 . I SEG="MSA" D MSA^IBCNEHL2(.ERACT,.ERCON,.ERROR,.ERTXT,.IBSEG,MGRP,.RIEN,.TRACE) Q:ERFLG
55 . ;
56 . ; Contact Segment
57 . I SEG="CTD" D CTD^IBCNEHL2(.ERROR,.IBSEG,RIEN)
58 . ;
59 . ; Patient Segment
60 . I SEG="PID" D PID^IBCNEHL2(.ERFLG,.ERROR,.IBSEG,RIEN)
61 . ;
62 . ; Guarantor Segment
63 . I SEG="GT1" D GT1^IBCNEHL2(.ERROR,.IBSEG,RIEN,.SUBID)
64 . ;
65 . ; Insurance Segment
66 . I SEG="IN1" D IN1^IBCNEHL2(.ERROR,.IBSEG,RIEN,SUBID)
67 . ;
68 . ; Addt'l Insurance Segment
69 . ;I SEG="IN2" ; for future expansion, add IN2 tag to IBCNEHL2
70 . ;
71 . ; Addt'l Insurance - Cert Segment
72 . I SEG="IN3" D IN3^IBCNEHL2(.ERROR,.IBSEG,RIEN)
73 . ;
74 . ; Eligibility/Benefit Segment
75 . I SEG="ZEB" D ZEB^IBCNEHL2(.EBDA,.ERROR,.IBSEG,RIEN)
76 . ;
77 . ; Notes Segment
78 . I SEG="NTE" D NTE^IBCNEHL2(EBDA,.IBSEG,RIEN)
79 ;
80 D FIL
81 Q
82 ;
83 ; =================================================================
84FIL ; Finish processing the response message
85 ;
86 ; Input Variables
87 ; ERACT, ERFLG, ERROR, IIVSTAT, MAP, RIEN, TRACE
88 ;
89 ; If no record IEN, quit
90 I $G(RIEN)="" Q
91 ;
92 N BUFF,DFN,FILEIT,IBFDA,IBIEN,IBQFL,RDAT0,RSRVDT,RSTYPE,SYMBOL,TQDATA,TQN,TQSRVDT
93 ; Initialize variables from the Response File
94 S RDAT0=$G(^IBCN(365,RIEN,0)),TQN=$P(RDAT0,U,5)
95 S TQDATA=$G(^IBCN(365.1,TQN,0))
96 S IBQFL=$P(TQDATA,U,11)
97 S DFN=$P(RDAT0,U,2),BUFF=$P(RDAT0,U,4)
98 S IBIEN=$P(TQDATA,U,5),RSTYPE=$P(RDAT0,U,10)
99 S RSRVDT=$P($G(^IBCN(365,RIEN,1)),U,10)
100 ;
101 ; If an unknown error action or an error filing the response message,
102 ; send a warning email message
103 ; Note - A call to UEACT will always set ERFLAG=1
104 I ",W,X,R,P,C,N,Y,S,"'[(","_$G(ERACT)_",")&($G(ERACT)'="")!$D(ERROR) D UEACT
105 ;
106 ; If an error occurred, processing complete
107 I $G(ERFLG)=1 Q
108 ;
109 ; For an original response, set the Transmission Queue Status to 'Response Received' &
110 ; update remaining retries to comm failure (5)
111 I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
112 ;
113 ; Update the TQ service date to the date in the response file
114 ; if they are different AND the Error Action <>
115 ; 'P' for 'Please submit original transaction'
116 ;
117 ; *** Temporary change to suppress update of service & freshness dates.
118 ; *** To reinstate, remove comment (;) from next line.
119 ;I TQN'="",$G(RSTYPE)="O" D
120 ;. S TQSRVDT=$P($G(^IBCN(365.1,TQN,0)),U,12)
121 ;. I RSRVDT'="",TQSRVDT'=RSRVDT,$G(ERACT)'="P" D SAVETQ^IBCNEUT2(TQN,RSRVDT)
122 ;. ; update freshness date by same delta
123 ;. D SAVFRSH^IBCNEUT5(TQN,+$$FMDIFF^XLFDT(RSRVDT,TQSRVDT,1))
124 ;
125 ; Check for error action
126 I $G(ERACT)'=""!($G(ERTXT)'="") D ERROR^IBCNEHL3(TQN,ERACT,ERCON,TRACE) G FILX
127 ;
128 ; Stop processing if identification response and not an active policy
129 S FILEIT=1
130 I $G(IIVSTAT)=6,TQN]"" D
131 . I TQDATA="" Q
132 . I IBQFL'="I" Q
133 . S FILEIT=0
134 I 'FILEIT G FILX
135 ;
136 ; If there is an associated buffer entry & one or both of the following
137 ; is true, stop filing (don't update buffer entry)
138 ; 1) buffer status is not 'Entered'
139 ; 2) the buffer entry is verified (* symbol)
140 I BUFF'="",($P(^IBA(355.33,BUFF,0),U,4)'="E")!($$SYMBOL^IBCNBLL(BUFF)="*") G FILX
141 ;
142 ; Set buffer symbol based on value returned from EC
143 S SYMBOL=MAP(IIVSTAT)
144 ;
145 ; If there is an associated buffer entry, update the buffer entry w/
146 ; response data
147 I BUFF'="" D RP^IBCNEBF(RIEN,"",BUFF)
148 ;
149 ; If no associated buffer entry, create one & populate w/ response
150 ; data (routine call sets IBFDA)
151 I BUFF="" D RP^IBCNEBF(RIEN,1) S BUFF=+IBFDA,UP(365,RIEN_",",.04)=BUFF
152 ;
153 ; Set eIV Processed Date to now
154 S UP(355.33,BUFF_",",.15)=$$NOW^XLFDT()
155 D FILE^DIE("I","UP","ERROR")
156FILX ;
157 Q
158 ;
159 ; =================================================================
160WARN ; Create and send a response processing error warning message
161 ;
162 ; Input Variables
163 ; ERROR, TRACE
164 ;
165 ; Output Variables
166 ; ERFLG=1
167 ;
168 N MCT,MSG,SUBCNT,VEN,XMY
169 S VEN=0,MCT=8,ERFLG=1,SUBCNT=""
170 S MSG(1)="IMPORTANT: Error While Processing Response Message from the EC"
171 S MSG(2)="-------------------------------------------------------------"
172 S MSG(3)="*** IRM *** Please log a NOIS because the"
173 S MSG(4)="response message received from the Eligibility Communicator"
174 S MSG(5)="could not be processed. Programming changes may be necessary"
175 S MSG(6)="to properly handle the response."
176 S MSG(7)="The associated Trace # is "_$S($G(TRACE)="":"Unknown",1:TRACE)_". If applicable,"
177 S MSG(8)="please review the response with the eIV Response Report by Trace#."
178 F S VEN=$O(ERROR("DIERR",VEN)) Q:'VEN D
179 . F S SUBCNT=$O(ERROR("DIERR",VEN,"TEXT",SUBCNT)) Q:'SUBCNT D
180 . . S MCT=MCT+1,MSG(MCT)=ERROR("DIERR",VEN,"TEXT",SUBCNT)
181 . S MCT=MCT+1,MSG(MCT)=" "
182 D MSG^IBCNEUT5(MGRP,MSG(1),"MSG(",,.XMY)
183 Q
184 ;
185 ; =================================================================
186UEACT ; Send warning msg if Unknown Error Action Code was received or
187 ; encountered problem filing date
188 ;
189 ; Input Variables
190 ; ERROR, IBIEN, IBQFL, RIEN, RSTYPE, TQDATA, TRACE
191 ;
192 ; Output Variables
193 ; ERFLG=1 (SET IN WARN TAG)
194 ;
195 N DFN,SYMBOL
196 D WARN ; send warning msg
197 ;
198 ; If the response could not be created or there is no associated TQ entry, stop processing
199 I '$G(RIEN)!(TQDATA="") Q
200 ;
201 ; For an original response, set the Transmission Queue Status to 'Response Received' &
202 ; update remaining retries to comm failure (5)
203 I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
204 ;
205 ; If it is an identification and policy is not active don't
206 ; create buffer entry
207 I IBQFL="I",IIVSTAT'=1 Q
208 ;
209 ; If unsolicited message or no buffer in TQ, create new buffer entry
210 I RSTYPE="U" S IBIEN=""
211 I IBIEN="" D Q
212 . S DFN=$P(TQDATA,U,2) ; Determine Patient DFN
213 . S SYMBOL=22 D BUF^IBCNEHL3 ; Create a new buffer entry
214 ;
215 ;Update buffer symbol
216 D BUFF^IBCNEUT2(IBIEN,22)
217 ;
218 Q
Note: See TracBrowser for help on using the repository browser.