source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNRHLT.m@ 699

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

initial load of WorldVistAEHR
File size: 6.0 KB
RevLine 
[613]1IBCNRHLT ;DAOU/DMK - Receive HL7 e-Pharmacy MFN Message ;23-OCT-2003
2 ;;2.0;INTEGRATED BILLING;**251**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Description
6 ;
7 ; Receive HL7 e-Pharmacy MFN Message
8 ; Table Update
9 ;
10 ; Control processing of segments
11 ;
12 ; Required segments listed in order
13 ; MSH (Message Header Segment) (processed by IBCNEHLT)
14 ; MFI (Master File Identifier Segment) (processed by IBCNEHLT)
15 ; MFE (Master File Entry Segment)
16 ;
17 ; Optional segments listed by file
18 ; ZP0 (365.12 PAYER File Update Segment)
19 ;
20 ; ZPT (366.01 NCPDP PROCESSOR File Update Segment)
21 ; ZCM (366.012 NCPDP PROCESSOR CONTACT MEANS Subfile Update Segment)
22 ;
23 ; ZPB (366.02 PHARMACY BENEFITS MANAGER (PBM) File Update Segment)
24 ; ZCM (366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
25 ; Update Segment)
26 ;
27 ; ZPL (366.03 PLAN File Update Segment)
28 ; ZCM (366.032 PLAN CONTACT MEANS Subfile Update Segment)
29 ;
30 ; ZRX (366.03 PLAN File (Pharmacy) Update Segment)
31 ; ZCM (366.0312 PLAN RX CONTACT MEANS Subfile Update Segment)
32 ;
33 ; Called by IBCNEHLT if all of the following are true
34 ; * File # (MFI Segment) = 365.12, 366.01, 366.02, or 366.03
35 ; * Primary Key Value (MFE Segment) does not contain "IIV"
36 ; * Segment ID (every segment) = MFE, ZCM, ZP0, ZPB, ZPL, ZPT, or ZRX
37 ;
38 ; Entry point
39 ;
401000 ; Control processing
41 I $D(ERROR) Q
42 D @SEG
43 ;
44 ; Initialize MFK Message (Application Acknowledgement) variables
45 I $D(ERROR) D Q
46 . S DATAMFK("ERROR")=ERROR
47 . S DATAMFK("IEN")=IEN
48 ;
49 ; Quit if more segments
50 I $O(^TMP($J,"IBCNEHLI",HCT))]"" Q
51 ;
52 ; Update File?
53 I $D(DATA) D
54 . S FIELDNO="" F S FIELDNO=$O(DATA(FIELDNO)) Q:FIELDNO="" D
55 .. ;
56 .. ; Convert "" to "@" to delete field value if necessary
57 .. I IEN'=-1,DATA(FIELDNO)="" S DATA(FIELDNO)="@"
58 .. ;
59 .. ; Convert HL7 special characters if necessary
60 .. I DATA(FIELDNO)[$E(HLECH,3) S DATA(FIELDNO)=$$TRAN1^IBCNRHLU(DATA(FIELDNO))
61 . D FILE
62 ;
63 ; Update File?
64 I $D(DATABPS) D
65 . S FIELDNO="" F S FIELDNO=$O(DATABPS(FIELDNO)) Q:FIELDNO="" D
66 .. ;
67 .. ; Convert "" to "@" to delete field value if necessary
68 .. I IEN'=-1,DATABPS(FIELDNO)="" S DATABPS(FIELDNO)="@"
69 .. ;
70 .. ; Convert HL7 special characters if necessary
71 .. I DATABPS(FIELDNO)[$E(HLECH,3) S DATABPS(FIELDNO)=$$TRAN1^IBCNRHLU(DATABPS(FIELDNO))
72 . ;
73 . D FILEBPS
74 ;
75 ; Update APPLICATION Subfile?
76 I $D(DATAAP) D
77 . S FIELDNO="" F S FIELDNO=$O(DATAAP(FIELDNO)) Q:FIELDNO="" D
78 .. ;
79 .. ; Convert "" to "@" to delete field value if necessary
80 .. I APIEN'=-1,DATAAP(FIELDNO)="" S DATAAP(FIELDNO)="@"
81 .. ;
82 .. ; Convert HL7 special characters if necessary
83 .. I DATAAP(FIELDNO)[$E(HLECH,3) S DATAAP(FIELDNO)=$$TRAN1^IBCNRHLU(DATAAP(FIELDNO))
84 . S FIELDNO=$S(FILENO=365.12:1,1:3)
85 . D FILEAP
86 ;
87 ; Update CONTACT MEANS Subfile?
88 I $D(DATACM) D
89 . S FIELDNO="" F S FIELDNO=$O(DATACM(FIELDNO)) Q:FIELDNO="" D
90 .. ;
91 .. ; Convert "" to "@" to delete field value if necessary
92 .. I CMIEN'=-1,DATACM(FIELDNO)="" S DATACM(FIELDNO)="@"
93 .. ;
94 .. ; Convert HL7 special characters if necessary
95 .. I DATACM(FIELDNO)[$E(HLECH,3) S DATACM(FIELDNO)=$$TRAN1^IBCNRHLU(DATACM(FIELDNO))
96 . S FIELDNO=$S(FILE["Pharmacy"&FILENO=366.03:12,1:2)
97 . I IBCNACT="MDL" D DELETECM Q
98 . D FILECM
99 Q
100 ;
101ADD ; Add File entry
102 ; 365.12 PAYER File
103 ; 366.01 NCPDP PROCESSOR File
104 ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
105 ; 366.03 PLAN File
106 ;
107 S IEN=$$ADD1^IBCNRFM1(FILENO,DATA(.01))
108 Q
109 ;
110ADDAP ; Add APPLICATION Subfile entry
111 ; 365.121 PAYER APPLICATION Subfile
112 ; 366.013 NCPDP PROCESSOR APPLICATION File
113 ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
114 ; 366.033 PLAN APPLICATION Subfile
115 ;
116 S APIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,AIEN)
117 Q
118 ;
119ADDCM ; Add CONTACT MEANS Subfile entry
120 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
121 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
122 ; 366.032 PLAN CONTACT MEANS Subfile
123 ; 366.0312 PLAN RX CONTACT MEANS Subfile
124 ;
125 S CMIEN=$$ADD2^IBCNRFM1(FILENO,IEN,FIELDNO,DATACM(.01))
126 Q
127 ;
128DELETECM ; Delete CONTACT MEANS Subfile entry
129 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
130 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
131 ; 366.032 PLAN CONTACT MEANS Subfile
132 ; 366.0312 PLAN RX CONTACT MEANS Subfile
133 ;
134 D DELETE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN)
135 Q
136 ;
137FILE ; File data
138 ; 365.12 PAYER File
139 ; 366.01 NCPDP PROCESSOR File
140 ; 366.02 PHARMACY BENEFITS MANAGER (PBM) File
141 ; 366.03 PLAN File
142 ;
143 ; Add?
144 I IEN=-1 D ADD
145 ;
146 ; Update
147 D FILE1^IBCNRFM1(FILENO,IEN,.DATA)
148 Q
149 ;
150FILEAP ; File APPLICATION Subfile data
151 ; 365.121 PAYER APPLICATION Subfile
152 ; 366.013 NCPDP PROCESSOR APPLICATION Subfile
153 ; 366.023 PHARMACY BENEFITS MANAGER (PBM) APPLICATION Subfile
154 ; 366.033 PLAN APPLICATION Subfile
155 ;
156 ; Add?
157 I APIEN=-1 D ADDAP
158 ;
159 ; Update
160 D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,APIEN,.DATAAP)
161 Q
162 ;
163FILEBPS ; File data
164 ; 90002312.92 BPS NCPDP FORMATS File
165 ;
166 N FILENO1
167 S FILENO1=9002313.92
168 ;
169 ; Update Billing Payer Sheet Entry?
170 S BPSIEN=DATA(10.07) I BPSIEN'="@" D
171 . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
172 ;
173 ; Update Rebill Payer Sheet Entry?
174 S BPSIEN=DATA(10.09) I BPSIEN'="@" D
175 . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
176 ;
177 ; Update Reversal Payer Sheet Entry?
178 S BPSIEN=DATA(10.08) I BPSIEN'="@" D
179 . ;
180 . ; 1.03 = Maximum RX's Per Claim
181 . S DATABPS(1.03)=1
182 . ;
183 . ; 1.07 = Is A Reversal Format
184 . S DATABPS(1.07)=1
185 . ;
186 . D FILE1^IBCNRFM1(FILENO1,BPSIEN,.DATABPS)
187 Q
188 ;
189FILECM ; File CONTACT MEANS Subfile data
190 ; 366.012 NCPDP PROCESSOR CONTACT MEANS Subfile
191 ; 366.022 PHARMACY BENEFITS MANAGER (PBM) CONTACT MEANS Subfile
192 ; 366.032 PLAN CONTACT MEANS Subfile
193 ; 366.0312 PLAN RX CONTACT MEANS Subfile
194 ;
195 ; Add?
196 I CMIEN=-1 D ADDCM
197 ;
198 ; Update
199 D FILE2^IBCNRFM1(FILENO,IEN,FIELDNO,CMIEN,.DATACM)
200 Q
201 ;
202MFE ; Process MFE Segment
203 D ^IBCNRMFE
204 Q
205 ;
206ZP0 ; Process ZP0 Segment
207 D ^IBCNRZP0
208 Q
209 ;
210ZCM ; Process ZCM Segment
211 D ^IBCNRZCM
212 Q
213 ;
214ZPB ; Process ZPB Segment
215 D ^IBCNRZPB
216 Q
217 ;
218ZPL ; Process ZPL Segment
219 D ^IBCNRZPL
220 Q
221 ;
222ZPT ; Process ZPT Segment
223 D ^IBCNRZPT
224 Q
225 ;
226ZRX ; Process ZRX Segment
227 D ^IBCNRZRX
228 Q
Note: See TracBrowser for help on using the repository browser.