1 | IBCNEHLT ;DAOU/ALA - HL7 Process Incoming MFN Messages ; 09 Dec 2005 3:30 PM
|
---|
2 | ;;2.0;INTEGRATED BILLING;**184,251,271,300**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | ;**Program Description**
|
---|
6 | ; This program will process incoming MFN messages and
|
---|
7 | ; update the appropriate tables
|
---|
8 | ;
|
---|
9 | EN ; Entry Point
|
---|
10 | NEW AIEN,APIEN,APP,D0,D,DESC,DQ,DR,FILE,FLN,HEDI,ID,IEN
|
---|
11 | NEW PEDI,SEG,STAT,HCT,NEWID,TSSN,USSN,REQSUB,NAFLG,NPFLG
|
---|
12 | NEW IBCNACT,IBCNADT,FSVDY,PSVDY
|
---|
13 | NEW BPSIEN,CMIEN,DATA,DATAAP,DATABPS,DATACM,DATE,ERROR,FIELDNO,FILENO
|
---|
14 | NEW IBSEG,MSG,BUFF
|
---|
15 | NEW X12TABLE,BADFMT
|
---|
16 | ;
|
---|
17 | ; BADFMT is true if a site with patch 300 receives an IIV message in the previous HL7 interface structure (pre-300)
|
---|
18 | ;
|
---|
19 | ; Build local table of file numbers to determine if response is IIV or ePHARM
|
---|
20 | F D=11:1:18,21 S X12TABLE("365.0"_D)=""
|
---|
21 | ;
|
---|
22 | ; Decide if message belongs to "E-Pharm" or "IIV"
|
---|
23 | S APP=""
|
---|
24 | S HCT=0,ERFLG=0
|
---|
25 | F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D SPAR^IBCNEHLU I $G(IBSEG(1))="MFI" S FILE=$G(IBSEG(2)),FLN=$P(FILE,$E(HLECH,1),1) Q
|
---|
26 | I ",366.01,366.02,366.03,365.12,355.3,"[(","_FLN_",") S APP="E-PHARM"
|
---|
27 | I FLN=365.12 D
|
---|
28 | . S HCT=0,BADFMT=0
|
---|
29 | . F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D Q:(APP="IIV")!BADFMT
|
---|
30 | .. D SPAR^IBCNEHLU
|
---|
31 | .. I $G(IBSEG(1))="MFE",$P($G(IBSEG(5)),$E(HLECH,1),3)'="" D Q
|
---|
32 | ... S BADFMT=1,APP=""
|
---|
33 | ... S MSG(1)="Log a Remedy Ticket for this issue."
|
---|
34 | ... S MSG(2)="Please include in the Remedy Ticket that the IIV payer tables may be out"
|
---|
35 | ... S MSG(3)="of sync with the master list and will need a new copy of the payer table"
|
---|
36 | ... S MSG(4)="from Austin."
|
---|
37 | ... D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"IIV payer tables may be out of synch with master list","MSG(")
|
---|
38 | .. I $G(IBSEG(1))="ZPA" S APP="IIV"
|
---|
39 | I $D(X12TABLE(FLN)) S APP="IIV"
|
---|
40 | ; If neither IIV or ePHARM then quit
|
---|
41 | I APP="" Q
|
---|
42 | ;
|
---|
43 | S HCT=1,NAFLG=0,NPFLG=0,D=""
|
---|
44 | F S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT="" D Q:ERFLG
|
---|
45 | . D SPAR^IBCNEHLU
|
---|
46 | . S SEG=$G(IBSEG(1))
|
---|
47 | . ;
|
---|
48 | . I APP="E-PHARM" D
|
---|
49 | .. I SEG="MFI" D
|
---|
50 | ... S FILE=$G(IBSEG(2))
|
---|
51 | ... S FLN=$P(FILE,$E(HLECH,1),1)
|
---|
52 | ... ;
|
---|
53 | ... ; Initialize MFK Message (Application Acknowledgement) variables
|
---|
54 | ... ; Master File Identifier
|
---|
55 | ... S DATAMFK("MFI-1")=$G(IBSEG(2))
|
---|
56 | ... ;
|
---|
57 | ... ; File-Level Event Code
|
---|
58 | ... S DATAMFK("MFI-3")=$G(IBSEG(4))
|
---|
59 | .. ;
|
---|
60 | .. I SEG="MFE" D
|
---|
61 | ... I $G(FLN)="" S ERFLG=1,MSG(1)="File Number not found in MFN message" Q
|
---|
62 | ... I '$$VFILE^DILFD(FLN) S ERFLG=1,MSG(1)="File "_FLN_" not found in the Data Dictionary" Q
|
---|
63 | ... ;
|
---|
64 | ... ; Initialize MFK Message (Application Acknowledgement) variables
|
---|
65 | ... ; Record-Level Event Code
|
---|
66 | ... S DATAMFK("MFE-1")=$G(IBSEG(2))
|
---|
67 | ... ;
|
---|
68 | ... ; Primary Key Value
|
---|
69 | ... S DATAMFK("MFE-4")=$G(IBSEG(5))
|
---|
70 | ... ;
|
---|
71 | ... ; Primary Key Value Type
|
---|
72 | ... S DATAMFK("MFE-5")=$G(IBSEG(6))
|
---|
73 | ... ;
|
---|
74 | ... ; Transfer control to e-Pharmacy
|
---|
75 | ... D ^IBCNRHLT Q
|
---|
76 | .. ;
|
---|
77 | .. ; Transfer control on other segments
|
---|
78 | .. I ",ZCM,ZP0,ZPB,ZPL,ZPT,ZRX,"[(","_SEG_",") D ^IBCNRHLT
|
---|
79 | . ;
|
---|
80 | . ;
|
---|
81 | . I APP="IIV" D
|
---|
82 | .. I SEG="MFI" D
|
---|
83 | ... S FILE=$G(IBSEG(2))
|
---|
84 | ... S FLN=$P(FILE,$E(HLECH,1),1)
|
---|
85 | .. ;
|
---|
86 | .. I SEG="MFE" D
|
---|
87 | ... I $G(FLN)="" S ERFLG=1,MSG(1)="File Number not found in MFN message" Q
|
---|
88 | ... I '$$VFILE^DILFD(FLN) S ERFLG=1,MSG(1)="File "_FLN_" not found in the Data Dictionary" Q
|
---|
89 | ... ;
|
---|
90 | ... I FLN'=365.12 D Q
|
---|
91 | .... S DATA=$G(IBSEG(5))
|
---|
92 | .... S ID=$$DECHL7^IBCNEHL2($P(DATA,$E(HLECH,1),1)),DESC=$$DECHL7^IBCNEHL2($P(DATA,$E(HLECH,1),2))
|
---|
93 | .... D TFIL
|
---|
94 | ... ;
|
---|
95 | ... ; Pull the action code
|
---|
96 | ... S IBCNACT=$G(IBSEG(2))
|
---|
97 | ... ; Effective Date
|
---|
98 | ... S IBCNADT=$G(IBSEG(4))
|
---|
99 | .. ;
|
---|
100 | .. I SEG="ZP0" D
|
---|
101 | ... S ID=$$DECHL7^IBCNEHL2(IBSEG(3)),NEWID=$$DECHL7^IBCNEHL2(IBSEG(4))
|
---|
102 | ... S DESC=$$DECHL7^IBCNEHL2(IBSEG(5)),HEDI=$$DECHL7^IBCNEHL2(IBSEG(6)),PEDI=$$DECHL7^IBCNEHL2(IBSEG(7))
|
---|
103 | .. ;
|
---|
104 | .. I SEG="ZPA" D
|
---|
105 | ... S STAT=IBSEG(4),STAT=$S(STAT="Y":"Active",1:"Not Active")
|
---|
106 | ... S TSSN=IBSEG(5),USSN=IBSEG(6),REQSUB=IBSEG(7)
|
---|
107 | ... S FSVDY=IBSEG(8),PSVDY=IBSEG(9)
|
---|
108 | ... D PFIL
|
---|
109 | Q
|
---|
110 | ;
|
---|
111 | PFIL ; Payer Table Filer
|
---|
112 | ; Set the action:
|
---|
113 | ; MAD=Add, MUP=Update, MDC=Deactivate, MAC=Reactivate
|
---|
114 | S IBCNADT=$$FMDATE^HLFNC(IBCNADT)
|
---|
115 | I IBCNADT="" S IBCNADT=$$NOW^XLFDT()
|
---|
116 | ; If the action is MAD - Add the payer as new
|
---|
117 | N IBNOK,IBAPP,IBID,IBDESC,IBSTR
|
---|
118 | S IBNOK=0,IBAPP=($TR(APP," ")="")
|
---|
119 | I IBCNACT="MAD" D I IBNOK G PFILX
|
---|
120 | . ; Check certain required fields: Application, VA National & Payer Name
|
---|
121 | . ; If not populated, send MailMan message.
|
---|
122 | . S IBID=($TR(ID," ")=""),IBDESC=($TR(DESC," ")="")
|
---|
123 | . S IBNOK=IBAPP!IBID!IBDESC
|
---|
124 | . I 'IBNOK D MAD(DESC) Q
|
---|
125 | . S IBSTR="" I IBAPP S IBSTR="Application"
|
---|
126 | . I IBID S:IBSTR]"" IBSTR=IBSTR_", " S IBSTR=IBSTR_"VA National"
|
---|
127 | . I IBDESC S:IBSTR]"" IBSTR=IBSTR_", " S IBSTR=IBSTR_"Payer Name"
|
---|
128 | . S MSG(1)="MAD action received. "_IBSTR_" unknown."
|
---|
129 | I IBCNACT'="MAD" D FND
|
---|
130 | N IBCNTYPE
|
---|
131 | I IEN<1!IBAPP D G PFILX
|
---|
132 | . S IBCNTYPE=$S(IBCNACT="MAD":"Add",IBCNACT="MUP":"Update",IBCNACT="MDC":"Deactivate",IBCNACT="MAC":"Reactivate",1:"Unknown")
|
---|
133 | . S MSG(1)=IBCNTYPE_" ("_IBCNACT_") action received. Payer and/or Application may be unknown."
|
---|
134 | . S MSG(2)=""
|
---|
135 | . S MSG(3)="VA National : "_ID
|
---|
136 | . S MSG(4)="Payer Name : "_DESC
|
---|
137 | . S MSG(5)="Application : "_APP
|
---|
138 | . S MSG(6)=""
|
---|
139 | . S MSG(7)="Log a Remedy Ticket for this issue."
|
---|
140 | . S MSG(8)=""
|
---|
141 | . S MSG(9)="Please include in the Remedy Ticket that VISTA did not receive the required"
|
---|
142 | . S MSG(10)="information or the accurate information to add/update this Payer."
|
---|
143 | . D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"IIV payer tables may be out of synch with master list","MSG(")
|
---|
144 | ;
|
---|
145 | S DESC=$E(DESC,1,80) ;restriction of the field in the DD
|
---|
146 | S DIC=$$ROOT^DILFD(FLN)
|
---|
147 | S DR=".01///^S X=DESC;.02////^S X=NEWID;.05////^S X=PEDI;.06////^S X=HEDI"
|
---|
148 | ;
|
---|
149 | ; If new payer, add the Date/Time created
|
---|
150 | I NPFLG S DR=DR_";.04///^S X=$$NOW^XLFDT()"
|
---|
151 | S DIE=DIC,DA=IEN D ^DIE
|
---|
152 | ;
|
---|
153 | ; Check for application
|
---|
154 | S DIC="^IBE(365.13,",DIC(0)="X",X=APP D ^DIC
|
---|
155 | S AIEN=+Y I AIEN<1 D
|
---|
156 | . S DLAYGO=365.13,DIC(0)="L",DIC("P")=DLAYGO
|
---|
157 | . S DIE=DIC,X=APP
|
---|
158 | . K DD,DO
|
---|
159 | . D FILE^DICN
|
---|
160 | . K DO
|
---|
161 | . S AIEN=+Y
|
---|
162 | ;
|
---|
163 | S APIEN=$O(^IBE(365.12,IEN,1,"B",AIEN,""))
|
---|
164 | I APIEN="" D
|
---|
165 | . S DLAYGO=365.121,DIC(0)="L",DIC("P")=DLAYGO,DA(1)=IEN,X=AIEN
|
---|
166 | . S DIC="^IBE(365.12,"_DA(1)_",1,",DIE=DIC
|
---|
167 | . I '$D(^IBE(365.12,IEN,1,0)) S ^IBE(365.12,IEN,1,0)="^365.121P^^"
|
---|
168 | . K DD,DO
|
---|
169 | . D FILE^DICN
|
---|
170 | . K DO
|
---|
171 | . S APIEN=+Y,NAFLG=1
|
---|
172 | ;
|
---|
173 | I $G(STAT)="" S STAT=$P(^IBE(365.12,IEN,1,APIEN,0),U,2)
|
---|
174 | ;
|
---|
175 | S DA(1)=IEN,DA=APIEN,DIC="^IBE(365.12,"_DA(1)_",1,",DR=""
|
---|
176 | ;
|
---|
177 | I IBCNACT="MDC" S DR=DR_".11///^S X=1;.12////^S X=IBCNADT;",STAT=0
|
---|
178 | I IBCNACT="MAC" S DR=DR_".11///^S X=0;.12///@;"
|
---|
179 | S DR=DR_".02///^S X=STAT;.06///^S X=$$NOW^XLFDT()"
|
---|
180 | I IBCNACT'="MDC" S DR=DR_";.08///^S X=REQSUB;.09///^S X=USSN;.1///^S X=TSSN;.14///^S X=FSVDY;.15///^S X=PSVDY"
|
---|
181 | ;
|
---|
182 | ; If new application, add the Date/Time created
|
---|
183 | I NAFLG S DR=DR_";.13///^S X=$$NOW^XLFDT()"
|
---|
184 | ;
|
---|
185 | S DIE=DIC D ^DIE
|
---|
186 | I IBCNACT="MDC" D MDC Q
|
---|
187 | PFILX ;
|
---|
188 | Q
|
---|
189 | ;
|
---|
190 | TFIL ; Non Payer Tables Filer
|
---|
191 | NEW DIC,DIE,X,DA,DLAYGO,Y,DR,IEN
|
---|
192 | S DIC(0)="X",X=ID,DIC=$$ROOT^DILFD(FLN)
|
---|
193 | D ^DIC S IEN=+Y
|
---|
194 | ;
|
---|
195 | S DESC=$E(DESC,1,80) ;restriction of the field in the DD
|
---|
196 | ;
|
---|
197 | ; If no matching entry found, add it to table
|
---|
198 | I IEN<1 D
|
---|
199 | . S DLAYGO=FLN,DIC(0)="L",DIC("P")=DLAYGO,DIE=DIC
|
---|
200 | . K DD,DO
|
---|
201 | . D FILE^DICN S IEN=+Y
|
---|
202 | . K DO
|
---|
203 | ;
|
---|
204 | S DR=".02///^S X=DESC",DA=IEN,DIE=DIC D ^DIE
|
---|
205 | Q
|
---|
206 | ;
|
---|
207 | MAD(X) ; Add an entry
|
---|
208 | D FND
|
---|
209 | I IEN>0 G MADX
|
---|
210 | NEW DIC,DIE,DA,DLAYGO,Y,DR
|
---|
211 | S DIC=$$ROOT^DILFD(FLN)
|
---|
212 | S DLAYGO=FLN,DIC(0)="L",DIC("P")=DLAYGO,DIE=DIC
|
---|
213 | K DD,DO
|
---|
214 | D FILE^DICN
|
---|
215 | K DO
|
---|
216 | S IEN=+Y,NPFLG=1
|
---|
217 | MADX ;
|
---|
218 | Q
|
---|
219 | ;
|
---|
220 | FND ; Find an existing Payer entry
|
---|
221 | NEW DIC,DIE,X,DA,DLAYGO,Y,DR
|
---|
222 | S X=ID,DIC(0)="X",D="C",DIC=$$ROOT^DILFD(FLN)
|
---|
223 | ;
|
---|
224 | ; Do a lookup with the "C" cross-reference
|
---|
225 | D IX^DIC
|
---|
226 | S IEN=+Y
|
---|
227 | Q
|
---|
228 | ;
|
---|
229 | MDC ; Check for active transmissions and cancel
|
---|
230 | NEW STA,HIEN,RIEN,TQIEN
|
---|
231 | F STA=1,2,4,6 S TQIEN="" D
|
---|
232 | . F S TQIEN=$O(^IBCN(365.1,"AC",STA,TQIEN)) Q:TQIEN="" D
|
---|
233 | .. ;
|
---|
234 | .. ; If the record doesn't match the payer, quit
|
---|
235 | .. I $P(^IBCN(365.1,TQIEN,0),U,3)'=IEN Q
|
---|
236 | .. ;
|
---|
237 | .. ; Set the status to 'Cancelled'
|
---|
238 | .. D SST^IBCNEUT2(TQIEN,7)
|
---|
239 | .. ;
|
---|
240 | .. ; If a buffer entry, set to ! (bang)
|
---|
241 | .. S BUFF=$P(^IBCN(365.1,TQIEN,0),U,5)
|
---|
242 | .. I BUFF'="" D BUFF^IBCNEUT2(BUFF,17)
|
---|
243 | .. ;
|
---|
244 | .. ; Change any responses status also
|
---|
245 | .. S HIEN=0 F S HIEN=$O(^IBCN(365.1,TQIEN,2,HIEN)) Q:'HIEN D
|
---|
246 | ... S RIEN=$P(^IBCN(365.1,TQIEN,2,HIEN,0),U,3)
|
---|
247 | ... ; If the Response status is 'Response Received', don't change it
|
---|
248 | ... I $P(^IBCN(365,RIEN,0),U,6)=3 Q
|
---|
249 | ... D RSP^IBCNEUT2(RIEN,7)
|
---|
250 | Q
|
---|