Produced by Araxis Merge on 9/11/2018 8:57:52 AM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | OSCIF MCCF EDI TAS_Sept2018.zip | TAS+eBill+SDD+US3+v2.00.docx | Mon Jul 9 15:28:45 2018 UTC |
2 | OSCIF MCCF EDI TAS_Sept2018.zip | TAS+eBill+SDD+US3+v2.00.docx | Mon Sep 10 18:22:57 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 5 | 10890 |
Changed | 4 | 8 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | TAS eBill SDD US3 v2 .0 | |
2 | System Des ign Docume nt | |
3 | IB*2.0*608 | |
4 | ||
5 | ||
6 | ||
7 | ||
8 | Department of Vetera ns Affairs | |
9 | March 2018 | |
10 | Version 2. 0 | |
11 | Revision H istory | |
12 | Date | |
13 | Version | |
14 | Descriptio n | |
15 | Author | |
16 | 10/17 | |
17 | 1.0 | |
18 | Initial su bmittal pr ior to dev elopment | |
19 | PII | |
20 | 3/18 | |
21 | 1.1 | |
22 | Updated af ter comple tion of de velopment | |
23 | PII | |
24 | 5/18 | |
25 | 2.0 | |
26 | Updated af ter comple tion of ad ditional a nd final d evelopment | |
27 | PII | |
28 | ||
29 | ||
30 | ||
31 | ||
32 | ||
33 | ||
34 | ||
35 | ||
36 | ||
37 | ||
38 | ||
39 | ||
40 | ||
41 | ||
42 | ||
43 | ||
44 | ||
45 | ||
46 | ||
47 | ||
48 | ||
49 | ||
50 | ||
51 | ||
52 | ||
53 | ||
54 | ||
55 | User Story Number: N O ID | |
56 | User Story Name: CMN Oxygen an d EPN Nutr ition | |
57 | Product Ba cklog ID: n/a | |
58 | Rally ID: US-3 | |
59 | Design/Ass umption: | |
60 | The design for this user story is going on the ass umption th at FILEMAN 22.2 (pat ch DI*22.2 *3) will h ave been i nstalled a t all site s. | |
61 | Resolution Summary: | |
62 | To resolve this requ est, the f ollowing i tems will need to be accomplis hed. Note that the user will be prompte d for CMN data only if the cla im is Prof essional ( Institutio nal & Dent al exclude d): | |
63 | Create sec tion 21 in the IB Sy stem Param eters call ed “CMN CP T Code Inc lusion” wh ich contai ns a list of CPT cod es requiri ng CMN pro mpting (ro utines IBJ PS & IBJPS 8). There is also a function in this ro utine to d etermine i f a partic ular code is in the list. | |
64 | Create a n ew Procedu res sub-fi eld 399.30 4,23 to st ore the re sponse to the “CMN R equired?” prompt (Ye s or No). CMN promp ting will only occur for proce dures in t he “CMN CP T Code Inc lusion” li st. | |
65 | Create new file CMN FORM TYPES (399.6) t hat will b e pointed to from th e new CMN FORM TYPE field 399. 304,24 (IV below). T his new fi le will st ore an ent ry for eac h of the C MN Form Ty pes. At t his time t here are o nly two CM N Form Typ es referen ced in thi s SDD, nam ely, the C MS-484 For m for Oxyg en, and th e CMS-1012 6 form for Enteral a nd Parente ral Nutrit ion. Thou gh this fe ature coul d have bee n handled by definin g the new field in t he 399.304 sub-file as a “SET” , there is a potenti al for up to 12 diff erent Form Types so rather tha n possibly having to convert t he new fie ld to a po inter in t he future, it was de termined t hat a new file would be best t o store th e CMN Form Types. | |
66 | ||
67 | Create a n ew Procedu res sub-fi eld CMN FO RM TYPE (3 99.304,24) to store the CMN Fo rm Type. | |
68 | Create Pro cedures su b-fields ( a.k.a. CMN fields) 2 4.01 thru 24.08 hold ing respon ses for qu estions wh ich are th e same for both form s, fields 24.1 thru 24.115 for questions specific to the CMN -484, and fields 24. 201 thru 2 4.216 for questions specific t o the CMN- 10126. Ne w nodes in ^DGCR wil l be creat ed to hold the respo nses to th e prompts for each o f the new CMN forms: Node ‘CM N’ will ho ld respons es to ques tions that are the s ame for bo th forms, node ‘CMN- 484’ will hold respo nses speci fic to the CMN-484 f orm, and n ode ‘CMN-1 0126’ will hold resp onses spec ific to th e CMN-1012 6 form. | |
69 | Add entrie s to files 364.5 (IB DATA ELEM ENT DEFINI TION), 364 .6 (IB FOR M SKELETON DEFINITIO N) and 364 .7 (IB FOR M FIELD CO NTENT) in order to i nclude the new CMN f ields in t he 837 Tra nsmission. | |
70 | Add IB err or message s for miss ing requir ed CMN fie lds, field s missing a correspo nding date , or CMN d ata irregu larities ( routines I BCBB1, IBC BB13). Th is involve s adding 1 2 entries to file 35 0.8 (IB ER ROR) to st ore the CM N data err or message s. | |
71 | Entries ad ded to fil es 364.5, 364.6 and 364.7 done via the p re-install routine I BY608PR. | |
72 | CMN CPT Co de Inclusi on list in IB System Parameter s is popul ated via t he post-in stall rout ine IBY608 PO. | |
73 | DR prompti ng used to collect t he data fo r CMN fiel ds 23 thro ugh 24.216 specified above (ro utine IBCU 7 and IBCU 75) | |
74 | Develop Ex tract Code for to pu ll the val ues for th e new CMN fields and related d ata (routi ne IBCEF31 ). | |
75 | ||
76 | Add the CM N nodes to compariso n code whe n rolling up procedu res for th e 837 tran smission ( routine IB CF23A) | |
77 | Modify the cloning o f a claim to include the new C MN fields (routine I BCCC2). | |
78 | Modify the Interface Control D ocument (I CD) for th e 837-P mo dification s by addin g the CMN, FRM, LQ a nd MEA seg ments (sep arate docu ment). | |
79 | Rules to b e Applied during Des ign: | |
80 | If user st ates no CM N is Requi red, then none of th e subseque nt CMN rel ated promp ts will ap pear. The system wi ll automat ically con tinue with the “Sele ct CPT MOD IFIER SEQU ENCE:” pro mpt. | |
81 | If the cla im has a C MN then qu alifier UT for CMN i s required in 2440 L Q01 and th e “CMN For m type” (3 99.0304,24 ) is Requi red in 244 0 LQ02 Cod e Set. | |
82 | “Certifica tion Type” (399.0304 ,24.01) is Required. | |
83 | “Patient H eight (in) ” (399.030 4,24.02) i s Not Requ ired and n eeds modif ier TR whe n populate d. “Patie nt Weight (lbs)” (39 9.0304,24. 03) field is Not Req uired, but when popu lated it n eeds modif ier 01. | |
84 | The “Edema due to CH F Present? ” (399.030 4,24.104), “COR Pulm onale/Pulm onary Hype rtension P resent?” ( 399.0304,2 4.105) and “Hematocr it > 56%?” (399.0304 ,24.106) p rompts sho uld only a ppear if t he “ABG PO 2 (mmHg)” (399.0304, 24.1) is b etween 56 and 59 or the “O2 Sa turation ( %)” (399.0 304,24.102 ) value is equal to 89. | |
85 | When “Cert ification Type” (399 .0304,24.0 1) equals R or S, a date is re quired in “Recertifi cation/Rev ision Date ” (399.030 4,24.07) a nd needs Q ualifier 6 07 | |
86 | “Date Ther apy Starte d” (399.03 04,24.05) is require d and need s Qualifie r 463 | |
87 | “Last Cert ification Date” (399 .0304,24.0 6) is requ ired and n eeds Quali fier 461 | |
88 | The only o ption for Units of M easurement for the l ength of t ime for eq uipment is months so the defau lt for 240 0 CR302 is equal to MO for Mon ths. | |
89 | The Suppli er should be calcula ted to be the Billin g Provider . | |
90 | Oxygen flo w rate can be a numb er or X if less than 1. | |
91 | The “Lates t 4 LPM AB G PO2 (mmH g)” (399.0 304,24.111 ), “Date o f Latest 4 LPM ABG T est” (399. 0304,24.11 2), “Lates t 4 LPM O2 Saturatio n (%)” (39 9.0304,24. 113) and “ Date of La test 4 LPM O2 Satura tion Test” (399.0304 ,24.114) f ields shou ld only ha ve values when the “ Highest O2 Flow Rate ” (399.030 4,24.11) f ield is gr eater than 4 LPM. | |
92 | CRC Condit ion Indica tor/Durabl e Medical Equipment should be populated with Repla cement Ite m equal to ZV. For example: C RC*09*N*ZV | |
93 | Detailed D esign: | |
94 | I) Create new Proce dures sub- field 23 – “CMN REQU IRED?”: | |
95 | Create a n ew field 3 99.304,23 to store t he respons e to the “ CMN Requir ed?” promp t. This i s a REQUIR ED field. | |
96 | 399.0304,2 3 CMN RE QUIRED? CMN ;1 SET (Re quired) | |
97 | CMN Re quired? | |
98 | '0' FOR NO; | |
99 | '1' FOR YES; | |
100 | LAST E DITED: NOV 15, 2017 | |
101 | HELP-P ROMPT: Enter 'Y es' (1) if this proc edure requ ires a Cer tificate o f Medical Necessity, or 'No' ( 0) if it d oes not. | |
102 | DESCRI PTION: This fie ld indicat es whether a Certifi cate of Me dical Nece ssity must be submit ted with t his proced ure. | |
103 | [NOTE: If CMN is NO T REQUIRED , then non e of the s ubsequent CMN relate d prompts will appea r. The sy stem will automatica lly contin ue with th e “Select CPT MODIFI ER SEQUENC E:” prompt .] | |
104 | ||
105 | ||
106 | II) Creat e new “CMN Form Type s” file 39 9.6 contai ning 4 fie lds: | |
107 | STANDARD D ATA DICTIO NARY #399. 6 -- CMN F ORM TYPES FILE 5/23/1 8 PAGE 1 | |
108 | STORED IN ^IBE(399.6 , (2 ENTR IES) SIT E: TEST.CH EYENNE.MED .VA.GOV UCI: VISTA ,ROU (VERS ION 2.0) | |
109 | ||
110 | DATA NAME GLOB AL DATA | |
111 | ELEMENT TITLE LOCA TION TYPE | |
112 | ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
113 | The CMN FO RM TYPES f ile was cr eated to h old specif ications f or the var ious Certi ficate of Medical Ne cessity (C MN) form t ypes and i s | |
114 | used in En ter/Edit B illing whe n the user specifies CMN infor mation for an eligib le procedu re. | |
115 | ||
116 | DD ACC ESS: @ | |
117 | RD ACC ESS: @ | |
118 | WR ACC ESS: @ | |
119 | DEL ACC ESS: @ | |
120 | LAYGO ACC ESS: @ | |
121 | AUDIT ACC ESS: @ | |
122 | ||
123 | POINTED TO BY: CMN F ORM TYPE f ield (#24) of the PR OCEDURES s ub-field ( #399.0304) of the BI LL/CLAIMS File (#399 ) | |
124 | ||
125 | CROSS | |
126 | REFERENCED BY: NAME( B) | |
127 | ||
128 | CREATED ON : JUN 2,20 17 by P I
|
|
129 | ||
130 | 399.6,.01 NAME 0;1 FREE TEXT (Required ) | |
131 | INPUT TRANSFORM: K:$L(X)> 50!($L(X)< 3)!'(X'?1P .E) X | |
132 | MAXIMU M LENGTH: 50 | |
133 | LAST E DITED: MAY 22, 2018 | |
134 | HELP-P ROMPT: Enter th e external name of t he CMN for m. Enter between 3 and 50 fre e-text cha racters. | |
135 | DESCRI PTION: This is the extern al name of the Certi ficate of Medical Ne cessity (C MN) form. For examp le: 'OXYGE N (CMS-484 )' | |
136 | ||
137 | CROSS- REFERENCE: 399.6^B | |
138 | 1)= S ^I BE(399.6," B",$E(X,1, 30),DA)="" | |
139 | 2)= K ^I BE(399.6," B",$E(X,1, 30),DA) | |
140 | ||
141 | 399.6,1 DESCRI PTION 0;2 FREE TEXT | |
142 | INPUT TRANSFORM: K:$L(X)> 80!($L(X)< 1) X | |
143 | MAXIMU M LENGTH: 80 | |
144 | LAST E DITED: MAY 22, 2018 | |
145 | HELP-P ROMPT: Enter a brief desc ription (u p to 80 ch aracters) of the For m Type | |
146 | DESCRI PTION: Th is is a fr ee-text de scription of the CMN form type . | |
147 | ||
148 | 399.6,2 INDUST RY CODE 0;3 FREE TEXT (Required ) | |
149 | INPUT TRANSFORM: K:$L(X)> 15!($L(X)< 1) X | |
150 | MAXIMU M LENGTH: 15 | |
151 | LAST E DITED: MAY 22, 2018 | |
152 | HELP-P ROMPT: Enter th e Industry Code (up to 15 free -text char acters) as sociated w ith this C MN form ty pe. | |
153 | DESCRI PTION: This is the indust ry code as sociated w ith this f orm. It i s usually found in t he upper-r ight corne r of the p rinted for m and is t he number following 'DME'. Fo r the 'E & P NUTRITI ON (CMS-10 126)' form the indus try code i s 10.3 and for the ' OXYGEN (CM S-484)' it is 484.3. | |
154 | ||
155 | 399.6,3 DATA N ODE 0;4 FREE TEXT (Required ) | |
156 | INPUT TRANSFORM: K:$L(X)> 20!($L(X)< 7) X | |
157 | MAXIMU M LENGTH: 20 | |
158 | LAST E DITED: MAY 22, 2018 | |
159 | HELP-P ROMPT: Enter th e node in ^DGCR wher e data for this form is stored . Enter b etween 7 a nd 20 free -text char acters. | |
160 | DESCRI PTION: This is the node i n ^DGCR wh ere the CM N data for a particu lar form i s stored. For the " 484" form, the data node MUST be 'CMN-48 4' and for the "1012 6" form, t he data no de MUST be 'CMN-1012 6'. | |
161 | ||
162 | Create th e 2 necess ary D399.6 entries f or the CMS -484 and C MS-10126 f orms: | |
163 | CMS-484-O xygen | |
164 | NAME: OXYG EN (CMS-48 4) | |
165 | DESCRIPT ION: CERTI FICATE OF MEDICAL NE CESSITY FO RM 484.3 F OR OXYGEN | |
166 | INDUSTRY CODE: 484 .3 | |
167 | DATA NOD E: CMN-484 | |
168 | ||
169 | CMS-10126 -Enteral & Parentera l Nutritio n | |
170 | NAME: ENTE RAL & PARE NTERAL NUT RITION (CM S-10126) | |
171 | DESCRIPT ION: CERTI FICATE OF MEDICAL NE CESSITY FO RM 10126 F OR ENTERAL & PARENTE RAL NUTRIT ION | |
172 | INDUSTRY CODE: 10. 03 | |
173 | DATA NOD E: CMN-101 26 | |
174 | ||
175 | ||
176 | III) Crea te Procedu res sub-fi eld 24 – “ CMN FORM T YPE” | |
177 | Create a n ew field 3 99.304,24 to store t he CMN For m Type, wh ich is a p ointer to the new CM N FORM TYP ES file (3 99.6). Th is is a RE QUIRED fie ld. | |
178 | 399.0304,2 4 CMN FO RM TYPE CMN ;2 POINTER TO CMN FO RM TYPES F ILE (#399. 6) | |
179 | CMN Fo rm type | |
180 | LAST E DITED: MAR 08, 2018 | |
181 | HELP-P ROMPT: Select t he REQUIRE D CMN form type that will be s ent with t his proced ure. | |
182 | DESCRI PTION: This fie ld indicat es the Cer tificate o f Medical Necessity form type that is to be submit ted with t his proced ure. | |
183 | TECHNI CAL DESCR: If the C MN Require d? field i s set to " Y"es, this field mus t be an en try in the CMS FORM TYPES file #399.6. | |
184 | ||
185 | ||
186 | ||
187 | IV) Creat e Procedur e sub-fiel ds 24.01 t hru 24.08, 24.1 thru 24.115, a nd 24.201 thru 24.21 9 to promp t the user for the n ew CMN for m informat ion. | |
188 | Creation o f these Pr ocedure su b-fields i nvolves cr eating 3 n ew nodes i n ^DGCR(39 9), namely nodes ‘CM N’, CMN-48 4’ and ‘CM N-10126’, which will contain t he respons es for BOT H forms, t he CMN-484 form, and the CMN-1 0126 form, respectiv ely. | |
189 | Fields 24.01 thr u 24.09 ar e the same for both the CMN-48 4 and the CMN-10126: | |
190 | 399.0304,2 4.01 CMN CERTIFICA TION TYPE [REQUIRED] | |
191 | 399.0304,2 4.01 CMN C ERTIFICATI ON TYPE CM N;3 SET | |
192 | Certif ication Ty pe | |
193 | 'I' FOR INITIAL; | |
194 | 'R' FOR RENEWAL; | |
195 | 'S' FOR REVISED; | |
196 | LAST E DITED: MAR 08, 2018 | |
197 | HELP-P ROMPT: Select t he REQUIRE D Type of Certificat ion reques ted. | |
198 | DESCRI PTION: This fiel d indicate s the type of Certif ication th at is bein g requeste d. | |
199 | [NOTE: Wh en “CMN CE RTIFICATIO N TYPE” eq uals ‘R’ o r ‘S’, a d ate is req uired for the “CMN R ECERTIFICA TION/REVIS ION DATE” (399.0304, 24.07)] | |
200 | ||
201 | 399.0304,2 4.02 CMN PATIENT H EIGHT (IN) [Qualifi er TR] | |
202 | 399.0304,2 4.02 CMN P ATIENT HEI GHT (IN) C MN;4 NUMBE R | |
203 | Patien t Height ( in) | |
204 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
205 | LAST E DITED: APR 03, 2018 | |
206 | HELP-P ROMPT: Enter th e Patient' s height i n whole nu mbers repr esenting i nches. | |
207 | DESCRI PTION: This fie ld indicat es the Pat ient's hei ght in who le numbers represent ing inches . | |
208 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
209 | ||
210 | 399.0304,2 4.03 CMN PATIENT W EIGHT (LBS ) [Qualif ier 01] | |
211 | 399.0304,2 4.03 CMN P ATIENT WEI GHT (LBS) CMN;5 NUMB ER | |
212 | Patien t Weight ( lbs) | |
213 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
214 | LAST E DITED: MAR 02, 2018 | |
215 | HELP-P ROMPT: Enter th e Patient' s weight i n whole nu mbers repr esenting p ounds. | |
216 | DESCRI PTION: T his field indicates the Patien t's weight in whole numbers re presenting pounds. | |
217 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
218 | ||
219 | 399.0304,2 4.04 CMN MONTHS DM E EQUIP NE EDED | |
220 | 399.0304,2 4.04 CMN M ONTHS DME EQUIP NEED ED CMN;6 N UMBER | |
221 | Months DME Equip ment Neede d | |
222 | INPUT TRANSFORM: K:+X'=X! (X>99)!(X< 1)!(X?.E1" ."1N.N) X | |
223 | LAST E DITED: NOV 14, 2017 | |
224 | HELP-P ROMPT: Enter th e number o f MONTHS t he patient will need the DME E quipment. Enter 1-9 9 with 99 equal to a lifetime. | |
225 | DESCRI PTION: This fie ld indicat es the num ber of MON THS that t he Patient will need the DME E quipment. '99' repr esents a l ifetime. | |
226 | ||
227 | 399.0304,2 4.05 CMN DATE THER APY STARTE D [REQUIR ED; Qualif ier is 463 ] | |
228 | 399.0304,2 4.05 CMN D ATE THERAP Y STARTED CMN;7 DATE | |
229 | Date T herapy Sta rted | |
230 | INPUT TRANSFORM: S %DT="E X" D ^%DT S X=Y K:Y< 1 X | |
231 | LAST E DITED: MAR 08, 2018 | |
232 | HELP-P ROMPT: Enter th e REQUIRED date the therapy be gan. | |
233 | DESCRI PTION: This fiel d indicate s the date the thera py began. | |
234 | ||
235 | 399.0304,2 4.06 CMN LAST CERT IFICATION DATE [REQ UIRED; Qua lifier is 461] | |
236 | 399.0304,2 4.06 CMN L AST CERTIF ICATION DA TE CMN;8 D ATE | |
237 | Last C ertificati on Date | |
238 | INPUT TRANSFORM: S %DT="E X" D ^%DT S X=Y K:Y< 1 X | |
239 | LAST E DITED: MAR 08, 2018 | |
240 | HELP-P ROMPT: Enter th e REQUIRED date the physician signed the Certifica te of Medi cal Necess ity. | |
241 | DESCRI PTION: This fiel d indicate s the date the physi cian signe d the Cert ificate of Medical N ecessity. | |
242 | ||
243 | 399.0304,2 4.07 CMN RECERTIFI CATION/REV ISN DT [ REQUIRED w hen “CMN C ERTIFICATI ON TYPE” ( 399.0304,2 4.01) equa ls ‘R’ or ‘S’] | |
244 | 399.0304,2 4.07 CMN R ECERTIFICA TION/REVIS N DT CMN;9 DATE | |
245 | Recert ification/ Revision D ate | |
246 | INPUT TRANSFORM: S %DT="E X" D ^%DT S X=Y K:Y< 1 X | |
247 | LAST E DITED: NOV 14, 2017 | |
248 | HELP-P ROMPT: If the C ertificati on Type is a Renewal or Revise d, enter a REQUIRED Recertific ation/Revi sion date. | |
249 | DESCRI PTION: If the C ertificati on Type is a Renewal or Revise d, this fi eld is REQ UIRED and indicates the date o f the Rece rtificatio n/Renewal. | |
250 | ||
251 | 399.0304,2 4.08 CMN REPLACEME NT ITEM? | |
252 | 399.0304,2 4.08 CMN R EPLACEMENT ITEM? CM N;10 SET | |
253 | Replac ement Item ? | |
254 | '0' FOR NO; | |
255 | '1' FOR YES; | |
256 | LAST E DITED: NOV 14, 2017 | |
257 | HELP-P ROMPT: Enter 'Y es' (1) if this item is being billed as a replacem ent item, or 'No' (0 ) if it is not. | |
258 | DESCRI PTION: This fiel d indicate s whether or not the item bein g billed i s a Replac ement item . | |
259 | ||
260 | Fields 24. 1 thru 24. 115 are sp ecific to the CMN-48 4: | |
261 | 399.0304,2 4.1 CMN ABG PO2 (M MHG) | |
262 | 399.0304,2 4.1 CMN AB G PO2 (MMH G) CMN -484;16 NU MBER | |
263 | ABG PO 2 (mmHg) | |
264 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
265 | LAST E DITED: MAR 02, 2018 | |
266 | HELP-P ROMPT: Enter th e result o f the most recent AB G test. E nter a who le Number which will be report ed as mmHg . | |
267 | DESCRI PTION: This fie ld indicat es the res ult of the most rece nt ABG tes t. The Nu mber enter ed will be reported as mmHg. | |
268 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
269 | ||
270 | 399.0304,2 4.102 CM N O2 SATUR ATION % | |
271 | 399.0304,2 4.102 CMN O2 SATURAT ION % CM N-484;2 NU MBER | |
272 | O2 Sat uration (% ) | |
273 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
274 | LAST E DITED: MAR 02, 2018 | |
275 | HELP-P ROMPT: Enter th e result o f the most recent Ox ygen satur ation test . Enter a whole num ber which will be re ported as %. | |
276 | DESCRI PTION: This fie ld indicat es the res ult of the most rece nt Oxygen saturation test. Th e number e ntered wil l be repor ted as %. | |
277 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
278 | ||
279 | 399.0304,2 4.103 CMN DT LAST A BG PO2 AND O2 SAT | |
280 | 399.0304,2 4.103 CMN DT LAST AB G PO2 AND O2 SAT CMN -484;3 DAT E | |
281 | ||
282 | Date o f Last ABG PO2 and/o r O2 Satur ation Test (s) | |
283 | INPUT TRANSFORM: S %DT="E X" D ^%DT S X=Y K:Y< 1 X | |
284 | LAST E DITED: MAR 14, 2018 | |
285 | HELP-P ROMPT: Enter th e REQUIRED date for the most r ecent ABG PO2 and/or O2 Satura tion Test( s). | |
286 | DESCRI PTION: This fi eld indica tes the Da te for the most rece nt ABG PO2 and/or O2 Saturatio n test(s). | |
287 | ||
288 | 399.0304,2 4.104 CM N EDEMA DU E TO CHF P RESENT? | |
289 | 399.0304,2 4.104 CMN EDEMA DUE TO CHF PRE SENT? CMN- 484;4 SET | |
290 | Edema due to CHF Present? | |
291 | '0' FOR NO; | |
292 | '1' FOR YES; | |
293 | LAST E DITED: NOV 14, 2017 | |
294 | HELP-P ROMPT: Enter 'Y es' (1) if Edema bei ng due to CHF being Present, o r 'No' (0) if it is not. | |
295 | DESCRI PTION: This fie ld indicat es whether or not th e patient has depend ent Edema due to Con gestive He art Failur e. | |
296 | [NOTE: T he “CMN ED EMA DUE TO CHF PRESE NT?” promp t should o nly appear if the “C MN ABG PO2 ” (399.030 4,24.1) va lue is bet ween 56 an d 59 or th e “CMN O2 SATURATION %” (399.0 304,24.102 ) value is equal to 89.] | |
297 | ||
298 | 399.0304,2 4.105 CM N COR PULM ONARY HYPE RTENSION? | |
299 | 399.0304,2 4.105 CMN COR PULMON ARY HYPERT ENSN? CMN- 484;5 SET | |
300 | COR Pu lmonale/Pu lmonary Hy pertension Present? | |
301 | '0' FOR NO; | |
302 | '1' FOR YES; | |
303 | LAST E DITED: NOV 14, 2017 | |
304 | HELP-P ROMPT: Enter 'Y es' (1) if COR Pulmo nale or Pu lmonary Hy pertension is Presen t, or 'No' (0) if it is not. | |
305 | DESCRI PTION: This fie ld indicat es whether or not th e patient has cor pu lmonate or pulmonary hypertens ion docume nted by P pulmonale on an EKG or echocar diogram, g ated blood pool scan or direct pulmonary artery pr essure mea surement. | |
306 | [NOTE: Th e “COR Pul monary/Pul monary Hyp ertension Present?” prompt sho uld only a ppear if t he “CMN AB G PO2 (MMH G)” (399.0 304,24.1) value is b etween 56 and 59 or the “CMN O 2 SATURATI ON %” (399 .0304,24.1 02) value is equal t o 89.] | |
307 | ||
308 | 399.0304,2 4.106 CM N HEMATOCR IT > 56%? | |
309 | 399.0304,2 4.106 CMN HEMATOCRIT > 56%? CM N-484;6 SE T | |
310 | Hemato crit > 56% ? | |
311 | '0' FOR NO; | |
312 | '1' FOR YES; | |
313 | LAST E DITED: NOV 14, 2017 | |
314 | HELP-P ROMPT: Enter 'Y es' (1) if the patie nt has a H ematocrit level grea ter that 5 6% or 'No' (0) if no t. | |
315 | DESCRI PTION: This fiel d indicate s whether or not the patient h as a Hemat ocrit leve l greater than 56%. | |
316 | [NOTE: Th e “Hematoc rit > 56%? ” prompt s hould only appear if the “CMN ABG PO2 (M MHG)” (399 .0304,24.1 ) value is between 5 6 and 59 o r the “CMN O2 SATURA TION %” ( 399.0304,2 4.102) val ue is equa l to 89.] | |
317 | ||
318 | 399.0304,2 4.107 CM N PT CONDI TION AT TE ST TIME | |
319 | 399.0304,2 4.107 CMN PT CONDITI ON AT TEST TIME CMN- 484;7 SET | |
320 | Patien t Conditio n At Test Time | |
321 | '1' FOR CHRONIC AN D STABLE A S OUTPT; | |
322 | '2' FOR W/I TWO DA YS PRIOR T O D/C FROM INPT FACI LITY; | |
323 | '3' FOR UNDER OTHE R CIRCUMST ANCES; | |
324 | LAST E DITED: NOV 14, 2017 | |
325 | HELP-P ROMPT: Enter th e patient' s conditio n at the t ime of the ABG and/o r O2 Satur ation test (s). | |
326 | DESCRI PTION: This fiel d indicate s the pati ent's cond ition at t he time of the ABG a nd/or O2 S aturation test(s). | |
327 | ||
328 | 399.0304,2 4.108 CM N TEST CON DITIONS | |
329 | 399.0304,2 4.108 CMN TEST CONDI TIONS CM N-484;8 SE T | |
330 | Test C onditions | |
331 | '1' FOR AT REST; | |
332 | '2' FOR DURING EXE RCISE; | |
333 | '3' FOR DURING SLE EP; | |
334 | LAST E DITED: NOV 14, 2017 | |
335 | HELP-P ROMPT: Enter th e conditio ns for the ABG and/o r O2 Satur ation test (s). | |
336 | DESCRI PTION: This field indicates the condi tion for t he ABG and /or O2 Sat uration te st(s). | |
337 | ||
338 | 399.0304,2 4.109 CM N PORTABLE O2 INDICA TOR | |
339 | 399.0304,2 4.109 CMN PORTABLE O2 INDICAT OR CMN-484 ;9 SET | |
340 | Portab le O2 Indi cator | |
341 | 'Y' FOR PATIENT MO BILE WITHI N HOME; | |
342 | 'N' FOR PATIENT NO T MOBILE W ITHIN HOME ; | |
343 | 'D' FOR NOT ORDERI NG PORTABL E OXYGEN; | |
344 | LAST E DITED: NOV 14, 2017 | |
345 | HELP-P ROMPT: Enter th e patient' s mobility if orderi ng portabl e oxygen o r indicate if not or dering por table oxyg en. | |
346 | DESCRI PTION: This field indi cates the patient's mobility c oncerning the orderi ng of port able oxyge n. | |
347 | ||
348 | 399.0304,2 4.11 CMN HIGHEST O 2 FLOW RAT E | |
349 | 399.0304,2 4.11 CMN H IGHEST O2 FLOW RATE CMN-484;10 FREE TEXT | |
350 | Highes t O2 Flow Rate | |
351 | INPUT TRANSFORM: K:$L(X)> 50!($L(X)< 1) X | |
352 | MAXIMU M LENGTH: 50 | |
353 | LAST E DITED: MAR 02, 2018 | |
354 | HELP-P ROMPT: Enter th e highest oxygen flo w rate ord ered for t his patien t in liter s per minu te (LPM). Enter a n umber. If oxygen ra te is less than 1 LP M, enter ' X'. | |
355 | DESCRI PTION: This fie ld indicat es the hig hest oxyge n flow rat e ordered for this P atient in liters per minute (L PM). The value is e ither a nu mber, or i f the valu e is less than 1 LPM , it shoul d be enter ed as an " X". | |
356 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER. | |
357 | ||
358 | 399.0304,2 4.111 CM N LAST 4 L PM ABG PO2 (MMHG) | |
359 | 399.0304,2 4.111 CMN LAST 4 LPM ABG PO2 ( MMHG) CMN- 484;11 NUM BER | |
360 | Latest 4 LPM ABG PO2 (mmHg ) | |
361 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
362 | LAST E DITED: MAR 02, 2018 | |
363 | HELP-P ROMPT: Enter th e result o f the most recent AB G test tak en on 4 LP M. Enter a whole nu mber which will be r eported as mmHg. | |
364 | DESCRI PTION: This fie ld indicat es the res ult of the most rece nt ABG tes t taken on 4 LPM. T he number entered wi ll be repo rted as mm Hg. | |
365 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
366 | ||
367 | 399.0304,2 4.113 CM N LAST 4 L PM O2 SATU RATION % | |
368 | 399.0304,2 4.113 CMN LAST 4 LPM O2 SATURA TION % CMN -484;13 NU MBER | |
369 | Latest 4 LPM O2 Saturation (%) | |
370 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
371 | LAST E DITED: MAR 02, 2018 | |
372 | HELP-P ROMPT: Enter th e result o f the most recent Ox ygen satur ation test . Enter a whole num ber which will be re ported as %. | |
373 | DESCRI PTION: This fie ld indicat es the res ult of the most rece nt Oxygen saturation test. Th e number e ntered wil l be repor ted as %. | |
374 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
375 | ||
376 | 399.0304,2 4.114 CM N DATE OF LAST 4 LPM TESTS | |
377 | 399.0304,2 4.114 CMN DATE OF LA ST 4 LPM T ESTS CMN-4 84;14 DATE | |
378 | Date o f the Late st 4 LPM T est(s) | |
379 | INPUT TRANSFORM: S %DT="E X" D ^%DT S X=Y K:Y< 1 X | |
380 | LAST E DITED: MAR 14, 2018 | |
381 | HELP-P ROMPT: Enter th e REQUIRED date for the most r ecent 4 LP M Test(s). | |
382 | DESCRI PTION: This fie ld indicat es the Dat e for the most recen t ABG PO2 and/or O2 Saturation test(s) t aken on 4 LPM. | |
383 | ||
384 | 399.0304,2 4.115 CM N EQUIPMEN T/COST DES CRIPTION | |
385 | 399.0304, 24.115 CM N EQUIPMEN T/COST DES CRIPTION C MN-484;15 FREE TEXT | |
386 | Equipm ent/Cost D escription | |
387 | INPUT TRANSFORM: K:$L(X)> 50!($L(X)< 1) X | |
388 | MAXIMU M LENGTH: 50 | |
389 | LAST E DITED: NOV 14, 2017 | |
390 | HELP-P ROMPT: Enter a 1-50 chara cter free text descr iption of items, acc essories, and option s ordered, suppliers charge an d Medicare Fee Sched ule allowa nce for ea ch item, a ccessory a nd option. | |
391 | DESCRI PTION: This fie ld indicat es the des cription o f the item s, accesso ries, and options or dered, sup pliers cha rge and Me dicare Fee Schedule Allowance for each i tem, acces sory and o ption. | |
392 | ||
393 | ||
394 | Fields 24. 201 thru 2 4.219 are specific t o the CMN- 10126 | |
395 | ||
396 | 399.0304,2 4.201 CM N SM BOWEL ABSORPTIO N DOC? | |
397 | 399.0304,2 4.201 CMN SM BOWEL ABSORPTION DOC? CMN- 10126;1 SE T | |
398 | Small Bowel Abso rption Doc umentation Present? | |
399 | '0' FOR NO; | |
400 | '1' FOR YES; | |
401 | LAST E DITED: NOV 14, 2017 | |
402 | HELP-P ROMPT: Enter 'Y es' (1) if there is documentat ion on fil e for Smal l Bowel Ab sorption, or 'No' (0 ) if there is not. | |
403 | DESCRI PTION: This fie ld indicat es whether or not th ere is doc umentation in the me dical reco rd that su pports the patient's permanent non-funct ion or dis ease of th e structur es that pe rmit food to reach o r be absor bed from t he small b owel. | |
404 | ||
405 | 399.0304,2 4.202 CM N ENTERAL NUTRITION BY TUBE? | |
406 | 399.0304,2 4.202 CMN ENTERAL NU TRITION BY TUBE? CMN -10126;2 S ET | |
407 | Entera l Nutritio n by Tube? | |
408 | '0' FOR NO; | |
409 | '1' FOR YES; | |
410 | LAST E DITED: NOV 21, 2017 | |
411 | HELP-P ROMPT: E nter 'Yes' (1) if th e Enteral Nutrition is being a dministere d by a tub e, or 'No' (0) if it is not. | |
412 | DESCRI PTION: T his field indicates whether or not the E nteral Nut rition is being admi nistered v ia a tube (Example: gastrostom y tube). | |
413 | ||
414 | 399.0304,2 4.203 CM N PROCEDUR E A CALORI ES | |
415 | 399.0304,2 4.203 CMN PROCEDURE A CALORIES CMN-10126 ;3 NUMBER | |
416 | Proced ure A Calo ries | |
417 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
418 | LAST E DITED: APR 20, 2018 | |
419 | HELP-P ROMPT: Enter th e calories per day a ssociated with Proce dure A. | |
420 | DESCRI PTION: | |
421 | This fie ld indicat es the cal ories per day associ ated with Procedure A. | |
422 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
423 | ||
424 | 399.0304,2 4.204 CM N PROCEDUR E A | |
425 | 399.0304,2 4.204 CMN PROCEDURE A CM N-10126;4 POINTER TO CPT FILE (#81) | |
426 | Proced ure A | |
427 | LAST E DITED: APR 20, 2018 | |
428 | HELP-P ROMPT: Enter fi rst proced ure with a ssociated calories. | |
429 | DESCRI PTION: This is the proce dure code to which t he "Proced ure A Calo ries" fiel d correspo nds. | |
430 | ||
431 | 399.0304,2 4.205 CM N METHOD O F ADMINIST RATION | |
432 | 399.0304,2 4.205 CMN METHOD OF ADMINISTRA TION CMN-1 0126;5 SET | |
433 | Method of Admini stration | |
434 | '1' FOR SYRINGE; | |
435 | '2' FOR GRAVITY; | |
436 | '3' FOR PUMP; | |
437 | '4' FOR ORAL; | |
438 | LAST E DITED: NOV 15, 2017 | |
439 | HELP-P ROMPT: S elect the appropriat e method b y which th e service was admini stered. | |
440 | DESCRI PTION: This fiel d indicate s the meth od by whic h the serv ice was ad ministered . | |
441 | ||
442 | 399.030424 ,24.206 CMN DAYS P ER WEEK AD MINISTERED | |
443 | 399.0304,2 4.206 CMN DAYS PER WEEK ADMIN ISTERED CM N-10126;6 NUMBER | |
444 | Days/W eek Admini stered | |
445 | INPUT TRANSFORM: K:+X'=X! (X>7)!(X<1 )!(X?.E1". "1N.N) X | |
446 | LAST E DITED: NOV 14, 2017 | |
447 | HELP-P ROMPT: Enter th e number o f days per week that the nutri tion is ad ministered or infuse d. | |
448 | DESCRI PTION: This f ield indic ates the n umber of d ays per we ek that th e nutritio n is admin istered or infused. | |
449 | ||
450 | 399.030424 ,24.207 CMN SEVERE MALABSORP TION DOC? | |
451 | 399.0304,2 4.207 CMN SEVERE MA LABSORPTIO N DOC? CMN -10126;7 S ET | |
452 | Severe Malabsorp tion Docum entation P resent? | |
453 | '0' FOR NO; | |
454 | '1' FOR YES; | |
455 | LAST E DITED: NOV 14, 2017 | |
456 | HELP-P ROMPT: Enter 'Y es' (1) if there is documentat ion on fil e for Seve re Malabso rption, or 'No' (0) if there i s not. | |
457 | DESCRI PTION: This fie ld indicat es whether or not th ere is doc umentation in the me dical reco rd that su pports the patient h aving perm anent dise ase of the gastroint estinal tr act causin g malabsor ption seve re enough to prevent maintenan ce of weig ht and str ength. | |
458 | ||
459 | 399.030424 ,24.208 CMN AMINO ACID (ML/D AY) | |
460 | 399.0304,2 4.208 CMN AMINO ACID (ML/DAY) CMN-10126; 8 NUMBER | |
461 | Amino Acid (ml/d ay) | |
462 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
463 | LAST E DITED: MAR 02, 2018 | |
464 | HELP-P ROMPT: Enter th e number o f millilit ers of the component Amino Aci d that are administe red per da y in this nutritiona l formula. | |
465 | DESCRI PTION: This fie ld indicat es the num ber of mil liliters o f the comp onent Amin o Acid tha t are admi nistered p er day in this nutri tional for mula. | |
466 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
467 | ||
468 | 399.030424 ,24.209 CMN AMINO ACID CONCE NTRATION % | |
469 | 399.0304,2 4.209 CMN AMINO ACID CONCENTRA TION % CMN -10126;9 N UMBER | |
470 | Amino Acid Conce ntration ( %) | |
471 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
472 | LAST E DITED: MAR 02, 2018 | |
473 | HELP-P ROMPT: Enter the percent c oncentrati on of Amin o Acids in this nutr itional fo rmula. | |
474 | DESCRI PTION: This fi eld indica tes the pe rcent conc entration of Amino A cids in th is nutriti onal formu la. | |
475 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
476 | ||
477 | 399.030424 ,24.21 C MN AMINO A CID PROTEI N (GM/DY) | |
478 | 399.0304,2 4.21 CMN A MINO ACID PROTEIN (G M/DY) CMN- 10126;10 N UMBER | |
479 | Amino Acid Prote in (gm/day ) | |
480 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
481 | LAST E DITED: MAR 02, 2018 | |
482 | HELP-P ROMPT: Enter th e amount o f protein administer ed in gram s/day in t his nutrit ional form ula. | |
483 | DESCRI PTION: This f ield indic ates the a mount of p rotein adm inistered in grams/d ay in this nutrition al formula . | |
484 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
485 | ||
486 | 399.030424 ,24.211 CMN DEXTRO SE (ML/DAY ) | |
487 | 399.0304,2 4.211 CMN DEXTROSE ( ML/DAY) CM N-10126;11 NUMBER | |
488 | Dextro se (ml/day ) | |
489 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
490 | LAST E DITED: MAR 02, 2018 | |
491 | HELP-P ROMPT: Enter th e number o f millilit ers of the component Dextrose that are a dministere d per day in this nu tritional formula. | |
492 | DESCRI PTION: This fie ld indicat es the num ber of mil liliters o f the comp onent Dext rose that are admini stered per day in th is nutriti onal formu la. | |
493 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
494 | ||
495 | 399.030424 ,24.212 CMN DEXTRO SE CONCENT RATE % | |
496 | 399.0304,2 4.212 CMN DEXTROSE C ONCENTRATE % CMN-101 26;12 NUMB ER | |
497 | Dextro se Concent rate (%) | |
498 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
499 | LAST E DITED: MAR 02, 2018 | |
500 | HELP-P ROMPT: E nter the p ercent con centration of Dextro se in this nutrition al formula . | |
501 | DESCRI PTION: This fiel d indicate s the perc ent concen tration of Dextrose in this nu tritional formula. | |
502 | ||
503 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
504 | ||
505 | 399.030424 ,24.213 CMN LIPIDS (ML/DAY) | |
506 | 399.0304,2 4.213 CMN LIPIDS (ML /DAY) CM N-10126;13 NUMBER | |
507 | Lipids (ml/day) | |
508 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
509 | LAST E DITED: MAR 02, 2018 | |
510 | HELP-P ROMPT: Enter th e number o f millilit ers of the component Lipids th at are adm inistered per day in this nutr itional fo rmula. | |
511 | DESCRI PTION: This fie ld indicat es the num ber of mil liliters o f the comp onent Lipi ds that ar e administ ered per d ay in this nutrition al formula . | |
512 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
513 | ||
514 | 399.030424 ,24.214 ROUTE OF A DMINISTRAT ION | |
515 | 399.0304,2 4.214 CMN ROUTE OF A DMINISTRAT ION CMN-10 126;14 SET | |
516 | Route of Adminis tration | |
517 | '1' FOR CENTRAL LI NE (INCLUD ES PICC); | |
518 | '2' FOR HEMODIALYS IS ACCESS LINE; | |
519 | '3' FOR PERITONEAL CATHETER; | |
520 | LAST E DITED: NOV 14, 2017 | |
521 | HELP-P ROMPT: Enter th e number t hat repres ents the a ppropriate route by which the nutrition was admini stered. | |
522 | DESCRI PTION: This fiel d indicate s the rout e by which the nutri tion was a dministere d. | |
523 | ||
524 | 399.0304 24,24.215 CMN LIPI DS (DAYS/W EEK) | |
525 | 399.0304,2 4.215 CMN LIPIDS (D AYS/WEEK) CMN-10126; 15 NUMBER | |
526 | Lipids (days/wk) | |
527 | INPUT TRANSFORM: K:+X'=X! (X>7)!(X<1 )!(X?.E1". "1N.N) X | |
528 | LAST E DITED: NOV 14, 2017 | |
529 | HELP-P ROMPT: Enter th e number o f days per week the component lipids are administe red in thi s nutritio nal formul a. | |
530 | DESCRI PTION: This fie ld indicat es the num ber of day s per week the compo nent Lipid s are admi nistered i n this nut ritional f ormula. | |
531 | ||
532 | 399.0304 24,24.216 CMN LIPI DS CONCENT RATE % | |
533 | 399.0304,2 4.216 CMN LIPIDS CON CENTRATE % CMN-10126 ;16 NUMBER | |
534 | Lipids Concentra te (%) | |
535 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
536 | LAST E DITED: MAR 02, 2018 | |
537 | HELP-P ROMPT: Enter the percent c oncentrati on of Lipi ds in this nutrition al formula . | |
538 | DESCRI PTION: This fi eld indica tes the pe rcent conc entration of Lipids in this nu tritional formula. | |
539 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
540 | ||
541 | 399.030 424,24.217 CMN PAR ENTERAL/EN TERAL/BOTH | |
542 | 399.0304,2 4.217 CMN PARENTERAL /ENTERAL/B OTH CMN-10 126;17 SET | |
543 | Is thi s for Pare nteral nut rition, En teral nutr ition, or Both? | |
544 | 'P' FOR PARENTERAL ; | |
545 | 'E' FOR ENTERAL; | |
546 | 'B' FOR BOTH; | |
547 | LAST E DITED: APR 23, 2018 | |
548 | HELP-P ROMPT: Is this CMN for Pa renteral n utrition, enteral nu trition, o r both? | |
549 | DESCRI PTION: This fie ld designa tes whethe r this CMN form is f or Parente ral nutrit ion, enter al nutriti on, or bot h. | |
550 | ||
551 | 399.030 424,24.218 CMN PRO CEDURE B C ALORIES | |
552 | 399.0304, 24.218 CMN PROCEDURE B CALORIE S CMN-1012 6;18 NUMBE R | |
553 | Proced ure B Calo ries | |
554 | INPUT TRANSFORM: K:+X'=X! (X<1)!(X?. E1"."1N.N) X | |
555 | LAST E DITED: APR 23, 2018 | |
556 | HELP-P ROMPT: Enter th e calories per day a ssociated with Proce dure B. | |
557 | DESCRI PTION: This fie ld indicat es the cal ories per day associ ated with Procedure B. | |
558 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
559 | ||
560 | 399.030 424,24.219 CMN PRO CEDURE B | |
561 | 399.0304,2 4.219 CMN PROCEDURE B CM N-10126;19 POINTER T O CPT FILE (#81) | |
562 | Proced ure B | |
563 | LAST E DITED: APR 20, 2018 | |
564 | HELP-P ROMPT: Enter se cond proce dure with associated calories. | |
565 | DESCRI PTION: This is the proced ure code t o which th e "Procedu re B Calor ies" field correspon ds. | |
566 | ||
567 | ||
568 | ||
569 | V) Create new Entri es in File s 364.5, 3 64.6 and 3 64.7 for t he 837 Tra nsmission of CMN Dat a via new segments C MN, FRM, L Q and MEA and 2 new pieces add ed to the existing P T1 segment . | |
570 | File 364.5 Entries: | |
571 | N-CMN RECO RD ID ‘CMN ‘ | |
572 | NAME: N-CM N RECORD I D 'CMN ' | |
573 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
574 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
575 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
576 | ||
577 | N-CMN RECO RD ID ‘FRM ‘ | |
578 | NAME: N-CM N RECORD I D 'FRM ' | |
579 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
580 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
581 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
582 | ||
583 | N-CMN RECO RD ID ‘LQ ‘ | |
584 | NAME: N-CM N RECORD I D 'LQ ' | |
585 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
586 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
587 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
588 | ||
589 | N-CMN RECO RD ID ‘MEA ‘ | |
590 | NAME: N-CM N RECORD I D 'MEA ' | |
591 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
592 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
593 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
594 | ||
595 | File 364.6 Entries | |
596 | CMN Se gment | |
597 | CMN REC ORD ID 'CM N ' | |
598 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
599 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
600 | STARTING COLUMN OR PIECE: 1 LENGTH: 4 | |
601 | SHORT DE SCRIPTION: CMN RECOR D ID 'CMN ' | |
602 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
603 | CMN DATA EXTRACT | |
604 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
605 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
606 | STARTING COLUMN OR PIECE: 1. 5 LENGTH: 1 | |
607 | SHORT DE SCRIPTION: CMN DATA EXTRACT | |
608 | CALCULAT E ONLY OR OUTPUT: CA LCULATE ON LY | |
609 | TRANSMIT IGNORES I F NULL: TR UE | |
610 | ||
611 | SERVICE LINE # | |
612 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
613 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
614 | STARTING COLUMN OR PIECE: 2 LENGTH: 6 | |
615 | SHORT DE SCRIPTION: SERVICE L INE # | |
616 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
617 | ||
618 | CMN CERT IFICATION TYPE | |
619 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
620 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
621 | STARTING COLUMN OR PIECE: 3 LENGTH: 1 | |
622 | SHORT DE SCRIPTION: CMN CERTI FICATION T YPE | |
623 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
624 | DATA REQ UIRED FOR FIELD: NO | |
625 | ||
626 | CMN UNIT OR BASIS FOR MEASUR EMENT CODE | |
627 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
628 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
629 | STARTING COLUMN OR PIECE: 4 LENGTH: 2 | |
630 | SHORT DE SCRIPTION: CMN UNIT OR BASIS F OR MEASURE MENT CODE | |
631 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
632 | ||
633 | CMN MONT HS DME EQU IPMENT NEE DED | |
634 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
635 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
636 | STARTING COLUMN OR PIECE: 5 LENGTH: 2 | |
637 | SHORT DE SCRIPTION: CMN MONTH S DME EQUI PMENT NEED ED | |
638 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
639 | ||
640 | CMN CODE CATEGORY | |
641 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
642 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
643 | STARTING COLUMN OR PIECE: 6 LENGTH: 2 | |
644 | SHORT DE SCRIPTION: CMN CODE CATEGORY | |
645 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
646 | ||
647 | CMN CERT IFICATION CONDITION INDICATOR | |
648 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
649 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
650 | STARTING COLUMN OR PIECE: 7 LENGTH: 1 | |
651 | SHORT DE SCRIPTION: CMN CERTI FICATION C ONDITION I NDICATOR | |
652 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
653 | ||
654 | CMN COND ITION INDI CATOR | |
655 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
656 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
657 | STARTING COLUMN OR PIECE: 8 LENGTH: 3 | |
658 | SHORT DE SCRIPTION: CMN CONDI TION INDIC ATOR | |
659 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
660 | ||
661 | CMN REPL ACEMENT IT EM? | |
662 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
663 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
664 | STARTING COLUMN OR PIECE: 9 LENGTH: 3 | |
665 | SHORT DE SCRIPTION: CMN REPLA CEMENT ITE M? | |
666 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
667 | ||
668 | CMN DATE THERAPY S TARTED QUA LIFIER | |
669 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
670 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
671 | STARTING COLUMN OR PIECE: 10 LENGTH: 3 | |
672 | SHORT DE SCRIPTION: CMN DATE THERAPY ST ARTED QUAL IFIER | |
673 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
674 | ||
675 | CMN DATE THERAPY S TARTED | |
676 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
677 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
678 | STARTING COLUMN OR PIECE: 11 LENGTH: 8 | |
679 | SHORT DE SCRIPTION: CMN DATE THERAPY ST ARTED | |
680 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
681 | ||
682 | CMN LAST CERTIFICA TION DATE QUALIFIER | |
683 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
684 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
685 | STARTING COLUMN OR PIECE: 12 LENGTH: 3 | |
686 | SHORT DE SCRIPTION: CMN LAST CERTIFICAT ION DATE Q UALIFIER | |
687 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
688 | ||
689 | CMN LAST CERTIFICA TION DATE | |
690 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
691 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
692 | STARTING COLUMN OR PIECE: 13 LENGTH: 8 | |
693 | SHORT DE SCRIPTION: CMN LAST CERTIFICAT ION DATE | |
694 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
695 | ||
696 | CMN CERT IFICATION TYPE QUAL | |
697 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
698 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
699 | STARTING COLUMN OR PIECE: 14 LENGTH: 3 | |
700 | SHORT DE SCRIPTION: CMN CERTI FICATION T YPE QUAL | |
701 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
702 | ||
703 | CMN RECE RTIFICATIO N/REVISION DATE | |
704 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
705 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
706 | STARTING COLUMN OR PIECE: 15 LENGTH: 8 | |
707 | SHORT DE SCRIPTION: CMN RECER TIFICATION /REVISION DATE | |
708 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
709 | ||
710 | CMN ATTA CHMENT REP ORT TYPE C ODE | |
711 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
712 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
713 | STARTING COLUMN OR PIECE: 16 LENGTH: 2 | |
714 | SHORT DE SCRIPTION: CMN ATTAC HMENT REPO RT TYPE CO DE | |
715 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
716 | ||
717 | CMN ATTA CHMENT TRA NSMISSION CODE | |
718 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
719 | PAGE OR SEQUENCE: 191.4 FIRST LINE NUMBER: 1 | |
720 | STARTING COLUMN OR PIECE: 17 LENGTH: 2 | |
721 | SHORT DE SCRIPTION: CMN ATTAC HMENT TRAN SMISSION C ODE | |
722 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
723 | ||
724 | ||
725 | FRM Segmen t | |
726 | ||
727 | CMN RECO RD ID 'FRM ' | |
728 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
729 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
730 | STARTING COLUMN OR PIECE: 1 LENGTH: 4 | |
731 | SHORT DE SCRIPTION: CMN RECOR D ID 'FRM ' | |
732 | CALCULAT E ONLY OR OUTPUT: OU TPUT TRANSMIT I GNORES IF NULL: FALS E | |
733 | DATA REQ UIRED FOR FIELD: YES | |
734 | ||
735 | FRM DATA EXTRACT | |
736 | BILL FORM: IB 837 TR ANSMISSION PAGE OR SE QUENCE: 21 0 | |
737 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
738 | STARTING COLUMN OR PIECE: 1. 5 LENGTH: 1 | |
739 | SHORT DE SCRIPTION: FRM DATA EXTRACT | |
740 | CALCULAT E ONLY OR OUTPUT: CA LCULATE ON LY | |
741 | TRANSMIT IGNORES I F NULL: TR UE | |
742 | ||
743 | SERVICE LINE # | |
744 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
745 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
746 | STARTING COLUMN OR PIECE: 2 LENGTH: 6 | |
747 | SHORT DE SCRIPTION: SERVICE L INE # | |
748 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
749 | ||
750 | CMN QUES TION NUMBE R/LETTER | |
751 | BILL FORM: IB 837 TR ANSMISSION PAGE OR SE QUENCE: 21 0 | |
752 | FIRST LI NE NUMBER: 1 STARTING C OLUMN OR P IECE: 3 | |
753 | LENGTH: 20 | |
754 | SHORT DE SCRIPTION: CMN QUEST ION NUMBER /LETTER | |
755 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
756 | TRANSMIT IGNORES I F NULL: FA LSE | |
757 | ||
758 | CMN QUES TION RESPO NSE Y/N | |
759 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
760 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
761 | STARTING COLUMN OR PIECE: 4 LENGTH: 1 | |
762 | SHORT DE SCRIPTION: CMN QUEST ION RESPON SE Y/N | |
763 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
764 | ||
765 | CMN QUES TION RESPO NSE REF ID | |
766 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
767 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
768 | STARTING COLUMN OR PIECE: 5 LENGTH: 50 | |
769 | SHORT DE SCRIPTION: CMN QUEST ION RESPON SE REF ID | |
770 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
771 | ||
772 | CMN QUES TION RESPO NSE DATE | |
773 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
774 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
775 | STARTING COLUMN OR PIECE: 6 LENGTH: 8 | |
776 | SHORT DE SCRIPTION: CMN QUEST ION RESPON SE DATE | |
777 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
778 | ||
779 | CMN QUES TION RESPO NSE % & DE CIMAL | |
780 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
781 | PAGE OR SEQUENCE: 210 FIRST LINE NUMBER: 1 | |
782 | STARTING COLUMN OR PIECE: 7 LENGTH: 6 | |
783 | SHORT DE SCRIPTION: CMN QUEST ION RESPON SE % & DEC IMAL | |
784 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
785 | ||
786 | ||
787 | L Q Segment | |
788 | ||
789 | CMN RECO RD ID 'LQ ' | |
790 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
791 | PAGE OR SEQUENCE: 205 FIRST LINE NUMBER: 1 | |
792 | STARTING COLUMN OR PIECE: 1 LENGTH: 4 | |
793 | SHORT DE SCRIPTION: CMN RECOR D ID 'LQ ' | |
794 | CALCULAT E ONLY OR OUTPUT: OU TPUT TRANSMIT I GNORES IF NULL: FALS E | |
795 | DATA REQ UIRED FOR FIELD: YES | |
796 | ||
797 | LQ DATA EXTRACT | |
798 | BILL FORM: IB 837 TR ANSMISSION PAGE OR SE QUENCE: 20 5 | |
799 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
800 | STARTING COLUMN OR PIECE: 1. 5 LENGTH: 1 | |
801 | SHORT DE SCRIPTION: LQ DATA E XTRACT | |
802 | CALCULAT E ONLY OR OUTPUT: CA LCULATE ON LY | |
803 | TRANSMIT IGNORES I F NULL: TR UE | |
804 | ||
805 | SERVICE LINE # | |
806 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
807 | PAGE OR SEQUENCE: 205 FIRST LINE NUMBER: 1 | |
808 | STARTING COLUMN OR PIECE: 2 LENGTH: 6 | |
809 | SHORT DE SCRIPTION: SERVICE L INE # | |
810 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
811 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
812 | ||
813 | CMN FORM TYPE QUAL IFIER | |
814 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
815 | PAGE OR SEQUENCE: 205 FIRST LINE NUMBER: 1 | |
816 | STARTING COLUMN OR PIECE: 3 LENGTH: 30 | |
817 | SHORT DE SCRIPTION: CMN FORM TYPE QUALI FIER | |
818 | CALCULAT E ONLY OR OUTPUT: OU TPUT TRANSMIT I GNORES IF NULL: FALS E | |
819 | DATA REQ UIRED FOR FIELD: NO | |
820 | ||
821 | CMN INDU STRY CODE | |
822 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
823 | PAGE OR SEQUENCE: 205 FIRST LINE NUMBER: 1 | |
824 | STARTING COLUMN OR PIECE: 4 LENGTH: 10 | |
825 | SHORT DE SCRIPTION: CMN INDUS TRY CODE | |
826 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
827 | TRANSMIT IGNORES I F NULL: FA LSE DATA REQUI RED FOR FI ELD: NO | |
828 | ||
829 | ||
830 | M EA Segment | |
831 | ||
832 | CMN RECO RD ID 'MEA ' | |
833 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
834 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
835 | STARTING COLUMN OR PIECE: 1 LENGTH: 4 | |
836 | SHORT DE SCRIPTION: CMN RECOR D ID 'MEA ' | |
837 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
838 | ||
839 | MEA DATA EXTRACT | |
840 | BILL FORM: IB 837 TR ANSMISSION | |
841 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
842 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
843 | STARTING COLUMN OR PIECE: 1. 5 LENGTH: 1 | |
844 | SHORT DE SCRIPTION: MEA DATA EXTRACT | |
845 | CALCULAT E ONLY OR OUTPUT: CA LCULATE ON LY | |
846 | ||
847 | SERVICE LINE # | |
848 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
849 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
850 | STARTING COLUMN OR PIECE: 2 LENGTH: 6 | |
851 | SHORT DE SCRIPTION: SERVICE L INE # | |
852 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
853 | ||
854 | CMN MEAS UREMENT RE FERENCE ID CODE (Pa tient Heig ht Modifie r) | |
855 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
856 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
857 | STARTING COLUMN OR PIECE: 3 LENGTH: 2 | |
858 | SHORT DE SCRIPTION: CMN MEASU REMENT REF ERENCE ID CODE | |
859 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
860 | ||
861 | CMN MEAS UREMENT QU ALIFIER | |
862 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
863 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
864 | STARTING COLUMN OR PIECE: 4 LENGTH: 3 | |
865 | SHORT DE SCRIPTION: CMN MEASU REMENT QUA LIFIER | |
866 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
867 | ||
868 | CMN TEST RESULTS (Patient H eight) | |
869 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
870 | PAGE OR SEQUENCE: 191.7 FIRST LINE NUMBER: 1 | |
871 | STARTING COLUMN OR PIECE: 5 LENGTH: 20 | |
872 | SHORT DE SCRIPTION: CMN TEST RESULTS | |
873 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
874 | ||
875 | ||
876 | P T1 Segment | |
877 | ||
878 | CMN PATI ENT WEIGHT MODIFIER | |
879 | BILL FOR M: IB 837 TRANSMISSI ON SECURITY LEVEL: NA TIONAL,NO EDIT | |
880 | PAGE OR SEQUENCE: 40 FIRST LINE NUMBER: 1 | |
881 | STARTING COLUMN OR PIECE: 14 LENGTH: 2 | |
882 | SHORT DE SCRIPTION: CMN PATIE NT WEIGHT MODIFIER | |
883 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
884 | ||
885 | CMN PATI ENT WEIGHT (LBS) | |
886 | BILL FORM: IB 837 TR ANSMISSION SECURITY L EVEL: NATI ONAL,NO ED IT | |
887 | PAGE OR SEQUENCE: 40 FIRST LINE NUMBER: 1 | |
888 | STARTING COLUMN OR PIECE: 15 LENGTH: 4 | |
889 | SHORT DE SCRIPTION: CMN PATIE NT WEIGHT (LBS) | |
890 | CALCULAT E ONLY OR OUTPUT: OU TPUT | |
891 | ||
892 | ||
893 | File 364.7 Entries | |
894 | ||
895 | C MN Segment | |
896 | CMN RECORD ID 'CMN ' | |
897 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
898 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
899 | DATA ELE MENT: N-CM N RECORD I D 'CMN ' | |
900 | PAD CHAR ACTER: NO PAD REQUIR ED | |
901 | FORMAT C ODE: K IBX DATA S IBX DATA="CMN " | |
902 | ||
903 | CMN DATA E XTRACT | |
904 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
905 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
906 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
907 | FORMAT C ODE: D:$D( IBXSAVE("C MNDEX"))'> 1 CMNDEX^I BCEF31(IBX IEN,.IBXSA VE) | |
908 | ||
909 | SERVICE LI NE # | |
910 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
911 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
912 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
913 | FORMAT C ODE: D:$D( IBXSAVE("C MNDEX"))'> 1 CMNDEX^I BCEF31(IBX IEN,.IBXSA VE) | |
914 | ||
915 | CMN CERTIF ICATION TY PE | |
916 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
917 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
918 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
919 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
920 | EDIT STA TUS: EDITA BLE | |
921 | FORMAT C ODE: N Z N Z K IBXDA TA S Z=0 F S Z=$O(I BXSAVE("CM NDEX",Z)) Q:'Z S IB XDATA(Z)=$ $CMNDATA^I BCEF31(IBX IEN,+IBXSA VE("CMNDEX ",Z),24.01 ,"I") | |
922 | ||
923 | CMN UNIT O R BASIS FO R MEASUREM ENT CODE | |
924 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
925 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
926 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
927 | PAD CHAR ACTER: NO PAD REQUIR ED | |
928 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="MO" | |
929 | ||
930 | CMN MONTHS DME EQUIP MENT NEEDE D | |
931 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
932 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
933 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
934 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
935 | EDIT STA TUS: EDITA BLE | |
936 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$CMN DATA^IBCEF 31(IBXIEN, +IBXSAVE(" CMNDEX",Z) ,24.04) | |
937 | ||
938 | CMN CODE C ATEGORY | |
939 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
940 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
941 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
942 | PAD CHAR ACTER: NO PAD REQUIR ED | |
943 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="09" | |
944 | ||
945 | CMN CERTIF ICATION CO NDITION IN DICATOR | |
946 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
947 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
948 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
949 | PAD CHAR ACTER: NO PAD REQUIR ED | |
950 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="Y" | |
951 | ||
952 | CMN CONDIT ION INDICA TOR | |
953 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
954 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
955 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
956 | PAD CHAR ACTER: NO PAD REQUIR ED | |
957 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="38" | |
958 | ||
959 | CMN REPLAC EMENT ITEM ? | |
960 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
961 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
962 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
963 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
964 | EDIT STA TUS: EDITA BLE | |
965 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z I $$CMND ATA^IBCEF3 1(IBXIEN,+ IBXSAVE("C MNDEX",Z), 24.08,"I") S IBXDATA (Z)="ZV" | |
966 | ||
967 | CMN DATE T HERAPY STA RTED QUALI FIER | |
968 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
969 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
970 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
971 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
972 | EDIT STA TUS: DISPL AY ONLY | |
973 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=463 | |
974 | FORMAT C ODE DESCRI PTION: T he value o f CMN DATE THERAPY S TARTED QUA LIFIER is always '46 3'. | |
975 | ||
976 | CMN DATE T HERAPY STA RTED | |
977 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
978 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
979 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
980 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
981 | EDIT STA TUS: EDITA BLE | |
982 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$DT^ IBCEFG1($$ CMNDATA^IB CEF31(IBXI EN,+IBXSAV E("CMNDEX" ,Z),24.05, "I"),"","D 8") | |
983 | ||
984 | CMN LAST C ERTIFICATI ON DATE QU ALIFIER | |
985 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
986 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
987 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
988 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
989 | EDIT STA TUS: EDITA BLE | |
990 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=461 | |
991 | ||
992 | CMN LAST C ERTIFICATI ON DATE | |
993 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
994 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
995 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
996 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
997 | EDIT STA TUS: EDITA BLE | |
998 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$DT^ IBCEFG1($$ CMNDATA^IB CEF31(IBXI EN,+IBXSAV E("CMNDEX" ,Z),24.06, "I"),"","D 8") | |
999 | ||
1000 | CMN CERTIF ICATION TY PE QUAL | |
1001 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1002 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1003 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1004 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1005 | EDIT STA TUS: DISPL AY ONLY | |
1006 | FORMAT C ODE: N Z,C ERTYP K IB XDATA S Z= 0 F S Z=$ O(IBXSAVE( "CMNDEX",Z )) Q:'Z S CERTYP=$$ CMNDATA^IB CEF31(IBXI EN,+IBXSAV E("CMNDEX" ,Z),24.01, "I") I CER TYP="R"!(C ERTYP="S") S IBXDATA (Z)=607 | |
1007 | ||
1008 | CMN RECERT IFICATION/ REVISION D ATE | |
1009 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1010 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1011 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1012 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1013 | EDIT STA TUS: EDITA BLE | |
1014 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$DT^ IBCEFG1($$ CMNDATA^IB CEF31(IBXI EN,+IBXSAV E("CMNDEX" ,Z),24.07, "I"),"","D 8") | |
1015 | ||
1016 | CMN ATTACH MENT REPOR T TYPE COD E | |
1017 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1018 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1019 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1020 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1021 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="CT" | |
1022 | ||
1023 | CMN ATTACH MENT TRANS MISSION CO DE | |
1024 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1025 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1026 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1027 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1028 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="AD" | |
1029 | ||
1030 | ||
1031 | FRM Segmen t | |
1032 | CMN RECORD ID 'FRM ' | |
1033 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1034 | SECURITY LEVEL: NA TIONAL,NO EDIT DATA ELEME NT: N-CMN RECORD ID 'FRM ' | |
1035 | PAD CHAR ACTER: NO PAD REQUIR ED EDIT STATU S: DISPLAY ONLY | |
1036 | FORMAT C ODE: K IBX DATA S IBX DATA="FRM " | |
1037 | ||
1038 | FRM DATA E XTRACT | |
1039 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1040 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1041 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1042 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1043 | FORMAT C ODE: K IBX SAVE("FRM" ) D FRM^IB CEF31(IBXI EN,.IBXSAV E) | |
1044 | ||
1045 | SERVICE LI NE # | |
1046 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1047 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1048 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1049 | PAD CHAR ACTER: NO PAD REQUIR ED EDIT STATU S: DISPLAY ONLY | |
1050 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z )=$P(IBXSA VE("FRM",Z ),U,6) D:Z >1 ID^IBCE F2(Z,"FRM" ) | |
1051 | ||
1052 | CMN QUESTI ON NUMBER/ LETTER | |
1053 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1054 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1055 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1056 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1057 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z )=$P(IBXSA VE("FRM",Z ),U) | |
1058 | ||
1059 | CMN QUE STION RESP ONSE Y/N | |
1060 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1061 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1062 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1063 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1064 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z )=$P(IBXSA VE("FRM",Z ),U,2) | |
1065 | ||
1066 | CMN QUESTI ON RESPONS E REF ID | |
1067 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1068 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1069 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1070 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1071 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z )=$P(IBXSA VE("FRM",Z ),U,3) | |
1072 | ||
1073 | CMN QUESTI ON RESPONS E DATE | |
1074 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1075 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1076 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1077 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1078 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z | |
1079 | )=$P(IBXSA VE("FRM",Z ),U,4) | |
1080 | ||
1081 | CMN QUESTI ON RESPONS E % & DECI MAL | |
1082 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1083 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1084 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1085 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("FRM",Z )) Q:'Z S IBXDATA(Z )=$P(IBXSA VE("FRM",Z ),U,5) | |
1086 | ||
1087 | ||
1088 | LQ Segmen t | |
1089 | CMN RECORD ID 'LQ ' | |
1090 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1091 | SECURITY LEVEL: NA TIONAL,NO EDIT DATA ELEME NT: N-CMN RECORD ID 'LQ ' | |
1092 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1093 | EDIT STA TUS: DISPL AY ONLY FORMAT COD E: K IBXDA TA S IBXDA TA="LQ " | |
1094 | ||
1095 | LQ DATA EX TRACT | |
1096 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1097 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1098 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1099 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1100 | FORMAT C ODE: D:$D( IBXSAVE("C MNDEX"))'> 1 CMNDEX^I BCEF31(IBX IEN,.IBXSA VE) | |
1101 | ||
1102 | SERVICE LI NE # | |
1103 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1104 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1105 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1106 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1107 | EDIT STA TUS: DISPL AY ONLY | |
1108 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$P(IB XSAVE("CMN DEX",Z),U, 2) D:Z>1 I D^IBCEF2(Z ,"LQ") | |
1109 | ||
1110 | CMN FORM T YPE QUALIF IER | |
1111 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1112 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1113 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1114 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1115 | EDIT STA TUS: DISPL AY ONLY | |
1116 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="UT" | |
1117 | FORMAT CO DE DESCRIP TION: Th e CMN FORM TYPE QUAL IFIER is a lways 'UT' . | |
1118 | ||
1119 | CMN INDUST RY CODE | |
1120 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1121 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1122 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1123 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1124 | EDIT STA TUS: DISPL AY ONLY | |
1125 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$CMN DATA^IBCEF 31(IBXIEN, +IBXSAVE(" CMNDEX",Z) ,"24:2") | |
1126 | ||
1127 | MEA Segme nt | |
1128 | CMN RECORD ID ‘MEA ‘ | |
1129 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1130 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1131 | DATA ELE MENT: N-CM N RECORD I D 'MEA ' | |
1132 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1133 | FORMAT CO DE: K IBXD ATA S IBXD ATA="MEA " | |
1134 | ||
1135 | MEA DATA E XTRACT | |
1136 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1137 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1138 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1139 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1140 | FORMAT C ODE: D:$D( IBXSAVE("C MNDEX"))'> 1 CMNDEX^I BCEF31(IBX IEN,.IBXSA VE) | |
1141 | ||
1142 | SERVICE LI NE # | |
1143 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1144 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1145 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1146 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1147 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$P(IB XSAVE("CMN DEX",Z),U, 2) D:Z>1 I D^IBCEF2(Z ,"MEA") | |
1148 | ||
1149 | CMN MEASUR EMENT REFE RENCE ID C ODE | |
1150 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1151 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1152 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1153 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1154 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="TR" | |
1155 | ||
1156 | CMN MEASUR EMENT QUAL IFIER | |
1157 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1158 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1159 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1160 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1161 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)="" I $$CMNDATA^ IBCEF31(IB XIEN,+IBXS AVE("CMNDE X",Z),24.0 2) S IBXDA TA(Z)="HT" | |
1162 | ||
1163 | CMN TEST R ESULTS | |
1164 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1165 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1166 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1167 | PAD CHAR ACTER: NO PAD REQUIR ED | |
1168 | FORMAT C ODE: N Z K IBXDATA S Z=0 F S Z=$O(IBXSA VE("CMNDEX ",Z)) Q:'Z S IBXDAT A(Z)=$$CMN DATA^IBCEF 31(IBXIEN, +IBXSAVE(" CMNDEX",Z) ,24.02) | |
1169 | ||
1170 | P T1 Segment | |
1171 | CMN PATI ENT WEIGHT (LBS) | |
1172 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1173 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1174 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1175 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1176 | EDIT STA TUS: EDITA BLE | |
1177 | FORMAT C ODE: K IBX DATA S IBX DATA=$$PTW T^IBCEF31( IBXIEN) | |
1178 | ||
1179 | CMN PATI ENT WEIGHT MODIFIER | |
1180 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
1181 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
1182 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
1183 | PAD CHAR ACTER: NO PAD REQUIR ED REQUIRED: NO | |
1184 | EDIT STA TUS: EDITA BLE | |
1185 | FORMAT C ODE: K IBX DATA S IBX DATA="" I $$PTWT^IBC EF31(IBXIE N) S IBXDA TA="01" | |
1186 | FORMAT C ODE DESCRI PTION: T his is the PATIENT W EIGHT MODI FIER which is always '01'. | |
1187 | ||
1188 | ||
1189 | VI) New e ntries to the IB ERR OR file 35 0.8 for mi ssing or i ncorrect C MN Data: | |
1190 | IB CMN NOT REQ BUT D ATA | |
1191 | NAME: IB C MN NOT REQ BUT DATA | |
1192 | ERROR ME SSAGE: - " CMN Requir ed?" set t o NO, but CMN data e xists. | |
1193 | ERROR CO DE: IB901 | |
1194 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1195 | ERROR AC TION: DISP LAY MESSAG E | |
1196 | ||
1197 | IB CMN FOR M TYPE | |
1198 | NAME: IB C MN FORM TY PE | |
1199 | ERROR ME SSAGE: - " CMN Form t ype" missi ng. | |
1200 | ERROR CO DE: IB902 | |
1201 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1202 | ERROR AC TION: DISP LAY MESSAG E | |
1203 | ||
1204 | IB CMN NO DATA NODE | |
1205 | NAME: IB C MN NO DATA NODE | |
1206 | ERROR ME SSAGE: - C MN form-sp ecific dat a missing for the Fo rm Type ch osen. | |
1207 | ERROR CO DE: IB903 | |
1208 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1209 | ERROR AC TION: DISP LAY MESSAG E | |
1210 | ||
1211 | IB CMN BAD DATA NODE | |
1212 | NAME: IB C MN BAD DAT A NODE | |
1213 | ERROR ME SSAGE: - C MN data do es not mat ch the cho sen Form T ype. | |
1214 | ERROR CO DE: IB904 | |
1215 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1216 | ERROR AC TION: DISP LAY MESSAG E | |
1217 | ||
1218 | IB CMN CER T TYPE | |
1219 | NAME: IB C MN CERT TY PE | |
1220 | ERROR ME SSAGE: - " Certificat ion Type" missing. | |
1221 | ERROR CO DE: IB905 | |
1222 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1223 | ERROR AC TION: DISP LAY MESSAG E | |
1224 | ||
1225 | IB CMN PEB | |
1226 | NAME: IB C MN PEB | |
1227 | ERROR ME SSAGE: - " Is this fo r Parenter al nutriti on, Entera l nutritio n, or Both ?" missing . | |
1228 | ERROR CO DE: IB906 | |
1229 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1230 | ERROR AC TION: DISP LAY MESSAG E | |
1231 | ||
1232 | IB CMN THE RAPY DT | |
1233 | NAME: IB C MN THERAPY DT | |
1234 | ERROR ME SSAGE: - " Date Thera py Started " missing. | |
1235 | ERROR CO DE: IB907 | |
1236 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1237 | ERROR AC TION: DISP LAY MESSAG E | |
1238 | ||
1239 | IB CMN LAS T CERT DT | |
1240 | NAME: IB C MN LAST CE RT DT | |
1241 | ERROR ME SSAGE: - " Last Certi fication D ate" missi ng. | |
1242 | ERROR CO DE: IB908 | |
1243 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1244 | ERROR AC TION: DISP LAY MESSAG E | |
1245 | ||
1246 | IB CMN REC ERT/REVISI ON DT | |
1247 | NAME: IB C MN RECERT/ REVISION D T | |
1248 | ERROR ME SSAGE: - " Recertific ation/Revi sion Date" missing. | |
1249 | ERROR CO DE: IB909 | |
1250 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1251 | ERROR AC TION: DISP LAY MESSAG E | |
1252 | ||
1253 | IB CMN ABG SAT DT | |
1254 | NAME: IB C MN ABG SAT DT | |
1255 | ERROR ME SSAGE: - D ate of las t "ABG PO2 " and/or " O2 Saturat ion" Test( s) missing . | |
1256 | ERROR CO DE: IB912 | |
1257 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1258 | ERROR AC TION: DISP LAY MESSAG E | |
1259 | ||
1260 | IB CMN 4 L PM DATE | |
1261 | NAME: IB C MN 4 LPM D ATE | |
1262 | ERROR ME SSAGE: - " Date of La test 4 LPM Test(s) m issing. | |
1263 | ERROR CO DE: IB914 | |
1264 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1265 | ERROR AC TION: DISP LAY MESSAG E | |
1266 | ||
1267 | IB CMN ERR ORS HEADER | |
1268 | NAME: IB C MN ERRORS HEADER | |
1269 | ERROR ME SSAGE: The following CMN field (s) missin g or in er ror for at least 1 p rocedure: | |
1270 | ERROR CO DE: IB915 | |
1271 | PACKAGE REPORTING ERROR: INT EGRATED BI LLING | |
1272 | ERROR AC TION: DISP LAY MESSAG E | |
1273 | ||
1274 | ||
1275 | Routines M odified | |
1276 | ||
1277 | V1) Check for missi ng CMN dat a after en tering a b ill and di splay appr opriate er ror messag es: | |
1278 | IBCBB1 – C alls routi ne IBCBB13 to perfor m the chec ks for mis sing CMN d ata | |
1279 | Routines | |
1280 | Activities | |
1281 | Routine Na me | |
1282 | IBCBB1 | |
1283 | Enhancemen t Category | |
1284 | New | |
1285 | Modify | |
1286 | Delete | |
1287 | No Change | |
1288 | RTM | |
1289 | ||
1290 | Related Op tions | |
1291 | None | |
1292 | Related Ro utines | |
1293 | Routines “ Called By” | |
1294 | Routines “ Called” | |
1295 | ||
1296 | ||
1297 | ||
1298 | ||
1299 | Data Dicti onary (DD) Reference s | |
1300 | ||
1301 | Related Pr otocols | |
1302 | None | |
1303 | Related In tegration Control Re gistration s (ICRs) | |
1304 | None | |
1305 | Data Passi ng | |
1306 | Input | |
1307 | Output Re ference | |
1308 | Both | |
1309 | Global Re ference | |
1310 | Local | |
1311 | Input Attr ibute Name and Defin ition | |
1312 | Name: | |
1313 | Definition : | |
1314 | Output Att ribute Nam e and Defi nition | |
1315 | Name: | |
1316 | Definition : | |
1317 | Current Lo gic | |
1318 | IBCBB1 ;AL B/AAS - CO NTINUATION OF EDIT C HECK ROUTI NE ;2-NOV- 89 | |
1319 | ;;2.0;INT EGRATED BI LLING;**27 ,52,80,93, 106,51,151 ,148,153,1 37,232,280 ,155,320,3 43,349,363 ,371,395,3 84,432,447 ,488,554,5 77,592**;2 1-MAR-94;B uild 25 | |
1320 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
1321 | ; | |
1322 | ; *** Beg in IB*2.0* 488 VD (I ssue 46 RB N) | |
1323 | N I | |
1324 | S I="" | |
1325 | S X=+$G(^ DGCR(399,I BIFN,"MP") ) | |
1326 | I 'X,$$MC RWNR^IBEFU NC(+$$CURR ^IBCEF2(IB IFN)) S X= +$$CURR^IB CEF2(IBIFN ) | |
1327 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1328 | I X,+$G(^ DIC(36,X,3 )) S I=$P( ^(3),U,$S( $$FT^IBCEF (IBIFN)=2: 2,$$FT^IBC EF(IBIFN)= 7:2,1:4)) | |
1329 | S I=$$UP^ XLFSTR(I) | |
1330 | I (I'=""& (I["PRNT") &($G(IBER) '["IB488") ) D | |
1331 | . S IBER= $G(IBER)_" IB488;" | |
1332 | ; | |
1333 | ; Cause a n error if FORCED TO PRINT TO CLEARINGHO USE | |
1334 | I $P($G(^ DGCR(399,I BIFN,"TX") ),U,8)=2 D | |
1335 | . S IBER= $G(IBER)_" IB489;" | |
1336 | ; | |
1337 | ; Cause a fatal err or if the claim has no procedu res & is N OT a UB-04 Inpatient claim. | |
1338 | I +$O(^DG CR(399,IBI FN,"CP",0) )=0 D | |
1339 | .I $$INPA T^IBCEF(IB IFN,1),$$I NSPRF^IBCE F(IBIFN) Q ; inpat ient UB-04 check | |
1340 | .I '$$INP AT^IBCEF(I BIFN,1),$$ INSPRF^IBC EF(IBIFN) D Q ; Outpatie nt Institu tional Cla im. | |
1341 | ..I IBER[ "IB352" Q | |
1342 | ..S IBER= IBER_"IB35 2;" | |
1343 | .; | |
1344 | .; Profes sional cla im | |
1345 | .I IBER[" IB353" Q | |
1346 | .S IBER=I BER_"IB353 ;" | |
1347 | .Q | |
1348 | ; *** End IB*2.0*48 8 -- VD | |
1349 | ; | |
1350 | ;MAP TO D GCRBB1 | |
1351 | ; | |
1352 | % ;Bill St atus | |
1353 | N Z,Z0,Z1 ,IBFT | |
1354 | I $S(+IBS T=0:1,1:"^ 1^2^3^4^7^ "'[(U_IBST _U)) S IBE R=IBER_"IB 045;" | |
1355 | ; | |
1356 | ;Statemen t Covers F rom | |
1357 | I IBFDT=" " S IBER=I BER_"IB061 ;" | |
1358 | I IBFDT]" ",IBFDT'?7 N&(IBFDT'? 7N1".".N) S IBER=IBE R_"IB061;" | |
1359 | I IBFDT>I BTDT S IBE R=IBER_"IB 061;" ; fr om must be on or bef ore the to date | |
1360 | S IBFFY=$ $FY^IBOUTL (IBFDT) | |
1361 | ; if inpa t - from d ate must n ot be prio r to admit date. | |
1362 | I $$INPAT ^IBCEF(IBI FN,1),(IBF DT<($P($G( ^DGPT(+$P( IBND0,U,8) ,0)),U,2)\ 1)) S IBE R=IBER_"IB 061;" | |
1363 | ; | |
1364 | ;Statemen t Covers T o | |
1365 | I IBTDT=" " S IBER=I BER_"IB062 ;" | |
1366 | I IBTDT]" ",IBTDT'?7 N&(IBTDT'? 7N1".".N) S IBER=IBE R_"IB062;" | |
1367 | I IBTDT>D T!(IBTDT<I BFDT) S IB ER=IBER_"I B062;" ; to date mu st not be >than toda y's date | |
1368 | S IBTFY=$ $FY^IBOUTL (IBTDT) | |
1369 | ; | |
1370 | ;Total Ch arges | |
1371 | ; IB*2.0* 447/TAZ Re moved this error so that zero dollar rev enue codes can proce ss on the 837 | |
1372 | ;I +IBTC' >0!(+IBTC' =IBTC) S I BER=IBER_" IB064;" | |
1373 | ; | |
1374 | ;Billable charges f or seconda ry claim | |
1375 | I $$MCRON BIL^IBEFUN C(IBIFN)&( ($P(IBNDU1 ,U,1)-$P(I BNDU1,U,2) )'>0) S IB ER=IBER_"I B094;" | |
1376 | ;Fiscal Y ear 1 | |
1377 | S IBFFY=$ $FY^IBOUTL (IBFDT) | |
1378 | ; | |
1379 | ;Check pr ovider lin k for curr ent user, enterer, r eviewer an d Authoriz or | |
1380 | I '$D(^VA (200,DUZ,0 )) S IBER= IBER_"IB04 8;" | |
1381 | I IBEU]"" ,'$D(^VA(2 00,IBEU,0) ) S IBER=I BER_"IB048 ;" | |
1382 | I IBRU]"" ,'$D(^VA(2 00,IBRU,0) ) S IBER=I BER_"IB060 ;" | |
1383 | I IBAU]"" ,'$D(^VA(2 00,IBAU,0) ) S IBER=I BER_"IB041 ;" | |
1384 | ; | |
1385 | I IBER="" ,+$$STA^PR CAFN(IBIFN )=104 S IB ER=IBER_"I B040;" | |
1386 | ; If ins bill, must have vali d COB sequ ence | |
1387 | I $P(IBND 0,U,11)="i ",$S($P(IB ND0,U,21)= "":1,1:"PS T"'[$P(IBN D0,U,21)) S IBER=IBE R_"IB324;" | |
1388 | ; | |
1389 | ; Check f or valid s ec provide r id for c urrent ins | |
1390 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"PRV",Z )) Q:'Z S Z0=$G(^(Z ,0)),Z1=+$ $COBN^IBCE F(IBIFN) I $P(Z0,U,4 +Z1)'="",$ P(Z0,U,11+ Z1)'="" D | |
1391 | . I '$$SE CIDCK^IBCE F74(IBIFN, Z1,$P(Z0,U ,11+Z1),Z) D WARN^IB CBB11("Pro v secondar y id type for the "_ $P("PRIMAR Y^SECONDAR Y^TERTIARY ",U,Z1)_" "_$$EXTERN AL^DILFD(3 99.0222,.0 1,,+Z0)_" is invalid /won't tra nsmit") | |
1392 | ; Check N PIs | |
1393 | D NPICHK^ IBCBB11 | |
1394 | ; | |
1395 | ; Check m ultiple rx NPIs | |
1396 | D RXNPI^I BCBB11(IBI FN) | |
1397 | ; | |
1398 | ; Check t axonomies | |
1399 | D TAXCHK^ IBCBB11 | |
1400 | ; | |
1401 | ; Check f or Physici an Name | |
1402 | K IBXDATA D F^IBCEF ("N-ATT/RE ND PHYSICI AN NAME",, ,IBIFN) | |
1403 | ; IB*2.0* 432 - CMS1 500 no lon ger needs a claim le vel render ing | |
1404 | S IBFT=$$ FT^IBCEF(I BIFN) | |
1405 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1406 | I IBFT'=2 ,IBFT'=7,$ P($G(IBXDA TA),U)="" S IBER=IBE R_"IB303;" | |
1407 | ; | |
1408 | N FUNCTIO N,IBINS | |
1409 | ; IB*2.0* 432 - CMS1 500 no lon ger needs a claim le vel render ing | |
1410 | ;S FUNCTI ON=$S($$FT ^IBCEF(IBI FN)=3:4,1: 3) | |
1411 | S FUNCTIO N=$S(IBFT= 3:4,1:3) | |
1412 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1413 | I IBFT'=2 ,IBFT'=7,I BER'["IB30 3;" D | |
1414 | . F IBINS =1:1:3 D | |
1415 | .. S Z=$$ GETTYP^IBC EP2A(IBIFN ,IBINS) | |
1416 | .. I Z,$P (Z,U,2) D ; Renderi ng/attendi ng prov se condary id required | |
1417 | ... N IBI D,IBOK,Q0 | |
1418 | ... D PRO VINF^IBCEF 74(IBIFN,I BINS,.IBID ,1,"C") ; check all as though they were current | |
1419 | ... S IBO K=0 | |
1420 | ... S Q0= 0 F S Q0= $O(IBID(1, FUNCTION,Q 0)) Q:'Q0 I $P(IBID (1,FUNCTIO N,Q0),U,9) =+Z S IBOK =1 Q | |
1421 | ... I 'IB OK S IBER= IBER_$S(IB INS=1:"IB2 36;",IBINS =2:"IB237; ",IBINS=3: "IB238;",1 :"") | |
1422 | ; | |
1423 | ; Patch 4 32 enh5:Th e IB syste m shall no longer pr event user s from aut horizing(f atal error message)a claim bec ause the s ystem cann ot find th e provider sSSNorEIN | |
1424 | ; D PRIID CHK^IBCBB1 1 | |
1425 | ; | |
1426 | N IBM,IBM 1 | |
1427 | S IBM=$G( ^DGCR(399, IBIFN,"M") ) | |
1428 | S IBM1=$G (^DGCR(399 ,IBIFN,"M1 ")) | |
1429 | I $P(IBM, U),$P($G(^ DIC(36,$P( IBM,U),4)) ,U,6),$P(I BM1,U,2)=" " S IBER=I BER_"IB244 ;" | |
1430 | I $P(IBM, U,2),$P($G (^DIC(36,$ P(IBM,U,2) ,4)),U,6), $P(IBM1,U, 3)="" S IB ER=IBER_"I B245;" | |
1431 | I $P(IBM, U,3),$P($G (^DIC(36,$ P(IBM,U,3) ,4)),U,6), $P(IBM1,U, 4)="" S IB ER=IBER_"I B246;" | |
1432 | ; | |
1433 | ; If outs ide facili ty, check for ID and qualifier in 355.93 | |
1434 | ; 5/15/06 - esg - h ard error IB243 turn ed into wa rning mess age instea d | |
1435 | S Z=$P($G (^DGCR(399 ,IBIFN,"U2 ")),U,10) | |
1436 | I Z D | |
1437 | . I $P($G (^IBA(355. 93,Z,0)),U ,9)=""!($P ($G(^IBA(3 55.93,Z,0) ),U,13)="" ) D | |
1438 | .. N Z1,Z 2 | |
1439 | .. S Z1=" Missing La b or Facil ity Primar y ID for n on-VA faci lity, " | |
1440 | .. S Z2=$ $EXTERNAL^ DILFD(399, 232,,Z) | |
1441 | .. I $L(Z 2)'>19 D W ARN^IBCBB1 1(Z1_Z2) Q | |
1442 | .. D WARN ^IBCBB11(Z 1),WARN^IB CBB11(" "_Z2) | |
1443 | .. Q | |
1444 | . Q | |
1445 | ; | |
1446 | ; Must be one and o nly one di vision on bill | |
1447 | S IBZ=$$M ULTDIV^IBC BB11(IBIFN ,IBND0) | |
1448 | ; I IBZ S IBER=IBER _$S(IBZ=1: "IB095;",I BZ=2:"IB10 4;",1:"IB1 05;") | |
1449 | ; Allow m ulti-divis ional for OP instuti onal claim s | |
1450 | I IBZ,$$I NPAT^IBCEF (IBIFN)!'( $$INSPRF^I BCEF(IBIFN )) S IBER= IBER_$S(IB Z=1:"IB095 ;",IBZ=2:" IB104;",1: "IB105;") | |
1451 | ; Still n eed error msg on OP Institutio nal if No Default di vision | |
1452 | I IBZ=3,' $$INPAT^IB CEF(IBIFN) ,$$INSPRF^ IBCEF(IBIF N) S IBER= IBER_"IB10 5;" | |
1453 | ; Divisio n address must be de fined in i nstitution file | |
1454 | I $P(IBND 0,U,22) D | |
1455 | . N Z,Z0, Z1 | |
1456 | . S Z0=$G (^DIC(4,+$ P($G(^DG(4 0.8,+$P(IB ND0,U,22), 0)),U,7),0 )) | |
1457 | . S Z1=$G (^DIC(4,+$ P($G(^DG(4 0.8,+$P(IB ND0,U,22), 0)),U,7),1 )) | |
1458 | . I $P(Z0 ,U,2)="" S IBER=IBER _"IB097;" Q | |
1459 | . F Z=1,3 ,4 I $P(Z1 ,U,Z)="" S IBER=IBER _"IB097;" Q | |
1460 | ; | |
1461 | ; IB*2.0* 432 Check ambulance addresses, COB Non-c overed amt . & Attach ment Contr ol | |
1462 | I $$AMBCK ^IBCBB11(I BIFN)=1 S IBER=IBER_ "IB329;" | |
1463 | I $$COBAM T^IBCBB11( IBIFN)=1 S IBER=IBER _"IB330;" | |
1464 | I $$TMCK^ IBCBB11(IB IFN)=1 S I BER=IBER_" IB331;" | |
1465 | I $$ACCK^ IBCBB11(IB IFN)=1 S I BER=IBER_" IB332;" | |
1466 | I $$COBMR A^IBCBB11( IBIFN)=1 S IBER=IBER _"IB342;" | |
1467 | I $$COBSE C^IBCBB11( IBIFN)=1 S IBER=IBER _"IB343;" | |
1468 | ; | |
1469 | ;CHAMPVA Rate Type and Primar y Insuranc e Carriers Type of C overage mu st match | |
1470 | S (IBRTCH V,IBPICHV) =0 | |
1471 | I $P($G(^ DGCR(399.3 ,+IBAT,0)) ,U,1)="CHA MPVA" S IB RTCHV=1 | |
1472 | I $P($G(^ IBE(355.2, +$P($G(^DI C(36,+IBND MP,0)),U,1 3),0)),U,1 )="CHAMPVA " S IBPICH V=1 | |
1473 | I (+IBRTC HV!+IBPICH V)&('IBRTC HV!'IBPICH V) S IBER= IBER_"IB08 5;" | |
1474 | ; | |
1475 | ;Non-VA b ill must u se FEE REI MB INS rat e type; FE E REIMB IN S rate typ e can only be used f or Non-VA bill | |
1476 | ;IB*2.0*5 54/DRF 10/ 9/2015 | |
1477 | ;N IBNVAR T,IBNVAST | |
1478 | ;S (IBNVA RT,IBNVAST )=0 | |
1479 | ;I $P($G( ^DGCR(399. 3,+IBAT,0) ),U,1)="FE E REIMB IN S" S IBNVA RT=1 | |
1480 | ;S IBNVAS T=$$NONVAF LG(IBIFN) | |
1481 | ;I IBNVAR T,'IBNVAST S IBER=IB ER_"IB360; " ;Non-VA rate type used for bill that is not Non -VA | |
1482 | ;I 'IBNVA RT,IBNVAST S IBER=IB ER_"IB361; " ;Non-VA rate type not used for bill t hat is Non -VA | |
1483 | ; | |
1484 | N IBZPRC, IBZPRCUB | |
1485 | D F^IBCEF ("N-ALL PR OCEDURES", "IBZPRC",, IBIFN) | |
1486 | ; Procedu re Clinic is require d for Surg ical Proce dures Outp t Facility Charges | |
1487 | I +$P(IBN D0,U,27)'= 2,$$BILLRA TE^IBCRU3( IBAT,IBCL, IBEVDT,"RC OUTPATIEN T") D | |
1488 | . N Z,Z0, Z1,ZE S (Z E,Z)=0 F S Z=$O(^DG CR(399,IBI FN,"CP",Z) ) Q:'Z D I +ZE S I BER=IBER_" IB320;" Q | |
1489 | .. S Z0=$ G(^DGCR(39 9,IBIFN,"C P",Z,0)),Z 1=+Z0 I Z0 '[";ICPT(" Q | |
1490 | .. I '((Z 1'<10000)& (Z1'>69999 ))&'((Z1'< 93501)&(Z1 '>93533)) Q | |
1491 | .. I '$P( Z0,U,7) S ZE=1 | |
1492 | ; | |
1493 | ; Extract procedure s for UB-0 4 | |
1494 | D F^IBCEF ("N-UB-04 PROCEDURES ","IBZPRCU B",,IBIFN) | |
1495 | ; Does th is bill ha ve ANY pre scriptions associate d with it? | |
1496 | ; Must bi ll prescri ptions sep arately fr om other c harges | |
1497 | ; | |
1498 | ; DEM;432 - Call li ne level p rovider ed it checks. | |
1499 | D LNPROV^ IBCBB12(IB IFN) ; DE M;432 - If there are line prov ider edits , then rou tine LNPRO V^IBCBB12( IBIFN) upd ates IBER string. | |
1500 | ; DEM;432 - Call to Other Ope rating/Ope rating Pro vider edit checks. | |
1501 | I $$OPPRO VCK^IBCBB1 2(IBIFN)=1 S IBER=IB ER_"IB337; " ; DEM;4 32 | |
1502 | ; DEM;432 - Line le vel Attach ment Contr ol edits. | |
1503 | I $$LNTMC K^IBCBB11( IBIFN)=1 S IBER=IBER _"IB331;" ; DEM;432 | |
1504 | I $$LNACC K^IBCBB11( IBIFN)=1 S IBER=IBER _"IB332;" ; DEM;432 | |
1505 | ; | |
1506 | ; vd/Begi nning of I B*2*577 - Validate L ine Level NDC edits. | |
1507 | I $$LNNDC CK^IBCBB11 (IBIFN)=1 S IBER=IBE R_"IB365;" ;IB*2*57 7;JWS;11/2 0/17 FIX | |
1508 | ; vd/End of IB*2*57 7 | |
1509 | I $$ISRX^ IBCEF1(IBI FN) D | |
1510 | . N IBZ,I BRXDEF | |
1511 | . S IBRXD EF=$P($G(^ IBE(350.9, 1,1)),U,30 ),IBZ=0 | |
1512 | . F S IB Z=$O(IBZPR CUB(IBZ)) Q:'IBZ I IBZPRCUB(I BZ),+$P(IB ZPRCUB(IBZ ),U)'=IBRX DEF S IBER =IBER_"IB1 02;" Q | |
1513 | . K IBZ | |
1514 | ; | |
1515 | ; Check t hat COB se quences ar e not skip ped | |
1516 | K Z | |
1517 | F Z=1:1:3 S:+$G(^DG CR(399,IBI FN,"I"_Z)) Z(Z)="" | |
1518 | F Z=0:1:2 S Z0=$O(Z (Z)) Q:'Z0 I Z0'=(Z +1) S IBER =IBER_"IB3 22;" Q | |
1519 | K Z | |
1520 | ; HD64676 IB*2*371 - OK for payer sequ ence to be blank whe n the Rate | |
1521 | ; Type is either Interagen cy or Shar ing Agreem ent | |
1522 | I $P($G(^ DGCR(399,I BIFN,0)),U ,21)="",$P ($G(^DGCR( 399,IBIFN, 0)),U,7)'= 4,$P($G(^D GCR(399,IB IFN,0)),U, 7)'=9 S IB ER=IBER_"I B323;" | |
1523 | K IBXDATA D F^IBCEF ("N-PROCED URE CODING METHD",,, IBIFN) | |
1524 | ; Coding method sho uld agree with types of proced ure codes | |
1525 | S IBOK=$S ('$O(IBZPR C(0))!(IBX DATA=""):1 ,1:0) | |
1526 | I 'IBOK S IBOK=1,IB Z=0 F S I BZ=$O(IBZP RC(IBZ)) Q :'IBZ I I BZPRC(IBZ) ,$P(IBZPRC (IBZ),U)'[ $S(IBXDATA =9:"ICD",1 :"ICP") S IBOK=0 Q | |
1527 | I 'IBOK D WARN^IBCB B11("Codin g Method d oes not ag ree with a ll procedu re codes f ound on bi ll") | |
1528 | D EDITMRA ^IBCBB3(.I BQUIT,.IBE R,IBIFN,IB FT) | |
1529 | Q:$G(IBQU IT) | |
1530 | ; | |
1531 | ;Other th ings that could be a dded: Rev Code - ca lculating charges | |
1532 | ; Diagnosis Coding, if MT copay - check fo r other co -payments | |
1533 | ; | |
1534 | I $P(IBND TX,U,8),$$ REQMRA^IBE FUNC(IBIFN ) S IBER=I BER_"IB121 ;" ; can 't force M RAs to pri nt | |
1535 | I $P(IBND TX,U,8)!$P (IBNDTX,U, 9) D | |
1536 | . Q:$P(IB NDTX,U,8)= 2 ; Don 't want to do this f or option 2 any more . | |
1537 | . D WARN^ IBCBB11($S ($$REQMRA^ IBEFUNC(IB IFN)&($P(I BNDTX,U,9) ):"MRA Sec ondary ",1 :"")_"Bill has been forced to print "_$S ($P(IBNDTX ,U,8)=1!($ P(IBNDTX,U ,9)=1):"lo cally",1:" at clearin ghouse")) | |
1538 | N IBXZ,IB IZ F IBIZ= 12,13,14 S IBXZ=$P(I BNDM,U,IBI Z) I +IBXZ S IBXZ=$P ($G(^DPT(D FN,.312,IB XZ,0)),U,1 8) I +IBXZ S IBXZ=$G (^IBA(355. 3,+IBXZ,0) ) I +$P(IB XZ,U,12) D | |
1539 | . D WARN^ IBCBB11($P ($G(^DIC(3 6,+IBXZ,0) ),U,1)_" r equires Am b Care Cer tification ") | |
1540 | ; | |
1541 | D VALNDC^ IBCBB11(IB IFN,DFN) ;validate NDC# | |
1542 | ; | |
1543 | ;Build AR array if no errors and MRA no t needed o r already rec'd | |
1544 | I IBER="" ,$S($$NEED MRA^IBEFUN C(IBIFN)!( $$REQMRA^I BEFUNC(IBI FN)):0,1:1 ) D ARRAY | |
1545 | ; | |
1546 | ;Check RO I | |
1547 | N ROIERR | |
1548 | S ROIERR= 0 I $P($G( ^DGCR(399, IBIFN,"U") ),U,5)=1,+ $P($G(^DGC R(399,IBIF N,"U")),U, 7)=0 S ROI ERR=1 ; sc reen 7 sen sitive rec ord and no ROI | |
1549 | I $$ROICH K^IBCBB11( IBIFN,DFN, +IBNDMP) S ROIERR=1 ; check fi le for sen sitive Rx and missin g ROI | |
1550 | I ROIERR S IBER=IBE R_"IB328;" | |
1551 | ; | |
1552 | ;Verify L ine Charge s Match Cl aim Total Charge. IB *2.0*447 B I | |
1553 | I +$$GET1 ^DIQ(399,I BIFN_",",2 01)'=+$$IB LNTOT^IBCB B13(IBIFN) S IBER=IB ER_"IB344; " | |
1554 | ; | |
1555 | ;Test for valid EIN /SY ID Val ues. IB*2. 0*447 BI | |
1556 | I $$IBSYE I^IBCBB13( IBIFN) S I BER=IBER_" IB345;" | |
1557 | ; | |
1558 | ;Test for a missing ICN. IB*2 .0*447 BI | |
1559 | I $$IBMIC N^IBCBB13( IBIFN) S I BER=IBER_" IB346;" | |
1560 | ; | |
1561 | ;Test for a ZERO ch arge amoun ts. IB*2.0 *447 BI | |
1562 | I $$IBRCC HK^IBCBB13 (IBIFN) D WARN^IBCBB 11("Claim contains r evenue cod es with no associate d charges. ") | |
1563 | ; | |
1564 | ;Test for missing " Patient re ason for v isit". IB* 2.0*447 BI | |
1565 | I $$FT^IB CEF(IBIFN) =3,'$$INPA T^IBCEF(IB IFN),$$IBP RV3^IBCBB1 3(IBIFN) S IBER=IBER _"IB347;" | |
1566 | ; | |
1567 | ;Test for missing P ayer ID. I B*2.0*447 BI | |
1568 | ;I $$IBMP ID^IBCBB13 (IBIFN) S IBER=IBER_ "IB348;" | |
1569 | ;Changed Error to W arning. IB *2.0*447 T AZ | |
1570 | I $$IBMPI D^IBCBB13( IBIFN) D W ARN^IBCBB1 1("Not all payers ha ve Payer I Ds.") | |
1571 | ; | |
1572 | ;Test for missing " Priority ( Type) of A dmission" for UB-04. IB*2.0*44 7 BI | |
1573 | I $$FT^IB CEF(IBIFN) =3,$$GET1^ DIQ(399,IB IFN_",",15 8)="" S IB ER=IBER_"I B349;" | |
1574 | ; | |
1575 | END ;Don't kill IBIF N, IBER, D FN | |
1576 | I $O(^TMP ($J,"BILL- WARN",0)), $G(IBER)=" " S IBER=" WARN" ;War nings only | |
1577 | K IBBNO,I BEVDT,IBLO C,IBCL,IBT F,IBAT,IBW HO,IBST,IB FDT,IBTDT, IBTC,IBFY, IBFY1,IBAU ,IBRU,IBEU ,IBARTP,IB FYC,IBMRA, IBTOB,IBTO B12,IBNDU2 ,IBNDUF3,I BNDUF31,IB NDTX | |
1578 | K IBNDS,I BND0,IBNDU ,IBNDM,IBN DMP,IBNDU1 ,IBFFY,IBT FY,IBFT,IB RTCHV,IBPI CHV,IBXDAT A,IBOK | |
1579 | I $D(IBER ),IBER="" W !,"No Er rors found for Natio nal edits" | |
1580 | Q | |
1581 | ; | |
1582 | ARRAY ;Bui ld PRCASV( array) | |
1583 | N IBCOBN, X | |
1584 | K PRCASV | |
1585 | Q:$$MCRWN R^IBEFUNC( +$$CURR^IB CEF2(IBIFN )) | |
1586 | S IBCOBN= $$COBN^IBC EF(IBIFN) | |
1587 | S X=IBIFN | |
1588 | S PRCASV( "BDT")=DT, PRCASV("AR REC")=IBIF N | |
1589 | S PRCASV( "APR")=DUZ | |
1590 | S PRCASV( "PAT")=DFN ,PRCASV("C AT")=$P(^D GCR(399.3, IBAT,0),"^ ",6) | |
1591 | I IBWHO=" i" S PRCAS V("DEBTOR" )=+IBNDMP_ ";DIC(36," | |
1592 | S PRCASV( "DEBTOR")= $S(IBWHO=" p":DFN_";D PT(",IBWHO ="o":$P(IB NDM,"^",11 )_";DIC(4, ",IBWHO="i ":PRCASV(" DEBTOR"),1 :"") | |
1593 | S PRCASV( "CARE")=$E ($$TOB^IBC EF1(IBIFN) ,1,2) | |
1594 | S PRCASV( "FY")=$$FY ^IBOUTL(DT )_U_($P(IB NDU1,U)-$P (IBNDU1,U, 2)) | |
1595 | ;S PRCASV ("FY")=$P( IBNDU1,U,9 )_U_$S($P( IBNDU1,U,2 )]"":($P(I BNDU1,U,10 )-$P(IBNDU 1,U,2)),1: $P(IBNDU1, U,10))_$S( $P(IBNDU1, U,11)]"":U _$P(IBNDU1 ,U,11)_U_$ P(IBNDU1,U ,12),1:"") | |
1596 | PLUS I IBW HO="i",$P( IBNDM,"^", 2),$D(^DIC (36,$P(IBN DM,"^",2), 0)) S PRCA SV("2NDINS ")=$P(IBND M,"^",2) | |
1597 | I IBWHO=" i",$P(IBND M,"^",3),$ D(^DIC(36, $P(IBNDM," ^",3),0)) S PRCASV(" 3RDINS")=$ P(IBNDM,"^ ",3) | |
1598 | ; | |
1599 | N IBX S I BX=$P(IBND 0,U,21),IB X=$S(IBX=" P":"I1",IB X="S":"I2" ,IBX="T":" I3",1:"") Q:IBX="" | |
1600 | N IBNDI1 | |
1601 | Q:'$D(^DG CR(399,IBI FN,IBX)) S IBNDI1=^ (IBX) | |
1602 | S:$P(IBND I1,"^",3)] "" PRCASV( "GPNO")=$P (IBNDI1,"^ ",3) | |
1603 | S:$P(IBND I1,"^",15) ]"" PRCASV ("GPNM")=$ P(IBNDI1," ^",15) | |
1604 | S:$P(IBND I1,"^",17) ]"" PRCASV ("INPA")=$ P(IBNDI1," ^",17) | |
1605 | S:$P(IBND I1,"^",2)] "" PRCASV( "IDNO")=$P (IBNDI1,"^ ",2),PRCAS V("INID")= PRCASV("ID NO") | |
1606 | ; Check t hat this i s a second ary or ter tiary bill and insur ance for p revious | |
1607 | ; COB seq uence is M edicare WN R and MRA is active --> send d ata elemen ts to AR | |
1608 | I IBCOBN> 1,$$WNRBIL L^IBEFUNC( IBIFN,IBCO BN-1),$$ED IACTV^IBCE F4(2) D MR A | |
1609 | Q | |
1610 | ; | |
1611 | MRA N IBEO B S IBEOB= 0 | |
1612 | ; | |
1613 | K PRCASV( "MEDURE"), PRCASV("ME DCA") | |
1614 | ; Get EOB data | |
1615 | F S IBEO B=$O(^IBM( 361.1,"B", IBIFN,IBEO B)) Q:'IBE OB D | |
1616 | . D MRACA LC^IBCEMU2 (IBEOB,IBI FN,1,.PRCA SV) | |
1617 | Q ;MRA | |
1618 | ; | |
1619 | ;; PREGNA NCY DX COD ES: V22**- V24**, V27 **-V28**, 630**-677* * | |
1620 | ;; FLU SH OTS PROCED URE CODES: 90724, G0 008, 90732 , G0009 | |
1621 | ; | |
1622 | NONVAFLG(I BIFN) ; Ch eck if Non -VA bill | |
1623 | ; Functio n returns 1 if Non-V A bill | |
1624 | ; IB*2.0* 554/DRF 10 /9/2015 | |
1625 | N FLAG,PT F | |
1626 | S FLAG=0 | |
1627 | I $P($G(^ DGCR(399,I BIFN,"U2") ),U,10)]"" S FLAG=1 ;Non-VA pr ovider def ined | |
1628 | S PTF=$P( $G(^DGCR(3 99,IBIFN,0 )),U,8) | |
1629 | I PTF,$P( $G(^DGPT(P TF,0)),U,4 )=1 S FLAG =1 ;PTF en try indica tes Non-VA | |
1630 | Q FLAG | |
1631 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
1632 | IBCBB1 ;AL B/AAS - CO NTINUATION OF EDIT C HECK ROUTI NE ;2-NOV- 89 | |
1633 | ;;2.0;INT EGRATED BI LLING;**27 ,52,80,93, 106,51,151 ,148,153,1 37,232,280 ,155,320,3 43,349,363 ,371,395,3 84,432,447 ,488,554,5 77,592,608 **;21-MAR- 94;Build 2 1 | |
1634 | ;Per VA D irective 6 402, this routine sh ould not b e modified . | |
1635 | ; | |
1636 | ; *** Beg in IB*2.0* 488 VD (I ssue 46 RB N) | |
1637 | N I | |
1638 | S I="" | |
1639 | S X=+$G(^ DGCR(399,I BIFN,"MP") ) | |
1640 | I 'X,$$MC RWNR^IBEFU NC(+$$CURR ^IBCEF2(IB IFN)) S X= +$$CURR^IB CEF2(IBIFN ) | |
1641 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1642 | I X,+$G(^ DIC(36,X,3 )) S I=$P( ^(3),U,$S( $$FT^IBCEF (IBIFN)=2: 2,$$FT^IBC EF(IBIFN)= 7:2,1:4)) | |
1643 | S I=$$UP^ XLFSTR(I) | |
1644 | I (I'=""& (I["PRNT") &($G(IBER) '["IB488") ) D | |
1645 | . S IBER= $G(IBER)_" IB488;" | |
1646 | ; | |
1647 | ; Cause a n error if FORCED TO PRINT TO CLEARINGHO USE | |
1648 | I $P($G(^ DGCR(399,I BIFN,"TX") ),U,8)=2 D | |
1649 | . S IBER= $G(IBER)_" IB489;" | |
1650 | ; | |
1651 | ; Cause a fatal err or if the claim has no procedu res & is N OT a UB-04 Inpatient claim. | |
1652 | I +$O(^DG CR(399,IBI FN,"CP",0) )=0 D | |
1653 | .I $$INPA T^IBCEF(IB IFN,1),$$I NSPRF^IBCE F(IBIFN) Q ; inpat ient UB-04 check | |
1654 | .I '$$INP AT^IBCEF(I BIFN,1),$$ INSPRF^IBC EF(IBIFN) D Q ; Outpatie nt Institu tional Cla im. | |
1655 | ..I IBER[ "IB352" Q | |
1656 | ..S IBER= IBER_"IB35 2;" | |
1657 | .; | |
1658 | .; Profes sional cla im | |
1659 | .I IBER[" IB353" Q | |
1660 | .S IBER=I BER_"IB353 ;" | |
1661 | .Q | |
1662 | ; *** End IB*2.0*48 8 -- VD | |
1663 | ; | |
1664 | ;MAP TO D GCRBB1 | |
1665 | ; | |
1666 | % ;Bill St atus | |
1667 | N Z,Z0,Z1 ,IBFT | |
1668 | I $S(+IBS T=0:1,1:"^ 1^2^3^4^7^ "'[(U_IBST _U)) S IBE R=IBER_"IB 045;" | |
1669 | ; | |
1670 | ;Statemen t Covers F rom | |
1671 | I IBFDT=" " S IBER=I BER_"IB061 ;" | |
1672 | I IBFDT]" ",IBFDT'?7 N&(IBFDT'? 7N1".".N) S IBER=IBE R_"IB061;" | |
1673 | I IBFDT>I BTDT S IBE R=IBER_"IB 061;" ; fr om must be on or bef ore the to date | |
1674 | S IBFFY=$ $FY^IBOUTL (IBFDT) | |
1675 | ; if inpa t - from d ate must n ot be prio r to admit date. | |
1676 | I $$INPAT ^IBCEF(IBI FN,1),(IBF DT<($P($G( ^DGPT(+$P( IBND0,U,8) ,0)),U,2)\ 1)) S IBE R=IBER_"IB 061;" | |
1677 | ; | |
1678 | ;Statemen t Covers T o | |
1679 | I IBTDT=" " S IBER=I BER_"IB062 ;" | |
1680 | I IBTDT]" ",IBTDT'?7 N&(IBTDT'? 7N1".".N) S IBER=IBE R_"IB062;" | |
1681 | I IBTDT>D T!(IBTDT<I BFDT) S IB ER=IBER_"I B062;" ; to date mu st not be >than toda y's date | |
1682 | S IBTFY=$ $FY^IBOUTL (IBTDT) | |
1683 | ; | |
1684 | ;Total Ch arges | |
1685 | ; IB*2.0* 447/TAZ Re moved this error so that zero dollar rev enue codes can proce ss on the 837 | |
1686 | ;I +IBTC' >0!(+IBTC' =IBTC) S I BER=IBER_" IB064;" | |
1687 | ; | |
1688 | ;Billable charges f or seconda ry claim | |
1689 | I $$MCRON BIL^IBEFUN C(IBIFN)&( ($P(IBNDU1 ,U,1)-$P(I BNDU1,U,2) )'>0) S IB ER=IBER_"I B094;" | |
1690 | ;Fiscal Y ear 1 | |
1691 | S IBFFY=$ $FY^IBOUTL (IBFDT) | |
1692 | ; | |
1693 | ;Check pr ovider lin k for curr ent user, enterer, r eviewer an d Authoriz or | |
1694 | I '$D(^VA (200,DUZ,0 )) S IBER= IBER_"IB04 8;" | |
1695 | I IBEU]"" ,'$D(^VA(2 00,IBEU,0) ) S IBER=I BER_"IB048 ;" | |
1696 | I IBRU]"" ,'$D(^VA(2 00,IBRU,0) ) S IBER=I BER_"IB060 ;" | |
1697 | I IBAU]"" ,'$D(^VA(2 00,IBAU,0) ) S IBER=I BER_"IB041 ;" | |
1698 | ; | |
1699 | I IBER="" ,+$$STA^PR CAFN(IBIFN )=104 S IB ER=IBER_"I B040;" | |
1700 | ; If ins bill, must have vali d COB sequ ence | |
1701 | I $P(IBND 0,U,11)="i ",$S($P(IB ND0,U,21)= "":1,1:"PS T"'[$P(IBN D0,U,21)) S IBER=IBE R_"IB324;" | |
1702 | ; | |
1703 | ; Check f or valid s ec provide r id for c urrent ins | |
1704 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"PRV",Z )) Q:'Z S Z0=$G(^(Z ,0)),Z1=+$ $COBN^IBCE F(IBIFN) I $P(Z0,U,4 +Z1)'="",$ P(Z0,U,11+ Z1)'="" D | |
1705 | . I '$$SE CIDCK^IBCE F74(IBIFN, Z1,$P(Z0,U ,11+Z1),Z) D WARN^IB CBB11("Pro v secondar y id type for the "_ $P("PRIMAR Y^SECONDAR Y^TERTIARY ",U,Z1)_" "_$$EXTERN AL^DILFD(3 99.0222,.0 1,,+Z0)_" is invalid /won't tra nsmit") | |
1706 | ; Check N PIs | |
1707 | D NPICHK^ IBCBB11 | |
1708 | ; | |
1709 | ; Check m ultiple rx NPIs | |
1710 | D RXNPI^I BCBB11(IBI FN) | |
1711 | ; | |
1712 | ; Check t axonomies | |
1713 | D TAXCHK^ IBCBB11 | |
1714 | ; | |
1715 | ; Check f or Physici an Name | |
1716 | K IBXDATA D F^IBCEF ("N-ATT/RE ND PHYSICI AN NAME",, ,IBIFN) | |
1717 | ; IB*2.0* 432 - CMS1 500 no lon ger needs a claim le vel render ing | |
1718 | S IBFT=$$ FT^IBCEF(I BIFN) | |
1719 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1720 | I IBFT'=2 ,IBFT'=7,$ P($G(IBXDA TA),U)="" S IBER=IBE R_"IB303;" | |
1721 | ; | |
1722 | N FUNCTIO N,IBINS | |
1723 | ; IB*2.0* 432 - CMS1 500 no lon ger needs a claim le vel render ing | |
1724 | ;S FUNCTI ON=$S($$FT ^IBCEF(IBI FN)=3:4,1: 3) | |
1725 | S FUNCTIO N=$S(IBFT= 3:4,1:3) | |
1726 | ;JWS;IB*2 .0*592:US1 108 - Dent al form ch eck | |
1727 | I IBFT'=2 ,IBFT'=7,I BER'["IB30 3;" D | |
1728 | . F IBINS =1:1:3 D | |
1729 | .. S Z=$$ GETTYP^IBC EP2A(IBIFN ,IBINS) | |
1730 | .. I Z,$P (Z,U,2) D ; Renderi ng/attendi ng prov se condary id required | |
1731 | ... N IBI D,IBOK,Q0 | |
1732 | ... D PRO VINF^IBCEF 74(IBIFN,I BINS,.IBID ,1,"C") ; check all as though they were current | |
1733 | ... S IBO K=0 | |
1734 | ... S Q0= 0 F S Q0= $O(IBID(1, FUNCTION,Q 0)) Q:'Q0 I $P(IBID (1,FUNCTIO N,Q0),U,9) =+Z S IBOK =1 Q | |
1735 | ... I 'IB OK S IBER= IBER_$S(IB INS=1:"IB2 36;",IBINS =2:"IB237; ",IBINS=3: "IB238;",1 :"") | |
1736 | ; | |
1737 | ; Patch 4 32 enh5:Th e IB syste m shall no longer pr event user s from aut horizing(f atal error message)a claim bec ause the s ystem cann ot find th e provider sSSNorEIN | |
1738 | ; D PRIID CHK^IBCBB1 1 | |
1739 | ; | |
1740 | N IBM,IBM 1 | |
1741 | S IBM=$G( ^DGCR(399, IBIFN,"M") ) | |
1742 | S IBM1=$G (^DGCR(399 ,IBIFN,"M1 ")) | |
1743 | I $P(IBM, U),$P($G(^ DIC(36,$P( IBM,U),4)) ,U,6),$P(I BM1,U,2)=" " S IBER=I BER_"IB244 ;" | |
1744 | I $P(IBM, U,2),$P($G (^DIC(36,$ P(IBM,U,2) ,4)),U,6), $P(IBM1,U, 3)="" S IB ER=IBER_"I B245;" | |
1745 | I $P(IBM, U,3),$P($G (^DIC(36,$ P(IBM,U,3) ,4)),U,6), $P(IBM1,U, 4)="" S IB ER=IBER_"I B246;" | |
1746 | ; | |
1747 | ; If outs ide facili ty, check for ID and qualifier in 355.93 | |
1748 | ; 5/15/06 - esg - h ard error IB243 turn ed into wa rning mess age instea d | |
1749 | S Z=$P($G (^DGCR(399 ,IBIFN,"U2 ")),U,10) | |
1750 | I Z D | |
1751 | . I $P($G (^IBA(355. 93,Z,0)),U ,9)=""!($P ($G(^IBA(3 55.93,Z,0) ),U,13)="" ) D | |
1752 | .. N Z1,Z 2 | |
1753 | .. S Z1=" Missing La b or Facil ity Primar y ID for n on-VA faci lity, " | |
1754 | .. S Z2=$ $EXTERNAL^ DILFD(399, 232,,Z) | |
1755 | .. I $L(Z 2)'>19 D W ARN^IBCBB1 1(Z1_Z2) Q | |
1756 | .. D WARN ^IBCBB11(Z 1),WARN^IB CBB11(" "_Z2) | |
1757 | .. Q | |
1758 | . Q | |
1759 | ; | |
1760 | ; Must be one and o nly one di vision on bill | |
1761 | S IBZ=$$M ULTDIV^IBC BB11(IBIFN ,IBND0) | |
1762 | ; I IBZ S IBER=IBER _$S(IBZ=1: "IB095;",I BZ=2:"IB10 4;",1:"IB1 05;") | |
1763 | ; Allow m ulti-divis ional for OP instuti onal claim s | |
1764 | I IBZ,$$I NPAT^IBCEF (IBIFN)!'( $$INSPRF^I BCEF(IBIFN )) S IBER= IBER_$S(IB Z=1:"IB095 ;",IBZ=2:" IB104;",1: "IB105;") | |
1765 | ; Still n eed error msg on OP Institutio nal if No Default di vision | |
1766 | I IBZ=3,' $$INPAT^IB CEF(IBIFN) ,$$INSPRF^ IBCEF(IBIF N) S IBER= IBER_"IB10 5;" | |
1767 | ; Divisio n address must be de fined in i nstitution file | |
1768 | I $P(IBND 0,U,22) D | |
1769 | . N Z,Z0, Z1 | |
1770 | . S Z0=$G (^DIC(4,+$ P($G(^DG(4 0.8,+$P(IB ND0,U,22), 0)),U,7),0 )) | |
1771 | . S Z1=$G (^DIC(4,+$ P($G(^DG(4 0.8,+$P(IB ND0,U,22), 0)),U,7),1 )) | |
1772 | . I $P(Z0 ,U,2)="" S IBER=IBER _"IB097;" Q | |
1773 | . F Z=1,3 ,4 I $P(Z1 ,U,Z)="" S IBER=IBER _"IB097;" Q | |
1774 | ; | |
1775 | ; IB*2.0* 432 Check ambulance addresses, COB Non-c overed amt . & Attach ment Contr ol | |
1776 | I $$AMBCK ^IBCBB11(I BIFN)=1 S IBER=IBER_ "IB329;" | |
1777 | I $$COBAM T^IBCBB11( IBIFN)=1 S IBER=IBER _"IB330;" | |
1778 | I $$TMCK^ IBCBB11(IB IFN)=1 S I BER=IBER_" IB331;" | |
1779 | I $$ACCK^ IBCBB11(IB IFN)=1 S I BER=IBER_" IB332;" | |
1780 | I $$COBMR A^IBCBB11( IBIFN)=1 S IBER=IBER _"IB342;" | |
1781 | I $$COBSE C^IBCBB11( IBIFN)=1 S IBER=IBER _"IB343;" | |
1782 | ; | |
1783 | ;CHAMPVA Rate Type and Primar y Insuranc e Carriers Type of C overage mu st match | |
1784 | S (IBRTCH V,IBPICHV) =0 | |
1785 | I $P($G(^ DGCR(399.3 ,+IBAT,0)) ,U,1)="CHA MPVA" S IB RTCHV=1 | |
1786 | I $P($G(^ IBE(355.2, +$P($G(^DI C(36,+IBND MP,0)),U,1 3),0)),U,1 )="CHAMPVA " S IBPICH V=1 | |
1787 | I (+IBRTC HV!+IBPICH V)&('IBRTC HV!'IBPICH V) S IBER= IBER_"IB08 5;" | |
1788 | ; | |
1789 | ;Non-VA b ill must u se FEE REI MB INS rat e type; FE E REIMB IN S rate typ e can only be used f or Non-VA bill | |
1790 | ;IB*2.0*5 54/DRF 10/ 9/2015 | |
1791 | ;N IBNVAR T,IBNVAST | |
1792 | ;S (IBNVA RT,IBNVAST )=0 | |
1793 | ;I $P($G( ^DGCR(399. 3,+IBAT,0) ),U,1)="FE E REIMB IN S" S IBNVA RT=1 | |
1794 | ;S IBNVAS T=$$NONVAF LG(IBIFN) | |
1795 | ;I IBNVAR T,'IBNVAST S IBER=IB ER_"IB360; " ;Non-VA rate type used for bill that is not Non -VA | |
1796 | ;I 'IBNVA RT,IBNVAST S IBER=IB ER_"IB361; " ;Non-VA rate type not used for bill t hat is Non -VA | |
1797 | ; | |
1798 | N IBZPRC, IBZPRCUB | |
1799 | D F^IBCEF ("N-ALL PR OCEDURES", "IBZPRC",, IBIFN) | |
1800 | ; Procedu re Clinic is require d for Surg ical Proce dures Outp t Facility Charges | |
1801 | I +$P(IBN D0,U,27)'= 2,$$BILLRA TE^IBCRU3( IBAT,IBCL, IBEVDT,"RC OUTPATIEN T") D | |
1802 | . N Z,Z0, Z1,ZE S (Z E,Z)=0 F S Z=$O(^DG CR(399,IBI FN,"CP",Z) ) Q:'Z D I +ZE S I BER=IBER_" IB320;" Q | |
1803 | .. S Z0=$ G(^DGCR(39 9,IBIFN,"C P",Z,0)),Z 1=+Z0 I Z0 '[";ICPT(" Q | |
1804 | .. I '((Z 1'<10000)& (Z1'>69999 ))&'((Z1'< 93501)&(Z1 '>93533)) Q | |
1805 | .. I '$P( Z0,U,7) S ZE=1 | |
1806 | ; | |
1807 | ; Extract procedure s for UB-0 4 | |
1808 | D F^IBCEF ("N-UB-04 PROCEDURES ","IBZPRCU B",,IBIFN) | |
1809 | ; Does th is bill ha ve ANY pre scriptions associate d with it? | |
1810 | ; Must bi ll prescri ptions sep arately fr om other c harges | |
1811 | ; | |
1812 | ; DEM;432 - Call li ne level p rovider ed it checks. | |
1813 | D LNPROV^ IBCBB12(IB IFN) ; DE M;432 - If there are line prov ider edits , then rou tine LNPRO V^IBCBB12( IBIFN) upd ates IBER string. | |
1814 | ; DEM;432 - Call to Other Ope rating/Ope rating Pro vider edit checks. | |
1815 | I $$OPPRO VCK^IBCBB1 2(IBIFN)=1 S IBER=IB ER_"IB337; " ; DEM;4 32 | |
1816 | ; DEM;432 - Line le vel Attach ment Contr ol edits. | |
1817 | I $$LNTMC K^IBCBB11( IBIFN)=1 S IBER=IBER _"IB331;" ; DEM;432 | |
1818 | I $$LNACC K^IBCBB11( IBIFN)=1 S IBER=IBER _"IB332;" ; DEM;432 | |
1819 | ; | |
1820 | ; vd/Begi nning of I B*2*577 - Validate L ine Level NDC edits. | |
1821 | I $$LNNDC CK^IBCBB11 (IBIFN)=1 S IBER=IBE R_"IB360;" ;IB*2*57 7 | |
1822 | ; vd/End of IB*2*57 7 | |
1823 | I $$ISRX^ IBCEF1(IBI FN) D | |
1824 | . N IBZ,I BRXDEF | |
1825 | . S IBRXD EF=$P($G(^ IBE(350.9, 1,1)),U,30 ),IBZ=0 | |
1826 | . F S IB Z=$O(IBZPR CUB(IBZ)) Q:'IBZ I IBZPRCUB(I BZ),+$P(IB ZPRCUB(IBZ ),U)'=IBRX DEF S IBER =IBER_"IB1 02;" Q | |
1827 | . K IBZ | |
1828 | ; | |
1829 | ; Check t hat COB se quences ar e not skip ped | |
1830 | K Z | |
1831 | F Z=1:1:3 S:+$G(^DG CR(399,IBI FN,"I"_Z)) Z(Z)="" | |
1832 | F Z=0:1:2 S Z0=$O(Z (Z)) Q:'Z0 I Z0'=(Z +1) S IBER =IBER_"IB3 22;" Q | |
1833 | K Z | |
1834 | ; HD64676 IB*2*371 - OK for payer sequ ence to be blank whe n the Rate | |
1835 | ; Type is either Interagen cy or Shar ing Agreem ent | |
1836 | I $P($G(^ DGCR(399,I BIFN,0)),U ,21)="",$P ($G(^DGCR( 399,IBIFN, 0)),U,7)'= 4,$P($G(^D GCR(399,IB IFN,0)),U, 7)'=9 S IB ER=IBER_"I B323;" | |
1837 | K IBXDATA D F^IBCEF ("N-PROCED URE CODING METHD",,, IBIFN) | |
1838 | ; Coding method sho uld agree with types of proced ure codes | |
1839 | S IBOK=$S ('$O(IBZPR C(0))!(IBX DATA=""):1 ,1:0) | |
1840 | I 'IBOK S IBOK=1,IB Z=0 F S I BZ=$O(IBZP RC(IBZ)) Q :'IBZ I I BZPRC(IBZ) ,$P(IBZPRC (IBZ),U)'[ $S(IBXDATA =9:"ICD",1 :"ICP") S IBOK=0 Q | |
1841 | I 'IBOK D WARN^IBCB B11("Codin g Method d oes not ag ree with a ll procedu re codes f ound on bi ll") | |
1842 | D EDITMRA ^IBCBB3(.I BQUIT,.IBE R,IBIFN,IB FT) | |
1843 | Q:$G(IBQU IT) | |
1844 | ; | |
1845 | ;Other th ings that could be a dded: Rev Code - ca lculating charges | |
1846 | ; Diagnosis Coding, if MT copay - check fo r other co -payments | |
1847 | ; | |
1848 | I $P(IBND TX,U,8),$$ REQMRA^IBE FUNC(IBIFN ) S IBER=I BER_"IB121 ;" ; can 't force M RAs to pri nt | |
1849 | I $P(IBND TX,U,8)!$P (IBNDTX,U, 9) D | |
1850 | . Q:$P(IB NDTX,U,8)= 2 ; Don 't want to do this f or option 2 any more . | |
1851 | . D WARN^ IBCBB11($S ($$REQMRA^ IBEFUNC(IB IFN)&($P(I BNDTX,U,9) ):"MRA Sec ondary ",1 :"")_"Bill has been forced to print "_$S ($P(IBNDTX ,U,8)=1!($ P(IBNDTX,U ,9)=1):"lo cally",1:" at clearin ghouse")) | |
1852 | N IBXZ,IB IZ F IBIZ= 12,13,14 S IBXZ=$P(I BNDM,U,IBI Z) I +IBXZ S IBXZ=$P ($G(^DPT(D FN,.312,IB XZ,0)),U,1 8) I +IBXZ S IBXZ=$G (^IBA(355. 3,+IBXZ,0) ) I +$P(IB XZ,U,12) D | |
1853 | . D WARN^ IBCBB11($P ($G(^DIC(3 6,+IBXZ,0) ),U,1)_" r equires Am b Care Cer tification ") | |
1854 | ; | |
1855 | D VALNDC^ IBCBB11(IB IFN,DFN) ;validate NDC# | |
1856 | ; | |
1857 | ;Build AR array if no errors and MRA no t needed o r already rec'd | |
1858 | I IBER="" ,$S($$NEED MRA^IBEFUN C(IBIFN)!( $$REQMRA^I BEFUNC(IBI FN)):0,1:1 ) D ARRAY | |
1859 | ; | |
1860 | ;Check RO I | |
1861 | N ROIERR | |
1862 | S ROIERR= 0 I $P($G( ^DGCR(399, IBIFN,"U") ),U,5)=1,+ $P($G(^DGC R(399,IBIF N,"U")),U, 7)=0 S ROI ERR=1 ; sc reen 7 sen sitive rec ord and no ROI | |
1863 | I $$ROICH K^IBCBB11( IBIFN,DFN, +IBNDMP) S ROIERR=1 ; check fi le for sen sitive Rx and missin g ROI | |
1864 | I ROIERR S IBER=IBE R_"IB328;" | |
1865 | ; | |
1866 | ;Verify L ine Charge s Match Cl aim Total Charge. IB *2.0*447 B I | |
1867 | I +$$GET1 ^DIQ(399,I BIFN_",",2 01)'=+$$IB LNTOT^IBCB B13(IBIFN) S IBER=IB ER_"IB344; " | |
1868 | ; | |
1869 | ;Test for valid EIN /SY ID Val ues. IB*2. 0*447 BI | |
1870 | I $$IBSYE I^IBCBB13( IBIFN) S I BER=IBER_" IB345;" | |
1871 | ; | |
1872 | ;Test for a missing ICN. IB*2 .0*447 BI | |
1873 | I $$IBMIC N^IBCBB13( IBIFN) S I BER=IBER_" IB346;" | |
1874 | ; | |
1875 | ;Test for a ZERO ch arge amoun ts. IB*2.0 *447 BI | |
1876 | I $$IBRCC HK^IBCBB13 (IBIFN) D WARN^IBCBB 11("Claim contains r evenue cod es with no associate d charges. ") | |
1877 | ; | |
1878 | ;Test for missing " Patient re ason for v isit". IB* 2.0*447 BI | |
1879 | I $$FT^IB CEF(IBIFN) =3,'$$INPA T^IBCEF(IB IFN),$$IBP RV3^IBCBB1 3(IBIFN) S IBER=IBER _"IB347;" | |
1880 | ; | |
1881 | ;Test for missing P ayer ID. I B*2.0*447 BI | |
1882 | ;I $$IBMP ID^IBCBB13 (IBIFN) S IBER=IBER_ "IB348;" | |
1883 | ;Changed Error to W arning. IB *2.0*447 T AZ | |
1884 | I $$IBMPI D^IBCBB13( IBIFN) D W ARN^IBCBB1 1("Not all payers ha ve Payer I Ds.") | |
1885 | ; | |
1886 | ;Test for missing " Priority ( Type) of A dmission" for UB-04. IB*2.0*44 7 BI | |
1887 | I $$FT^IB CEF(IBIFN) =3,$$GET1^ DIQ(399,IB IFN_",",15 8)="" S IB ER=IBER_"I B349;" | |
1888 | ; | |
1889 | I $$FT^IB CEF(IBIFN) =2 S IBER= IBER_$$CMN CHK^IBCBB1 3(IBIFN) ;JRA;IB*2. 0*608 Chec k for miss ing CMN in fo | |
1890 | ; | |
1891 | END ;Don't kill IBIF N, IBER, D FN | |
1892 | I $O(^TMP ($J,"BILL- WARN",0)), $G(IBER)=" " S IBER=" WARN" ;War nings only | |
1893 | K IBBNO,I BEVDT,IBLO C,IBCL,IBT F,IBAT,IBW HO,IBST,IB FDT,IBTDT, IBTC,IBFY, IBFY1,IBAU ,IBRU,IBEU ,IBARTP,IB FYC,IBMRA, IBTOB,IBTO B12,IBNDU2 ,IBNDUF3,I BNDUF31,IB NDTX | |
1894 | K IBNDS,I BND0,IBNDU ,IBNDM,IBN DMP,IBNDU1 ,IBFFY,IBT FY,IBFT,IB RTCHV,IBPI CHV,IBXDAT A,IBOK | |
1895 | I $D(IBER ),IBER="" W !,"No Er rors found for Natio nal edits" | |
1896 | Q | |
1897 | ; | |
1898 | ARRAY ;Bui ld PRCASV( array) | |
1899 | N IBCOBN, X | |
1900 | K PRCASV | |
1901 | Q:$$MCRWN R^IBEFUNC( +$$CURR^IB CEF2(IBIFN )) | |
1902 | S IBCOBN= $$COBN^IBC EF(IBIFN) | |
1903 | S X=IBIFN | |
1904 | S PRCASV( "BDT")=DT, PRCASV("AR REC")=IBIF N | |
1905 | S PRCASV( "APR")=DUZ | |
1906 | S PRCASV( "PAT")=DFN ,PRCASV("C AT")=$P(^D GCR(399.3, IBAT,0),"^ ",6) | |
1907 | I IBWHO=" i" S PRCAS V("DEBTOR" )=+IBNDMP_ ";DIC(36," | |
1908 | S PRCASV( "DEBTOR")= $S(IBWHO=" p":DFN_";D PT(",IBWHO ="o":$P(IB NDM,"^",11 )_";DIC(4, ",IBWHO="i ":PRCASV(" DEBTOR"),1 :"") | |
1909 | S PRCASV( "CARE")=$E ($$TOB^IBC EF1(IBIFN) ,1,2) | |
1910 | S PRCASV( "FY")=$$FY ^IBOUTL(DT )_U_($P(IB NDU1,U)-$P (IBNDU1,U, 2)) | |
1911 | ;S PRCASV ("FY")=$P( IBNDU1,U,9 )_U_$S($P( IBNDU1,U,2 )]"":($P(I BNDU1,U,10 )-$P(IBNDU 1,U,2)),1: $P(IBNDU1, U,10))_$S( $P(IBNDU1, U,11)]"":U _$P(IBNDU1 ,U,11)_U_$ P(IBNDU1,U ,12),1:"") | |
1912 | PLUS I IBW HO="i",$P( IBNDM,"^", 2),$D(^DIC (36,$P(IBN DM,"^",2), 0)) S PRCA SV("2NDINS ")=$P(IBND M,"^",2) | |
1913 | I IBWHO=" i",$P(IBND M,"^",3),$ D(^DIC(36, $P(IBNDM," ^",3),0)) S PRCASV(" 3RDINS")=$ P(IBNDM,"^ ",3) | |
1914 | ; | |
1915 | N IBX S I BX=$P(IBND 0,U,21),IB X=$S(IBX=" P":"I1",IB X="S":"I2" ,IBX="T":" I3",1:"") Q:IBX="" | |
1916 | N IBNDI1 | |
1917 | Q:'$D(^DG CR(399,IBI FN,IBX)) S IBNDI1=^ (IBX) | |
1918 | S:$P(IBND I1,"^",3)] "" PRCASV( "GPNO")=$P (IBNDI1,"^ ",3) | |
1919 | S:$P(IBND I1,"^",15) ]"" PRCASV ("GPNM")=$ P(IBNDI1," ^",15) | |
1920 | S:$P(IBND I1,"^",17) ]"" PRCASV ("INPA")=$ P(IBNDI1," ^",17) | |
1921 | S:$P(IBND I1,"^",2)] "" PRCASV( "IDNO")=$P (IBNDI1,"^ ",2),PRCAS V("INID")= PRCASV("ID NO") | |
1922 | ; Check t hat this i s a second ary or ter tiary bill and insur ance for p revious | |
1923 | ; COB seq uence is M edicare WN R and MRA is active --> send d ata elemen ts to AR | |
1924 | I IBCOBN> 1,$$WNRBIL L^IBEFUNC( IBIFN,IBCO BN-1),$$ED IACTV^IBCE F4(2) D MR A | |
1925 | Q | |
1926 | ; | |
1927 | MRA N IBEO B S IBEOB= 0 | |
1928 | ; | |
1929 | K PRCASV( "MEDURE"), PRCASV("ME DCA") | |
1930 | ; Get EOB data | |
1931 | F S IBEO B=$O(^IBM( 361.1,"B", IBIFN,IBEO B)) Q:'IBE OB D | |
1932 | . D MRACA LC^IBCEMU2 (IBEOB,IBI FN,1,.PRCA SV) | |
1933 | Q ;MRA | |
1934 | ; | |
1935 | ;; PREGNA NCY DX COD ES: V22**- V24**, V27 **-V28**, 630**-677* * | |
1936 | ;; FLU SH OTS PROCED URE CODES: 90724, G0 008, 90732 , G0009 | |
1937 | ; | |
1938 | NONVAFLG(I BIFN) ; Ch eck if Non -VA bill | |
1939 | ; Functio n returns 1 if Non-V A bill | |
1940 | ; IB*2.0* 554/DRF 10 /9/2015 | |
1941 | N FLAG,PT F | |
1942 | S FLAG=0 | |
1943 | I $P($G(^ DGCR(399,I BIFN,"U2") ),U,10)]"" S FLAG=1 ;Non-VA pr ovider def ined | |
1944 | S PTF=$P( $G(^DGCR(3 99,IBIFN,0 )),U,8) | |
1945 | I PTF,$P( $G(^DGPT(P TF,0)),U,4 )=1 S FLAG =1 ;PTF en try indica tes Non-VA | |
1946 | Q FLAG | |
1947 | ||
1948 | IBCBB13 – Perform th e actual c hecks for missing CM N data (ca lled by IB CBB1) | |
1949 | Routines | |
1950 | Activities | |
1951 | Routine Na me | |
1952 | IBCBB13 | |
1953 | Enhancemen t Category | |
1954 | New | |
1955 | Modify | |
1956 | Delete | |
1957 | No Change | |
1958 | RTM | |
1959 | ||
1960 | Related Op tions | |
1961 | None | |
1962 | Related Ro utines | |
1963 | Routines “ Called By” | |
1964 | Routines “ Called” | |
1965 | ||
1966 | ||
1967 | ||
1968 | ||
1969 | Data Dicti onary (DD) Reference s | |
1970 | ||
1971 | Related Pr otocols | |
1972 | None | |
1973 | Related In tegration Control Re gistration s (ICRs) | |
1974 | None | |
1975 | Data Passi ng | |
1976 | Input | |
1977 | Output Re ference | |
1978 | Both | |
1979 | Global Re ference | |
1980 | Local | |
1981 | Input Attr ibute Name and Defin ition | |
1982 | Name: | |
1983 | Definition : | |
1984 | Output Att ribute Nam e and Defi nition | |
1985 | Name: | |
1986 | Definition : | |
1987 | Current Lo gic | |
1988 | IBCBB13 ;A LB/BI - PR OCEDURE AN D LINE LEV EL PROVIDE R EDITS ;5 -OCT-2011 | |
1989 | ;;2.0;INT EGRATED BI LLING;**44 7**;21-MAR -94;Build 80 | |
1990 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
1991 | Q | |
1992 | ; | |
1993 | IBLNTOT(IB IFN) ; C alculate L ine total charges. IB*2.0*447 BI | |
1994 | N X,SUM S SUM=0 | |
1995 | S X=0 F S X=$O(^DG CR(399,IBI FN,"RC",X) ) Q:+X=0 D | |
1996 | . S SUM=S UM+$P($G(^ DGCR(399,I BIFN,"RC", X,0)),"^", 4) | |
1997 | Q SUM | |
1998 | ; | |
1999 | IBSYEI(IBI FN) ; Te st for val id EIN/SY ID Values. IB*2.0*44 7 BI | |
2000 | N X12CODE ,RESULT,IB PIEN,IBWIE N,IBLIEN | |
2001 | S RESULT= 0 | |
2002 | ; Check C laim Level Providers | |
2003 | S IBWIEN= IBIFN_"," | |
2004 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,128,"I")_ ",",.03) | |
2005 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,122),"-", "")'?9N S RESULT=1 Q RESULT | |
2006 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,129,"I")_ ",",.03) | |
2007 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,123),"-", "")'?9N S RESULT=1 Q RESULT | |
2008 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,130,"I")_ ",",.03) | |
2009 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,124),"-", "")'?9N S RESULT=1 Q RESULT | |
2010 | ; Check C laim Level Providers | |
2011 | S IBPIEN= 0 F S IBP IEN=$O(^DG CR(399,IBI FN,"PRV",I BPIEN)) Q: +IBPIEN=0 Q:RESULT= 1 D | |
2012 | .S IBWIEN =IBPIEN_", "_IBIFN_", " | |
2013 | .; Test f or each pr ovider lis ted. | |
2014 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.12 ,"I")_",", .03) | |
2015 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.05 ),"-","")' ?9N S RESU LT=1 Q | |
2016 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.13 ,"I")_",", .03) | |
2017 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.06 ),"-","")' ?9N S RESU LT=1 Q | |
2018 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.14 ,"I")_",", .03) | |
2019 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.07 ),"-","")' ?9N S RESU LT=1 Q | |
2020 | ; Check L ine Level Providers | |
2021 | ; For eac h charge c ode / line . | |
2022 | S IBLIEN= 0 F S IBL IEN=$O(^DG CR(399,IBI FN,"CP",IB LIEN)) Q:+ IBLIEN=0 Q:RESULT=1 D | |
2023 | .; For ea ch provide r associat ed with th e line. | |
2024 | .S IBPIEN =0 F S IB PIEN=$O(^D GCR(399,IB IFN,"CP",I BLIEN,"LNP RV",IBPIEN )) Q:+IBPI EN=0 Q:RE SULT=1 D | |
2025 | ..S IBWIE N=IBPIEN_" ,"_IBLIEN_ ","_IBIFN_ "," | |
2026 | ..; Test for each p rovider li sted. | |
2027 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 2,"I")_"," ,.03) | |
2028 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 5),"-","") '?9N S RES ULT=1 Q | |
2029 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 3,"I")_"," ,.03) | |
2030 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 6),"-","") '?9N S RES ULT=1 Q | |
2031 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 4,"I")_"," ,.03) | |
2032 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 7),"-","") '?9N S RES ULT=1 Q | |
2033 | Q RESULT | |
2034 | ; | |
2035 | IBMICN(IBI FN) ; Te st for a m issing ICN . IB*2.0*4 47 BI | |
2036 | N IBTFOB ; TIMEFRAM E OF BILL | |
2037 | N IBCBPS ; CURRENT BILL PAYER SEQUENCE, P-PRI, S- SEC, T-TER , A-PATIEN T | |
2038 | S IBTFOB= $$GET1^DIQ (399,IBIFN _",",.06," I") | |
2039 | I '((IBTF OB=7)!(IBT FOB=8)) Q 0 | |
2040 | S IBCBPS= $$GET1^DIQ (399,IBIFN _",",.21," I") | |
2041 | I IBCBPS= "P",$$GET1 ^DIQ(399,I BIFN_",",1 01)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",453)="" Q 1 | |
2042 | I IBCBPS= "S",$$GET1 ^DIQ(399,I BIFN_",",1 02)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",454)="" Q 1 | |
2043 | I IBCBPS= "T",$$GET1 ^DIQ(399,I BIFN_",",1 03)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",455)="" Q 1 | |
2044 | Q 0 | |
2045 | ; | |
2046 | IBRCCHK(IB IFN) ; T est for a ZERO charg e amounts. IB*2.0*44 7 BI | |
2047 | N IBN0 | |
2048 | N IBRCCNT S IBRCCNT =0 | |
2049 | N IBRCCHG S IBRCCHG =0 | |
2050 | F S IBRC CNT=$O(^DG CR(399,IBI FN,"RC",IB RCCNT)) Q: +IBRCCNT=0 Q:IBRCCH G=1 D | |
2051 | .S IBN0=$ G(^DGCR(39 9,IBIFN,"R C",IBRCCNT ,0)) | |
2052 | .I $P(IBN 0,U,1)'="" ,+$P(IBN0, U,4)=0 S I BRCCHG=1 | |
2053 | Q IBRCCHG | |
2054 | ; | |
2055 | IBPRV3(IBI FN) ; Te st for mis sing "Pati ent reason for visit ". IB*2.0* 447 BI | |
2056 | I $$GET1^ DIQ(399,IB IFN_",",24 9)="",$$GE T1^DIQ(399 ,IBIFN_"," ,250)="",$ $GET1^DIQ( 399,IBIFN_ ",",251)=" " Q 1 | |
2057 | Q 0 | |
2058 | ; | |
2059 | IBMPID(IBI FN) ; Te st for mul tiple paye rs. IB*2.0 *447 BI | |
2060 | N IBPAY1 S IBPAY1=$ $GET1^DIQ( 399,IBIFN_ ",",101,"I ") | |
2061 | N IBPAY2 S IBPAY2=$ $GET1^DIQ( 399,IBIFN_ ",",102,"I ") | |
2062 | N IBPAY3 S IBPAY3=$ $GET1^DIQ( 399,IBIFN_ ",",103,"I ") | |
2063 | N IBCNT S IBCNT=0 | |
2064 | S:IBPAY1 IBCNT=IBCN T+1 S:IBPA Y2 IBCNT=I BCNT+1 S:I BPAY3 IBCN T=IBCNT+1 I IBCNT<2 Q 0 | |
2065 | N IBINSTI T S IBINST IT=$$INSPR F^IBCEF(IB IFN) | |
2066 | I IBPAY1, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y1_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY1_",", 3.02))="" Q 1 | |
2067 | I IBPAY2, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y2_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY2_",", 3.02))="" Q 1 | |
2068 | I IBPAY3, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y3_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY3_",", 3.02))="" Q 1 | |
2069 | Q 0 | |
2070 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
2071 | IBCBB13 ;A LB/BI - PR OCEDURE AN D LINE LEV EL PROVIDE R EDITS ;5 -OCT-2011 | |
2072 | ;;2.0;INT EGRATED BI LLING;**44 7,608**;21 -MAR-94;Bu ild 40 | |
2073 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
2074 | Q | |
2075 | ; | |
2076 | IBLNTOT(IB IFN) ; C alculate L ine total charges. IB*2.0*447 BI | |
2077 | N X,SUM S SUM=0 | |
2078 | S X=0 F S X=$O(^DG CR(399,IBI FN,"RC",X) ) Q:+X=0 D | |
2079 | . S SUM=S UM+$P($G(^ DGCR(399,I BIFN,"RC", X,0)),"^", 4) | |
2080 | Q SUM | |
2081 | ; | |
2082 | IBSYEI(IBI FN) ; Te st for val id EIN/SY ID Values. IB*2.0*44 7 BI | |
2083 | N X12CODE ,RESULT,IB PIEN,IBWIE N,IBLIEN | |
2084 | S RESULT= 0 | |
2085 | ; Check C laim Level Providers | |
2086 | S IBWIEN= IBIFN_"," | |
2087 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,128,"I")_ ",",.03) | |
2088 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,122),"-", "")'?9N S RESULT=1 Q RESULT | |
2089 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,129,"I")_ ",",.03) | |
2090 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,123),"-", "")'?9N S RESULT=1 Q RESULT | |
2091 | S X12CODE =$$GET1^DI Q(355.97,$ $GET1^DIQ( 399,IBWIEN ,130,"I")_ ",",.03) | |
2092 | I ((X12CO DE="SY")!( X12CODE="E I")),$TR($ $GET1^DIQ( 399,IBWIEN ,124),"-", "")'?9N S RESULT=1 Q RESULT | |
2093 | ; Check C laim Level Providers | |
2094 | S IBPIEN= 0 F S IBP IEN=$O(^DG CR(399,IBI FN,"PRV",I BPIEN)) Q: +IBPIEN=0 Q:RESULT= 1 D | |
2095 | .S IBWIEN =IBPIEN_", "_IBIFN_", " | |
2096 | .; Test f or each pr ovider lis ted. | |
2097 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.12 ,"I")_",", .03) | |
2098 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.05 ),"-","")' ?9N S RESU LT=1 Q | |
2099 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.13 ,"I")_",", .03) | |
2100 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.06 ),"-","")' ?9N S RESU LT=1 Q | |
2101 | .S X12COD E=$$GET1^D IQ(355.97, $$GET1^DIQ (399.0222, IBWIEN,.14 ,"I")_",", .03) | |
2102 | .I ((X12C ODE="SY")! (X12CODE=" EI")),$TR( $$GET1^DIQ (399.0222, IBWIEN,.07 ),"-","")' ?9N S RESU LT=1 Q | |
2103 | ; Check L ine Level Providers | |
2104 | ; For eac h charge c ode / line . | |
2105 | S IBLIEN= 0 F S IBL IEN=$O(^DG CR(399,IBI FN,"CP",IB LIEN)) Q:+ IBLIEN=0 Q:RESULT=1 D | |
2106 | .; For ea ch provide r associat ed with th e line. | |
2107 | .S IBPIEN =0 F S IB PIEN=$O(^D GCR(399,IB IFN,"CP",I BLIEN,"LNP RV",IBPIEN )) Q:+IBPI EN=0 Q:RE SULT=1 D | |
2108 | ..S IBWIE N=IBPIEN_" ,"_IBLIEN_ ","_IBIFN_ "," | |
2109 | ..; Test for each p rovider li sted. | |
2110 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 2,"I")_"," ,.03) | |
2111 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 5),"-","") '?9N S RES ULT=1 Q | |
2112 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 3,"I")_"," ,.03) | |
2113 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 6),"-","") '?9N S RES ULT=1 Q | |
2114 | ..S X12CO DE=$$GET1^ DIQ(355.97 ,$$GET1^DI Q(399.0404 ,IBWIEN,.1 4,"I")_"," ,.03) | |
2115 | ..I ((X12 CODE="SY") !(X12CODE= "EI")),$TR ($$GET1^DI Q(399.0404 ,IBWIEN,.0 7),"-","") '?9N S RES ULT=1 Q | |
2116 | Q RESULT | |
2117 | ; | |
2118 | IBMICN(IBI FN) ; Te st for a m issing ICN . IB*2.0*4 47 BI | |
2119 | N IBTFOB ; TIMEFRAM E OF BILL | |
2120 | N IBCBPS ; CURRENT BILL PAYER SEQUENCE, P-PRI, S- SEC, T-TER , A-PATIEN T | |
2121 | S IBTFOB= $$GET1^DIQ (399,IBIFN _",",.06," I") | |
2122 | I '((IBTF OB=7)!(IBT FOB=8)) Q 0 | |
2123 | S IBCBPS= $$GET1^DIQ (399,IBIFN _",",.21," I") | |
2124 | I IBCBPS= "P",$$GET1 ^DIQ(399,I BIFN_",",1 01)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",453)="" Q 1 | |
2125 | I IBCBPS= "S",$$GET1 ^DIQ(399,I BIFN_",",1 02)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",454)="" Q 1 | |
2126 | I IBCBPS= "T",$$GET1 ^DIQ(399,I BIFN_",",1 03)'="",$$ GET1^DIQ(3 99,IBIFN_" ,",455)="" Q 1 | |
2127 | Q 0 | |
2128 | ; | |
2129 | IBRCCHK(IB IFN) ; T est for a ZERO charg e amounts. IB*2.0*44 7 BI | |
2130 | N IBN0 | |
2131 | N IBRCCNT S IBRCCNT =0 | |
2132 | N IBRCCHG S IBRCCHG =0 | |
2133 | F S IBRC CNT=$O(^DG CR(399,IBI FN,"RC",IB RCCNT)) Q: +IBRCCNT=0 Q:IBRCCH G=1 D | |
2134 | .S IBN0=$ G(^DGCR(39 9,IBIFN,"R C",IBRCCNT ,0)) | |
2135 | .I $P(IBN 0,U,1)'="" ,+$P(IBN0, U,4)=0 S I BRCCHG=1 | |
2136 | Q IBRCCHG | |
2137 | ; | |
2138 | IBPRV3(IBI FN) ; Te st for mis sing "Pati ent reason for visit ". IB*2.0* 447 BI | |
2139 | I $$GET1^ DIQ(399,IB IFN_",",24 9)="",$$GE T1^DIQ(399 ,IBIFN_"," ,250)="",$ $GET1^DIQ( 399,IBIFN_ ",",251)=" " Q 1 | |
2140 | Q 0 | |
2141 | ; | |
2142 | IBMPID(IBI FN) ; Te st for mul tiple paye rs. IB*2.0 *447 BI | |
2143 | N IBPAY1 S IBPAY1=$ $GET1^DIQ( 399,IBIFN_ ",",101,"I ") | |
2144 | N IBPAY2 S IBPAY2=$ $GET1^DIQ( 399,IBIFN_ ",",102,"I ") | |
2145 | N IBPAY3 S IBPAY3=$ $GET1^DIQ( 399,IBIFN_ ",",103,"I ") | |
2146 | N IBCNT S IBCNT=0 | |
2147 | S:IBPAY1 IBCNT=IBCN T+1 S:IBPA Y2 IBCNT=I BCNT+1 S:I BPAY3 IBCN T=IBCNT+1 I IBCNT<2 Q 0 | |
2148 | N IBINSTI T S IBINST IT=$$INSPR F^IBCEF(IB IFN) | |
2149 | I IBPAY1, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y1_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY1_",", 3.02))="" Q 1 | |
2150 | I IBPAY2, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y2_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY2_",", 3.02))="" Q 1 | |
2151 | I IBPAY3, $S(IBINSTI T:$$GET1^D IQ(36,IBPA Y3_",",3.0 4),1:$$GET 1^DIQ(36,I BPAY3_",", 3.02))="" Q 1 | |
2152 | Q 0 | |
2153 | ; | |
2154 | CMNCHK(IBI FN) ;JRA;I B*2.0*608 Check for missing re quired Cer tificate o f Medical Necessity (CMN) data | |
2155 | ; Input : IBIFN = I EN of the Bill/Claim (D399) | |
2156 | ; Output: IBER = N ULL if no errors | |
2157 | ; = S tring of I B Error Me ssage code s delimite d by ';' | |
2158 | ; => Note that the return value is appended t o the 'IBE R' variabl e in routi ne ^IBCBB1 | |
2159 | Q:IBIFN=" " "" | |
2160 | N CERTYP, CMNNODE,CM NREQ,DA,DI E,ERR,FRMN AM,FRMIEN, FORM,FRMTY P,IBER,IBP ROCP,PROCN UM | |
2161 | S IBER="" | |
2162 | ;Set up a rray of ea ch existin g Form Typ e (i.e. Fo rm IENs) a nd associa ted ^DGCR data node. | |
2163 | S FRMNAM= "" F S FR MNAM=$O(^I BE(399.6," B",FRMNAM) ) Q:FRMNAM ="" S FRM IEN=+$O(^I BE(399.6," B",FRMNAM, "")) I FRM IEN D | |
2164 | . S FORM( FRMIEN)=$P ($G(^IBE(3 99.6,FRMIE N,0)),U,4) | |
2165 | ;Loop thr u all proc edures on the claim searching for missin g CMN data | |
2166 | S IBPROCP =0 F S IB PROCP=$O(^ DGCR(399,I BIFN,"CP", IBPROCP)) Q:'IBPROCP D Q:IBE R]"" | |
2167 | . ;If "CM N Required ?" is NULL then QUIT w/out fur ther check ing | |
2168 | . S CMNRE Q=$$CVALCH K(IBPROCP, 23,,"I") Q :CMNREQ="" | |
2169 | . I 'CMNR EQ,$D(FORM )>1 D Q ;"CMN Requ ired?" fla gged as "N O" so chec k if data node(s) ex ist anyway for at le ast 1 form | |
2170 | . . S ERR =0,FRMIEN= "" F S FR MIEN=$O(FO RM(FRMIEN) ) Q:FRMIEN ="" I FOR M(FRMIEN)] "" D Q:ER R | |
2171 | . . . S C MNNODE="^D GCR(399,"_ IBIFN_","" CP"","_IBP ROCP_",""" _FORM(FRMI EN)_""")" I $D(@CMNN ODE) S ERR =1,IBER=IB ER_"IB901; " | |
2172 | . S FRMTY P=$$CVALCH K(IBPROCP, 24,"IB902" ,"I") Q:'F RMTYP ;Ch eck for "C MN FORM TY PE" (Inter nal value) | |
2173 | . I $G(FO RM(FRMTYP) )]"" D Q: ERR | |
2174 | . . ;Chec k if any d ata exists at the no de specifi c to the F orm Type | |
2175 | . . S ERR =0,CMNNODE ="^DGCR(39 9,"_IBIFN_ ",""CP""," _IBPROCP_" ,"""_FORM( FRMTYP)_"" ")" | |
2176 | . . I '$D (@CMNNODE) S ERR=1,I BER=IBER_" IB903;" Q | |
2177 | . . Q:FOR M(FRMTYP)' [10126 | |
2178 | . . N ND1 0126 | |
2179 | . . S ND1 0126=@CMNN ODE | |
2180 | . . I $P( ND10126,U, 17)]"" S $ P(ND10126, U,17)="" I $TR(ND101 26,U)="" S ERR=1,IBE R=IBER_"IB 903;" | |
2181 | . ;Check if any dat a exists f or at leas t 1 node o ther than that assoc iated with the Form Type | |
2182 | . S ERR=0 ,FRMIEN="" F S FRMI EN=$O(FORM (FRMIEN)) Q:FRMIEN=" " I FRMIE N'=FRMTYP, FORM(FRMIE N)]"" D Q :ERR | |
2183 | . . S CMN NODE="^DGC R(399,"_IB IFN_",""CP "","_IBPRO CP_","""_F ORM(FRMIEN )_""")" I $D(@CMNNOD E) S ERR=1 ,IBER=IBER _"IB904;" | |
2184 | . ;Check for Requir ed fields at the dat a node com mon to all forms (no de 'CMN') | |
2185 | . S CERTY P=$$CVALCH K(IBPROCP, 24.01,"IB9 05","I") Q :CERTYP="" ;Check f or "CMN CE RTIFICATIO N TYPE" | |
2186 | . D CVALC HK(IBPROCP ,24.05,"IB 907","I") ;Check fo r "CMN DAT E THERAPY STARTED" | |
2187 | . D CVALC HK(IBPROCP ,24.06,"IB 908","I") ;Check fo r "CMN LAS T CERTIFIC ATION DATE " | |
2188 | . ;IF Cer tificate T ype is "RE NEWAL" (R) or "REVIS ED" (S) th en "CMN RE CERTIFICAT ION/REVISN DT" is Re quired. | |
2189 | . I CERTY P="R"!(CER TYP="S") D CVALCHK(I BPROCP,24. 07,"IB909" ,"I") | |
2190 | . ; | |
2191 | . ;Check for requir ed fields specific t o the CMN- 484 form | |
2192 | . I FORM( FRMTYP)[48 4 D ;Chec k for requ ired field s/dates | |
2193 | . . I $$C VALCHK(IBP ROCP,24.1, ,"I")]""!( $$CVALCHK( IBPROCP,24 .102,,"I") ]"") D CVA LCHK(IBPRO CP,24.103, "IB912","I ") | |
2194 | . . I $$C VALCHK(IBP ROCP,24.11 1,,"I")]"" !($$CVALCH K(IBPROCP, 24.113,,"I ")]"") D C VALCHK(IBP ROCP,24.11 4,"IB914", "I") | |
2195 | . ; | |
2196 | . ;Check for requir ed fields specific t o the CMN- 10126 form | |
2197 | . I FORM( FRMTYP)[10 126 D | |
2198 | . . D CVA LCHK(IBPRO CP,24.217, "IB906","I ") | |
2199 | . . N PRO CMSG | |
2200 | . . S PRO CMSG="CMN ""Procedur e ",PROCMS G(1)=""" h as no asso ciated Cal ories." | |
2201 | . . I $$C VALCHK(IBP ROCP,24.20 4,,"I")]"" ,'$$CVALCH K(IBPROCP, 24.203,,"I ") D WARN^ IBCBB11(PR OCMSG_"A"_ PROCMSG(1) ) | |
2202 | . . I $$C VALCHK(IBP ROCP,24.21 9,,"I")]"" ,'$$CVALCH K(IBPROCP, 24.218,,"I ") D WARN^ IBCBB11(PR OCMSG_"B"_ PROCMSG(1) ) | |
2203 | ; | |
2204 | I IBER]"" S IBER="I B915;"_IBE R | |
2205 | Q IBER | |
2206 | ; | |
2207 | CVALCHK(IB PROCP,FLD, ERROR,FLG) ;JRA;IB*2 .0*608 Che ck value o f CMN fiel d & append Error Cod e (if any) to list o f errors | |
2208 | Q:($G(FLD )=""!('$G( IBPROCP))) | |
2209 | N VAL | |
2210 | S VAL=$$C MNDATA^IBC EF31(IBIFN ,IBPROCP,F LD,$G(FLG) ) | |
2211 | I $G(ERRO R)]"",VAL= "" S IBER= IBER_ERROR _";" | |
2212 | Q VAL | |
2213 | ; | |
2214 | ||
2215 | ||
2216 | VII) Use DR Prompti ng to coll ect CMN in formation: | |
2217 | IBCU7 – Ca lls new ro utine IBCU 75 to prom pt user fo r CMN info (due to l arge size of IBCU7) | |
2218 | Routines | |
2219 | Activities | |
2220 | Routine Na me | |
2221 | IBCU7 | |
2222 | Enhancemen t Category | |
2223 | New | |
2224 | Modify | |
2225 | Delete | |
2226 | No Change | |
2227 | RTM | |
2228 | ||
2229 | Related Op tions | |
2230 | None | |
2231 | Related Ro utines | |
2232 | Routines “ Called By” | |
2233 | Routines “ Called” | |
2234 | ||
2235 | ||
2236 | ||
2237 | ||
2238 | Data Dicti onary (DD) Reference s | |
2239 | ||
2240 | Related Pr otocols | |
2241 | None | |
2242 | Related In tegration Control Re gistration s (ICRs) | |
2243 | None | |
2244 | Data Passi ng | |
2245 | Input | |
2246 | Output Re ference | |
2247 | Both | |
2248 | Global Re ference | |
2249 | Local | |
2250 | Input Attr ibute Name and Defin ition | |
2251 | Name: | |
2252 | Definition : | |
2253 | Output Att ribute Nam e and Defi nition | |
2254 | Name: | |
2255 | Definition : | |
2256 | Current Lo gic | |
2257 | IBCU7 ;ALB /AAS - INT ERCEPT SCR EEN INPUT OF PROCEDU RE CODES ; 29-OCT-91 | |
2258 | ;;2.0;INT EGRATED BI LLING;**62 ,52,106,12 5,51,137,2 10,245,228 ,260,348,3 71,432,447 ,488,461,5 16,522,577 ,592**;21- MAR-94;Bui ld 25 | |
2259 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
2260 | ; | |
2261 | ;MAP TO D GCRU7 | |
2262 | ; | |
2263 | CHKX ; -i nterceptio n of input x from Ad ditional P rocedure i nput | |
2264 | G:X=" " C HKXQ | |
2265 | I $$INPAT ^IBCEF(DA( 1)),'$P($G (^IBE(350. 9,1,1)),"^ ",15),X'?1 A1.2N D G CHKXQ | |
2266 | . K X | |
2267 | . D EN^DD IOL("Site param does not allow entry of non-PTF pr ocedures") ;Fileman error here will be: The previo us error o ccurred wh en perform ing an act ion specif ied in a P re-lookup transform (7.5 node) . | |
2268 | G:'$D(^UT ILITY($J," IB")) CHKX Q | |
2269 | ;S M=($A( $E(X,1))-6 4),S=+$E(X ,2) Q:'$G( ^UTILITY($ J,"IB",M,S )) S X="` "_+^(S) | |
2270 | S M=0 I X ?1A1.2N S N=$G(^UTIL ITY($J,"IB ","B",X)) S M=+N,S=+ $P(N,U,2), P=X S S=$G (^UTILITY( $J,"IB",M, S)) I +S S X="`"_+S I $P(N,U,3 )="N" S X= """"_X_""" " S $P(^UT ILITY($J," IB","B",P) ,U,3)="Y" | |
2271 | I +M,$D(D GPROCDT),D GPROCDT'=$ P($G(^UTIL ITY($J,"IB ",M,1)),"^ ",2) S DGP ROCDT=$P(^ (1),"^",2) W !!,"Pro cedure Dat e: " S Y=D GPROCDT X ^DD("DD") W Y,! | |
2272 | CHKXQ Q | |
2273 | ; | |
2274 | CODMUL ;Da te oriente d entry of procedure | |
2275 | DELASK I $ D(IBZ20),I BZ20,IBZ20 '=$P(^DGCR (399,IBIFN ,0),U,9) S %=2 W !," SINCE THE PROCEDURE CODING MET HOD HAS BE EN CHANGED , DO YOU W ANT TO DEL ETE ALL",! ,"PROCEDUR E CODES IN THIS BILL " | |
2276 | I D YN^D ICN Q:%=-1 D:%=1 DE LADD I %Y? 1."?" W !! ,"If you a nswer 'Yes ', all pro cedure cod es will be DELETED f rom this b ill.",! G DELASK | |
2277 | K %,%Y,DA ,IBZ20,DIK ;W !,"Pro cedure Ent ry:" | |
2278 | ; | |
2279 | CODDT I $D (IBIFN),$D (^DGCR(399 ,IBIFN,0)) ,$P(^(0),U ,9) S DIC( "V")=$S($P (^(0),U,9) =9:"I +Y(0 )=80.1",$P (^(0),U,9) =4!($P(^(0 ),U,9)=5): "I +Y(0)=8 1",1:"") | |
2280 | I $P($G(^ DGCR(399,I BIFN,0))," ^",5)<3 S IBZTYPE=1 I $P($G(^U TILITY($J, "IB",1,1)) ,"^",2) S DGPROCDT=$ P(^(1),"^" ,2) D ASKC OD | |
2281 | S X=$$PRC DIV^IBCU71 (IBIFN) I +X W !!,$P (X,U,2),! | |
2282 | N Z,Z0 S Z=$G(^DGCR (399,IBIFN ,"U")),Z0= $$FMTE^XLF DT($P(Z,U) ,"2D")_"-" _$$FMTE^XL FDT($P(Z,U ,2),"2D") | |
2283 | W !,"Sele ct PROCEDU RE DATE"_$ S($TR(Z0," -")'="":" ("_Z0_")", 1:"")_": " R X:DTIME G:'$T!("^ "[X) CODQ D:X["?" CO DHLP | |
2284 | S IBEX=0 D ; Get p rocedure d ate | |
2285 | . I X=" " ,$D(DGPROC DT),DGPROC DT?7N S Y= DGPROCDT D D^DIQ W " (",Y,") " Q | |
2286 | . I X=" " ,+$P($G(^D GCR(399,IB IFN,"OP",0 )),"^",4) S (DGPROCD T,Y)=$O(^D GCR(399,IB IFN,"OP",0 )) D D^DIQ W " (", Y,")" Q | |
2287 | . S %DT=" EXP",%DT(0 )=-DT D ^% DT K %DT I Y<1 S IBE X=1 Q | |
2288 | . I '$$OP V2^IBCU41( Y,IBIFN,1) S IBEX=1 Q | |
2289 | . S:'$G(I BZTYPE) X= $$OPV^IBCU 41(Y,IBIFN ) S DGPROC DT=Y | |
2290 | I 'IBEX D ASKCOD,AD DCPT^IBCU7 1:$D(DGCPT ) | |
2291 | K IBEX | |
2292 | G CODDT | |
2293 | ; | |
2294 | ASKCOD N Z ,Z0,DA,IBA CT,IBQUIT, IBLNPRV ; WCJ;2.0*43 2 | |
2295 | N IBPOPOU T S IBPOP OUT=0 ; I B*2.0*447 BI | |
2296 | K DGCPT | |
2297 | S DGCPT=0 ,DGCPTUP=$ P($G(^IBE( 350.9,1,1) ),"^",19), DGADDVST=0 ,IBFT=$P($ G(^DGCR(39 9,IBIFN,0) ),"^",19) | |
2298 | I '$D(^DG CR(399,IBI FN,"CP",0) ) S ^DGCR( 399,IBIFN, "CP",0)=U_ $$GETSPEC^ IBEFUNC(39 9,304) | |
2299 | ; | |
2300 | F S IBQU IT=0 D Q: IBQUIT | |
2301 | . S IBPOP OUT=0 | |
2302 | . D DICV ; restrict code type to PCM | |
2303 | . S DIC(" A")=" Se lect PROCE DURE: " | |
2304 | . S DIC=" ^DGCR(399, "_IBIFN_", ""CP""," | |
2305 | . S DIC(0 )="AEQMNL" | |
2306 | . S DIC(" S")="I '$D (DIV(""S"" ))&($P(^(0 ),U,2)=DGP ROCDT)" | |
2307 | . S DIC(" DR")="1/// ^S X=DGPRO CDT" | |
2308 | . S DA(1) =IBIFN,DLA YGO=399 | |
2309 | . W ! D ^ DIC I Y<1 S IBQUIT=1 Q | |
2310 | . S IBPRO CP=+Y | |
2311 | . ; If we just adde d inactive code - it must be d eleted. | |
2312 | . S IBACT =0 ; Activ e flag | |
2313 | . I Y["IC D0" S IBAC T=$$ICD0AC T^IBACSV(+ $P(Y,U,2), $$BDATE^IB ACSV(IBIFN )) | |
2314 | . I Y["IC PT" S IBAC T=$$CPTACT ^IBACSV(+$ P(Y,U,2),D GPROCDT) | |
2315 | . S DGCPT NEW=$P(Y," ^",3) ;Was the proce dure just added? | |
2316 | . I DGCPT NEW,'IBACT D DELPROC Q | |
2317 | . I 'IBAC T W !,*7," Warning: Procedure code is in active on this date" ,! | |
2318 | . I DGCPT NEW,$D(^UT ILITY($J," IB")),$$IN PAT^IBCEF( IBIFN),Y[" ICPT(" D D ATA^IBCU74 (Y,.IBLNPR V) | |
2319 | . S DGADD VST=$S(DGC PTNEW:1,$D (DGADDVST) :DGADDVST, 1:0) | |
2320 | . N IBPRV ,IBPRVO,IB PRVN | |
2321 | . ; | |
2322 | . ; Line level prov ider funct ion by for m type. | |
2323 | . ; C MS-1500 (F ORM TYPE=2 ) | |
2324 | . ; RE NDERING PR OVIDER, RE FERRING PR OVIDER, | |
2325 | . ; an d SUPERVIS ING PROVID ER. | |
2326 | . ; U B-04 (FORM TYPE=3) | |
2327 | . ; RE NDERING PR OVIDER, RE FERRING PR OVIDER, | |
2328 | . ; OP ERATING PR OVIDER, an d OTHER OP ERATING | |
2329 | . ; PR OVIDER. | |
2330 | . ; | |
2331 | . ; Remov ed: Call t o $$MAINPR V^IBCEU(IB IFN) is fo r claim | |
2332 | . ; level provider d efaults. | |
2333 | . ; 1 . For new line level providers we don't need | |
2334 | . ; or want default cl aim level provider | |
2335 | . ; (require ment). | |
2336 | . ; 2 . We don't want to d efault cla im level t o | |
2337 | . ; line lev el provide r (require ment). | |
2338 | . ; | |
2339 | . K DIC(" V") ; DEM ;432 - KIL L DIC("V") because t his was fo r previous variable pointer us e. | |
2340 | . ; | |
2341 | . N IBPRO CSV ; DEM ;432 - Var iable IBPR OCSV is va riable to preserve v alue of 'Y ', which i s procedur e code inf o returned by call t o ^DIC. | |
2342 | . S IBPRO CSV=Y ; D EM;432 - P reserve va lue of Y f or after c alls to Fi leMan (Y = procedure code info returned by call to ^DIC). | |
2343 | . K DR ;WCJ;IB*2. 0*432 | |
2344 | . ; | |
2345 | . I IBPRO CSV["ICD0" S DR=".01 ",DIE=DIC, (IBPROCP,D A)=+Y D ^D IE Q:'$D(D A)!($D(Y)) K DR ; I B*2.0*461 | |
2346 | . ; | |
2347 | . I IBPRO CSV["ICPT" S DR=".01 ;16",DIE=D IC,(IBPROC P,DA)=+Y D ^DIE Q:'$ D(DA)!($D( Y)) K DR ; IB*2.0*4 47 BI | |
2348 | . ; | |
2349 | . S DR="" | |
2350 | . ; | |
2351 | . ; MRD;I B*2.0*516 - Added li ne level P ROCEDURE D ESCRIPTION field, | |
2352 | . ; asked only if t he procedu re is an " NOC". | |
2353 | . I IBPRO CSV["ICPT" ,$$NOCPROC (IBPROCSV) D | |
2354 | . . S DA= $P(IBPROCS V,"^") ; The line# on the bil l/claim. | |
2355 | . . S DR= 51 ; Field# for PROCEDURE DESCRIPTI ON | |
2356 | . . D ^DI E | |
2357 | . . Q | |
2358 | . ; | |
2359 | . D EN^IB CU7B ; DEM ;432 - Cal l to line level prov ider user input. | |
2360 | . S Y=IBP ROCSV ; D EM;432 - R estore val ue of Y af ter calls to FileMan | |
2361 | . K IBPRO CSV | |
2362 | . K DR ;WCJ;IB*2. 0*432 | |
2363 | . I IBPOP OUT Q ; IB*2.0*447 BI | |
2364 | . S DR="" I Y["ICPT " S DR="6; 5//"_$$DEF DIV(IBIFN) _";" | |
2365 | . ;JWS;IB *2.0*592 U S1108 - De ntal | |
2366 | . ;IA# 10 018 | |
2367 | . S DR=DR _$S(IBFT=7 :"8;9//;", IBFT=2:"8; 9;17//NO;" ,1:"")_3,D IE=DIC,(IB PROCP,DA)= +Y D ^DIE Q:'$D(DA)! ($E($G(Y)) =U) | |
2368 | . K DR ;WCJ;IB*2. 0*432 | |
2369 | . ; | |
2370 | . ; MRD;I B*2.0*516 - Allow us er to add an NDC and Units. A sk only if | |
2371 | . ; codin g system i s not ICD and this i s not a pr escription claim. If | |
2372 | . ; an ND C is enter ed, prompt for Units . | |
2373 | . I $P($G (^DGCR(399 ,IBIFN,0)) ,U,9)'=9,' $$RXLINK^I BCSC5C(IBI FN,IBPROCP ) D | |
2374 | . . ;JWS; IB*2.0*592 US1108 - Dental | |
2375 | . . I IBF T=7 Q | |
2376 | . . K DA | |
2377 | . . S DA= IBPROCP,DA (1)=IBIFN, DIE="^DGCR (399,"_IBI FN_",""CP" "," | |
2378 | . . ; vd/ Beginning IB*2*577 - Added the prompt fo r Unit/Bas is of Meas urement. | |
2379 | . . ; S D R="53NDC N UMBER;I X= """" S Y=" """;54//1" | |
2380 | . . S DR= "53NDC NUM BER;I X="" "" S Y=""" ";52//UN;5 4QUANTITY/ /1" ;Prom pt for NDC , UN & amt . | |
2381 | . . ; vd/ Ending IB* 2*577 | |
2382 | . . D ^DI E | |
2383 | . . Q | |
2384 | . ; | |
2385 | . I IBFT= 3 D:'$$INP AT^IBCEF(I BIFN) ATTA CH ; DEM; 432 - Prom pt for Att achment Co ntrol Numb er. | |
2386 | . ; DEM;4 32 - Add A dditional OB Minutes to DR str ing for ca ll to DIE. | |
2387 | . S DR=$$ SPCUNIT(IB IFN,IBPROC P) S:DR["1 5;" DR=DR_ "74Additio nal OB Min utes" D ^D IE ; miles /minutes/h ours | |
2388 | . ;JWS;IB *2.0*592 U S1108 - De ntal | |
2389 | . I IBFT= 2!(IBFT=7) D | |
2390 | .. D DX^I BCU72(IBIF N,IBPROCP) | |
2391 | .. ;JWS;I B*2.0*592 US1108 - D ental | |
2392 | .. I IBFT '=7 S X=$$ ADDTNL(IBI FN,.DA) | |
2393 | . Q:$$INP AT^IBCEF(I BIFN) ;on ly outpati ent bills | |
2394 | . ;JWS;IB *2.0*592 U S1108 - De ntal input fields | |
2395 | . I $$FT^ IBCEF(IBIF N)=7 D ORA L^IBCU72 | |
2396 | . ;add pr ocedures t o array fo r download to PCE: d gcpt(assoc clinic,cp t,'provide r^first dx ^modifiers ',cnt)="" | |
2397 | . S DGPRO C=$G(^DGCR (399,IBIFN ,"CP",+DA, 0)) | |
2398 | . S X=$P( DGPROC,U,1 8)_U_+$G(^ IBA(362.3, +$P(DGPROC ,U,11),0)) _U_$P(DGPR OC,U,15) | |
2399 | . I 'DGCP TNEW,$P(DG PROC,"^",7 )="" S DGC PTNEW=2 | |
2400 | . I DGCPT UP,DGCPTNE W S DGCPT= DGCPT+1 I $P(DGPROC, "^",7) S D GCPT($P(DG PROC,"^",7 ),+DGPROC, X,DGCPT)=" " | |
2401 | . ; add v isit date to bill | |
2402 | . I DGADD VST S (X,D INUM)=DGPR OCDT D VFI LE1^IBCOPV 1 K DINUM, X,DGNOADD, DGADDVST | |
2403 | ; Delete modifiers with only a sequence #, no cod e | |
2404 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"CP",Z) ) Q:'Z S Z0=0 F S Z0=$O(^DGC R(399,IBIF N,"CP",Z," MOD",Z0)) Q:'Z0 I $ P($G(^(Z0, 0)),U,2)=" " S DA(2)= IBIFN,DA(1 )=Z,DA=Z0, DIK="^DGCR (399,"_DA( 2)_",""CP" ","_DA(1)_ ",""MOD"", " D ^DIK | |
2405 | Q | |
2406 | ; | |
2407 | CODQ K %DT ,DGPROC,DI C,DIE,DR,D GPROCDT,IB PROCP,DLAY GO | |
2408 | K IBFT,DG NOADD,DGAD DVST,DGCPT ,DGCPTUP,I BZTYPE,DGC PTNEW | |
2409 | Q | |
2410 | ; | |
2411 | DELPROC ; Remove the selected procedure, because o f inactive status (c ancel sele ction) | |
2412 | W !!,*7," The Proced ure code i s inactive on ",$$DA T1^IBOUTL( DGPROCDT), "." | |
2413 | W !,"Plea se select another Pr ocedure." | |
2414 | S DA(1)=I BIFN,DA=+Y ,DIK="^DGC R(399,"_IB IFN_",""CP ""," | |
2415 | D ^DIK | |
2416 | Q | |
2417 | ; | |
2418 | DELADD N Z ,Z0,DA,DIK ,X,Y | |
2419 | S DA(1)=I BIFN | |
2420 | ;Delete r eferences to proc on rev codes | |
2421 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"RC",Z) ) Q:'Z S Z0=$G(^(Z, 0)) I Z0'= "",$P(Z0,U ,15)!$S($P (Z0,U,10)= 3:$P(Z0,U, 11),1:0) S DIE="^DGC R(399,"_DA (1)_",""RC "",",DA=Z, DR=".11/// @;.15///@" _$S($P(Z0, U,8):"",1: ";.08////1 ") D ^DIE | |
2422 | S DIK="^D GCR(399,"_ DA(1)_","" CP""," F D A=0:0 S DA =$O(^DGCR( 399,DA(1), "CP",DA)) Q:'DA D ^ DIK | |
2423 | S DGRVRCA L=1 | |
2424 | Q | |
2425 | ; | |
2426 | DTMES ;Mes sage if pr ocedure da te not in date range | |
2427 | Q:'$D(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"U" )) S DGNO DUU=^("U") | |
2428 | G:X'<$P(D GNODUU,"^" )&(X'>$P(D GNODUU,"^" ,2)) DTMES Q | |
2429 | W *7,!!?3 ,"Date mus t be withi n STATEMEN T COVERS F ROM and ST ATEMENT CO VERS TO pe riod." | |
2430 | S Y=$P(DG NODUU,"^") X ^DD("DD ") | |
2431 | W !?3,"En ter a date between " ,Y," and " S Y=$P(DG NODUU,"^", 2) X ^DD(" DD") W Y,! | |
2432 | K X,Y | |
2433 | DTMESQ K D GNODUU Q | |
2434 | ; | |
2435 | CODHLP ;Di splay Addi tional Pro cedure cod es | |
2436 | N I,J,Y,I BMOD | |
2437 | I '$O(^DG CR(399,IBI FN,"CP",0) ) W !!?5," No Codes E ntered!",! Q | |
2438 | W ! F I=0 :0 S I=$O( ^DGCR(399, IBIFN,"CP" ,I)) Q:'I S Y=$G(^( I,0)) S Z= $$PRCNM^IB CSCH1($P(Y ,"^",1),$P (Y,"^",2)) W !?5,$E( $P(Z,"^",2 ),1,33),?4 0,"- ",$P( Z,"^") D | |
2439 | . N IBY | |
2440 | . S IBY=$ P(Y,U,2) | |
2441 | . S IBMOD =$$GETMOD^ IBEFUNC(IB IFN,I,1) | |
2442 | . I IBMOD '="" S IBM OD="/"_IBM OD W IBMOD | |
2443 | . W ?60," Date: " S Y=IBY D DT ^DIQ | |
2444 | W ! | |
2445 | ; | |
2446 | K Z Q | |
2447 | ; | |
2448 | DICV I $D( IBIFN),$D( ^DGCR(399, IBIFN,0)), $P(^(0),U, 9) S DIC(" V")=$S($P( ^(0),U,9)= 9:"I +Y(0) =80.1",$P( ^(0),U,9)= 4!($P(^(0) ,U,9)=5):" I +Y(0)=81 ",1:"") | |
2449 | Q | |
2450 | ; | |
2451 | DEFDIV(IBI FN) ; Find default d ivision fo r bill IBI FN | |
2452 | Q $P($G(^ DG(40.8,+$ P($G(^DGCR (399,IBIFN ,0)),U,22) ,0)),U) | |
2453 | ; | |
2454 | ADDTNL(IBI FN,DA) ; | |
2455 | N DR,IBOK ,X,Y,DIR | |
2456 | S IBOK=1 | |
2457 | S DR="19T ;50.09T;50 .08T" D ^D IE ; WCJ; IB*2.0*488 Added Ts | |
2458 | ;I '($$FT ^IBCEF(IBI FN)'=3&($$ INPAT^IBCE F(IBIFN))) D ATTACH ; DEM;432 - Prompt for Attach ment Contr ol Number. | |
2459 | I '($$FT^ IBCEF(IBIF N)=3&($$IN PAT^IBCEF( IBIFN))) D ATTACH ; DEM;432 - Prompt fo r Attachme nt Control Number. | |
2460 | I $D(Y) S IBOK=0 G ADDTNLQ | |
2461 | ;/Beginni ng of IB*2 .0*488 (vd ) | |
2462 | ;S DIR("B ")="NO",DI R("A")="ED IT CMS-150 0 SPECIAL PROGRAM FI ELDS and B OX 19?: ", DIR("A",1) =" ",DIR(0 )="YA" | |
2463 | ;S DIR("? ",1)="Resp ond YES on ly if you need to ad d/edit dat a for chir opractic v isits," | |
2464 | ;S DIR("? ")="EPSDT care, or i f billing for HOSPIC E and atte nding is n ot a hospi ce employe e." | |
2465 | ;D ^DIR K DIR | |
2466 | ;I Y'=1 S IBOK=0 G ADDTNLQ | |
2467 | ;S DR="W !,"" <<EP SDT>>"";50 .07;W !!," " <<HOSPI CE>>"";50. 03" | |
2468 | S DR="50. 07T;50.03T " ;WCJ;I B*2.0*488 added Ts | |
2469 | ;/End of IB*2.0*488 (vd) | |
2470 | D ^DIE | |
2471 | W ! | |
2472 | ADDTNLQ Q IBOK | |
2473 | ; | |
2474 | XTRA1(Y) ; | |
2475 | K Y | |
2476 | Q | |
2477 | ; | |
2478 | SPCUNIT(IB IFN,DA) ; return fie lds for sp ecial unit s if appli cable, in DR form | |
2479 | N IB0,IBC PT,IBDR,IB CT,IBFT,DF N S IBDR=" " | |
2480 | S IB0=$G( ^DGCR(399, +$G(IBIFN) ,0)),IBCT= $P(IB0,U,2 7),IBFT=$P (IB0,U,19) ,DFN=$P(IB 0,U,2) | |
2481 | S IBCPT=$ G(^DGCR(39 9,+$G(IBIF N),"CP",+$ G(DA),0)) I IBCPT'[" ICPT" G SP CUNTQ | |
2482 | I +$$ITMU NIT^IBCRU4 (+IBCPT,5, IBCT) S IB DR="15;" D SROMIN^IB CU74(IBIFN ,DA) G SPC UNTQ ; min utes | |
2483 | I +$$ITMU NIT^IBCRU4 (+IBCPT,4, IBCT) S IB DR="21;" G SPCUNTQ ; miles | |
2484 | I +$$ITMU NIT^IBCRU4 (+IBCPT,6, IBCT) S IB DR="22//"_ $$OBSHOUR^ IBCU74(DFN ,$P(IBCPT, U,2))_";" G SPCUNTQ ; hours | |
2485 | I +IBFT=2 ,$P($G(^IB E(353.2,+$ P(IBCPT,U, 10),0)),U, 2)="ANESTH ESIA" S IB DR="15;" ; minutes | |
2486 | SPCUNTQ Q IBDR | |
2487 | ; | |
2488 | ATTACH ; D EM;432 - A ttachment control nu mber. | |
2489 | ; Ask if user wants to enter Attachment Control N umber. | |
2490 | N DIR,X,Y ,DA,DIE,DR | |
2491 | S DIR("A" )="Enter A ttachment Control Nu mber" | |
2492 | S DIR(0)= "Y",DIR("B ")="NO" | |
2493 | D ^DIR | |
2494 | Q:'Y | |
2495 | ; User ch ose to ent er Attachm ent Contro l Number. | |
2496 | ; User en ters Attac hment Cont rol fields . | |
2497 | S DA(1)=I BIFN,DA=IB PROCP | |
2498 | S DIE="^D GCR(399,"_ DA(1)_","" CP""," | |
2499 | S DR="71R eport Type ;72Report Transmissi on Method; 70Attachme nt Control Number" | |
2500 | D ^DIE | |
2501 | Q | |
2502 | ; | |
2503 | NOCPROC(IB PROCSV) ; MRD;IB*2.0 *516 - Fun ction to d etermine i f procedur e is an | |
2504 | ; "NOC". Returns ' 1' if "NOC " procedur e, otherwi se '0'. | |
2505 | ; | |
2506 | N IBNOC,I BPROCEX,IB PROCIN,IBP ROCNM,IBX | |
2507 | S IBNOC=0 | |
2508 | I $G(IBPR OCSV)="" G NOCPROCQ | |
2509 | S IBPROCI N=$P($P(IB PROCSV,U,2 ),";") | |
2510 | I IBPROCI N="" G NOC PROCQ | |
2511 | ; | |
2512 | ; If proc edure code ends in ' 99', quit with a '1' . | |
2513 | ; | |
2514 | S IBPROCE X=$P($G(^I CPT(IBPROC IN,0)),U,1 ) | |
2515 | I $E(IBPR OCEX,$L(IB PROCEX)-1, $L(IBPROCE X))=99 S I BNOC=1 G N OCPROCQ | |
2516 | ; | |
2517 | ; Pull pr ocedure na me, then c heck to se e if it co ntains one of the | |
2518 | ; specifi ed strings . | |
2519 | ; | |
2520 | S IBPROCN M=$P($G(^I CPT(IBPROC IN,0)),U,2 ) | |
2521 | I IBPROCN M'="",$$NO C(IBPROCNM ) S IBNOC= 1 G NOCPRO CQ | |
2522 | ; | |
2523 | S IBX=0 | |
2524 | F S IBX= $O(^ICPT(I BPROCIN,"D ",IBX)) Q: 'IBX D I IBNOC=1 Q | |
2525 | . S IBTEX T=$G(^ICPT (IBPROCIN, "D",IBX,0) ) | |
2526 | . I $G(^I CPT(IBPROC IN,"D",IBX +1,0))'="" S IBTEXT= IBTEXT_" " _$G(^ICPT( IBPROCIN," D",IBX+1,0 )) | |
2527 | . S IBNOC =$$NOC(IBT EXT) | |
2528 | . Q | |
2529 | ; | |
2530 | NOCPROCQ ; Quit out. | |
2531 | Q IBNOC | |
2532 | ; | |
2533 | NOC(IBTEXT ) ; Quit w ith '1' if IBTEXT co ntains one of the sp ecified st rings. | |
2534 | ; | |
2535 | S IBTEXT= $TR(IBTEXT ,"abcdefgh ijklmnopqr stuvwxyz", "ABCDEFGHI JKLMNOPQRS TUVWXYZ") | |
2536 | ; | |
2537 | I IBTEXT[ "NOT OTHER WISE" Q 1 | |
2538 | I IBTEXT[ "NOT ELSEW HERE" Q 1 | |
2539 | I IBTEXT[ "NOT LISTE D" Q 1 | |
2540 | I IBTEXT[ "UNLISTED" Q 1 | |
2541 | I IBTEXT[ "UNSPECIFI ED" Q 1 | |
2542 | I IBTEXT[ "UNCLASSIF IED" Q 1 | |
2543 | I IBTEXT[ "NON-SPECI FIED" Q 1 | |
2544 | I IBTEXT[ "NOS " Q 1 | |
2545 | I IBTEXT[ "NOS;" Q 1 | |
2546 | I IBTEXT[ "NOS." Q 1 | |
2547 | I IBTEXT[ "NOS," Q 1 | |
2548 | I IBTEXT[ "NOS/" Q 1 | |
2549 | I IBTEXT[ "(NOS)" Q 1 | |
2550 | I IBTEXT[ "NOC " Q 1 | |
2551 | I IBTEXT[ "NOC;" Q 1 | |
2552 | I IBTEXT[ "NOC." Q 1 | |
2553 | I IBTEXT[ "NOC," Q 1 | |
2554 | I IBTEXT[ "NOC/" Q 1 | |
2555 | I IBTEXT[ "(NOC)" Q 1 | |
2556 | ; | |
2557 | ; Check i f last thr ee charcte rs are 'NO C' or 'NOS '. | |
2558 | ; | |
2559 | S IBTEXT= $E(IBTEXT, $L(IBTEXT) -2,$L(IBTE XT)) | |
2560 | I IBTEXT= "NOC" Q 1 | |
2561 | I IBTEXT= "NOS" Q 1 | |
2562 | ; | |
2563 | Q 0 | |
2564 | ; | |
2565 | ORALCAV(FL D) ;EP | |
2566 | ; Diction ary Screen function called fro m Procedur es Oral Ca vity Field s: | |
2567 | ; 399.030 4.90.01, 3 99.0304.90 .02, 399.0 304.90.03, 399.0304. 90.04, 399 .0304.90.0 5 | |
2568 | ; Prevent s the same Oral Cavi ty from be ing select ed more th an once. | |
2569 | ; Input: FLD - Field # of the field being che cked | |
2570 | ; DA - IEN of the Service L ine Multip le being e dited | |
2571 | ; DA(1) - IEN of the 356.22 en try being edited | |
2572 | ; Y - Internal V alue of th e user res ponse | |
2573 | ; Returns : 1 - Data input by the user i s valid, 0 otherwise | |
2574 | N NDE,RTN | |
2575 | S NDE=$G( ^DGCR(399, DA(1),"CP" ,DA,"DEN") ) | |
2576 | S RTN=1 ; A ssume Vali d Input | |
2577 | Q:Y="" 1 ; N o value en tered | |
2578 | ; | |
2579 | ; Make su re there a re no dupl icates | |
2580 | I FLD=90. 01 D Q RT N | |
2581 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2582 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2583 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2584 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2585 | I FLD=90. 02 D Q RT N | |
2586 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2587 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2588 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2589 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2590 | I FLD=90. 03 D Q RT N | |
2591 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2592 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2593 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2594 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2595 | I FLD=90. 04 D Q RT N | |
2596 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2597 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2598 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2599 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2600 | I FLD=90. 05 D Q RT N | |
2601 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2602 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2603 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2604 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2605 | Q RTN | |
2606 | ; | |
2607 | TOOTHS(FLD ) ;EP | |
2608 | ; Diction ary Screen function called fro m Dental S ervice Lin e Tooth fi elds: | |
2609 | ; 399,91, .02, 399,9 1,.03, 399 ,91,.04, 3 99,91,.05, 399,91,.0 6. Prevent s the | |
2610 | ; same To oth Surfac e from bei ng selecte d more tha n once. | |
2611 | ; Input: FLD - Field # of the field being che cked | |
2612 | ; DA - Tooth Surf ace multip le IEN | |
2613 | ; DA(1) - Service Li ne multipl e IEN | |
2614 | ; DA(2) - IEN of the 356.22 en try being edited | |
2615 | ; Y - Internal V alue of th e user res ponse | |
2616 | ; Returns : 1 - Data input by the user i s valid, 0 otherwise | |
2617 | N NDE,RTN | |
2618 | S NDE=$G( ^DGCR(399, DA(2),"CP" ,DA(1),"DE N1",DA,0)) | |
2619 | S RTN=1 ; Assume Valid Inpu t | |
2620 | Q:Y="" 1 ; No valu e entered | |
2621 | ; | |
2622 | ; Make su re there a re no dupl icates | |
2623 | I FLD=.02 D Q RTN | |
2624 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2625 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2626 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2627 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
2628 | I FLD=.03 D Q RTN | |
2629 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2630 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2631 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2632 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
2633 | I FLD=.04 D Q RTN | |
2634 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2635 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2636 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2637 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
2638 | I FLD=.05 D Q RTN | |
2639 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2640 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2641 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2642 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
2643 | I FLD=.06 D Q RTN | |
2644 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2645 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2646 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2647 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2648 | Q RTN | |
2649 | ; | |
2650 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
2651 | IBCU7 ;ALB /AAS - INT ERCEPT SCR EEN INPUT OF PROCEDU RE CODES ; 29-OCT-91 | |
2652 | ;;2.0;INT EGRATED BI LLING;**62 ,52,106,12 5,51,137,2 10,245,228 ,260,348,3 71,432,447 ,488,461,5 16,522,577 ,604,592,6 08**;21-MA R-94;Build 40 | |
2653 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
2654 | ; | |
2655 | ;MAP TO D GCRU7 | |
2656 | ; | |
2657 | ; This ro utine is a copy of I BUC7 for t esting pur poses. | |
2658 | ; | |
2659 | CHKX ; -i nterceptio n of input x from Ad ditional P rocedure i nput | |
2660 | G:X=" " C HKXQ | |
2661 | I $$INPAT ^IBCEF(DA( 1)),'$P($G (^IBE(350. 9,1,1)),"^ ",15),X'?1 A1.2N D G CHKXQ | |
2662 | . K X | |
2663 | . D EN^DD IOL("Site param does not allow entry of non-PTF pr ocedures") ;Fileman error here will be: The previo us error o ccurred wh en perform ing an act ion specif ied in a P re-lookup transform (7.5 node) . | |
2664 | G:'$D(^UT ILITY($J," IB")) CHKX Q | |
2665 | ;S M=($A( $E(X,1))-6 4),S=+$E(X ,2) Q:'$G( ^UTILITY($ J,"IB",M,S )) S X="` "_+^(S) | |
2666 | S M=0 I X ?1A1.2N S N=$G(^UTIL ITY($J,"IB ","B",X)) S M=+N,S=+ $P(N,U,2), P=X S S=$G (^UTILITY( $J,"IB",M, S)) I +S S X="`"_+S I $P(N,U,3 )="N" S X= """"_X_""" " S $P(^UT ILITY($J," IB","B",P) ,U,3)="Y" | |
2667 | I +M,$D(D GPROCDT),D GPROCDT'=$ P($G(^UTIL ITY($J,"IB ",M,1)),"^ ",2) S DGP ROCDT=$P(^ (1),"^",2) W !!,"Pro cedure Dat e: " S Y=D GPROCDT X ^DD("DD") W Y,! | |
2668 | CHKXQ Q | |
2669 | ; | |
2670 | CODMUL ;Da te oriente d entry of procedure | |
2671 | DELASK I $ D(IBZ20),I BZ20,IBZ20 '=$P(^DGCR (399,IBIFN ,0),U,9) S %=2 W !," SINCE THE PROCEDURE CODING MET HOD HAS BE EN CHANGED , DO YOU W ANT TO DEL ETE ALL",! ,"PROCEDUR E CODES IN THIS BILL " | |
2672 | I D YN^D ICN Q:%=-1 D:%=1 DE LADD I %Y? 1."?" W !! ,"If you a nswer 'Yes ', all pro cedure cod es will be DELETED f rom this b ill.",! G DELASK | |
2673 | K %,%Y,DA ,IBZ20,DIK ;W !,"Pro cedure Ent ry:" | |
2674 | ; | |
2675 | CODDT I $D (IBIFN),$D (^DGCR(399 ,IBIFN,0)) ,$P(^(0),U ,9) S DIC( "V")=$S($P (^(0),U,9) =9:"I +Y(0 )=80.1",$P (^(0),U,9) =4!($P(^(0 ),U,9)=5): "I +Y(0)=8 1",1:"") | |
2676 | I $P($G(^ DGCR(399,I BIFN,0))," ^",5)<3 S IBZTYPE=1 I $P($G(^U TILITY($J, "IB",1,1)) ,"^",2) S DGPROCDT=$ P(^(1),"^" ,2) D ASKC OD | |
2677 | S X=$$PRC DIV^IBCU71 (IBIFN) I +X W !!,$P (X,U,2),! | |
2678 | N Z,Z0 S Z=$G(^DGCR (399,IBIFN ,"U")),Z0= $$FMTE^XLF DT($P(Z,U) ,"2D")_"-" _$$FMTE^XL FDT($P(Z,U ,2),"2D") | |
2679 | W !,"Sele ct PROCEDU RE DATE"_$ S($TR(Z0," -")'="":" ("_Z0_")", 1:"")_": " R X:DTIME G:'$T!("^ "[X) CODQ D:X["?" CO DHLP | |
2680 | S IBEX=0 D ; Get p rocedure d ate | |
2681 | . I X=" " ,$D(DGPROC DT),DGPROC DT?7N S Y= DGPROCDT D D^DIQ W " (",Y,") " Q | |
2682 | . I X=" " ,+$P($G(^D GCR(399,IB IFN,"OP",0 )),"^",4) S (DGPROCD T,Y)=$O(^D GCR(399,IB IFN,"OP",0 )) D D^DIQ W " (", Y,")" Q | |
2683 | . S %DT=" EXP",%DT(0 )=-DT D ^% DT K %DT I Y<1 S IBE X=1 Q | |
2684 | . I '$$OP V2^IBCU41( Y,IBIFN,1) S IBEX=1 Q | |
2685 | . S:'$G(I BZTYPE) X= $$OPV^IBCU 41(Y,IBIFN ) S DGPROC DT=Y | |
2686 | I 'IBEX D ASKCOD,AD DCPT^IBCU7 1:$D(DGCPT ) | |
2687 | K IBEX | |
2688 | G CODDT | |
2689 | ; | |
2690 | ASKCOD N Z ,Z0,DA,IBA CT,IBQUIT, IBLNPRV,IB CODE ;WCJ ;2.0*432 | |
2691 | N IBPOPOU T S IBPOP OUT=0 ; I B*2.0*447 BI | |
2692 | K DGCPT | |
2693 | S DGCPT=0 ,DGCPTUP=$ P($G(^IBE( 350.9,1,1) ),"^",19), DGADDVST=0 ,IBFT=$P($ G(^DGCR(39 9,IBIFN,0) ),"^",19) | |
2694 | I '$D(^DG CR(399,IBI FN,"CP",0) ) S ^DGCR( 399,IBIFN, "CP",0)=U_ $$GETSPEC^ IBEFUNC(39 9,304) | |
2695 | ; | |
2696 | F S IBQU IT=0 D Q: IBQUIT | |
2697 | . S IBPOP OUT=0 | |
2698 | . D DICV ; restrict code type to PCM | |
2699 | . S DIC(" A")=" Se lect PROCE DURE: " | |
2700 | . S DIC=" ^DGCR(399, "_IBIFN_", ""CP""," | |
2701 | . S DIC(0 )="AEQMNL" | |
2702 | . S DIC(" S")="I '$D (DIV(""S"" ))&($P(^(0 ),U,2)=DGP ROCDT)" | |
2703 | . S DIC(" DR")="1/// ^S X=DGPRO CDT" | |
2704 | . S DA(1) =IBIFN,DLA YGO=399 | |
2705 | . W ! D ^ DIC I Y<1 S IBQUIT=1 Q | |
2706 | . S IBPRO CP=+Y | |
2707 | . S IBCOD E=X ;Get t he code | |
2708 | . ; If we just adde d inactive code - it must be d eleted. | |
2709 | . S IBACT =0 ; Activ e flag | |
2710 | . I Y["IC D0" S IBAC T=$$ICD0AC T^IBACSV(+ $P(Y,U,2), $$BDATE^IB ACSV(IBIFN )) | |
2711 | . I Y["IC PT" S IBAC T=$$CPTACT ^IBACSV(+$ P(Y,U,2),D GPROCDT) | |
2712 | . S DGCPT NEW=$P(Y," ^",3) ;Was the proce dure just added? | |
2713 | . I DGCPT NEW,'IBACT D DELPROC Q | |
2714 | . I 'IBAC T W !,*7," Warning: Procedure code is in active on this date" ,! | |
2715 | . I DGCPT NEW,$D(^UT ILITY($J," IB")),$$IN PAT^IBCEF( IBIFN),Y[" ICPT(" D D ATA^IBCU74 (Y,.IBLNPR V) | |
2716 | . S DGADD VST=$S(DGC PTNEW:1,$D (DGADDVST) :DGADDVST, 1:0) | |
2717 | . N IBPRV ,IBPRVO,IB PRVN | |
2718 | . ; | |
2719 | . ; Line level prov ider funct ion by for m type. | |
2720 | . ; C MS-1500 (F ORM TYPE=2 ) | |
2721 | . ; RE NDERING PR OVIDER, RE FERRING PR OVIDER, | |
2722 | . ; an d SUPERVIS ING PROVID ER. | |
2723 | . ; U B-04 (FORM TYPE=3) | |
2724 | . ; RE NDERING PR OVIDER, RE FERRING PR OVIDER, | |
2725 | . ; OP ERATING PR OVIDER, an d OTHER OP ERATING | |
2726 | . ; PR OVIDER. | |
2727 | . ; | |
2728 | . ; Remov ed: Call t o $$MAINPR V^IBCEU(IB IFN) is fo r claim | |
2729 | . ; level provider d efaults. | |
2730 | . ; 1 . For new line level providers we don't need | |
2731 | . ; or want default cl aim level provider | |
2732 | . ; (require ment). | |
2733 | . ; 2 . We don't want to d efault cla im level t o | |
2734 | . ; line lev el provide r (require ment). | |
2735 | . ; | |
2736 | . K DIC(" V") ; DEM ;432 - KIL L DIC("V") because t his was fo r previous variable pointer us e. | |
2737 | . ; | |
2738 | . N IBPRO CSV ; DEM ;432 - Var iable IBPR OCSV is va riable to preserve v alue of 'Y ', which i s procedur e code inf o returned by call t o ^DIC. | |
2739 | . S IBPRO CSV=Y ; D EM;432 - P reserve va lue of Y f or after c alls to Fi leMan (Y = procedure code info returned by call to ^DIC). | |
2740 | . K DR ;WCJ;IB*2. 0*432 | |
2741 | . ; | |
2742 | . I IBPRO CSV["ICD0" S DR=".01 ",DIE=DIC, (IBPROCP,D A)=+Y D ^D IE Q:'$D(D A)!($D(Y)) K DR ; I B*2.0*461 | |
2743 | . ; | |
2744 | . ;JRA;IB *2.0*608 P rompt user for Certi ficate of Medical Ne cessity (C MN) info | |
2745 | . I $$FT^ IBCEF(IBIF N)=2,$$CMN PRMT^IBJPS 8(IBIFN,IB PROCP,$P($ P(IBPROCSV ,U,2),";") ) D CMN^IB CU75(IBIFN ,IBPROCP) | |
2746 | . ; | |
2747 | . I IBPRO CSV["ICPT" S DR=".01 ;16",DIE=D IC,(IBPROC P,DA)=+Y D ^DIE Q:'$ D(DA)!($D( Y)) K DR ; IB*2.0*4 47 BI | |
2748 | . ; | |
2749 | . S DR="" | |
2750 | . ; | |
2751 | . ; MRD;I B*2.0*516 - Added li ne level P ROCEDURE D ESCRIPTION field, | |
2752 | . ; asked only if t he procedu re is an " NOC". | |
2753 | . I IBPRO CSV["ICPT" ,$$NOCPROC (IBPROCSV, IBCODE,DGP ROCDT) D ; added IB CODE,DGPRO CDT in *60 4 | |
2754 | . . S DA= $P(IBPROCS V,"^") ; The line# on the bil l/claim. | |
2755 | . . S DR= 51 ; Field# for PROCEDURE DESCRIPTI ON | |
2756 | . . D ^DI E | |
2757 | . . Q | |
2758 | . ; | |
2759 | . D EN^IB CU7B ; DEM ;432 - Cal l to line level prov ider user input. | |
2760 | . S Y=IBP ROCSV ; D EM;432 - R estore val ue of Y af ter calls to FileMan | |
2761 | . K IBPRO CSV | |
2762 | . K DR ;WCJ;IB*2. 0*432 | |
2763 | . I IBPOP OUT Q ; IB*2.0*447 BI | |
2764 | . S DR="" I Y["ICPT " S DR="6; 5//"_$$DEF DIV(IBIFN) _";" | |
2765 | . ;JWS;IB *2.0*592 U S1108 - De ntal | |
2766 | . ;IA# 10 018 | |
2767 | . S DR=DR _$S(IBFT=7 :"8;9//;", IBFT=2:"8; 9;17//NO;" ,1:"")_3,D IE=DIC,(IB PROCP,DA)= +Y D ^DIE Q:'$D(DA)! ($E($G(Y)) =U) | |
2768 | . K DR ;WCJ;IB*2. 0*432 | |
2769 | . ; | |
2770 | . ; MRD;I B*2.0*516 - Allow us er to add an NDC and Units. A sk only if | |
2771 | . ; codin g system i s not ICD and this i s not a pr escription claim. If | |
2772 | . ; an ND C is enter ed, prompt for Units . | |
2773 | . I $P($G (^DGCR(399 ,IBIFN,0)) ,U,9)'=9,' $$RXLINK^I BCSC5C(IBI FN,IBPROCP ) D | |
2774 | . . ;JWS; IB*2.0*592 US1108 - Dental | |
2775 | . . I IBF T=7 Q | |
2776 | . . K DA | |
2777 | . . S DA= IBPROCP,DA (1)=IBIFN, DIE="^DGCR (399,"_IBI FN_",""CP" "," | |
2778 | . . ; vd/ Beginning IB*2*577 - Added the prompt fo r Unit/Bas is of Meas urement. | |
2779 | . . ; S D R="53NDC N UMBER;I X= """" S Y=" """;54//1" | |
2780 | . . S DR= "53NDC NUM BER;I X="" "" S Y=""" ";52R~//UN ;54R~QUANT ITY//1" ; Prompt for NDC, UN & amt. | |
2781 | . . ; vd/ Ending IB* 2*577 | |
2782 | . . D ^DI E | |
2783 | . . Q | |
2784 | . ; | |
2785 | . I IBFT= 3 D:'$$INP AT^IBCEF(I BIFN) ATTA CH ; DEM; 432 - Prom pt for Att achment Co ntrol Numb er. | |
2786 | . ; DEM;4 32 - Add A dditional OB Minutes to DR str ing for ca ll to DIE. | |
2787 | . S DR=$$ SPCUNIT(IB IFN,IBPROC P) S:DR["1 5;" DR=DR_ "74Additio nal OB Min utes" D ^D IE ; miles /minutes/h ours | |
2788 | . ;JWS;IB *2.0*592 U S1108 - De ntal | |
2789 | . I IBFT= 2!(IBFT=7) D | |
2790 | .. D DX^I BCU72(IBIF N,IBPROCP) | |
2791 | .. ;JWS;I B*2.0*592 US1108 - D ental | |
2792 | .. I IBFT '=7 S X=$$ ADDTNL(IBI FN,.DA) | |
2793 | . Q:$$INP AT^IBCEF(I BIFN) ;on ly outpati ent bills | |
2794 | . ;JWS;IB *2.0*592 U S1108 - De ntal input fields | |
2795 | . I IBFT= 7 D ORAL^I BCU72 | |
2796 | . ;add pr ocedures t o array fo r download to PCE: d gcpt(assoc clinic,cp t,'provide r^first dx ^modifiers ',cnt)="" | |
2797 | . S DGPRO C=$G(^DGCR (399,IBIFN ,"CP",+DA, 0)) | |
2798 | . S X=$P( DGPROC,U,1 8)_U_+$G(^ IBA(362.3, +$P(DGPROC ,U,11),0)) _U_$P(DGPR OC,U,15) | |
2799 | . I 'DGCP TNEW,$P(DG PROC,"^",7 )="" S DGC PTNEW=2 | |
2800 | . I DGCPT UP,DGCPTNE W S DGCPT= DGCPT+1 I $P(DGPROC, "^",7) S D GCPT($P(DG PROC,"^",7 ),+DGPROC, X,DGCPT)=" " | |
2801 | . ; add v isit date to bill | |
2802 | . I DGADD VST S (X,D INUM)=DGPR OCDT D VFI LE1^IBCOPV 1 K DINUM, X,DGNOADD, DGADDVST | |
2803 | ; Delete modifiers with only a sequence #, no cod e | |
2804 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"CP",Z) ) Q:'Z S Z0=0 F S Z0=$O(^DGC R(399,IBIF N,"CP",Z," MOD",Z0)) Q:'Z0 I $ P($G(^(Z0, 0)),U,2)=" " S DA(2)= IBIFN,DA(1 )=Z,DA=Z0, DIK="^DGCR (399,"_DA( 2)_",""CP" ","_DA(1)_ ",""MOD"", " D ^DIK | |
2805 | Q | |
2806 | CODQ K %DT ,DGPROC,DI C,DIE,DR,D GPROCDT,IB PROCP,DLAY GO | |
2807 | K IBFT,DG NOADD,DGAD DVST,DGCPT ,DGCPTUP,I BZTYPE,DGC PTNEW | |
2808 | Q | |
2809 | ; | |
2810 | DELPROC ; Remove the selected procedure, because o f inactive status (c ancel sele ction) | |
2811 | W !!,*7," The Proced ure code i s inactive on ",$$DA T1^IBOUTL( DGPROCDT), "." | |
2812 | W !,"Plea se select another Pr ocedure." | |
2813 | S DA(1)=I BIFN,DA=+Y ,DIK="^DGC R(399,"_IB IFN_",""CP ""," | |
2814 | D ^DIK | |
2815 | Q | |
2816 | ; | |
2817 | DELADD N Z ,Z0,DA,DIK ,X,Y | |
2818 | S DA(1)=I BIFN | |
2819 | ;Delete r eferences to proc on rev codes | |
2820 | S Z=0 F S Z=$O(^DG CR(399,IBI FN,"RC",Z) ) Q:'Z S Z0=$G(^(Z, 0)) I Z0'= "",$P(Z0,U ,15)!$S($P (Z0,U,10)= 3:$P(Z0,U, 11),1:0) S DIE="^DGC R(399,"_DA (1)_",""RC "",",DA=Z, DR=".11/// @;.15///@" _$S($P(Z0, U,8):"",1: ";.08////1 ") D ^DIE | |
2821 | S DIK="^D GCR(399,"_ DA(1)_","" CP""," F D A=0:0 S DA =$O(^DGCR( 399,DA(1), "CP",DA)) Q:'DA D ^ DIK | |
2822 | S DGRVRCA L=1 | |
2823 | Q | |
2824 | ; | |
2825 | DTMES ;Mes sage if pr ocedure da te not in date range | |
2826 | Q:'$D(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"U" )) S DGNO DUU=^("U") | |
2827 | G:X'<$P(D GNODUU,"^" )&(X'>$P(D GNODUU,"^" ,2)) DTMES Q | |
2828 | W *7,!!?3 ,"Date mus t be withi n STATEMEN T COVERS F ROM and ST ATEMENT CO VERS TO pe riod." | |
2829 | S Y=$P(DG NODUU,"^") X ^DD("DD ") | |
2830 | W !?3,"En ter a date between " ,Y," and " S Y=$P(DG NODUU,"^", 2) X ^DD(" DD") W Y,! | |
2831 | K X,Y | |
2832 | DTMESQ K D GNODUU Q | |
2833 | ; | |
2834 | CODHLP ;Di splay Addi tional Pro cedure cod es | |
2835 | N I,J,Y,I BMOD | |
2836 | I '$O(^DG CR(399,IBI FN,"CP",0) ) W !!?5," No Codes E ntered!",! Q | |
2837 | W ! F I=0 :0 S I=$O( ^DGCR(399, IBIFN,"CP" ,I)) Q:'I S Y=$G(^( I,0)) S Z= $$PRCNM^IB CSCH1($P(Y ,"^",1),$P (Y,"^",2)) W !?5,$E( $P(Z,"^",2 ),1,33),?4 0,"- ",$P( Z,"^") D | |
2838 | . N IBY | |
2839 | . S IBY=$ P(Y,U,2) | |
2840 | . S IBMOD =$$GETMOD^ IBEFUNC(IB IFN,I,1) | |
2841 | . I IBMOD '="" S IBM OD="/"_IBM OD W IBMOD | |
2842 | . W ?60," Date: " S Y=IBY D DT ^DIQ | |
2843 | W ! | |
2844 | ; | |
2845 | K Z Q | |
2846 | ; | |
2847 | DICV I $D( IBIFN),$D( ^DGCR(399, IBIFN,0)), $P(^(0),U, 9) S DIC(" V")=$S($P( ^(0),U,9)= 9:"I +Y(0) =80.1",$P( ^(0),U,9)= 4!($P(^(0) ,U,9)=5):" I +Y(0)=81 ",1:"") | |
2848 | Q | |
2849 | ; | |
2850 | DEFDIV(IBI FN) ; Find default d ivision fo r bill IBI FN | |
2851 | Q $P($G(^ DG(40.8,+$ P($G(^DGCR (399,IBIFN ,0)),U,22) ,0)),U) | |
2852 | ; | |
2853 | ADDTNL(IBI FN,DA) ; | |
2854 | N DR,IBOK ,X,Y,DIR | |
2855 | S IBOK=1 | |
2856 | S DR="19T ;50.09T;50 .08T" D ^D IE ; WCJ; IB*2.0*488 Added Ts | |
2857 | ;I '($$FT ^IBCEF(IBI FN)'=3&($$ INPAT^IBCE F(IBIFN))) D ATTACH ; DEM;432 - Prompt for Attach ment Contr ol Number. | |
2858 | I '($$FT^ IBCEF(IBIF N)=3&($$IN PAT^IBCEF( IBIFN))) D ATTACH ; DEM;432 - Prompt fo r Attachme nt Control Number. | |
2859 | I $D(Y) S IBOK=0 G ADDTNLQ | |
2860 | ;/Beginni ng of IB*2 .0*488 (vd ) | |
2861 | ;S DIR("B ")="NO",DI R("A")="ED IT CMS-150 0 SPECIAL PROGRAM FI ELDS and B OX 19?: ", DIR("A",1) =" ",DIR(0 )="YA" | |
2862 | ;S DIR("? ",1)="Resp ond YES on ly if you need to ad d/edit dat a for chir opractic v isits," | |
2863 | ;S DIR("? ")="EPSDT care, or i f billing for HOSPIC E and atte nding is n ot a hospi ce employe e." | |
2864 | ;D ^DIR K DIR | |
2865 | ;I Y'=1 S IBOK=0 G ADDTNLQ | |
2866 | ;S DR="W !,"" <<EP SDT>>"";50 .07;W !!," " <<HOSPI CE>>"";50. 03" | |
2867 | S DR="50. 07T;50.03T " ;WCJ;I B*2.0*488 added Ts | |
2868 | ;/End of IB*2.0*488 (vd) | |
2869 | D ^DIE | |
2870 | W ! | |
2871 | ADDTNLQ Q IBOK | |
2872 | ; | |
2873 | XTRA1(Y) ; | |
2874 | K Y | |
2875 | Q | |
2876 | ; | |
2877 | SPCUNIT(IB IFN,DA) ; return fie lds for sp ecial unit s if appli cable, in DR form | |
2878 | N IB0,IBC PT,IBDR,IB CT,IBFT,DF N S IBDR=" " | |
2879 | S IB0=$G( ^DGCR(399, +$G(IBIFN) ,0)),IBCT= $P(IB0,U,2 7),IBFT=$P (IB0,U,19) ,DFN=$P(IB 0,U,2) | |
2880 | S IBCPT=$ G(^DGCR(39 9,+$G(IBIF N),"CP",+$ G(DA),0)) I IBCPT'[" ICPT" G SP CUNTQ | |
2881 | I +$$ITMU NIT^IBCRU4 (+IBCPT,5, IBCT) S IB DR="15;" D SROMIN^IB CU74(IBIFN ,DA) G SPC UNTQ ; min utes | |
2882 | I +$$ITMU NIT^IBCRU4 (+IBCPT,4, IBCT) S IB DR="21;" G SPCUNTQ ; miles | |
2883 | I +$$ITMU NIT^IBCRU4 (+IBCPT,6, IBCT) S IB DR="22//"_ $$OBSHOUR^ IBCU74(DFN ,$P(IBCPT, U,2))_";" G SPCUNTQ ; hours | |
2884 | I +IBFT=2 ,$P($G(^IB E(353.2,+$ P(IBCPT,U, 10),0)),U, 2)="ANESTH ESIA" S IB DR="15;" ; minutes | |
2885 | SPCUNTQ Q IBDR | |
2886 | ; | |
2887 | ATTACH ; D EM;432 - A ttachment control nu mber. | |
2888 | ; Ask if user wants to enter Attachment Control N umber. | |
2889 | N DIR,X,Y ,DA,DIE,DR | |
2890 | S DIR("A" )="Enter A ttachment Control Nu mber" | |
2891 | S DIR(0)= "Y",DIR("B ")="NO" | |
2892 | D ^DIR | |
2893 | Q:'Y | |
2894 | ; User ch ose to ent er Attachm ent Contro l Number. | |
2895 | ; User en ters Attac hment Cont rol fields . | |
2896 | S DA(1)=I BIFN,DA=IB PROCP | |
2897 | S DIE="^D GCR(399,"_ DA(1)_","" CP""," | |
2898 | S DR="71R eport Type ;72Report Transmissi on Method; 70Attachme nt Control Number" | |
2899 | D ^DIE | |
2900 | Q | |
2901 | ; | |
2902 | NOCPROC(IB PROCSV,IBC ODE,IBDATE ) ; MRD;IB *2.0*516 - Function to determi ne if proc edure is a n | |
2903 | ; "NOC". Returns '1 ' if "NOC" procedure , otherwis e '0'. | |
2904 | ; | |
2905 | N IBNOC,I BPROCEX,IB PROCIN,IBP ROCNM,IBX, IBLINES,IB STR,IBEND, IBLN | |
2906 | S IBNOC=0 | |
2907 | I $G(IBPR OCSV)="" G NOCPROCQ | |
2908 | I $G(IBCO DE)="" G N OCPROCQ | |
2909 | I $G(IBDA TE)'?7N G NOCPROCQ | |
2910 | S IBPROCI N=$P($P(IB PROCSV,U,2 ),";") ;pa rsing out the IEN | |
2911 | I IBPROCI N="" G NOC PROCQ | |
2912 | ; | |
2913 | ; If proc edure code ends in ' 99', quit with a '1' . | |
2914 | ; | |
2915 | I $E(IBCO DE,$L(IBCO DE)-1,$L(I BCODE))=99 S IBNOC=1 G NOCPROC Q ;Does co de end wit h 99? If s o NOC | |
2916 | ; | |
2917 | ; Pull pr ocedure na me, then c heck to se e if it co ntains one of the | |
2918 | ; specifi ed strings . | |
2919 | ; | |
2920 | S IBPROCN M=$$CPT^IC PTCOD(IBCO DE,IBDATE) | |
2921 | S IBPROCN M=$P(IBPRO CNM,U,3) | |
2922 | I IBPROCN M'="",($$N OC(IBPROCN M)) S IBNO C=1 G NOCP ROCQ ; Doe s external match NOC strings? if so NOC | |
2923 | ; | |
2924 | ;Does arr ay strings match any of the sp ecified st rings | |
2925 | S IBLINES =$$CPTD^IC PTCOD(IBCO DE,"IBINFO ",,IBDATE) ;get numb er of line s/array of lines | |
2926 | S IBEND=1 S:IBLINES >1 IBEND=I BLINES-1 ; set up cou nter for l oop | |
2927 | F IBLN=1: 1:IBEND D Q:IBNOC=1 ;loop th rough arra y so we ca n check if node valu es = NOC | |
2928 | . N IBSTR S IBSTR=$ $TM($G(IBI NFO(IBLN)) )_" "_$$TM ($G(IBINFO (IBLN+1))) _" " ;Buil d strings for NOC co mparison | |
2929 | . S IBNOC =$$NOC(IBS TR) ;is cu rrent comb ination of strings a NOC? | |
2930 | . Q | |
2931 | ; | |
2932 | NOCPROCQ ; Quit out. | |
2933 | K IBINFO ;killing t he array m ade in CPT D^ICPTCOD | |
2934 | Q IBNOC | |
2935 | ; | |
2936 | NOC(IBTEXT ) ; Quit w ith '1' if IBTEXT co ntains one of the sp ecified st rings. | |
2937 | ; | |
2938 | S IBTEXT= $TR(IBTEXT ,"abcdefgh ijklmnopqr stuvwxyz", "ABCDEFGHI JKLMNOPQRS TUVWXYZ") | |
2939 | ; | |
2940 | I IBTEXT[ "NOT OTHER WISE" Q 1 | |
2941 | I IBTEXT[ "NOT ELSEW HERE" Q 1 | |
2942 | I IBTEXT[ "NOT LISTE D" Q 1 | |
2943 | I IBTEXT[ "UNLISTED" Q 1 | |
2944 | I IBTEXT[ "UNSPECIFI ED" Q 1 | |
2945 | I IBTEXT[ "UNCLASSIF IED" Q 1 | |
2946 | I IBTEXT[ "NON-SPECI FIED" Q 1 | |
2947 | I IBTEXT[ "NOS " Q 1 | |
2948 | I IBTEXT[ "NOS;" Q 1 | |
2949 | I IBTEXT[ "NOS." Q 1 | |
2950 | I IBTEXT[ "NOS," Q 1 | |
2951 | I IBTEXT[ "NOS/" Q 1 | |
2952 | I IBTEXT[ "(NOS)" Q 1 | |
2953 | I IBTEXT[ "NOC " Q 1 | |
2954 | I IBTEXT[ "NOC;" Q 1 | |
2955 | I IBTEXT[ "NOC." Q 1 | |
2956 | I IBTEXT[ "NOC," Q 1 | |
2957 | I IBTEXT[ "NOC/" Q 1 | |
2958 | I IBTEXT[ "(NOC)" Q 1 | |
2959 | ; | |
2960 | ; Check i f last thr ee charcte rs are 'NO C' or 'NOS '. | |
2961 | ; | |
2962 | S IBTEXT= $E(IBTEXT, $L(IBTEXT) -2,$L(IBTE XT)) | |
2963 | Q 0 | |
2964 | ; | |
2965 | TM(IBX,IBY ) ; Trim C haracter Y - Default " " | |
2966 | S IBX=$G( IBX) Q:IBX ="" IBX S IBY=$G(IB Y) S:'$L(I BY) IBY=" " | |
2967 | F Q:$E(I BX,1)'=IBY S IBX=$E (IBX,2,$L( IBX)) | |
2968 | F Q:$E(I BX,$L(IBX) )'=IBY S IBX=$E(IBX ,1,($L(IBX )-1)) | |
2969 | Q IBX | |
2970 | ; | |
2971 | ORALCAV(FL D) ;EP;IB* 2.0*592 | |
2972 | ; Diction ary Screen function called fro m Procedur es Oral Ca vity Field s: | |
2973 | ; 399.030 4.90.01, 3 99.0304.90 .02, 399.0 304.90.03, 399.0304. 90.04, 399 .0304.90.0 5 | |
2974 | ; Prevent s the same Oral Cavi ty from be ing select ed more th an once. | |
2975 | ; Input: FLD - Fiel d # of the field bei ng checked | |
2976 | ; DA - IE N of the S ervice Lin e Multiple being edi ted | |
2977 | ; DA(1) - IEN of th e 399 entr y being ed ited | |
2978 | ; Y - Int ernal Valu e of the u ser respon se | |
2979 | ; Returns : 1 - Data input by the user i s valid, 0 otherwise | |
2980 | N NDE,RTN | |
2981 | S NDE=$G( ^DGCR(399, DA(1),"CP" ,DA,"DEN") ) | |
2982 | S RTN=1 ; Assume Va lid Input | |
2983 | Q:Y="" 1 ; No value entered | |
2984 | ; | |
2985 | ; Make su re there a re no dupl icates | |
2986 | I FLD=90. 01 D Q RT N | |
2987 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2988 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2989 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2990 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2991 | I FLD=90. 02 D Q RT N | |
2992 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2993 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
2994 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
2995 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
2996 | I FLD=90. 03 D Q RT N | |
2997 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
2998 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
2999 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3000 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3001 | I FLD=90. 04 D Q RT N | |
3002 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
3003 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3004 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3005 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3006 | I FLD=90. 05 D Q RT N | |
3007 | . I $P(ND E,"^",1)=Y S RTN=0 Q | |
3008 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3009 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3010 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3011 | Q RTN | |
3012 | ; | |
3013 | TOOTHS(FLD ) ;EP;IB*2 .0*592 | |
3014 | ; Diction ary Screen function called fro m Dental S ervice Lin e Tooth fi elds: | |
3015 | ; 399,91, .02, 399,9 1,.03, 399 ,91,.04, 3 99,91,.05, 399,91,.0 6. Prevent s the | |
3016 | ; same To oth Surfac e from bei ng selecte d more tha n once. | |
3017 | ; Input: FLD - Fiel d # of the field bei ng checked | |
3018 | ; DA - To oth Surfac e multiple IEN | |
3019 | ; DA(1) - Service L ine multip le IEN | |
3020 | ; DA(2) - IEN of th e 399 entr y being ed ited | |
3021 | ; Y - Int ernal Valu e of the u ser respon se | |
3022 | ; Returns : 1 - Data input by the user i s valid, 0 otherwise | |
3023 | N NDE,RTN | |
3024 | S NDE=$G( ^DGCR(399, DA(2),"CP" ,DA(1),"DE N1",DA,0)) | |
3025 | S RTN=1 ; Assume Va lid Input | |
3026 | Q:Y="" 1 ; No value entered | |
3027 | ; | |
3028 | ; Make su re there a re no dupl icates | |
3029 | I FLD=.02 D Q RTN | |
3030 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3031 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3032 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3033 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
3034 | I FLD=.03 D Q RTN | |
3035 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3036 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3037 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3038 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
3039 | I FLD=.04 D Q RTN | |
3040 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3041 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3042 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3043 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
3044 | I FLD=.05 D Q RTN | |
3045 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3046 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3047 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3048 | . I $P(ND E,"^",6)=Y S RTN=0 Q | |
3049 | I FLD=.06 D Q RTN | |
3050 | . I $P(ND E,"^",2)=Y S RTN=0 Q | |
3051 | . I $P(ND E,"^",3)=Y S RTN=0 Q | |
3052 | . I $P(ND E,"^",4)=Y S RTN=0 Q | |
3053 | . I $P(ND E,"^",5)=Y S RTN=0 Q | |
3054 | Q RTN | |
3055 | ; | |
3056 | ||
3057 | IBCU75 – U se DR Prom pting to p rompt user for CMN i nformation (called b y IBCU7) | |
3058 | Routines | |
3059 | Activities | |
3060 | Routine Na me | |
3061 | IBCU75 | |
3062 | Enhancemen t Category | |
3063 | New | |
3064 | Modify | |
3065 | Delete | |
3066 | No Change | |
3067 | RTM | |
3068 | ||
3069 | Related Op tions | |
3070 | None | |
3071 | Related Ro utines | |
3072 | Routines “ Called By” | |
3073 | Routines “ Called” | |
3074 | ||
3075 | ||
3076 | ||
3077 | ||
3078 | Data Dicti onary (DD) Reference s | |
3079 | ||
3080 | Related Pr otocols | |
3081 | None | |
3082 | Related In tegration Control Re gistration s (ICRs) | |
3083 | None | |
3084 | Data Passi ng | |
3085 | Input | |
3086 | Output Re ference | |
3087 | Both | |
3088 | Global Re ference | |
3089 | Local | |
3090 | Input Attr ibute Name and Defin ition | |
3091 | Name: | |
3092 | Definition : | |
3093 | Output Att ribute Nam e and Defi nition | |
3094 | Name: | |
3095 | Definition : | |
3096 | Current Lo gic | |
3097 | IBCU75 ;AL B/JRA - IN TERCEPT SC REEN INPUT OF PROCED URE CODES (ENTER CMN INFO) ;23 -Apr-18 | |
3098 | ;;2.0;INT EGRATED BI LLING;**60 8**;23-Apr -18 | |
3099 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3100 | ; | |
3101 | Q | |
3102 | ; | |
3103 | CMN(IBXIEN ,IBPROCP) ;JRA;IB*2. 0*608 Prom pt user fo r CMN info | |
3104 | ;Input: I BXIEN = I nternal bi ll/claim n umber | |
3105 | ; I BPROCP = P rocedure l ine subscr ipt in ^DG CR | |
3106 | ; | |
3107 | Q:('$G(IB XIEN)!('$G (IBPROCP)) ) | |
3108 | N ABGMSG, ABGPO2,CER TDT,CERTYP ,CHNGFRM,C MNNODE,CMN REQ,CMSG,D A,DIC,DIE, DIR,DGLB,D R,DRTAG,DT OLD,EDIT,E VNTDT,FIEN ,FNAM,FORM ,FRMTAG | |
3109 | N FRMTYP, HT,HTOLD,I ,IBPEB,WTO LD,LKGLB,L PM4ABG,LPM 4SAT,MSG,N ODE0,O2SAT ,OK,OLDVAL ,PROCA,PRO CB,QUIT,RR DT,TDY,THE RPYDT,X,Y | |
3110 | S DGLB="^ TMP(""CMN" ",$J)" K @ DGLB | |
3111 | S LKGLB=" ^DGCR(399, "_IBXIEN_" )" L +@LKG LB:0 I '$T W !,$C(7) ,"Another user is ed iting this entry -- EXITING" H 2 Q | |
3112 | S EVNTDT= $$FMTE^DIL IBF($G(IBD T),"5U") ;Get the E vent Date - will be the defaul t for seve ral date f ields. | |
3113 | S TDY=$$H TFM^DILIBF (+$H) | |
3114 | S ABGMSG= """ABG PO2 "" and/or ""O2 Satur ation"" Te st(s) REQU IRED" | |
3115 | S DA=IBPR OCP,DA(1)= IBXIEN,DIE ="^DGCR(39 9,"_IBXIEN _",""CP"", " | |
3116 | ;Set FORM array of CMN Data N odes (D399 .6 field 3 ) indexed by CMN For m Type ien | |
3117 | S FNAM="" F S FNAM =$O(^IBE(3 99.6,"B",F NAM)) Q:FN AM="" S F IEN=+$O(^I BE(399.6," B",FNAM,"" )) I FIEN D | |
3118 | . S FORM( FIEN)=$P($ G(^IBE(399 .6,FIEN,0) ),U,4) K:$ TR(FORM(FI EN)," ")=" " FORM(FIE N) | |
3119 | I $D(FORM )'>1 S FOR M(1)="CMN- 484",FORM( 2)="CMN-10 126" ;Def ault nodes for CMN d ata | |
3120 | S DIE("NO ^")="BACKO UTOK" | |
3121 | S CMNREQ( "MSG")="If ""CMN Req uired?"" i s changed to ""NO"", existing CMN data w ill be del eted!" | |
3122 | S FRMTYP( "MSG")="Ch anging the Form Type will dele te any dat a specific to the cu rrent Form Type!" | |
3123 | S CERTYP( "MSG")="Yo u are chan ging the C ertificati on Type!" | |
3124 | S CERTYP( "MSGI")="C hanging Ce rtificatio n Type to ""I"" will delete "" Recertific ation/Revi sion Date! """ | |
3125 | D CMNREQ | |
3126 | S QUIT=0 F D Q:QU IT | |
3127 | . D ^DIE | |
3128 | . S CMNRE Q=$G(CMNRE Q),FRMTYP= $G(FRMTYP) ,CERTYP=$G (CERTYP) | |
3129 | . S CMNRE Q=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,23,"I ") I CMNRE Q=0 S QUIT =1 Q | |
3130 | . S FRMTY P=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24,"I ") | |
3131 | . S CERTY P=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.01 ,"I") | |
3132 | . I FRMTY P,CERTYP'= "" S QUIT= 1 Q | |
3133 | . I CMNRE Q="" W $C( 7),!,?3,"" "CMN Requi red?"" is a REQUIRED field!" D CMNREQ Q | |
3134 | . S MSG=" " | |
3135 | . I FRMTY P="" S MSG ="""Form T ype"" and ""Certific ation Type "" are REQ UIRED!",DR TAG="CMNRE Q" | |
3136 | . E I CE RTYP="" S MSG="""Cer tification Type"" is REQUIRED! ",DRTAG="C MNREQ" | |
3137 | . I MSG]" " S DR="", MSG=MSG_$C (13,10)_" ** To ex it, set "" CMN Requir ed?"" to " "NO""" W $ C(7),!,?3, MSG D @DRT AG Q | |
3138 | . S QUIT= 1 | |
3139 | ; | |
3140 | ;If CMN i s not requ ired, dele te all CMN data that may be as sociated w ith this p rocedure & exit | |
3141 | I $G(CMNR EQ)=0 D Q | |
3142 | . S FIEN= "" F S FI EN=$O(FORM (FIEN)) Q: FIEN="" I FORM(FIEN )]"" D | |
3143 | . . S CMN NODE="^DGC R(399,"_IB XIEN_",""C P"","_IBPR OCP_","""_ FORM(FIEN) _""")" K @ CMNNODE | |
3144 | . S CMNNO DE="^DGCR( 399,"_IBXI EN_",""CP" ","_IBPROC P_",""CMN" ")" K @CMN NODE S @CM NNODE=0 | |
3145 | ; | |
3146 | ;If user selected F orm Type w e need to remove dat a that may exist for any other Form Type . | |
3147 | I $G(FRMT YP) S FIEN ="" F S F IEN=$O(FOR M(FIEN)) Q :FIEN="" I FIEN'=FR MTYP D | |
3148 | . S CMNNO DE="^DGCR( 399,"_IBXI EN_",""CP" ","_IBPROC P_","""_FO RM(FIEN)_" "")" K @CM NNODE | |
3149 | ; | |
3150 | I $G(CERT YP)="I" D SETFLD(24. 07,"@") ; If "Certif ication Ty pe" is "IN ITIAL" del ete "Recer tification /Revision Date" | |
3151 | ; | |
3152 | I (($D(ED IT)&($G(ED IT)'="Y")) !(X=""!('$ G(CMNREQ)! ('$G(FRMTY P)!($G(CER TYP)=""))) )) Q | |
3153 | ; | |
3154 | S FRMTAG= "DR"_$S($G (FORM(FRMT YP))[484:4 84,1:10126 ) ;Set ta g to call to set DR with form- specific l ogic | |
3155 | D DRCOMM | |
3156 | ; | |
3157 | ;Prompt u ser for re maining qu estions & check for missing re quired fie lds | |
3158 | S (QUIT,U PCT)=0,DRT AG(1)="" F D Q:QUI T | |
3159 | . D ^DIE | |
3160 | . K MSG S MSG=0 | |
3161 | . S DRTAG ="" | |
3162 | . S CERTY P=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.01 ,"I") | |
3163 | . S HT=$$ CMNDATA^IB CEF31(IBXI EN,IBPROCP ,24.02,"I" ) | |
3164 | . S THERP YDT=$$CMND ATA^IBCEF3 1(IBXIEN,I BPROCP,24. 05,"I") | |
3165 | . S CERTD T=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.06 ,"I") | |
3166 | . S RRDT= $$CMNDATA^ IBCEF31(IB XIEN,IBPRO CP,24.07," I") | |
3167 | . I 'CERT DT S MSG=M SG+1,MSG(M SG)="""Las t Certific ation Date """ S DRTA G="DRCOMM" | |
3168 | . I 'RRDT ,CERTYP'=" I" S MSG=M SG+1,MSG(M SG)="""Rec ertificati on/Revisio n Date""" S:DRTAG="" DRTAG="RR DT" | |
3169 | . I 'THER PYDT S MSG =MSG+1,MSG (MSG)="""D ate Therap y Started" "" S:DRTAG ="" DRTAG= "STRTDT" | |
3170 | . I FORM( FRMTYP)[10 126 D | |
3171 | . . I $$C MNDATA^IBC EF31(IBXIE N,IBPROCP, 24.217,"I" )="" S MSG =MSG+1,MSG (MSG)="""I s this for Parentera l nutritio n, Enteral nutrition , or Both? """ S:DRTA G="" DRTAG ="DR10126" | |
3172 | . I +MSG D Q | |
3173 | . . S:X=" " UPCT=UPC T+1 I UPCT >1,DRTAG=D RTAG(1) S QUIT=1 Q | |
3174 | . . S DR= "" W $C(7) F I=1:1:M SG W !,?3, MSG(I)_" i s REQUIRED !" | |
3175 | . . W !,? 3,"** Exit ing now wi ll leave r equired fi elds unans wered." | |
3176 | . . W !,? 3,"** If y ou must ex it, enter '^' again. " | |
3177 | . . S DRT AG(1)=DRTA G D @DRTAG | |
3178 | . S QUIT= 1 | |
3179 | ; | |
3180 | ;Delete d ates assoc iated with result fi elds that were delet ed | |
3181 | I $D(@DGL B)>1 D | |
3182 | . N FLD | |
3183 | . S FLD=" " F S FLD =$O(@DGLB@ (FLD)) Q:F LD="" D S ETFLD(FLD, "@") | |
3184 | . K @DGLB | |
3185 | Q | |
3186 | ; | |
3187 | CMNREQ ; S et DR with logic for 1st 3 fie lds: "CMN Required?" , "Form Ty pe" and "C ertificati on Type" | |
3188 | S DR="@23 ;S CMNREQ( ""OLD"")=$ $CMNDATA^I BCEF31(IBX IEN,IBPROC P,23,""I"" );23R~T//N O;S CMNREQ =X I 'X,'C MNREQ(""OL D"") S Y=" "@999"";" | |
3189 | S DR=DR_" I CMNREQ=0 ,CMNREQ("" OLD"")=1 S FRM=$$CMN DATA^IBCEF 31(IBXIEN, IBPROCP,24 ,""I"") S: 'FRM OK=1 S:FRM OK=$ $USEROK^IB CU75(23,1, CMNREQ(""M SG""))" | |
3190 | S DR=DR_" S:OK Y="" @999"" I ' OK S Y=""@ 23"";" | |
3191 | FRMTYP ;En try point to set DR with logic for "Form Type" and "Certific ation Type " fields i n preparat ion for re -prompting . | |
3192 | S DR=DR_" @24;S DIC( 0)=""N"" S FRMTYP("" OLD"")=$$C MNDATA^IBC EF31(IBXIE N,IBPROCP, 24,""I""); 24R~T;S FR MTYP=X I F RMTYP(""OL D"")]"""", FRMTYP]""" "" | |
3193 | S DR=DR_" ,FRMTYP'=F RMTYP(""OL D"") S OK= $$USEROK^I BCU75(24,F RMTYP(""OL D""),FRMTY P(""MSG"") ) S:OK CHN GFRM=1 S:' OK Y=""@24 "";" | |
3194 | S DR=DR_" I $G(CHNGF RM)!($$CMN DATA^IBCEF 31(IBXIEN, IBPROCP,24 .01,""I"") ="""") D C OPYCMN^IBC U75(IBXIEN ,IBPROCP,F RMTYP);" | |
3195 | S DR=DR_" I $$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.01 ,""I"")]"" "",'$G(CHN GFRM) R !, ""Edit CMN Informati on for thi s Procedur e? NO// "" ,EDIT S ED IT=$E($ZCO NVERT(EDIT ,""U"")) " | |
3196 | S DR=DR_" W:(EDIT]"" ""&(EDIT'= ""^"")) "" ""_$S(ED IT=""Y"":" "YES"",1:" "NO"") I E DIT'=""Y"" S Y=""@99 9"";" | |
3197 | CERTYP ;En try point to set DR with logic for "Cert ification Type" fiel d in prepa ration for re-prompt ing. | |
3198 | S DR=DR_" @01;S CERT YP(""OLD"" )=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.01 ,""I"");24 .01R~T//IN ITIAL" | |
3199 | S DR=DR_" ;S CERTYP= X I CERTYP (""OLD"")] """",CERTY P]"""",CER TYP'=CERTY P(""OLD"") " | |
3200 | S DR=DR_" S CMSG=$S (CERTYP="" I"":CERTYP (""MSGI"") ,1:CERTYP( ""MSG""))" | |
3201 | S DR=DR_" S OK=$$US EROK^IBCU7 5(24.01,CE RTYP(""OLD ""),CMSG) S:'OK Y="" @01"";@999 ;" | |
3202 | Q | |
3203 | ; | |
3204 | DRCOMM ;Se t DR with logic for the remain ing fields common to all form types | |
3205 | S DR="@06 ;S DTOLD=$ $CMNDATA^I BCEF31(IBX IEN,IBPROC P,24.06,"" I"");24.06 R~T//"_EVN TDT_";D DT CHK^IBCU75 (X,TDY,""0 6"",$G(DTO LD));" | |
3206 | S DR=DR_" I CERTYP=" "I"" S @DG LB@(24.07) ="""",Y="" @02"";" | |
3207 | RRDT ;Entr y point to set DR wi th logic f or "Recert ification/ Revision D ate"... fi elds in pr eparation for re-pro mpting. | |
3208 | S DR=DR_" @07;S DTOL D=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.07 ,""I"");24 .07R~T//"_ EVNTDT_";D DTCHK^IBC U75(X,TDY, ""07"",$G( DTOLD));" | |
3209 | S DR=DR_" @02;S HTOL D=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.02 ,""I"");24 .02T;I X>9 6 S OK=$$U SEROK^IBCU 75(24.02,H TOLD,""Pat ient is ov er 8 feet tall!"")" | |
3210 | S DR=DR_" I 'OK S Y =""@02"";@ 03;S WTOLD =$$CMNDATA ^IBCEF31(I BXIEN,IBPR OCP,24.03, ""I"");24. 03T;I X>50 0 S OK=$$U SEROK^IBCU 75(24.03,W TOLD," | |
3211 | S DR=DR_" ""Patient is over 50 0 pounds!" ") I 'OK S Y=""@03"" ;24.04T;" | |
3212 | STRTDT ;En try point to set DR with logic for "Date Therapy S tarted"... fields in preparati on for re- prompting. | |
3213 | S DR=DR_" @05;S DTOL D=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.05 ,""I"");24 .05R~T//"_ EVNTDT_";D DTCHK^IBC U75(X,TDY, ""05"",$G( DTOLD));@0 8;24.08T// N;" | |
3214 | D @FRMTAG | |
3215 | Q | |
3216 | ; | |
3217 | DR484 ;Set DR with l ogic speci fic for fo rm CMN-484 | |
3218 | S DR=DR_" @100;24.1T ;S ABGPO2= X;@102;24. 102T;S O2S AT=X;I ABG PO2="""",O 2SAT="""" S Y=""@104 "";" | |
3219 | S DR=DR_" @103;S DTO LD=$$CMNDA TA^IBCEF31 (IBXIEN,IB PROCP,24.1 03,""I""); 24.103T;D DTCHK^IBCU 75(X,TDY,1 03,$G(DTOL D));" | |
3220 | S DR=DR_" @104;I (AB GPO2<56!(A BGPO2>59)) ,(O2SAT'=8 9) S @DGLB @(24.104)= """",@DGLB @(24.105)= """"" | |
3221 | S DR=DR_" ,@DGLB@(24 .106)="""" ,Y=""@107" ";24.104T/ /NO;24.105 T//NO;24.1 06T//NO;@1 07;24.107T ;24.108T;2 4.109T;24. 11T;I X'>4 S @DGLB@( 24.111)="" """ | |
3222 | S DR=DR_" ,@DGLB@(24 .113)="""" ,@DGLB@(24 .114)="""" ,Y=""@115" ";24.111T; S ABG4LPM= X;" | |
3223 | S DR=DR_" @113;24.11 3T;I 'ABG4 LPM,'X S Y =""@115"", @DGLB@(24. 114)=""""; " | |
3224 | S DR=DR_" @114;S DTO LD=$$CMNDA TA^IBCEF31 (IBXIEN,IB PROCP,24.1 14,""I""); 24.114T;D DTCHK^IBCU 75(X,TDY,1 14,$G(DTOL D));@115;2 4.115T;@99 9;" | |
3225 | Q | |
3226 | ; | |
3227 | DR10126 ;S et DR with logic spe cific to t he CMN-101 26 | |
3228 | S DR=DR_" @217;S IBP EB(""OLD"" )=$$CMNDAT A^IBCEF31( IBXIEN,IBP ROCP,24.21 7,""I"");2 4.217R~T// P;S IBPEB= X I IBPEB( ""OLD"")]" """,IBPEB] """",IBPEB (""OLD"")' =IBPEB " | |
3229 | S DR=DR_" S OK=$$USE ROK^IBCU75 (24.217,IB PEB(""OLD" "),""You a re changin g the nutr ition type !"") S:'OK Y=""@217" ";I $G(IBP EB)=""P"" S Y=""@206 "" " | |
3230 | S DR=DR_" N I F I=24 .201:.001: 24.205,24. 218,24.219 S @DGLB@( I)="""";24 .201T;24.2 02T;" | |
3231 | S DR=DR_" 24.204T;I '+X S Y="" @205"",@DG LB@(24.203 )="""" I $ $CMNDATA^I BCEF31(IBX IEN,IBPROC P,24.219)] """" S Y=" "@219"";" | |
3232 | S DR=DR_" 24.203T;I '+X S Y="" @205"" I $ $CMNDATA^I BCEF31(IBX IEN,IBPROC P,24.219)] """" S Y=" "@219"";" | |
3233 | S DR=DR_" @219;24.21 9T;I '+X S Y=""@205" ",@DGLB@(2 4.218)=""" ";" | |
3234 | S DR=DR_" 24.218T;@2 05;24.205T ;@206;24.2 06T;I $G(I BPEB)=""E" " S Y=""@9 99"" " | |
3235 | S DR=DR_" N I F I=24 .207:.001: 24.216 S @ DGLB@(I)=" """;" | |
3236 | S DR=DR_" 24.207T;24 .208T;24.2 09T;24.21T ;24.211T;2 4.212T;24. 213T;24.21 5T;24.216T ;@214;24.2 14T;@999;" | |
3237 | Q | |
3238 | ; | |
3239 | COPYCMN(IB XIEN,IBPRO CP,FRMTYP) ;Copy CMN informati on from la st procedu re entered that has it to curr ent proced ure | |
3240 | ;Input: I BXIEN = I nternal bi ll/claim n umber | |
3241 | ; I BPROCP = P rocedure l ine subscr ipt | |
3242 | ; F RMTYP = C MN Form Ty pe ien | |
3243 | ; | |
3244 | N DONE | |
3245 | S DONE=0 | |
3246 | Q:('$G(IB XIEN)!('$G (IBPROCP)! ('$G(FRMTY P)))) | |
3247 | N FRMND,F RMNDI,IBPR OC,IBXSAVE ,Z | |
3248 | S FRMNDI= FORM(FRMTY P) | |
3249 | D CMNDEX^ IBCEF31(IB XIEN,.IBXS AVE) | |
3250 | S Z="" F S Z=$O(IB XSAVE("CMN DEX",Z),-1 ) Q:'Z S IBPROC=+IB XSAVE("CMN DEX",Z) I IBPROCP,IB PROC'=IBPR OCP D Q:D ONE | |
3251 | . Q:('$D( ^DGCR(399, IBXIEN,"CP ",IBPROC," CMN"))!('$ D(^DGCR(39 9,IBXIEN," CP",IBPROC ,FRMNDI))) ) | |
3252 | . S FRMND =$O(^DGCR( 399,IBXIEN ,"CP",IBPR OC,"CMN")) Q:(FRMND= ""!(FRMND' =FRMNDI)) | |
3253 | . S ^DGCR (399,IBXIE N,"CP",IBP ROCP,"CMN" )=^DGCR(39 9,IBXIEN," CP",IBPROC ,"CMN") | |
3254 | . S ^DGCR (399,IBXIE N,"CP",IBP ROCP,FRMND )=^DGCR(39 9,IBXIEN," CP",IBPROC ,FRMND) | |
3255 | . S DONE= 1 | |
3256 | Q | |
3257 | ; | |
3258 | USEROK(FLD ,OLDVAL,MS G) ;JRA;IB *2.0*608 P rompt user if OK to change fie ld value | |
3259 | ;Input: F LD = F ield for w hich we ar e asking t he user to confirm t he change | |
3260 | ; O LDVAL = V alue of th e field be fore user changed | |
3261 | ; M SG = W arning mes sage to di splay to u ser regard ing the im plications of the ch ange | |
3262 | ; | |
3263 | Q:'$G(FLD ) 0 | |
3264 | N DIC,DIR ,X,Y | |
3265 | S OLDVAL= $G(OLDVAL) | |
3266 | W $C(7) I $TR($G(MS G)," ")]"" W !,MSG | |
3267 | S DIR(0)= "Y",DIR("A ")="OK to continue", DIR("B")=" NO" D ^DIR | |
3268 | I Y'=1 D SETFLD(FLD ,OLDVAL) ;Set field back to o ld value i f user doe sn't want to continu e | |
3269 | I Y=1 S X ="^" | |
3270 | Q Y | |
3271 | ; | |
3272 | SETFLD(FLD ,VAL) ;JRA ;IB*2.0*60 8 Set/Dele te field d ata w/out user promp ting | |
3273 | ;Input: F LD = Field to set/de lete | |
3274 | ; V AL = Value to set FL D to (Note : '@' will delete fi eld value) | |
3275 | ; | |
3276 | Q:('$G(FL D)!($G(VAL )="")) | |
3277 | N DIE,DI, DL,DP,DQ,D R,X,Y | |
3278 | S DIE="^D GCR(399,"_ IBXIEN_"," "CP""," | |
3279 | S DR=FLD_ "////"_VAL | |
3280 | D ^DIE | |
3281 | Q | |
3282 | ; | |
3283 | DTCHK(X,TD Y,TAG,DTOL D) ;JRA;IB *2.0*608 C heck if fu ture date entered by user | |
3284 | ;Input: X = Us er entry f or date fi eld (inter nal FileMa n date for mat) | |
3285 | ; TDY = To day's inte rnal FileM an date | |
3286 | ; TAG = Fi eld tag to jump to i f user ent ers a futu re date (u sually re- prompt sam e date) | |
3287 | ; DTOLD = Th e value of the date field prio r to user edit | |
3288 | ; | |
3289 | Q:('$G(X) )!('$G(TAG )) | |
3290 | N FLD | |
3291 | S:$G(DTOL D)="" DTOL D="@" | |
3292 | S:'$G(TDY ) TDY=$$HT FM^DILIBF( +$H) Q:X'> TDY | |
3293 | ;User ent ered futur e date so display er ror and ch ange date back to pr evious val ue. | |
3294 | W $C(7),! ,?3,"Futur e dates no t allowed? ?" | |
3295 | S Y="@"_T AG | |
3296 | D SETFLD( "24."_TAG, DTOLD) ;s et back to prior dat e | |
3297 | Q | |
3298 | ; | |
3299 | ||
3300 | VIII) Cre ate extrac t code for to pull t he values for the ne w CMN fiel ds: | |
3301 | IBCEF31 | |
3302 | Routines | |
3303 | Activities | |
3304 | Routine Na me | |
3305 | IBCEF31 | |
3306 | Enhancemen t Category | |
3307 | New | |
3308 | Modify | |
3309 | Delete | |
3310 | No Change | |
3311 | RTM | |
3312 | ||
3313 | Related Op tions | |
3314 | None | |
3315 | Related Ro utines | |
3316 | Routines “ Called By” | |
3317 | Routines “ Called” | |
3318 | ||
3319 | ||
3320 | ||
3321 | ||
3322 | Data Dicti onary (DD) Reference s | |
3323 | ||
3324 | Related Pr otocols | |
3325 | None | |
3326 | Related In tegration Control Re gistration s (ICRs) | |
3327 | None | |
3328 | Data Passi ng | |
3329 | Input | |
3330 | Output Re ference | |
3331 | Both | |
3332 | Global Re ference | |
3333 | Local | |
3334 | Input Attr ibute Name and Defin ition | |
3335 | Name: | |
3336 | Definition : | |
3337 | Output Att ribute Nam e and Defi nition | |
3338 | Name: | |
3339 | Definition : | |
3340 | Current Lo gic | |
3341 | IBCEF31 ;A LB/ESG - F ORMATTER S PECIFIC BI LL FLD FUN CTIONS - C ONT ;14-NO V-03 | |
3342 | ;;2.0;INT EGRATED BI LLING;**15 5,296,349, 400,432,48 8,516,592* *;21-MAR-9 4;Build 25 | |
3343 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3344 | ; | |
3345 | Q | |
3346 | ; | |
3347 | ALLTYP(IBI FN) ; retu rns codes to transla te to ALL ins types on a bill | |
3348 | ; IBIFN = ien of bi ll | |
3349 | N IBX,Z | |
3350 | F Z=1:1:3 S $P(IBX, U,Z)=$$INS TYP(IBIFN, Z) | |
3351 | ; IBX = p rimary cod e^secondar y code^ter tiary code | |
3352 | Q IBX | |
3353 | ; | |
3354 | INSTYP(IBI FN,SEQ) ; Returns in surance ty pe code fo r an ins o n a bill | |
3355 | ; IBIFN = ien of bi ll | |
3356 | ; SEQ = s equence (1 ,2,3) of i nsurance w anted - pr im, second , tert | |
3357 | ; D efault is current in surance co | |
3358 | ; | |
3359 | N IBA,Z | |
3360 | ; | |
3361 | I '$G(SEQ ) S SEQ=$$ COBN^IBCEF (IBIFN) | |
3362 | S Z=+$G(^ DGCR(399,I BIFN,"I"_S EQ)) | |
3363 | ;Codes 1: HMO;2:COMM ERCIAL;3:M EDICARE;4: MEDICAID;5 :GROUP POL ICY;9:OTHE R | |
3364 | I Z D | |
3365 | . S IBA=$ P($G(^DIC( 36,Z,3)),U ,9) | |
3366 | . I $$MCR WNR^IBEFUN C(Z) S IBA =3 ; for ce Medicar e (WNR) de finition t o be corre ct | |
3367 | . I IBA=" " S IBA=5 ;Default i s group po licy - 5 i f blank | |
3368 | ; | |
3369 | Q $G(IBA) | |
3370 | ; | |
3371 | POLTYP(IBI FN,IBSEQ) ; Returns ins electr onic polic y type cod e for one | |
3372 | ; ins p olicy on a bill | |
3373 | ; IBIFN = ien of bi ll | |
3374 | ; IBSEQ = sequence (1,2,3) of ins polic y wanted - prim, sec ond, tert | |
3375 | ; D efault is current in surance co | |
3376 | ; | |
3377 | N IBPLAN, IBPLTYP | |
3378 | ; | |
3379 | I '$G(IBS EQ) S IBSE Q=+$$COBN^ IBCEF(IBIF N) | |
3380 | S IBPLAN= $G(^IBA(35 5.3,+$P($G (^DGCR(399 ,IBIFN,"I" _IBSEQ)),U ,18),0)) | |
3381 | S IBPLTYP =$P(IBPLAN ,U,15) | |
3382 | ; | |
3383 | ; esg - 0 6/30/05 - IB*2.0*296 - Force M edicare (W NR) to be correct | |
3384 | ;JRA IB*2 .0*592 Tre at Dental Form 7 (J4 30D) the s ame as CMS -1500 | |
3385 | ;I $$WNRB ILL^IBEFUN C(IBIFN,IB SEQ),$$FT^ IBCEF(IBIF N)=2 S IBP LTYP="MB" ; CMS-15 00 ----> M edicare Pa rt B ;JRA IB*2.0*59 2 ';' | |
3386 | ;I $$WNRB ILL^IBEFUN C(IBIFN,IB SEQ),$$FT^ IBCEF(IBIF N)=3 S IBP LTYP="MA" ; UB-04 -------> M edicare Pa rt A | |
3387 | N FT S FT =$$FT^IBCE F(IBIFN) ;JRA IB*2. 0*592 | |
3388 | I $$WNRBI LL^IBEFUNC (IBIFN,IBS EQ),(FT=2! (FT=7)) S IBPLTYP="M B" ; CMS -1500 ---- > Medicare Part B ; JRA IB*2.0 *592 same for J430D | |
3389 | I $$WNRBI LL^IBEFUNC (IBIFN,IBS EQ),FT=3 S IBPLTYP=" MA" ; UB -04 ------ -> Medicar e Part A ;JRA IB*2. 0*592 Use 'FT' vs fu nction cal l | |
3390 | ; | |
3391 | I IBPLTYP ="" S IBPL TYP="CI" ; Default is commercia l - 'CI' | |
3392 | I IBPLTYP ="MX" D | |
3393 | . I $P(IB PLAN,U,14) '="","AB"[ $P(IBPLAN, U,14) S IB PLTYP="M"_ $P(IBPLAN, U,14) Q | |
3394 | . S IBPLT YP="CI" | |
3395 | Q $G(IBPL TYP) | |
3396 | ; | |
3397 | ALLPTYP(IB IFN) ; ret urns insur ance polic y type cod es for ALL ins on a bill | |
3398 | ; IBIFN = ien of bi ll | |
3399 | N IBX,Z S IBX="" | |
3400 | F Z=1:1:3 I $D(^DGC R(399,IBIF N,"I"_Z)) S $P(IBX,U ,Z)=$$POLT YP(IBIFN,Z ) | |
3401 | ; IBX = p rimary cod e^secondar y code^ter tiary code | |
3402 | Q IBX | |
3403 | ; | |
3404 | PGDX(DXCNT ,IBX0,IBXD A,IBXLN,IB XCOL,IBXSI ZE,IBXSAVE ) ; Subrou tine - Che cks for Di agnosis Co des (Dx) b eyond | |
3405 | ; the fir st four, t hat relate to the cu rrent Dx p osition pa ssed in DX CNT. | |
3406 | ; This su broutine s tores the Diagnosis Codes in o utput glob al using d isplay par ameters (I BXLN,IBXCO L) | |
3407 | ; THE PA GE IS ALWA YS 1 NOW S O WE DON'T NEED 4 LI NES BELOW BAA *488* | |
3408 | ; If DXCN T is 1, ch eck for Dx 's 5,9,... etc & disp lay on pag es 2,3,... etc | |
3409 | ; If DXCN T is 2, ch eck for Dx 's 6,10,.. .etc & dis play on pa ges 2,3,.. .etc | |
3410 | ; If DXCN T is 3, ch eck for Dx 's 7,11,.. .etc & dis play on pa ges 2,3,.. .etc | |
3411 | ; If DXCN T is 4, ch eck for Dx 's 8,12,.. .etc & dis play on pa ges 2,3,.. .etc | |
3412 | ; | |
3413 | ; Input: DXCNT= pos ition of c urrent Dx (from 1 to 4) | |
3414 | ; IBX0= zero -level of file 364.7 of curren t Dx | |
3415 | ; IBXDA= ien # of file 364.6 of c urrent Dx | |
3416 | ; IBXLN IBXC OL= line# & Column# of current Dx | |
3417 | ; IBXSIZE= s ize counte r | |
3418 | ; IBXSAVE("D X")= local array wit h all Dx's on curren t bill | |
3419 | ; | |
3420 | ; For pa tch *488* | |
3421 | ; S DXNM = 12 Thi s is the n umber of d iagnosis o n a 1500 f orm | |
3422 | ; S IBPG =1 This i s the page number. All 12 pri nt on page 1 | |
3423 | N IBPG,VA L | |
3424 | S IBPG=1 | |
3425 | I '$D(IBX SAVE("DX", DXCNT)) Q | |
3426 | S VAL=$P( $$ICD9^IBA CSV(+IBXSA VE("DX",DX CNT)),U) ; resolve Dx pointe r | |
3427 | S VAL=$$F ORMAT^IBCE F3(VAL,$G( IBX0),$G(I BXDA)) ;f ormat Dx v alue | |
3428 | D SETGBL^ IBCEFG(IBP G,IBXLN,IB XCOL,VAL,. IBXSIZE) ; store in o utput glob al | |
3429 | Q ;PGDX | |
3430 | ; | |
3431 | DXSV(IB,IB XSAVE) ; o utput form atter subr outine | |
3432 | ; save of f DX codes in IBXSAV E("DX") | |
3433 | N Z,IBCT | |
3434 | S (Z,IBCT )=0 | |
3435 | F S Z=$O (IB(Z)) Q: 'Z I $G(I B(Z)) S IB CT=IBCT+1 M IBXSAVE( "DX",IBCT) =IB(Z) | |
3436 | Q | |
3437 | ; | |
3438 | AUTRF(IBXI EN,IBL,Z) ; returns auth # and referral# if room f or both, s eparated b y a space - IB*2.0*4 32 | |
3439 | ; IBXIEN= claim ie n | |
3440 | ; IBL = field le ngth-1 to allow for 1 blank sp ace betwee n numbers (28 for CM S 1500, 30 for UB-04 ) | |
3441 | ; Z = 1 for PR IMARY, 2 f or SECONDA RY, 3 for TERTIARY | |
3442 | ; | |
3443 | N IBXDATA ,IBZ | |
3444 | Q:$G(IBXI EN)="" "" | |
3445 | ; if CMS 1500, find current c odes | |
3446 | I $G(Z)=" ",$G(IBL)= 28 S Z=$$C OBN^IBCEF( IBXIEN) | |
3447 | Q:$G(Z)=" " "" | |
3448 | ; if leng th not def ined, defa ult to sho rtest | |
3449 | S:IBL="" IBL=28 | |
3450 | D F^IBCEF ("N-"_$P(" PRIMARY^SE CONDARY^TE RTIARY",U, Z)_" AUTH CODE",,,IB XIEN) | |
3451 | D F^IBCEF ("N-"_$P(" PRIMARY^SE CONDARY^TE RTIARY",U, Z)_" REFER RAL NUMBER ","IBZ",,I BXIEN) | |
3452 | ; if leng th of auth and refer ral combin ed is too long, only return au th code | |
3453 | Q $S(IBZ= "":IBXDATA ,IBXDATA=" ":IBZ,$L(I BXDATA)+$L (IBZ)>IBL: IBXDATA,1: IBXDATA_" "_IBZ) | |
3454 | ; | |
3455 | GRPNAME(IB IEN,IBXDAT A) ; Popul ate IBXDAT A with the Group Nam e(s). | |
3456 | ; MRD;IB* 2.0*516 - Created th is procedu re as extr act code f or | |
3457 | ; ^IBA(36 4.5,199), N-ALL INSU RANCE GROU P NAME. | |
3458 | N A,Z | |
3459 | F Z=1:1:3 I $D(^DGC R(399,IBIE N,"I"_Z)) D | |
3460 | . S IBXDA TA(Z)=$$PO LICY^IBCEF (IBIEN,15, Z) I IBXDA TA(Z)'="" Q | |
3461 | . S A=$$P OLICY^IBCE F(IBIEN,1, Z) ; Pull piece 1, I ns. Type. | |
3462 | . I A'="" S IBXDATA (Z)=$P($G( ^DIC(36,+A ,0)),U) | |
3463 | . Q | |
3464 | Q | |
3465 | ; | |
3466 | GRPNUM(IBX IEN,IBXDAT A) ; Popul ate IBXDAT A with the Group Num ber(s). | |
3467 | ; MRD;IB* 2.0*516 - Created th is procedu re as extr act code f or | |
3468 | ; ^IBA(36 4.5,200), N-ALL INSU RANCE GROU P NUMBER. | |
3469 | N Z | |
3470 | F Z=1:1:3 I $D(^DGC R(399,IBXI EN,"I"_Z)) S IBXDATA (Z)=$$POLI CY^IBCEF(I BXIEN,3,Z) | |
3471 | Q | |
3472 | ; | |
3473 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
3474 | IBCEF31 ;A LB/ESG - F ORMATTER S PECIFIC BI LL FLD FUN CTIONS - C ONT ;14-NO V-03 | |
3475 | ;;2.0;INT EGRATED BI LLING;**15 5,296,349, 400,432,48 8,516,592, 608**;21-M AR-94;Buil d 40 | |
3476 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3477 | ; | |
3478 | Q | |
3479 | ; | |
3480 | ALLTYP(IBI FN) ; retu rns codes to transla te to ALL ins types on a bill | |
3481 | ; IBIFN = ien of bi ll | |
3482 | N IBX,Z | |
3483 | F Z=1:1:3 S $P(IBX, U,Z)=$$INS TYP(IBIFN, Z) | |
3484 | ; IBX = p rimary cod e^secondar y code^ter tiary code | |
3485 | Q IBX | |
3486 | ; | |
3487 | INSTYP(IBI FN,SEQ) ; Returns in surance ty pe code fo r an ins o n a bill | |
3488 | ; IBIFN = ien of bi ll | |
3489 | ; SEQ = s equence (1 ,2,3) of i nsurance w anted - pr im, second , tert | |
3490 | ; D efault is current in surance co | |
3491 | ; | |
3492 | N IBA,Z | |
3493 | ; | |
3494 | I '$G(SEQ ) S SEQ=$$ COBN^IBCEF (IBIFN) | |
3495 | S Z=+$G(^ DGCR(399,I BIFN,"I"_S EQ)) | |
3496 | ;Codes 1: HMO;2:COMM ERCIAL;3:M EDICARE;4: MEDICAID;5 :GROUP POL ICY;9:OTHE R | |
3497 | I Z D | |
3498 | . S IBA=$ P($G(^DIC( 36,Z,3)),U ,9) | |
3499 | . I $$MCR WNR^IBEFUN C(Z) S IBA =3 ; for ce Medicar e (WNR) de finition t o be corre ct | |
3500 | . I IBA=" " S IBA=5 ;Default i s group po licy - 5 i f blank | |
3501 | ; | |
3502 | Q $G(IBA) | |
3503 | ; | |
3504 | POLTYP(IBI FN,IBSEQ) ; Returns ins electr onic polic y type cod e for one | |
3505 | ; ins p olicy on a bill | |
3506 | ; IBIFN = ien of bi ll | |
3507 | ; IBSEQ = sequence (1,2,3) of ins polic y wanted - prim, sec ond, tert | |
3508 | ; D efault is current in surance co | |
3509 | ; | |
3510 | N IBPLAN, IBPLTYP | |
3511 | ; | |
3512 | I '$G(IBS EQ) S IBSE Q=+$$COBN^ IBCEF(IBIF N) | |
3513 | S IBPLAN= $G(^IBA(35 5.3,+$P($G (^DGCR(399 ,IBIFN,"I" _IBSEQ)),U ,18),0)) | |
3514 | S IBPLTYP =$P(IBPLAN ,U,15) | |
3515 | ; | |
3516 | ; esg - 0 6/30/05 - IB*2.0*296 - Force M edicare (W NR) to be correct | |
3517 | ;JRA IB*2 .0*592 Tre at Dental Form 7 (J4 30D) the s ame as CMS -1500 | |
3518 | ;I $$WNRB ILL^IBEFUN C(IBIFN,IB SEQ),$$FT^ IBCEF(IBIF N)=2 S IBP LTYP="MB" ; CMS-15 00 ----> M edicare Pa rt B ;JRA IB*2.0*59 2 ';' | |
3519 | ;I $$WNRB ILL^IBEFUN C(IBIFN,IB SEQ),$$FT^ IBCEF(IBIF N)=3 S IBP LTYP="MA" ; UB-04 -------> M edicare Pa rt A | |
3520 | N FT S FT =$$FT^IBCE F(IBIFN) ;JRA IB*2. 0*592 | |
3521 | I $$WNRBI LL^IBEFUNC (IBIFN,IBS EQ),(FT=2! (FT=7)) S IBPLTYP="M B" ; CMS -1500 ---- > Medicare Part B ; JRA IB*2.0 *592 same for J430D | |
3522 | I $$WNRBI LL^IBEFUNC (IBIFN,IBS EQ),FT=3 S IBPLTYP=" MA" ; UB -04 ------ -> Medicar e Part A ;JRA IB*2. 0*592 Use 'FT' vs fu nction cal l | |
3523 | ; | |
3524 | I IBPLTYP ="" S IBPL TYP="CI" ; Default is commercia l - 'CI' | |
3525 | I IBPLTYP ="MX" D | |
3526 | . I $P(IB PLAN,U,14) '="","AB"[ $P(IBPLAN, U,14) S IB PLTYP="M"_ $P(IBPLAN, U,14) Q | |
3527 | . S IBPLT YP="CI" | |
3528 | Q $G(IBPL TYP) | |
3529 | ; | |
3530 | ALLPTYP(IB IFN) ; ret urns insur ance polic y type cod es for ALL ins on a bill | |
3531 | ; IBIFN = ien of bi ll | |
3532 | N IBX,Z S IBX="" | |
3533 | F Z=1:1:3 I $D(^DGC R(399,IBIF N,"I"_Z)) S $P(IBX,U ,Z)=$$POLT YP(IBIFN,Z ) | |
3534 | ; IBX = p rimary cod e^secondar y code^ter tiary code | |
3535 | Q IBX | |
3536 | ; | |
3537 | PGDX(DXCNT ,IBX0,IBXD A,IBXLN,IB XCOL,IBXSI ZE,IBXSAVE ) ; Subrou tine - Che cks for Di agnosis Co des (Dx) b eyond | |
3538 | ; the fir st four, t hat relate to the cu rrent Dx p osition pa ssed in DX CNT. | |
3539 | ; This su broutine s tores the Diagnosis Codes in o utput glob al using d isplay par ameters (I BXLN,IBXCO L) | |
3540 | ; THE PA GE IS ALWA YS 1 NOW S O WE DON'T NEED 4 LI NES BELOW BAA *488* | |
3541 | ; If DXCN T is 1, ch eck for Dx 's 5,9,... etc & disp lay on pag es 2,3,... etc | |
3542 | ; If DXCN T is 2, ch eck for Dx 's 6,10,.. .etc & dis play on pa ges 2,3,.. .etc | |
3543 | ; If DXCN T is 3, ch eck for Dx 's 7,11,.. .etc & dis play on pa ges 2,3,.. .etc | |
3544 | ; If DXCN T is 4, ch eck for Dx 's 8,12,.. .etc & dis play on pa ges 2,3,.. .etc | |
3545 | ; | |
3546 | ; Input: DXCNT= pos ition of c urrent Dx (from 1 to 4) | |
3547 | ; IBX0= zero -level of file 364.7 of curren t Dx | |
3548 | ; IBXDA= ien # of file 364.6 of c urrent Dx | |
3549 | ; IBXLN IBXC OL= line# & Column# of current Dx | |
3550 | ; IBXSIZE= s ize counte r | |
3551 | ; IBXSAVE("D X")= local array wit h all Dx's on curren t bill | |
3552 | ; | |
3553 | ; For pa tch *488* | |
3554 | ; S DXNM = 12 Thi s is the n umber of d iagnosis o n a 1500 f orm | |
3555 | ; S IBPG =1 This i s the page number. All 12 pri nt on page 1 | |
3556 | N IBPG,VA L | |
3557 | S IBPG=1 | |
3558 | I '$D(IBX SAVE("DX", DXCNT)) Q | |
3559 | S VAL=$P( $$ICD9^IBA CSV(+IBXSA VE("DX",DX CNT)),U) ; resolve Dx pointe r | |
3560 | S VAL=$$F ORMAT^IBCE F3(VAL,$G( IBX0),$G(I BXDA)) ;f ormat Dx v alue | |
3561 | D SETGBL^ IBCEFG(IBP G,IBXLN,IB XCOL,VAL,. IBXSIZE) ; store in o utput glob al | |
3562 | Q ;PGDX | |
3563 | ; | |
3564 | DXSV(IB,IB XSAVE) ; o utput form atter subr outine | |
3565 | ; save of f DX codes in IBXSAV E("DX") | |
3566 | N Z,IBCT | |
3567 | S (Z,IBCT )=0 | |
3568 | F S Z=$O (IB(Z)) Q: 'Z I $G(I B(Z)) S IB CT=IBCT+1 M IBXSAVE( "DX",IBCT) =IB(Z) | |
3569 | Q | |
3570 | ; | |
3571 | AUTRF(IBXI EN,IBL,Z) ; returns auth # and referral# if room f or both, s eparated b y a space - IB*2.0*4 32 | |
3572 | ; IBXIEN= claim ie n | |
3573 | ; IBL = field le ngth-1 to allow for 1 blank sp ace betwee n numbers (28 for CM S 1500, 30 for UB-04 ) | |
3574 | ; Z = 1 for PR IMARY, 2 f or SECONDA RY, 3 for TERTIARY | |
3575 | ; | |
3576 | N IBXDATA ,IBZ | |
3577 | Q:$G(IBXI EN)="" "" | |
3578 | ; if CMS 1500, find current c odes | |
3579 | I $G(Z)=" ",$G(IBL)= 28 S Z=$$C OBN^IBCEF( IBXIEN) | |
3580 | Q:$G(Z)=" " "" | |
3581 | ; if leng th not def ined, defa ult to sho rtest | |
3582 | S:IBL="" IBL=28 | |
3583 | D F^IBCEF ("N-"_$P(" PRIMARY^SE CONDARY^TE RTIARY",U, Z)_" AUTH CODE",,,IB XIEN) | |
3584 | D F^IBCEF ("N-"_$P(" PRIMARY^SE CONDARY^TE RTIARY",U, Z)_" REFER RAL NUMBER ","IBZ",,I BXIEN) | |
3585 | ; if leng th of auth and refer ral combin ed is too long, only return au th code | |
3586 | Q $S(IBZ= "":IBXDATA ,IBXDATA=" ":IBZ,$L(I BXDATA)+$L (IBZ)>IBL: IBXDATA,1: IBXDATA_" "_IBZ) | |
3587 | ; | |
3588 | GRPNAME(IB IEN,IBXDAT A) ; Popul ate IBXDAT A with the Group Nam e(s). | |
3589 | ; MRD;IB* 2.0*516 - Created th is procedu re as extr act code f or | |
3590 | ; ^IBA(36 4.5,199), N-ALL INSU RANCE GROU P NAME. | |
3591 | N A,Z | |
3592 | F Z=1:1:3 I $D(^DGC R(399,IBIE N,"I"_Z)) D | |
3593 | . S IBXDA TA(Z)=$$PO LICY^IBCEF (IBIEN,15, Z) I IBXDA TA(Z)'="" Q | |
3594 | . S A=$$P OLICY^IBCE F(IBIEN,1, Z) ; Pull piece 1, I ns. Type. | |
3595 | . I A'="" S IBXDATA (Z)=$P($G( ^DIC(36,+A ,0)),U) | |
3596 | . Q | |
3597 | Q | |
3598 | ; | |
3599 | GRPNUM(IBX IEN,IBXDAT A) ; Popul ate IBXDAT A with the Group Num ber(s). | |
3600 | ; MRD;IB* 2.0*516 - Created th is procedu re as extr act code f or | |
3601 | ; ^IBA(36 4.5,200), N-ALL INSU RANCE GROU P NUMBER. | |
3602 | N Z | |
3603 | F Z=1:1:3 I $D(^DGC R(399,IBXI EN,"I"_Z)) S IBXDATA (Z)=$$POLI CY^IBCEF(I BXIEN,3,Z) | |
3604 | Q | |
3605 | ; | |
3606 | CMNDATA(IB XIEN,IBPRO C,FLD,INT) ;JRA;IB*2 .0*608 Ret urn data f or specifi ed Certifi cate of Me dical Nece ssity (CMN ) field. | |
3607 | ;Created to return data for a specific CMN field, which is a subfield of file 3 99, field 304 (Proce dure). Re turns data | |
3608 | ; in Exte rnal forma t by defau lt. | |
3609 | ; | |
3610 | ;Input: IBXIEN = I nternal bi ll/claim n umber | |
3611 | ; IBPROC = P rocedure # (subscrip t in ^DGCR ) | |
3612 | ; FLD = F ield numbe r of desir ed field | |
3613 | ; INT = F lag set to 'I' if th e subfield 's Interna l value is to be ret urned (opt ional) | |
3614 | ; | |
3615 | ;Output: VAL = E xternal (o r optional ly Interna l) value o f the CMN subfield s pecified b y FLD | |
3616 | ; | |
3617 | Q:('$G(IB XIEN)!('$G (FLD)!('$G (IBPROC))) ) "" | |
3618 | S INT=$G( INT) | |
3619 | N ND,VAL, X | |
3620 | S ND=IBPR OC_","_IBX IEN | |
3621 | S VAL=$$G ET1^DIQ(39 9.0304,ND, FLD,INT) | |
3622 | Q VAL | |
3623 | ; | |
3624 | CMNDEX(IBX IEN,IBXSAV E) ;JRA;IB *2.0*608 D ata Extrac t for LQ, CMN and ME A segments | |
3625 | Q:'$G(IBX IEN) | |
3626 | ; | |
3627 | N CMNREQ, ND,X,IBXDA TA | |
3628 | ;Get Proc edure Link s for all Procedures on the cl aim. | |
3629 | D OUTPT^I BCEF11(IBX IEN,0) Q:' $D(IBXDATA ) | |
3630 | N LP,Z,CN T | |
3631 | S LP=0 F S LP=$O(I BXDATA(LP) ) Q:'+LP D | |
3632 | . S CNT=$ G(CNT)+1 | |
3633 | . Q:'$D(I BXDATA(LP, "CPLNK")) | |
3634 | . S ND=IB XDATA(LP," CPLNK") | |
3635 | . S ND=ND _","_IBXIE N_"," | |
3636 | . S CMNRE Q=$$GET1^D IQ(399.030 4,ND,23,"I ") | |
3637 | . S:CMNRE Q="" CMNRE Q=0 | |
3638 | . Q:'+CMN REQ | |
3639 | . S Z=$G( Z)+1 | |
3640 | . S IBXSA VE("CMNDEX ",Z)=IBXDA TA(LP,"CPL NK")_U_CNT | |
3641 | Q | |
3642 | ; | |
3643 | FRM(IBXIEN ,IBXSAVE) ;JRA;IB*2. 0*608 Data Extract f or FRM seg ment | |
3644 | Q:'$G(IBX IEN) | |
3645 | ; | |
3646 | N CMNREQ, CNT,DEL,IB XDATA,LP,N D,QUIT,X,Z ,Z1 | |
3647 | ;Get Proc edure Data for all P rocedures on the cla im. | |
3648 | D OUTPT^I BCEF11(IBX IEN,0) Q:' $D(IBXDATA ) | |
3649 | S LP=0 F S LP=$O(I BXDATA(LP) ) Q:'+LP D | |
3650 | . Q:'$D(I BXDATA(LP, "CPLNK")) | |
3651 | . S CNT=$ G(CNT)+1 | |
3652 | . S ND=IB XDATA(LP," CPLNK") | |
3653 | . S ND=ND _","_IBXIE N_"," | |
3654 | . S CMNRE Q=$$GET1^D IQ(399.030 4,ND,23,"I ") | |
3655 | . S:CMNRE Q="" CMNRE Q=0 | |
3656 | . Q:'+CMN REQ | |
3657 | . S Z=$G( Z)+1 | |
3658 | . ;WHAT F ORM | |
3659 | . N DATA, FORM,FLD,F LDS,INTEXT ,QUES,QUES NUM,X | |
3660 | . S FORM= $TR($$GET1 ^DIQ(399.0 304,ND,"24 :3","I")," -") ; get the form number to figure wha t fields g o with it | |
3661 | . Q:FORM= "" ; quit if no for m number | |
3662 | . ; | |
3663 | . S FLDS= $P($T(@FOR M),";;",2, 9999) ; get all th e associat ed data fi elds from below | |
3664 | . ; | |
3665 | . N PAIRE DQA | |
3666 | . ;Parse FLDS to ge t DD field , question number, t ype of res ponse (2=Y /N, 3=text /code, 4=d ate, 5=per cent/decim al), and t he respons e data. | |
3667 | . F X=1:1 S QUES=$P (FLDS,"~", X) Q:QUES ="" D | |
3668 | .. S FLD= $P(QUES,U) | |
3669 | .. S QUES NUM=$P(QUE S,U,2) | |
3670 | .. S RESP TYP=$P(QUE S,U,3) | |
3671 | .. I RESP TYP=4 S IN TEXT="I" | |
3672 | .. E S I NTEXT=$P(Q UES,U,4) S :INTEXT="" INTEXT="E " | |
3673 | .. S DATA =$$GET1^DI Q(399.0304 ,ND,FLD,IN TEXT) | |
3674 | .. ; | |
3675 | .. ; KLUD GE; On for m CMN10126 If 4A or 3A is blan k, don't s end ther o ther (whic h means ge t rid of t he previou s Q/A) | |
3676 | .. ; same for 4B/3B | |
3677 | .. I FORM ="CMN10126 ",".3A.3B. 4A.4B."[QU ESNUM S PA IRQ=0 D Q :PAIRQ | |
3678 | ... I QUE SNUM="3A"! (QUESNUM=" 3B") S PAI REDQA(QUES NUM)=DATA Q | |
3679 | ... I QUE SNUM="4A", $G(PAIREDQ A("3A"))=" " S PAIRQ= 1 Q | |
3680 | ... I QUE SNUM="4B", $G(PAIREDQ A("3B"))=" " S PAIRQ= 1 Q | |
3681 | ..; | |
3682 | .. Q:DATA ="" ;Do n ot include FRM rec f or unanswe red questi ons | |
3683 | .. ; | |
3684 | .. S:RESP TYP=2 DATA =$E(DATA) ; only wa nt Y or N | |
3685 | .. S:RESP TYP=4 DATA =$$DT^IBCE FG1(DATA," ","D8") ; YYYYMMDD d ate format | |
3686 | .. ;Proce dure# has a 1 to man y ratio wi th Questio n# but can 't have 2 subscripts so combin e into 1, ordering I BXSAVE by Question#. | |
3687 | .. S IBXS AVE("FRM", (Z_"_"_(X/ 10)))=QUES NUM_U | |
3688 | .. S $P(I BXSAVE("FR M",(Z_"_"_ (X/10))),U ,RESPTYP)= DATA | |
3689 | .. S $P(I BXSAVE("FR M",(Z_"_"_ (X/10))),U ,6)=CNT | |
3690 | ; | |
3691 | ;Re-subsc ript IBXSA VE with se quential i ntegers as current s ubscript f ormat will not work with Outpu t Formatte r. | |
3692 | S (Z,Z1)= 0 F S Z=$ O(IBXSAVE( "FRM",Z)) Q:'Z S Z1 =Z1+1,IBXS AVE("FRM", Z1)=IBXSAV E("FRM",Z) ,DEL(Z)="" | |
3693 | S Z=0 F S Z=$O(DEL (Z)) Q:'Z K IBXSAVE ("FRM",Z) | |
3694 | Q | |
3695 | ; | |
3696 | PTWT(IBXIE N) ;JRA;IB *2.0*608 R eturn CMN Patient We ight from 1st Servic e Line # t hat has it (or NULL if none) | |
3697 | Q:'$G(IBX IEN) | |
3698 | N FOUND,I BPROC,IBXS AVE,PTWT | |
3699 | D CMNDEX( IBXIEN,.IB XSAVE) | |
3700 | S (FOUND, Z)=0,PTWT= "" F S Z= $O(IBXSAVE ("CMNDEX", Z)) Q:Z="" D Q:FOU ND | |
3701 | . S IBPRO C=+IBXSAVE ("CMNDEX", Z) Q:'IBPR OC | |
3702 | . S PTWT= $$CMNDATA( IBXIEN,IBP ROC,24.03) S:PTWT FO UND=1 | |
3703 | Q PTWT | |
3704 | ; | |
3705 | ;JRA;IB*2 .0*608 Tag s CMN484 & CMN10126 added | |
3706 | ; FIELD#^ QUESTION#^ RESPONSE_T YPE^INT/EX T | |
3707 | CMN484 ;;2 4.1^1A^3~2 4.102^1B^5 ~24.103^1C ^4~24.107^ 2^3^I~24.1 08^3^3^I~2 4.109^4^3^ I~24.11^5^ 3~24.111^6 A^3~24.113 ^6B^5~24.1 14^6C^4~24 .104^7^2~2 4.105^8^2~ 24.106^9^2 ~24.115^C^ 3 | |
3708 | ; | |
3709 | CMN10126 ; ;24.201^1^ 2~24.202^2 ^2~24.204^ 3A^3~24.21 9^3B^3~24. 203^4A^3~2 4.218^4B^3 ~24.205^5^ 3^I~24.206 ^6^3~24.20 7^7^2~24.2 08^8A^3~24 .209^8B^5~ 24.21^8C^3 ~24.211^8D ^3~24.212^ 8E^5~24.21 3^8F^3~24. 215^8G^3~2 4.216^8H^5 ~24.214^9^ 3^I | |
3710 | ; | |
3711 | ||
3712 | ||
3713 | IX) Add t he CMN nod es to comp arison cod e: | |
3714 | IBCF23A | |
3715 | Routines | |
3716 | Activities | |
3717 | Routine Na me | |
3718 | IBCF23A | |
3719 | Enhancemen t Category | |
3720 | New | |
3721 | Modify | |
3722 | Delete | |
3723 | No Change | |
3724 | RTM | |
3725 | ||
3726 | Related Op tions | |
3727 | None | |
3728 | Related Ro utines | |
3729 | Routines “ Called By” | |
3730 | Routines “ Called” | |
3731 | ||
3732 | ||
3733 | ||
3734 | ||
3735 | Data Dicti onary (DD) Reference s | |
3736 | ||
3737 | Related Pr otocols | |
3738 | None | |
3739 | Related In tegration Control Re gistration s (ICRs) | |
3740 | None | |
3741 | Data Passi ng | |
3742 | Input | |
3743 | Output Re ference | |
3744 | Both | |
3745 | Global Re ference | |
3746 | Local | |
3747 | Input Attr ibute Name and Defin ition | |
3748 | Name: | |
3749 | Definition : | |
3750 | Output Att ribute Nam e and Defi nition | |
3751 | Name: | |
3752 | Definition : | |
3753 | Current Lo gic | |
3754 | IBCF23A ;A LB/ARH - H CFA 1500 1 9-90 DATA - Split fr om IBCF23 ;12-JUN-93 | |
3755 | ;;2.0;INT EGRATED BI LLING;**51 ,432,516,5 47,577,592 **;21-MAR- 94;Build 2 5 | |
3756 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3757 | ; | |
3758 | ; $$INSTA LDT^XPDUTL (IBPATCH,. IBARY) - I CR 10141 | |
3759 | ; | |
3760 | B24 ; set individual entries i n print ar ray, exter nal format | |
3761 | ; IBAUX = additiona l data for EDI outpu t | |
3762 | ; IBRXF = array of RX procedu res | |
3763 | ;JWS;IB*2 .0*592;US1 31 | |
3764 | ; IBDEN = Dental da ta for EDI output | |
3765 | ; IBDEN1 = array of Dental da ta for EDI output | |
3766 | N IBX,Z,I BD1,IBD2,I BCPLINK | |
3767 | S IBI=IBI +1,IBPROC= $P(IBSS,U, 2),IBD1=$$ DATE^IBCF2 3(IBDT1),I BD2=$S(IBD T1'=IBDT2: $$DATE^IBC F23(IBDT2) ,1:"") | |
3768 | I '$D(IBX IEN) S IBD 1=$E(IBD1, 5,8)_$E(IB D1,1,4),IB D2=$E(IBD2 ,5,8)_$E(I BD2,1,4) | |
3769 | S IBFLD(2 4,IBI)=IBD 1_U_IBD2_U _$P($G(^IB E(353.1,+$ P(IBSS,U,6 ),0)),U)_U _$P($G(^IB E(353.2,+$ P(IBSS,U,7 ),0)),U) | |
3770 | I +IBPROC D | |
3771 | . S IBFLD (24,IBI)=I BFLD(24,IB I)_U_$P($$ PRCD^IBCEF 1(IBPROC,1 ),U,2) S:$ P(IBPROC," ;",2)'["IC PT" IBFLD( 24,IBI_"X" )="" | |
3772 | I 'IBPROC S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_$S('$D( IBXIEN):IB PROC,1:+IB REV),IBFLD (24,IBI_"A ")=$P($G(^ DGCR(399.2 ,+IBREV,0) ),U,2) | |
3773 | I $D(IBRX F),IBCHARG ="" S IBFL D(24,IBI_" A")=$P($G( ^DGCR(399. 2,+IBREV,0 )),U,2) | |
3774 | S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_$P(IBSS ,U,5)_U_IB CHARG_U_IB UNIT_U_$P( IBSS,U,8)_ U_$G(IBPCH G)_U_$G(IB MIN)_U_$G( IBEMG) | |
3775 | I $D(IBSS ("L")) S Z =0 F S Z= $O(IBSS("L ",Z)) Q:'Z S IBFLD( 24,IBI,$P( IBSS("L",Z ),U),$P(IB SS("L",Z), U,2))=$G(I BFLD(24,IB I,$P(IBSS( "L",Z),U), $P(IBSS("L ",Z),U,2)) )+1 | |
3776 | S:$TR($G( IBAUX),U)' ="" IBFLD( 24,IBI,"AU X")=$G(IBA UX) | |
3777 | S:$D(IBRX F) IBFLD(2 4,IBI,"RX" )=IBRXF | |
3778 | K IBPROC, IBSS("L") | |
3779 | S IBCPLIN K=$P(IBSS, U,$L(IBSS, U)) | |
3780 | S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_IBCPLIN K | |
3781 | ; MRD;IB* 2.0*516 - Added NDC and Units to line le vel of cla im. | |
3782 | ;I IBCPLI NK'="" S $ P(IBFLD(24 ,IBI),U,14 ,15)=$TR($ P($G(^DGCR (399,IBIFN ,"CP",IBCP LINK,1)),U ,7,8),"-") | |
3783 | ; vd/Begi nning of I B*2*577 - Added Unit /Basis of Measurment to line l evel of cl aim. | |
3784 | I IBCPLIN K'="" S $P (IBFLD(24, IBI),U,14, 16)=$TR($P ($G(^DGCR( 399,IBIFN, "CP",IBCPL INK,1)),U, 7,8),"-")_ U_$P($G(^D GCR(399,IB IFN,"CP",I BCPLINK,2) ),U) | |
3785 | ; vd/End of IB*2*57 7 | |
3786 | ;JWS;IB*2 .0*592;US1 31 | |
3787 | I $G(IBDE N)'="" S I BFLD(24,IB I,"DEN")=$ G(IBDEN) | |
3788 | I $D(IBDE N1) M IBFL D(24,IBI," DEN1")=IBD EN1 | |
3789 | I $D(IBDE ND) S IBFL D(24,IBI," DEND")=$G( IBDEND) | |
3790 | ;end ;JWS ;IB*2.0*59 2;US131 | |
3791 | Q | |
3792 | ; | |
3793 | AUXOK(IBSS ,IBSS1) ; Check all other flds are the s ame to com bine procs | |
3794 | ; IBSS = subscript of IBCP to check for dups to c ombine - p ass by ref | |
3795 | ; IBSS(IB SS,"AUX-X" ,n) = all the previo usly extra cted line items for the | |
3796 | ; same s et of basi c data, bu t having d ifferent " AUX" data | |
3797 | ; IBSS1 = the "AUX" data of t he current IBCP entr y | |
3798 | ; | |
3799 | ; Returns entry # i n IBSS arr ay if matc h found, o r 0 if no match | |
3800 | ; Set the IBSS "AUX -X" node f or no matc h | |
3801 | N Z,Z0,Z1 ,XIEN | |
3802 | S Z=0 F S Z=$O(IBS S(IBSS,"AU X-X",Z)) Q :'Z I IBS S1=IBSS(IB SS,"AUX-X" ,Z) Q | |
3803 | ;JWS;IB*2 .0*592;Den tal fields to check for roll-u p | |
3804 | S XIEN=$G (IBSS(IBSS ,1)) | |
3805 | I $D(IBCP (IBPO,"DEN "))!($D(IB CP(IBPO,"D EN1")))!($ D(IBCP(IBP O,"DEND")) )!($D(IBCP (XIEN,"DEN ")))!($D(I BCP(XIEN," DEN1")))!( $D(IBCP(XI EN,"DEND") )) D | |
3806 | . I $G(IB CP(IBPO,"D EN"))'=$G( IBCP(XIEN, "DEN")) S Z=0 Q | |
3807 | . I $G(IB CP(IBPO,"D END"))'=$G (IBCP(XIEN ,"DEND")) S Z=0 Q | |
3808 | . S Z1=0 F S Z1=$O (IBCP(IBPO ,"DEN1",Z1 )) Q:'Z1 I $G(IBCP( IBPO,"DEN1 ",Z1,0))'= $G(IBCP(XI EN,"DEN1", Z1,0)) S Z =0 Q | |
3809 | I 'Z S Z0 =+$O(IBSS( IBSS,"AUX- X",""),-1) +1,IBSS(IB SS,"AUX-X" ,Z0)=IBSS1 | |
3810 | Q +Z | |
3811 | ; | |
3812 | PRC ; Extr act proced ure data f or HCFA 15 00 | |
3813 | ; IBRC(IB SS) = #rev codes wit h same bil ling crite ria (IBSS) | |
3814 | ; IBLINK( 'CP' ien,' RC' ien) = IBSS incl uding modi fiers,rx s eq in pc 7 ,8 | |
3815 | ; IBLINK1 (IBSS, 'RC ' ien) = auto (1)^ 'CP' ien ( soft link) | |
3816 | ; | |
3817 | ; proc ar ray w/chrg | |
3818 | ;JWS;IB*2 .0*592;US1 31; added IBLN1, IBD ENLN | |
3819 | ;IA# 3820 | |
3820 | N IBPR,IB P,IBDENLN, IBLN1 | |
3821 | S IBI=0 F S IBI=$O (^DGCR(399 ,IBIFN,"CP ",IBI)) Q: 'IBI S IB LN=^(IBI,0 ),IBLN1=$G (^(1)),IBA UXLN=$G(^( "AUX")),IB DENLN=$G(^ ("DEN")) D | |
3822 | . I $O(^D GCR(399,IB IFN,"CP",I BI,"DEN1", 0)) M IBDE NLN("DEN1" )=^DGCR(39 9,IBIFN,"C P",IBI,"DE N1") | |
3823 | . ;end ;J WS;IB*2.0* 592;US131 | |
3824 | . N Z,Z0, Z1,Q1 | |
3825 | . S IBPDT =$P(IBLN,U ,2) | |
3826 | . S IBSS= $$IBSS(IBI ,.IBDXI,IB LN) | |
3827 | . S IBPO= $S($P(IBLN ,U,4):+$P( IBLN,U,4), 1:IBI+1000 ) ;Set pri nt order | |
3828 | . S IBCP( IBPO)=IBPD T_"^"_IBSS ,IBCP(IBPO ,"AUX")=IB AUXLN | |
3829 | . S IBCP( IBPO,"LNK" )=IBI | |
3830 | . ;JWS;IB *2.0*592;U S131 | |
3831 | . I $G(IB LN1)'="" S IBCP(IBPO ,"DEND")=I BLN1 | |
3832 | . I $G(IB DENLN)'="" S IBCP(IB PO,"DEN")= IBDENLN | |
3833 | . I $O(IB DENLN("DEN 1",0)) M I BCP(IBPO," DEN1")=IBD ENLN("DEN1 ") | |
3834 | . ;end ;J WS;IB*2.0* 592;US131 | |
3835 | . ; Rx | |
3836 | . N IBZ,I BITEM | |
3837 | . S IBZ=$ S($P(IBSS, U):$P(IBSS ,U),1:"") | |
3838 | . I IBZ'= "",$D(IBLI NKRX(IBZ,I BI)) D Q: IBCHARG'=" " | |
3839 | .. S IBPO 1=IBPO | |
3840 | .. S IBIT EM=+$O(IBL INKRX(IBZ, IBI,0)),IB RV=$G(IBLI NKRX(IBZ,I BI,IBITEM) ) | |
3841 | .. Q:$S(I BRV="":1,1 :'$G(IBRC( IBRV))) | |
3842 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
3843 | .. S $P(I BCP(IBPO1) ,U,9)=IBCH ARG,IBCP(I BPO1,"RX") =IBITEM K IBLINKRX(I BZ,IBI,IBI TEM) | |
3844 | . ; find chrgs dire ctly linke d to proc | |
3845 | . S IBK=0 F S IBK= $O(IBLINK( IBI,IBK)) Q:'IBK S IBRV1=IBLI NK(IBI,IBK ),IBRV=$P( IBRV1,U,1, 6) I +IBRC (IBRV1) D | |
3846 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV1)=I BRC(IBRV1) -1 | |
3847 | .. I IBCH ARG'="" S $P(IBSS,U, 8)=IBCHARG ,IBCP(IBPO )=IBPDT_"^ "_IBSS,IBP O=IBPO+.1 | |
3848 | ; | |
3849 | ; add chr gs associa ted with a proc (not a direct link) | |
3850 | ; find ch rg associa ted with p roc, if an y (match p roc,div,+/ -basc) | |
3851 | K IBP(0) | |
3852 | F IBP=3,2 Q:$D(IBP( 0)) S IBP O="" F S IBPO=$O(IB CP(IBPO)) Q:'IBPO I $P(IBCP(I BPO),U,9)= "" D | |
3853 | . S IBSS= $P(IBCP(IB PO),U,2,9) | |
3854 | . S IBCHA RG="",(IBR V,IBSS)=$P (IBSS,U,1, IBP) F S IBRV=$O(IB RC(IBRV)) Q:$P(IBRV, U,1,IBP)'= IBSS S IB P(0)=0 I + IBRC(IBRV) D Q | |
3855 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
3856 | .. I IBRC (IBRV) S Z =0 F S Z= $O(IBCP(IB PO,Z)) Q:' Z S IBRC( IBRV)=IBRC (IBRV)-1 | |
3857 | . S $P(IB CP(IBPO),U ,9)=IBCHAR G | |
3858 | . I IBCHA RG'="" S Z =$O(IBLINK 1(IBRV,0)) I Z S IBC P(IBPO,"L" ,Z)=IBLINK 1(IBRV,Z) K IBLINK1( IBRV,Z) | |
3859 | ; | |
3860 | ; add chr gs not ass ociated wi th a proc to first p roc with n o chrg | |
3861 | ; Aggggh! !! TP | |
3862 | S IBPO="" F S IBPO =$O(IBCP(I BPO)) Q:'I BPO I $P( IBCP(IBPO) ,U,9)="" D | |
3863 | . S IBCHA RG="",IBRV ="^" F S IBRV=$O(IB RC(IBRV)) Q:IBRV=""! +IBRV I + IBRC(IBRV) D Q | |
3864 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
3865 | .. S Z=$O (IBLINK1(I BRV,0)) I Z S IBCP(I BPO,"L",Z) =IBLINK1(I BRV,Z) K I BLINK1(IBR V,Z) | |
3866 | . S $P(IB CP(IBPO),U ,9)=IBCHAR G | |
3867 | ; | |
3868 | Q | |
3869 | IBSS(IBI,I BDXI,IBLN) ; Creates index seq uence for procedure | |
3870 | N IBPC,IB J,IBSS,IBL PI,IBX,IBL PAR | |
3871 | S (IBPC,I BLPI)=0 | |
3872 | F IBJ=1,6 ,5,0,9,10 S IBPC=IBP C+1 S:IBJ $P(IBSS,U, IBPC,IBPC+ 1)=($P(IBL N,U,IBJ)_U ) | |
3873 | S $P(IBSS ,U,7)=($$G ETMOD^IBEF UNC(IBIFN, IBI)_U) ;M odifiers | |
3874 | ;IB*547/T AZ - IBDXI not defin ed, use in ternal DX pointer | |
3875 | I '$G(IBN WPTCH) F I BJ=11:1:14 I $P(IBLN ,U,IBJ) S $P(IBSS,U, 4)=$P(IBSS ,U,4)_$S(I BJ>11:",", 1:"")_$G(I BDXI(+$P(I BLN,U,IBJ) )) ; dx | |
3876 | I $G(IBNW PTCH) F IB J=11:1:14 S IBX=$P(I BLN,U,IBJ) I IBX S $ P(IBSS,U,4 )=$P(IBSS, U,4)_$S(IB J>11:",",1 :"")_$G(IB DXI(IBX),I BX) ; dx | |
3877 | S $P(IBSS ,U,10)=$P( IBLN,U,16) ,$P(IBSS,U ,9)=$P(IBL N,U,19),$P (IBSS,U,11 )=+$P(IBLN ,U,17) | |
3878 | G:'$G(IBN WPTCH) IBS SX | |
3879 | ;IB*547/T AZ - Add a dditional fields for roll-up c ompare | |
3880 | S $P(IBSS ,U,21)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ASSO CIATED CLI NIC","I") | |
3881 | S $P(IBSS ,U,22)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","TYPE OF SERVIC E","I") | |
3882 | S $P(IBSS ,U,23)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ATTA CHMENT CON TROL NUMBE R","I") | |
3883 | S $P(IBSS ,U,24)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","NDC" ,"I") | |
3884 | S $P(IBSS ,U,25)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","PROC EDURE DESC RIPTION"," I") | |
3885 | S $P(IBSS ,U,26)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ADDI TIONAL OB MINUTES"," I") | |
3886 | ;Add Prov ider info in pieces 41-49 | |
3887 | M IBLPAR= ^DGCR(399, IBIFN,"CP" ,IBI,"LNPR V") | |
3888 | F S IBLP I=$O(IBLPA R(IBLPI)) Q:'IBLPI S IBX=IBLP AR(IBLPI,0 ),$P(IBSS, U,40+IBX)= $TR(IBX,"^ ","~") | |
3889 | K IBLPAR | |
3890 | IBSSX ; | |
3891 | Q IBSS | |
3892 | ; | |
3893 | IBNWPTCH(I BIFN,IBPAT CH) ; | |
3894 | ;Checks t he date th e primary claim was 1st transm itted and returns 1 if the tra nsmitted d ate is aft er the pat ch | |
3895 | ;referenc ed in vari able IBPAT CH was rel eased. Thi s allows t he MRA/EOB s returnin g to roll up procedu res the sa me | |
3896 | ;way as t hey went o ut. Other wise the o rder chang es and the MRA/EOB w on't match up. | |
3897 | ; | |
3898 | N IBARY,I BIDT,IBPFN ,IBEFN,IBB N,IBX,IBBD T | |
3899 | S IBX=0 | |
3900 | I $$INSTA LDT^XPDUTL (IBPATCH,. IBARY) D ;ICR 1014 1 | |
3901 | . S IBX=1 | |
3902 | . S IBIDT =$O(IBARY( "")) | |
3903 | . ; Get P rimary Bil l Number. This will insure COB data is c onsistent across all bills. | |
3904 | . S IBPFN =$$GET1^DI Q(399,IBIF N_",","PRI MARY BILL #","I") I 'IBPFN S I BPFN=IBIFN | |
3905 | . ; Find 1st Accept ed Entry ( A1, A2, or Z) of Pri mary Bill in EDI TRA NSMIT BILL FILE (364 ) to deter mine Batch Number | |
3906 | . S (IBEF N,IBBN)=0 F S IBEFN =$O(^IBA(3 64,"B",IBP FN,IBEFN)) Q:'IBEFN D I IBBN Q | |
3907 | .. I ",A1 ,A2,Z,"'[( ","_$$GET1 ^DIQ(364,I BEFN_","," TRANSMISSI ON STATUS" ,"I")_",") Q | |
3908 | .. S IBBN =$$GET1^DI Q(364,IBEF N_",","BAT CH NUMBER" ,"I") | |
3909 | . ;Retrie ve the dat e the batc h was 1st sent. If IBBN="" IB BDT will b e null | |
3910 | . S IBBDT =$$GET1^DI Q(364.1,$$ GET1^DIQ(3 64,IBBN_", ","BATCH N UMBER","I" )_",","DAT E FIRST SE NT","I") | |
3911 | . I IBBDT ,(IBBDT<IB IDT) S IBX =0 | |
3912 | Q IBX | |
3913 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
3914 | IBCF23A ;A LB/ARH - H CFA 1500 1 9-90 DATA - Split fr om IBCF23 ;12-JUN-93 | |
3915 | ;;2.0;INT EGRATED BI LLING;**51 ,432,516,5 47,577,592 ,608**;21- MAR-94;Bui ld 3 | |
3916 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
3917 | ; | |
3918 | ; $$INSTA LDT^XPDUTL (IBPATCH,. IBARY) - I CR 10141 | |
3919 | ; | |
3920 | B24 ; set individual entries i n print ar ray, exter nal format | |
3921 | ; IBAUX = additiona l data for EDI outpu t | |
3922 | ; IBRXF = array of RX procedu res | |
3923 | ;JWS;IB*2 .0*592;US1 31 | |
3924 | ; IBDEN = Dental da ta for EDI output | |
3925 | ; IBDEN1 = array of Dental da ta for EDI output | |
3926 | N IBX,Z,I BD1,IBD2,I BCPLINK | |
3927 | S IBI=IBI +1,IBPROC= $P(IBSS,U, 2),IBD1=$$ DATE^IBCF2 3(IBDT1),I BD2=$S(IBD T1'=IBDT2: $$DATE^IBC F23(IBDT2) ,1:"") | |
3928 | I '$D(IBX IEN) S IBD 1=$E(IBD1, 5,8)_$E(IB D1,1,4),IB D2=$E(IBD2 ,5,8)_$E(I BD2,1,4) | |
3929 | S IBFLD(2 4,IBI)=IBD 1_U_IBD2_U _$P($G(^IB E(353.1,+$ P(IBSS,U,6 ),0)),U)_U _$P($G(^IB E(353.2,+$ P(IBSS,U,7 ),0)),U) | |
3930 | I +IBPROC D | |
3931 | . S IBFLD (24,IBI)=I BFLD(24,IB I)_U_$P($$ PRCD^IBCEF 1(IBPROC,1 ),U,2) S:$ P(IBPROC," ;",2)'["IC PT" IBFLD( 24,IBI_"X" )="" | |
3932 | I 'IBPROC S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_$S('$D( IBXIEN):IB PROC,1:+IB REV),IBFLD (24,IBI_"A ")=$P($G(^ DGCR(399.2 ,+IBREV,0) ),U,2) | |
3933 | I $D(IBRX F),IBCHARG ="" S IBFL D(24,IBI_" A")=$P($G( ^DGCR(399. 2,+IBREV,0 )),U,2) | |
3934 | S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_$P(IBSS ,U,5)_U_IB CHARG_U_IB UNIT_U_$P( IBSS,U,8)_ U_$G(IBPCH G)_U_$G(IB MIN)_U_$G( IBEMG) | |
3935 | I $D(IBSS ("L")) S Z =0 F S Z= $O(IBSS("L ",Z)) Q:'Z S IBFLD( 24,IBI,$P( IBSS("L",Z ),U),$P(IB SS("L",Z), U,2))=$G(I BFLD(24,IB I,$P(IBSS( "L",Z),U), $P(IBSS("L ",Z),U,2)) )+1 | |
3936 | S:$TR($G( IBAUX),U)' ="" IBFLD( 24,IBI,"AU X")=$G(IBA UX) | |
3937 | S:$D(IBRX F) IBFLD(2 4,IBI,"RX" )=IBRXF | |
3938 | K IBPROC, IBSS("L") | |
3939 | S IBCPLIN K=$P(IBSS, U,$L(IBSS, U)) | |
3940 | S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_IBCPLIN K | |
3941 | ; MRD;IB* 2.0*516 - Added NDC and Units to line le vel of cla im. | |
3942 | ;I IBCPLI NK'="" S $ P(IBFLD(24 ,IBI),U,14 ,15)=$TR($ P($G(^DGCR (399,IBIFN ,"CP",IBCP LINK,1)),U ,7,8),"-") | |
3943 | ; vd/Begi nning of I B*2*577 - Added Unit /Basis of Measurment to line l evel of cl aim. | |
3944 | I IBCPLIN K'="" S $P (IBFLD(24, IBI),U,14, 16)=$TR($P ($G(^DGCR( 399,IBIFN, "CP",IBCPL INK,1)),U, 7,8),"-")_ U_$P($G(^D GCR(399,IB IFN,"CP",I BCPLINK,2) ),U) | |
3945 | ; vd/End of IB*2*57 7 | |
3946 | ;JWS;IB*2 .0*592;US1 31 | |
3947 | I $G(IBDE N)'="" S I BFLD(24,IB I,"DEN")=$ G(IBDEN) | |
3948 | I $D(IBDE N1) M IBFL D(24,IBI," DEN1")=IBD EN1 | |
3949 | I $D(IBDE ND) S IBFL D(24,IBI," DEND")=$G( IBDEND) | |
3950 | ;end ;JWS ;IB*2.0*59 2;US131 | |
3951 | Q | |
3952 | ; | |
3953 | AUXOK(IBSS ,IBSS1) ; Check all other flds are the s ame to com bine procs | |
3954 | ; IBSS = subscript of IBCP to check for dups to c ombine - p ass by ref | |
3955 | ; IBSS(IB SS,"AUX-X" ,n) = all the previo usly extra cted line items for the | |
3956 | ; same s et of basi c data, bu t having d ifferent " AUX" data | |
3957 | ; IBSS1 = the "AUX" data of t he current IBCP entr y | |
3958 | ; | |
3959 | ; Returns entry # i n IBSS arr ay if matc h found, o r 0 if no match | |
3960 | ; Set the IBSS "AUX -X" node f or no matc h | |
3961 | N Z,Z0,Z1 ,XIEN | |
3962 | S Z=0 F S Z=$O(IBS S(IBSS,"AU X-X",Z)) Q :'Z I IBS S1=IBSS(IB SS,"AUX-X" ,Z) Q | |
3963 | ;JWS;IB*2 .0*592;Den tal fields to check for roll-u p | |
3964 | S XIEN=$G (IBSS(IBSS ,1)) | |
3965 | I $D(IBCP (IBPO,"DEN "))!($D(IB CP(IBPO,"D EN1")))!($ D(IBCP(IBP O,"DEND")) )!($D(IBCP (XIEN,"DEN ")))!($D(I BCP(XIEN," DEN1")))!( $D(IBCP(XI EN,"DEND") )) D | |
3966 | . I $G(IB CP(IBPO,"D EN"))'=$G( IBCP(XIEN, "DEN")) S Z=0 Q | |
3967 | . I $G(IB CP(IBPO,"D END"))'=$G (IBCP(XIEN ,"DEND")) S Z=0 Q | |
3968 | . S Z1=0 F S Z1=$O (IBCP(IBPO ,"DEN1",Z1 )) Q:'Z1 I $G(IBCP( IBPO,"DEN1 ",Z1,0))'= $G(IBCP(XI EN,"DEN1", Z1,0)) S Z =0 Q | |
3969 | I 'Z S Z0 =+$O(IBSS( IBSS,"AUX- X",""),-1) +1,IBSS(IB SS,"AUX-X" ,Z0)=IBSS1 | |
3970 | Q +Z | |
3971 | ; | |
3972 | PRC ; Extr act proced ure data f or HCFA 15 00 | |
3973 | ; IBRC(IB SS) = #rev codes wit h same bil ling crite ria (IBSS) | |
3974 | ; IBLINK( 'CP' ien,' RC' ien) = IBSS incl uding modi fiers,rx s eq in pc 7 ,8 | |
3975 | ; IBLINK1 (IBSS, 'RC ' ien) = auto (1)^ 'CP' ien ( soft link) | |
3976 | ; | |
3977 | ; proc ar ray w/chrg | |
3978 | ;JWS;IB*2 .0*592;US1 31; added IBLN1, IBD ENLN | |
3979 | N IBPR,IB P,IBDENLN, IBLN1 | |
3980 | S IBI=0 F S IBI=$O (^DGCR(399 ,IBIFN,"CP ",IBI)) Q: 'IBI S IB LN=^(IBI,0 ),IBLN1=$G (^(1)),IBA UXLN=$G(^( "AUX")),IB DENLN=$G(^ ("DEN")) D | |
3981 | . I $O(^D GCR(399,IB IFN,"CP",I BI,"DEN1", 0)) M IBDE NLN("DEN1" )=^DGCR(39 9,IBIFN,"C P",IBI,"DE N1") | |
3982 | . ;end ;J WS;IB*2.0* 592;US131 | |
3983 | . N Z,Z0, Z1,Q1 | |
3984 | . S IBPDT =$P(IBLN,U ,2) | |
3985 | . S IBSS= $$IBSS(IBI ,.IBDXI,IB LN) | |
3986 | . S IBPO= $S($P(IBLN ,U,4):+$P( IBLN,U,4), 1:IBI+1000 ) ;Set pri nt order | |
3987 | . S IBCP( IBPO)=IBPD T_"^"_IBSS ,IBCP(IBPO ,"AUX")=IB AUXLN | |
3988 | . S IBCP( IBPO,"LNK" )=IBI | |
3989 | . ;JWS;IB *2.0*592;U S131 | |
3990 | . I $G(IB LN1)'="" S IBCP(IBPO ,"DEND")=I BLN1 | |
3991 | . I $G(IB DENLN)'="" S IBCP(IB PO,"DEN")= IBDENLN | |
3992 | . I $O(IB DENLN("DEN 1",0)) M I BCP(IBPO," DEN1")=IBD ENLN("DEN1 ") | |
3993 | . ;end ;J WS;IB*2.0* 592;US131 | |
3994 | . ; Rx | |
3995 | . N IBZ,I BITEM | |
3996 | . S IBZ=$ S($P(IBSS, U):$P(IBSS ,U),1:"") | |
3997 | . I IBZ'= "",$D(IBLI NKRX(IBZ,I BI)) D Q: IBCHARG'=" " | |
3998 | .. S IBPO 1=IBPO | |
3999 | .. S IBIT EM=+$O(IBL INKRX(IBZ, IBI,0)),IB RV=$G(IBLI NKRX(IBZ,I BI,IBITEM) ) | |
4000 | .. Q:$S(I BRV="":1,1 :'$G(IBRC( IBRV))) | |
4001 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
4002 | .. S $P(I BCP(IBPO1) ,U,9)=IBCH ARG,IBCP(I BPO1,"RX") =IBITEM K IBLINKRX(I BZ,IBI,IBI TEM) | |
4003 | . ; find chrgs dire ctly linke d to proc | |
4004 | . S IBK=0 F S IBK= $O(IBLINK( IBI,IBK)) Q:'IBK S IBRV1=IBLI NK(IBI,IBK ),IBRV=$P( IBRV1,U,1, 6) I +IBRC (IBRV1) D | |
4005 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV1)=I BRC(IBRV1) -1 | |
4006 | .. I IBCH ARG'="" S $P(IBSS,U, 8)=IBCHARG ,IBCP(IBPO )=IBPDT_"^ "_IBSS,IBP O=IBPO+.1 | |
4007 | ; | |
4008 | ; add chr gs associa ted with a proc (not a direct link) | |
4009 | ; find ch rg associa ted with p roc, if an y (match p roc,div,+/ -basc) | |
4010 | K IBP(0) | |
4011 | F IBP=3,2 Q:$D(IBP( 0)) S IBP O="" F S IBPO=$O(IB CP(IBPO)) Q:'IBPO I $P(IBCP(I BPO),U,9)= "" D | |
4012 | . S IBSS= $P(IBCP(IB PO),U,2,9) | |
4013 | . S IBCHA RG="",(IBR V,IBSS)=$P (IBSS,U,1, IBP) F S IBRV=$O(IB RC(IBRV)) Q:$P(IBRV, U,1,IBP)'= IBSS S IB P(0)=0 I + IBRC(IBRV) D Q | |
4014 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
4015 | .. I IBRC (IBRV) S Z =0 F S Z= $O(IBCP(IB PO,Z)) Q:' Z S IBRC( IBRV)=IBRC (IBRV)-1 | |
4016 | . S $P(IB CP(IBPO),U ,9)=IBCHAR G | |
4017 | . I IBCHA RG'="" S Z =$O(IBLINK 1(IBRV,0)) I Z S IBC P(IBPO,"L" ,Z)=IBLINK 1(IBRV,Z) K IBLINK1( IBRV,Z) | |
4018 | ; | |
4019 | ; add chr gs not ass ociated wi th a proc to first p roc with n o chrg | |
4020 | ; Aggggh! !! TP | |
4021 | S IBPO="" F S IBPO =$O(IBCP(I BPO)) Q:'I BPO I $P( IBCP(IBPO) ,U,9)="" D | |
4022 | . S IBCHA RG="",IBRV ="^" F S IBRV=$O(IB RC(IBRV)) Q:IBRV=""! +IBRV I + IBRC(IBRV) D Q | |
4023 | .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 | |
4024 | .. S Z=$O (IBLINK1(I BRV,0)) I Z S IBCP(I BPO,"L",Z) =IBLINK1(I BRV,Z) K I BLINK1(IBR V,Z) | |
4025 | . S $P(IB CP(IBPO),U ,9)=IBCHAR G | |
4026 | ; | |
4027 | Q | |
4028 | IBSS(IBI,I BDXI,IBLN) ; Creates index seq uence for procedure | |
4029 | N IBPC,IB J,IBSS,IBL PI,IBX,IBL PAR | |
4030 | S (IBPC,I BLPI)=0 | |
4031 | F IBJ=1,6 ,5,0,9,10 S IBPC=IBP C+1 S:IBJ $P(IBSS,U, IBPC,IBPC+ 1)=($P(IBL N,U,IBJ)_U ) | |
4032 | S $P(IBSS ,U,7)=($$G ETMOD^IBEF UNC(IBIFN, IBI)_U) ;M odifiers | |
4033 | ;IB*547/T AZ - IBDXI not defin ed, use in ternal DX pointer | |
4034 | I '$G(IBN WPTCH) F I BJ=11:1:14 I $P(IBLN ,U,IBJ) S $P(IBSS,U, 4)=$P(IBSS ,U,4)_$S(I BJ>11:",", 1:"")_$G(I BDXI(+$P(I BLN,U,IBJ) )) ; dx | |
4035 | I $G(IBNW PTCH) F IB J=11:1:14 S IBX=$P(I BLN,U,IBJ) I IBX S $ P(IBSS,U,4 )=$P(IBSS, U,4)_$S(IB J>11:",",1 :"")_$G(IB DXI(IBX),I BX) ; dx | |
4036 | S $P(IBSS ,U,10)=$P( IBLN,U,16) ,$P(IBSS,U ,9)=$P(IBL N,U,19),$P (IBSS,U,11 )=+$P(IBLN ,U,17) | |
4037 | G:'$G(IBN WPTCH) IBS SX | |
4038 | ;IB*547/T AZ - Add a dditional fields for roll-up c ompare | |
4039 | S $P(IBSS ,U,21)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ASSO CIATED CLI NIC","I") | |
4040 | S $P(IBSS ,U,22)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","TYPE OF SERVIC E","I") | |
4041 | S $P(IBSS ,U,23)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ATTA CHMENT CON TROL NUMBE R","I") | |
4042 | S $P(IBSS ,U,24)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","NDC" ,"I") | |
4043 | S $P(IBSS ,U,25)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","PROC EDURE DESC RIPTION"," I") | |
4044 | S $P(IBSS ,U,26)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ADDI TIONAL OB MINUTES"," I") | |
4045 | ;JRA;IB*2 .0*608 Put Certifica te of Medi cal Necess ity (CMN) info in pi eces 30,31 ,32 | |
4046 | M IBLPAR= ^DGCR(399, IBIFN,"CP" ,IBI) | |
4047 | S $P(IBSS ,U,30)=$TR ($G(IBLPAR ("CMN")),U ,"~") | |
4048 | S $P(IBSS ,U,31)=$TR ($G(IBLPAR ("CMN-1012 6")),U,"~" ) | |
4049 | S $P(IBSS ,U,32)=$TR ($G(IBLPAR ("CMN-484" )),U,"~") | |
4050 | K IBLPAR | |
4051 | ;Add Prov ider info in pieces 41-49 | |
4052 | M IBLPAR= ^DGCR(399, IBIFN,"CP" ,IBI,"LNPR V") | |
4053 | F S IBLP I=$O(IBLPA R(IBLPI)) Q:'IBLPI S IBX=IBLP AR(IBLPI,0 ),$P(IBSS, U,40+IBX)= $TR(IBX,"^ ","~") | |
4054 | K IBLPAR | |
4055 | IBSSX ; | |
4056 | Q IBSS | |
4057 | ; | |
4058 | IBNWPTCH(I BIFN,IBPAT CH) ; | |
4059 | ;Checks t he date th e primary claim was 1st transm itted and returns 1 if the tra nsmitted d ate is aft er the pat ch | |
4060 | ;referenc ed in vari able IBPAT CH was rel eased. Thi s allows t he MRA/EOB s returnin g to roll up procedu res the sa me | |
4061 | ;way as t hey went o ut. Other wise the o rder chang es and the MRA/EOB w on't match up. | |
4062 | ; | |
4063 | N IBARY,I BIDT,IBPFN ,IBEFN,IBB N,IBX,IBBD T | |
4064 | S IBX=0 | |
4065 | I $$INSTA LDT^XPDUTL (IBPATCH,. IBARY) D ;ICR 1014 1 | |
4066 | . S IBX=1 | |
4067 | . S IBIDT =$O(IBARY( "")) | |
4068 | . ; Get P rimary Bil l Number. This will insure COB data is c onsistent across all bills. | |
4069 | . S IBPFN =$$GET1^DI Q(399,IBIF N_",","PRI MARY BILL #","I") I 'IBPFN S I BPFN=IBIFN | |
4070 | . ; Find 1st Accept ed Entry ( A1, A2, or Z) of Pri mary Bill in EDI TRA NSMIT BILL FILE (364 ) to deter mine Batch Number | |
4071 | . S (IBEF N,IBBN)=0 F S IBEFN =$O(^IBA(3 64,"B",IBP FN,IBEFN)) Q:'IBEFN D I IBBN Q | |
4072 | .. I ",A1 ,A2,Z,"'[( ","_$$GET1 ^DIQ(364,I BEFN_","," TRANSMISSI ON STATUS" ,"I")_",") Q | |
4073 | .. S IBBN =$$GET1^DI Q(364,IBEF N_",","BAT CH NUMBER" ,"I") | |
4074 | . ;Retrie ve the dat e the batc h was 1st sent. If IBBN="" IB BDT will b e null | |
4075 | . S IBBDT =$$GET1^DI Q(364.1,$$ GET1^DIQ(3 64,IBBN_", ","BATCH N UMBER","I" )_",","DAT E FIRST SE NT","I") | |
4076 | . I IBBDT ,(IBBDT<IB IDT) S IBX =0 | |
4077 | Q IBX | |
4078 | ||
4079 | X) Modify cloning o f a claim: | |
4080 | IBCCC2 – C opy CMN no des to new claim whe n doing a cancel/cop y | |
4081 | Routines | |
4082 | Activities | |
4083 | Routine Na me | |
4084 | IBCCC2 | |
4085 | Enhancemen t Category | |
4086 | New | |
4087 | Modify | |
4088 | Delete | |
4089 | No Change | |
4090 | RTM | |
4091 | ||
4092 | Related Op tions | |
4093 | None | |
4094 | Related Ro utines | |
4095 | Routines “ Called By” | |
4096 | Routines “ Called” | |
4097 | ||
4098 | ||
4099 | ||
4100 | ||
4101 | Data Dicti onary (DD) Reference s | |
4102 | ||
4103 | Related Pr otocols | |
4104 | None | |
4105 | Related In tegration Control Re gistration s (ICRs) | |
4106 | None | |
4107 | Data Passi ng | |
4108 | Input | |
4109 | Output Re ference | |
4110 | Both | |
4111 | Global Re ference | |
4112 | Local | |
4113 | Input Attr ibute Name and Defin ition | |
4114 | Name: | |
4115 | Definition : | |
4116 | Output Att ribute Nam e and Defi nition | |
4117 | Name: | |
4118 | Definition : | |
4119 | Current Lo gic | |
4120 | IBCCC2 ;AL B/AAS - CA NCEL AND C LONE A BIL L - CONTIN UED ;6/6/0 3 9:56am | |
4121 | ;;2.0;INT EGRATED BI LLING;**80 ,106,124,1 38,51,151, 137,161,18 2,211,245, 155,296,32 0,348,349, 371,400,43 3,432,447, 516,577,59 2**;21-MAR -94;Build 25 | |
4122 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4123 | ; | |
4124 | ;MAP TO D GCRCC2 | |
4125 | ; | |
4126 | ;STEP 5 - get remai nder of da ta to move and store in MCCR t hen x-ref | |
4127 | ;STEP 6 - go to scr eens, come out to IB B1 or some thing like that | |
4128 | ; | |
4129 | STEP5 S IB IFN1=$P(^D GCR(399,IB IFN,0),"^" ,15) G END :$S(IBIFN1 ="":1,'$D( ^DGCR(399, IBIFN1,0)) :1,1:0) | |
4130 | ; NOTE: any new or changed d ata nodes may also n eed to be updated in IBNCPDP5 | |
4131 | ;move pur e data nod es | |
4132 | ; MRD;IB* 2.0*516 - Added "In7 " nodes. | |
4133 | F I="I1", "I17","I2" ,"I27","I3 ","I37","M 1" I $D(^D GCR(399,IB IFN1,I)) S ^DGCR(399 ,IBIFN,I)= ^DGCR(399, IBIFN1,I) | |
4134 | ; | |
4135 | ;move top level dat a node. ;D o not move 'TX' node EXCEPT pi ece 8 (add ed with IB *2.0*432) | |
4136 | ;F I="U", "U1","U2", "U3","UF2" ,"UF3","UF 31","C","M " I $D(^DG CR(399,IBI FN1,I)) S IBND(I)=^( I) D @I | |
4137 | ; add new data node s introduc ed with IB *2.0*432 | |
4138 | F I="TX", "U","U1"," U2","U3"," U4","U5"," U6","U7"," U8","UF2", "UF3","UF3 1","UF32", "C","M" I $D(^DGCR(3 99,IBIFN1, I)) S IBND (I)=^(I) D @I | |
4139 | ; | |
4140 | ;move mul tiple leve l data | |
4141 | ;F I="CC" ,"OC","OP" ,"OT","RC" ,"CP","CV" ,"PRV" I $ D(^DGCR(39 9,IBIFN1,I ,0)) D @I | |
4142 | ; add new data node s introduc ed with IB *2.0*447 B I | |
4143 | F I="CC", "OC","OP", "OT","RC", "CP","CV", "PRV","U9" I $D(^DGC R(399,IBIF N1,I,0)) D @I | |
4144 | ; | |
4145 | ;JWS;IB*2 .0*592;add new Denta l Claim fi elds; IA# 3820 | |
4146 | I $D(^DGC R(399,IBIF N1,"DEN")) S ^DGCR(3 99,IBIFN," DEN")=^DGC R(399,IBIF N1,"DEN") | |
4147 | I $D(^DGC R(399,IBIF N1,"DEN1", 0)) S ^DGC R(399,IBIF N,"DEN1",0 )=^DGCR(39 9,IBIFN1," DEN1",0) D | |
4148 | . S K=0 F S K=$O(^ DGCR(399,I BIFN1,"DEN 1",K)) Q:' K S ^DGCR (399,IBIFN ,"DEN1",K, 0)=^DGCR(3 99,IBIFN1, "DEN1",K,0 ) | |
4149 | I $D(^DGC R(399,IBIF N1,"DEN2") ) S ^DGCR( 399,IBIFN, "DEN2")=^D GCR(399,IB IFN1,"DEN2 ") | |
4150 | ; | |
4151 | ; IB*2.0* 432 ADDED IBSILENT flag so th at this ca n be proce ssed in ba ckground | |
4152 | D FTPRV^I BCEU5(IBIF N,$G(IBSIL ENT)) ; As k change p rov type i f form typ e not the same | |
4153 | D COBCHG( IBIFN,,.IB COB) | |
4154 | ; | |
4155 | D ^IBCCC3 ; copy ta ble files (362.3) | |
4156 | ; | |
4157 | S I=$G(^D GCR(399,IB IFN1,0)) I $P(I,U,13 )=7,$P(I,U ,20)=1 D C OPYB^IBCDC (IBIFN1,IB IFN) ; upd ate auto b ill files | |
4158 | D PRIOR(I BIFN) ; ad d new bill to previo us bills i n series, primary/se condary | |
4159 | ; | |
4160 | I +$G(IBC TCOPY) N I BAUTO S IB AUTO=1 D P ROC^IBCU7A (IBIFN),BI LL^IBCRBC( IBIFN),CPT MOD26^IBCU 73(IBIFN) D RECALL^D ILFD(399,I BIFN_",",D UZ) G END | |
4161 | ; | |
4162 | STEP6 N IB GOEND | |
4163 | ; need to kill CRD flag prior to enteri ng billing screens i n case a c opy for co rrespondin g claim is needed | |
4164 | K IBCNCRD | |
4165 | ; don't c all IB bil l edit scr eens if th is is non- MRA backgr ound proce ssing | |
4166 | I $G(IBST SM)=1 G EN D | |
4167 | I '$G(IBC E("EDI"))! $G(IBCE("E DI","NEW") ),'$G(IBCE AUTO) D IB SCEDT G EN D:$G(IBGOE ND) | |
4168 | ; | |
4169 | ; | |
4170 | END K DFN, IB,IBA,IBA 2,IBAD,IBA DD1,IBBNO, IBCAN,IBCC C,IBDA,IBD PT,IBDR,IB DT,IBI,IBI 1,IBIDS,IB IFN,IBIFN1 ,IBND,IBQU IT,IBU,IBU N,IBARST,I BCOB,IBCNC OPY,IBCBCO PY,IBCNCRD ,IBKEY | |
4171 | K IBV,IBV 1,IBW,IBWW ,IBYN,IBZZ ,PRCASV,PR CAERCD,PRC AERR,PRCAS VC,PRCAT,I BBT,IBCH,I BNDS,IBOA, IBREV,IBX, DGXRF1,VAE L,VAERR,IB AC,IBCCC,I BDD1,IBIN, DGREV,DGRE V00,DGREVH DR,IBCHK | |
4172 | K IBBS,IB LS,DGPCM,I BIP,IBND0, IBNDU,IBO, IBPTF,IBST ,IBUC,IBDD ,D,%,%DT,D IC,VA,VADM ,X,X1,X2,X 3,X4,Y,I,J ,K,DGRVRCA L,DDH,DGAC TDT,DGAMNT ,DGBR,DGBR N,DGBSI,DG BSLOS,IBA1 ,IBOD,IBIN S,IBN,IBPR OC,DGFUNC, DGIFN | |
4173 | Q | |
4174 | ; | |
4175 | ; | |
4176 | IBSCEDT ; call the I B bill edi t screens and valida te the dat a | |
4177 | N IBV,IBP AR,IBAC,IB HV,IBH,IBC IREDT | |
4178 | ; if the user came from CBW-> PC and thi s is a non -MRA claim w/a paper EOB, set force prin t flag IB* 2.0*432 | |
4179 | ; also, i f the user came from CBW->PC a nd this is a non-MRA claim and the only EEOB we ha ve has fil ing errors , set forc e print fl ag | |
4180 | I $G(IBMR ANOT)=1,$$ COBN^IBCEF (IBIFN)>1, $G(IBFROM) =2 D | |
4181 | .I $G(IBD A)="" D FO RCEPRT^IBC APP($G(IBI FN)) Q | |
4182 | .I $D(^IB M(361.1,IB DA,"ERR")) D FORCEPR T^IBCAPP($ G(IBIFN)) Q | |
4183 | D RECALL^ DILFD(399, IBIFN_",", DUZ) | |
4184 | ST1 S IBV= 0 D ^IBCSC U,^IBCSC1 I $G(IBPOP OUT) S IBG OEND=1 G I BSCX | |
4185 | S IBAC=1 | |
4186 | D ^IBCB1 | |
4187 | I $G(IBCI REDT) G ST 1 | |
4188 | IBSCX ; | |
4189 | Q | |
4190 | ; | |
4191 | ; | |
4192 | TX F J=8 I $P(IBND(" TX"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"TX" ),"^",J)=$ P(IBND("TX "),"^",J) | |
4193 | Q | |
4194 | U F J=3,4, 6:1:17,20 I $P(IBND( "U"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"U") ,"^",J)=$P (IBND("U") ,"^",J) | |
4195 | Q | |
4196 | U1 F J=1:1 :3,15 I $P (IBND("U1" ),"^",J)]" " S $P(^DG CR(399,IBI FN,"U1")," ^",J)=$P(I BND("U1"), "^",J) | |
4197 | Q | |
4198 | U2 F J=1:1 :19 I $P(I BND("U2"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U2"),"^" ,J)=$P(IBN D("U2"),"^ ",J) | |
4199 | Q | |
4200 | U3 F J=1:1 :11 I $P(I BND("U3"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U3"),"^" ,J)=$P(IBN D("U3"),"^ ",J) | |
4201 | Q | |
4202 | UF2 F J=1, 3 I $P(IBN D("UF2")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "UF2"),"^" ,J)=$P(IBN D("UF2")," ^",J) | |
4203 | Q | |
4204 | UF3 F J=4: 1:6 I $P(I BND("UF3") ,"^",J)]"" S $P(^DGC R(399,IBIF N,"UF3")," ^",J)=$P(I BND("UF3") ,"^",J) | |
4205 | Q | |
4206 | U4 F J=1:1 :14 I $P(I BND("U4"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U4"),"^" ,J)=$P(IBN D("U4"),"^ ",J) | |
4207 | Q | |
4208 | U5 F J=1:1 :6 I $P(IB ND("U5")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U5"),"^", J)=$P(IBND ("U5"),"^" ,J) | |
4209 | Q | |
4210 | U6 F J=1:1 :6 I $P(IB ND("U6")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U6"),"^", J)=$P(IBND ("U6"),"^" ,J) | |
4211 | Q | |
4212 | U7 F J=1:1 :5 I $P(IB ND("U7")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U7"),"^", J)=$P(IBND ("U7"),"^" ,J) | |
4213 | Q | |
4214 | U8 F J=1:1 :3 I $P(IB ND("U8")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U8"),"^", J)=$P(IBND ("U8"),"^" ,J) | |
4215 | Q | |
4216 | UF31 F J=3 I $P(IBND ("UF31")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "UF31"),"^ ",J)=$P(IB ND("UF31") ,"^",J) | |
4217 | Q | |
4218 | UF32 F J=1 :1:3 I $P( IBND("UF32 "),"^",J)] "" S $P(^D GCR(399,IB IFN,"UF32" ),"^",J)=$ P(IBND("UF 32"),"^",J ) | |
4219 | Q | |
4220 | C F J=10 I $P(IBND(" C"),"^",J) ]"" S $P(^ DGCR(399,I BIFN,"C"), "^",J)=$P( IBND("C"), "^",J) | |
4221 | I '$D(^DG CR(399,IBI FN1,"CP")) D CP1 | |
4222 | Q | |
4223 | M F J=1:1: 9,11:1:14 I $P(IBND( "M"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"M") ,"^",J)=$P (IBND("M") ,"^",J) | |
4224 | Q | |
4225 | CC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4226 | S IBDD=39 9.04 F J=0 :0 S J=$O( ^DGCR(399, IBIFN1,I,J )) Q:'J I $D(^(J,0) ) S ^DGCR( 399,IBIFN, I,J,0)=^DG CR(399,IBI FN1,I,J,0) ,X=$P(^(0) ,"^") | |
4227 | OP S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4228 | S IBDD=39 9.043 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4229 | Q | |
4230 | OC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4231 | S IBDD=39 9.041 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4232 | Q | |
4233 | OT S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4234 | S IBDD=39 9.048 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4235 | Q | |
4236 | CV ; Don't copy valu e codes fr om inpatie nt inst to inpatient prof bill s | |
4237 | I $$FT^IB CEF(IBIFN1 )'=2,$$FT^ IBCEF(IBIF N)=2 Q | |
4238 | S ^DGCR(3 99,IBIFN,I ,0)=^DGCR( 399,IBIFN1 ,I,0) | |
4239 | S IBDD=39 9.047 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4240 | Q | |
4241 | RC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4242 | S IBDD=39 9.042 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S IBND( "RC")=^(0) F K=1:1:1 6 S $P(^DG CR(399,IBI FN,I,J,0), "^",K)=$P( IBND("RC") ,"^",K),X= $P(IBND("R C"),"^",K) | |
4243 | Q | |
4244 | CP S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4245 | I +$G(IBN OCPT) Q | |
4246 | S IBDD=39 9.0304 F J =0:0 S J=$ O(^DGCR(39 9,IBIFN1,I ,J)) Q:'J I $D(^(J, 0)) S IBND ("CP")=^(0 ),IBND("CP 1")=$G(^(1 )),IBND("C P2")=$G(^( 2)),IBND(" CP-AUX")=$ G(^("AUX") ) D | |
4247 | . F K=1:1 :7,9:1:14, 16:1:22 S $P(^DGCR(3 99,IBIFN,I ,J,0),"^", K)=$P(IBND ("CP"),"^" ,K) | |
4248 | . ; IB*2. 0*432 add new 1 node | |
4249 | . ; MRD;I B*2.0*516 - Added pi eces 7 & 8 (NDC, Uni ts) to 1-n ode. | |
4250 | . F K=1:1 :8 S $P(^D GCR(399,IB IFN,I,J,1) ,"^",K)=$P (IBND("CP1 "),"^",K) | |
4251 | . ; WCJ;I B*2.0*577 - Added pi ece 1 (UNI TS/BASIS O F MEASUREM ENT) to 2- node. | |
4252 | . F K=1:1 :1 S $P(^D GCR(399,IB IFN,I,J,2) ,"^",K)=$P (IBND("CP2 "),"^",K) | |
4253 | . ; esg - 11/2/06 - IB*2*348 - 50.09 fi eld was ad ded - AUX piece [9] | |
4254 | . I IBND( "CP-AUX")' ="" F K=1: 1:9 S $P(^ DGCR(399,I BIFN,I,J," AUX"),"^", K)=$P(IBND ("CP-AUX") ,"^",K) | |
4255 | . ; IB*2. 0*432 add new LNPRV multiple | |
4256 | . I $D(^D GCR(399,IB IFN1,I,J," LNPRV",0)) S ^DGCR(3 99,IBIFN,I ,J,"LNPRV" ,0)=^DGCR( 399,IBIFN1 ,I,J,"LNPR V",0) D | |
4257 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"LNPRV",K )) Q:'K D | |
4258 | ... S ^DG CR(399,IBI FN,I,J,"LN PRV",K,0)= ^DGCR(399, IBIFN1,I,J ,"LNPRV",K ,0) | |
4259 | . I $D(^D GCR(399,IB IFN1,I,J," MOD",0)) S ^DGCR(399 ,IBIFN,I,J ,"MOD",0)= ^DGCR(399, IBIFN1,I,J ,"MOD",0) D | |
4260 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"MOD",K)) Q:'K D | |
4261 | ... I $G( IBNOTC),$P ($$MOD^ICP TMOD(+$P($ G(^DGCR(39 9,IBIFN1,I ,J,"MOD",K ,0)),U,2), "I"),U,2)= "TC" Q ; Don't copy TC modifi er from in st to prof bill | |
4262 | ... S ^DG CR(399,IBI FN,I,J,"MO D",K,0)=^D GCR(399,IB IFN1,I,J," MOD",K,0) | |
4263 | . ;JWS;IB *2.0*592;a dd new Den tal claim form field s | |
4264 | . I $D(^D GCR(399,IB IFN1,I,J," DEN")) S ^ DGCR(399,I BIFN,I,J," DEN")=^DGC R(399,IBIF N1,I,J,"DE N") | |
4265 | . I $D(^D GCR(399,IB IFN1,I,J," DEN1",0)) S ^DGCR(39 9,IBIFN,I, J,"DEN1",0 )=^DGCR(39 9,IBIFN1,I ,J,"DEN1", 0) D | |
4266 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"DEN1",K) ) Q:'K D | |
4267 | ... S ^DG CR(399,IBI FN,I,J,"DE N1",K,0)=^ DGCR(399,I BIFN1,I,J, "DEN1",K,0 ) | |
4268 | CP1 S IBCO D=$P($G(^D GCR(399,IB IFN,0)),"^ ",9) Q:IBC OD=""!('$D (^DGCR(399 ,IBIFN1,"C "))) | |
4269 | I IBCOD=9 F DGI=4,5 ,6 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICD0(" ,DGPROCDT= $P(^("C"), "^",DGI+7) D FILE | |
4270 | I IBCOD=4 F DGI=1,2 ,3 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICPT(" ,DGPROCDT= $P(^("C"), "^",DGI+10 ) D FILE | |
4271 | I IBCOD=5 F DGI=7,8 ,9 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICPT(" ,DGPROCDT= $P(^("C"), "^",DGI+4) D FILE | |
4272 | Q | |
4273 | ; | |
4274 | PRV ; Copy providers for clone d claim | |
4275 | N Z,Z0,CN T | |
4276 | S Z=$P($G (^DGCR(399 ,IBIFN,0)) ,U,19),Z0= $P($G(^DGC R(399,IBIF N1,0)),U,1 9),CNT=0 | |
4277 | S IBDD=39 9.0222 F J =0:0 S J=$ O(^DGCR(39 9,IBIFN1,I ,J)) Q:'J I $D(^(J, 0)) D | |
4278 | . I $$GET NPI^IBCEF7 3A($P(^DGC R(399,IBIF N1,I,J,0), U,2))="" Q ;Don't f ile provid er if no N PI - IB*2* 516 | |
4279 | . S CNT=C NT+1,^DGCR (399,IBIFN ,I,CNT,0)= ^DGCR(399, IBIFN1,I,J ,0),X=$P(^ (0),"^") | |
4280 | . I Z'=Z0 ,$S(X=3:Z0 =3,X=4:Z0= 2,1:0) S $ P(^DGCR(39 9,IBIFN,I, CNT,0),U)= (Z0+1) | |
4281 | I CNT S ^ DGCR(399,I BIFN,I,0)= ^DGCR(399, IBIFN1,I,0 ),$P(^DGCR (399,IBIFN ,I,0),U,3) =CNT,$P(^D GCR(399,IB IFN,I,0),U ,4)=CNT | |
4282 | Q | |
4283 | ; | |
4284 | U9 ; Added for new d ata elemen ts in IB*2 .0*447 BI | |
4285 | M ^DGCR(3 99,IBIFN,I )=^DGCR(39 9,IBIFN1,I ) | |
4286 | Q | |
4287 | ; | |
4288 | COB S J=0 F S J=$O( IBCOB(I,J) ) Q:'J S $P(^DGCR(3 99,IBIFN,I ),U,J)=IBC OB(I,J) | |
4289 | Q | |
4290 | ; | |
4291 | FILE N DIC ,DIE,DR,DA ,X,Y,DLAYG O,DD,DO | |
4292 | I '$D(^DG CR(399,IBI FN,"CP",0) ) S DIC("P ")=$$GETSP EC^IBEFUNC (399,304) | |
4293 | S DIC(0)= "L",DLAYGO =399,DA(1) =IBIFN,DIC ="^DGCR(39 9,"_DA(1)_ ",""CP""," Q:X="" D FILE^DICN K DO,DD Q :+Y<1 S D A=+Y | |
4294 | S DIE="^D GCR(399,"_ DA(1)_","" CP"",",DR= "1///"_DGP ROCDT D ^D IE | |
4295 | K DGPROCD T | |
4296 | Q | |
4297 | ; | |
4298 | INDEX ;ind ex entire file (set logic) | |
4299 | N IBMAED D SAVERC(I BIFN,.IBMA ED) ; IB* 2.0*447 BI - Save th e value of piece 16 of each RC node befo re re-inde xing. | |
4300 | S DIK="^D GCR(399,", DA=IBIFN D IX1^DIK K DA,DIK | |
4301 | D RESTRC( IBIFN,.IBM AED) ; IB *2.0*447 B I - Restor e the valu e of piece 16 of eac h RC node before re- indexing. | |
4302 | Q | |
4303 | ; | |
4304 | PRIOR(IBIF N) ; set S econdary/T ertiary Bi ll #s on p rior bills , if the b ill is can celled rem ove it fro m prior bi lls | |
4305 | N IBSEQ,I BSEQN,IBM1 ,I,IBIFN1 | |
4306 | S IBSEQ=$ $COB^IBCEF (IBIFN) | |
4307 | S IBSEQN= $S(IBSEQ=" S":6,IBSEQ ="T":7,1:" ") Q:'IBSE QN | |
4308 | ; | |
4309 | S IBM1=$G (^DGCR(399 ,IBIFN,"M1 ")) I +$P( ^DGCR(399, IBIFN,0),U ,13)=7 S I BIFN="" | |
4310 | F I=5,6 I I<IBSEQN S IBIFN1= +$P(IBM1,U ,I) I +IBI FN1,$D(^DG CR(399,+IB IFN1,0)) S $P(^DGCR( 399,IBIFN1 ,"M1"),U,I BSEQN)=IBI FN | |
4311 | Q | |
4312 | ; | |
4313 | COBCHG(IBI FN,IBINS,I BCOB) ; Ma ke changes for a new COB payer for bill | |
4314 | ; IBIFN = ien of bi ll in file 399 | |
4315 | ; IBINS = ien of bi ll's curre nt insuran ce (option al) | |
4316 | ; IBCOB = array sub scripted b y node,pie ce of COB data field change | |
4317 | ; | |
4318 | N I,IBFRM TYP,IBTAXL ST | |
4319 | ; Subtrac t the Prio r Payments from the bill's Off set (these are re-ad ded by tri ggers) | |
4320 | F I=4,5,6 S $P(^DG CR(399,IBI FN,"U1"),U ,2)=$P($G( ^DGCR(399, IBIFN,"U1" )),U,2)-$P ($G(^DGCR( 399,IBIFN, "U2")),U,I ) | |
4321 | ; | |
4322 | I $G(IBIN S),$$MCRWN R^IBEFUNC( IBINS) D | |
4323 | . ;MCRWNR is curren t insuranc e ... move payer onl y | |
4324 | . N IBCOB N,IBX | |
4325 | . S IBCOB N=$$COBN^I BCEF(IBIFN ) | |
4326 | . S IBCOB (0,21)=$P( "S^T^",U,I BCOBN) | |
4327 | . S IBCOB ("M1",IBCO BN+4)=IBIF N | |
4328 | . S IBCOB ("TX",1)=" ",IBCOB("T X",2)="" | |
4329 | . S IBX=$ $REQMRA^IB EFUNC(IBIF N) | |
4330 | . I IBX=0 S IBCOB(" TX",5)=0 ; MRA n ot needed | |
4331 | . I IBX[" R" S IBCOB ("TX",5)=" A" ; MRA s kipped | |
4332 | . I IBX=1 ,$$CHK^IBC EMU1(IBIFN ) S IBCOB( "TX",5)="C " ; MRA o n file | |
4333 | . I $G(IB PRCOB) S I BCOB("TX", 5)="C" ; MRA b eing proc' d | |
4334 | . D PRIOR (IBIFN) | |
4335 | . Q | |
4336 | ; | |
4337 | ;reset fi elds for n ext Sequen ce Payer | |
4338 | F I=0,"M1 ","U2","TX " I $D(IBC OB(I)) D C OB | |
4339 | ; | |
4340 | ; IB*2.0* 211 | |
4341 | ; save of f Form Typ e | |
4342 | S IBFRMTY P=$P($G(^D GCR(399,IB IFN,0)),U, 19) | |
4343 | ; Save of f Taxonomi es for pro viders. | |
4344 | S I=0 F S I=$O(^DG CR(399,IBI FN,"PRV",I )) Q:'I S IBTAXLST( I)=$P($G(^ DGCR(399,I BIFN,"PRV" ,I,0)),U,1 5) | |
4345 | ; | |
4346 | ; fire xr efs set lo gic | |
4347 | D INDEX | |
4348 | ; | |
4349 | ; Restore Form Type if change d, but don 't restore Form Type if | |
4350 | ; creat ing CMS-15 00 claim f rom CTCOPY 1^IBCCCB | |
4351 | I $G(IBCT COPY)'=1,I BFRMTYP'=$ P($G(^DGCR (399,IBIFN ,0)),U,19) N DA,DIE, DR S DA=IB IFN,DIE="^ DGCR(399," ,DR=".19// //"_IBFRMT YP D ^DIE | |
4352 | ; | |
4353 | ; Restore Claim MRA Status fi eld since triggers i n fields 1 01 & 102 | |
4354 | ; will overwrite the correc t value wh en process ing the MR A/EOB. | |
4355 | ; If we'r e processi ng the MRA /EOB, then a valid M RA has bee n received . | |
4356 | I $G(IBPR COB) N DA, DIE,DR S D A=IBIFN,DI E="^DGCR(3 99,",DR="2 4////C" D ^DIE | |
4357 | ; | |
4358 | ; Only if cloning, then resto re Taxonom ies in fie lds 243 an d 244 and 252. | |
4359 | I '$G(IBI NS),'$G(IB PRCOB) D | |
4360 | . S I=$P( $G(IBND("U 3")),U,2) | |
4361 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,2 ) D | |
4362 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="24 3////"_$S( I'="":I,1: "@") D ^DI E | |
4363 | . ; | |
4364 | . S I=$P( $G(IBND("U 3")),U,3) | |
4365 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,3 ) D | |
4366 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="24 4////"_$S( I'="":I,1: "@") D ^DI E | |
4367 | . ; | |
4368 | . S I=$P( $G(IBND("U 3")),U,11) | |
4369 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,1 1) D | |
4370 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="25 2////"_$S( I'="":I,1: "@") D ^DI E | |
4371 | . Q | |
4372 | ; | |
4373 | ; Restore Taxonomie s in field .15 in su b-file 399 .0222. | |
4374 | S IBTAXLS T=0 F S I BTAXLST=$O (IBTAXLST( IBTAXLST)) Q:'IBTAXL ST D | |
4375 | . S I=IBT AXLST(IBTA XLST) | |
4376 | . I I=$P( $G(^DGCR(3 99,IBIFN," PRV",IBTAX LST,0)),U, 15) Q ; N o change | |
4377 | . N DA,DI E,DR | |
4378 | . S DA(1) =IBIFN,DA= IBTAXLST | |
4379 | . S DIE=" ^DGCR(399, "_DA(1)_", ""PRV"",", DR=".15/// /"_$S(I'=" ":I,1:"@") | |
4380 | . D ^DIE | |
4381 | . Q | |
4382 | ; | |
4383 | K IBCOB(" TX") | |
4384 | Q | |
4385 | ; | |
4386 | SAVERC(IBI FN,IBMAED) ; IB*2.0 *447 BI - Save the v alue of pi ece 16 of each RC no de before re-indexin g. | |
4387 | Q:$G(IBCT COPY)=1 Q :$G(IBCTCO PY)=2 | |
4388 | N IBCNT S IBCNT=0 | |
4389 | Q:'$G(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"RC ")) | |
4390 | F S IBCN T=$O(^DGCR (399,IBIFN ,"RC",IBCN T)) Q:+IBC NT=0 D | |
4391 | . S IBMAE D(IBCNT)=$ P($G(^DGCR (399,IBIFN ,"RC",IBCN T,0)),U,16 ) | |
4392 | Q | |
4393 | ; | |
4394 | RESTRC(IBI FN,IBMAED) ; IB*2.0 *447 BI - Restore th e value of piece 16 of each RC node afte r re-index ing. | |
4395 | Q:$G(IBCT COPY)=1 Q :$G(IBCTCO PY)=2 | |
4396 | N IBCNT S IBCNT=0 | |
4397 | Q:'$G(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"RC ")) | |
4398 | F S IBCN T=$O(IBMAE D(IBCNT)) Q:+IBCNT=0 D | |
4399 | . S $P(^D GCR(399,IB IFN,"RC",I BCNT,0),U, 16)=IBMAED (IBCNT) | |
4400 | Q | |
4401 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
4402 | IBCCC2 ;AL B/AAS - CA NCEL AND C LONE A BIL L - CONTIN UED ;6/6/0 3 9:56am | |
4403 | ;;2.0;INT EGRATED BI LLING;**80 ,106,124,1 38,51,151, 137,161,18 2,211,245, 155,296,32 0,348,349, 371,400,43 3,432,447, 516,592,60 8**;21-MAR -94;Build 40 | |
4404 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4405 | ; | |
4406 | ;MAP TO D GCRCC2 | |
4407 | ; | |
4408 | ;STEP 5 - get remai nder of da ta to move and store in MCCR t hen x-ref | |
4409 | ;STEP 6 - go to scr eens, come out to IB B1 or some thing like that | |
4410 | ; | |
4411 | STEP5 S IB IFN1=$P(^D GCR(399,IB IFN,0),"^" ,15) G END :$S(IBIFN1 ="":1,'$D( ^DGCR(399, IBIFN1,0)) :1,1:0) | |
4412 | ; NOTE: any new or changed d ata nodes may also n eed to be updated in IBNCPDP5 | |
4413 | ;move pur e data nod es | |
4414 | ; MRD;IB* 2.0*516 - Added "In7 " nodes. | |
4415 | F I="I1", "I17","I2" ,"I27","I3 ","I37","M 1" I $D(^D GCR(399,IB IFN1,I)) S ^DGCR(399 ,IBIFN,I)= ^DGCR(399, IBIFN1,I) | |
4416 | ; | |
4417 | ;move top level dat a node. ;D o not move 'TX' node EXCEPT pi ece 8 (add ed with IB *2.0*432) | |
4418 | ;F I="U", "U1","U2", "U3","UF2" ,"UF3","UF 31","C","M " I $D(^DG CR(399,IBI FN1,I)) S IBND(I)=^( I) D @I | |
4419 | ; add new data node s introduc ed with IB *2.0*432 | |
4420 | F I="TX", "U","U1"," U2","U3"," U4","U5"," U6","U7"," U8","UF2", "UF3","UF3 1","UF32", "C","M" I $D(^DGCR(3 99,IBIFN1, I)) S IBND (I)=^(I) D @I | |
4421 | ; | |
4422 | ;move mul tiple leve l data | |
4423 | ;F I="CC" ,"OC","OP" ,"OT","RC" ,"CP","CV" ,"PRV" I $ D(^DGCR(39 9,IBIFN1,I ,0)) D @I | |
4424 | ; add new data node s introduc ed with IB *2.0*447 B I | |
4425 | F I="CC", "OC","OP", "OT","RC", "CP","CV", "PRV","U9" I $D(^DGC R(399,IBIF N1,I,0)) D @I | |
4426 | ; | |
4427 | ;JWS;IB*2 .0*592;add new Denta l Claim fi elds | |
4428 | I $D(^DGC R(399,IBIF N1,"DEN")) S ^DGCR(3 99,IBIFN," DEN")=^DGC R(399,IBIF N1,"DEN") | |
4429 | I $D(^DGC R(399,IBIF N1,"DEN1", 0)) S ^DGC R(399,IBIF N,"DEN1",0 )=^DGCR(39 9,IBIFN1," DEN1",0) D | |
4430 | . S K=0 F S K=$O(^ DGCR(399,I BIFN1,"DEN 1",K)) Q:' K S ^DGCR (399,IBIFN ,"DEN1",K, 0)=^DGCR(3 99,IBIFN1, "DEN1",K,0 ) | |
4431 | I $D(^DGC R(399,IBIF N1,"DEN2") ) S ^DGCR( 399,IBIFN, "DEN2")=^D GCR(399,IB IFN1,"DEN2 ") | |
4432 | ; | |
4433 | ; IB*2.0* 432 ADDED IBSILENT flag so th at this ca n be proce ssed in ba ckground | |
4434 | D FTPRV^I BCEU5(IBIF N,$G(IBSIL ENT)) ; As k change p rov type i f form typ e not the same | |
4435 | D COBCHG( IBIFN,,.IB COB) | |
4436 | ; | |
4437 | D ^IBCCC3 ; copy ta ble files (362.3) | |
4438 | ; | |
4439 | S I=$G(^D GCR(399,IB IFN1,0)) I $P(I,U,13 )=7,$P(I,U ,20)=1 D C OPYB^IBCDC (IBIFN1,IB IFN) ; upd ate auto b ill files | |
4440 | D PRIOR(I BIFN) ; ad d new bill to previo us bills i n series, primary/se condary | |
4441 | ; | |
4442 | I +$G(IBC TCOPY) N I BAUTO S IB AUTO=1 D P ROC^IBCU7A (IBIFN),BI LL^IBCRBC( IBIFN),CPT MOD26^IBCU 73(IBIFN) D RECALL^D ILFD(399,I BIFN_",",D UZ) G END | |
4443 | ; | |
4444 | STEP6 N IB GOEND | |
4445 | ; need to kill CRD flag prior to enteri ng billing screens i n case a c opy for co rrespondin g claim is needed | |
4446 | K IBCNCRD | |
4447 | ; don't c all IB bil l edit scr eens if th is is non- MRA backgr ound proce ssing | |
4448 | I $G(IBST SM)=1 G EN D | |
4449 | I '$G(IBC E("EDI"))! $G(IBCE("E DI","NEW") ),'$G(IBCE AUTO) D IB SCEDT G EN D:$G(IBGOE ND) | |
4450 | ; | |
4451 | ; | |
4452 | END K DFN, IB,IBA,IBA 2,IBAD,IBA DD1,IBBNO, IBCAN,IBCC C,IBDA,IBD PT,IBDR,IB DT,IBI,IBI 1,IBIDS,IB IFN,IBIFN1 ,IBND,IBQU IT,IBU,IBU N,IBARST,I BCOB,IBCNC OPY,IBCBCO PY,IBCNCRD ,IBKEY | |
4453 | K IBV,IBV 1,IBW,IBWW ,IBYN,IBZZ ,PRCASV,PR CAERCD,PRC AERR,PRCAS VC,PRCAT,I BBT,IBCH,I BNDS,IBOA, IBREV,IBX, DGXRF1,VAE L,VAERR,IB AC,IBCCC,I BDD1,IBIN, DGREV,DGRE V00,DGREVH DR,IBCHK | |
4454 | K IBBS,IB LS,DGPCM,I BIP,IBND0, IBNDU,IBO, IBPTF,IBST ,IBUC,IBDD ,D,%,%DT,D IC,VA,VADM ,X,X1,X2,X 3,X4,Y,I,J ,K,DGRVRCA L,DDH,DGAC TDT,DGAMNT ,DGBR,DGBR N,DGBSI,DG BSLOS,IBA1 ,IBOD,IBIN S,IBN,IBPR OC,DGFUNC, DGIFN | |
4455 | Q | |
4456 | ; | |
4457 | ; | |
4458 | IBSCEDT ; call the I B bill edi t screens and valida te the dat a | |
4459 | N IBV,IBP AR,IBAC,IB HV,IBH,IBC IREDT | |
4460 | ; if the user came from CBW-> PC and thi s is a non -MRA claim w/a paper EOB, set force prin t flag IB* 2.0*432 | |
4461 | ; also, i f the user came from CBW->PC a nd this is a non-MRA claim and the only EEOB we ha ve has fil ing errors , set forc e print fl ag | |
4462 | I $G(IBMR ANOT)=1,$$ COBN^IBCEF (IBIFN)>1, $G(IBFROM) =2 D | |
4463 | .I $G(IBD A)="" D FO RCEPRT^IBC APP($G(IBI FN)) Q | |
4464 | .I $D(^IB M(361.1,IB DA,"ERR")) D FORCEPR T^IBCAPP($ G(IBIFN)) Q | |
4465 | D RECALL^ DILFD(399, IBIFN_",", DUZ) | |
4466 | ST1 S IBV= 0 D ^IBCSC U,^IBCSC1 I $G(IBPOP OUT) S IBG OEND=1 G I BSCX | |
4467 | S IBAC=1 | |
4468 | D ^IBCB1 | |
4469 | I $G(IBCI REDT) G ST 1 | |
4470 | IBSCX ; | |
4471 | Q | |
4472 | ; | |
4473 | ; | |
4474 | TX F J=8 I $P(IBND(" TX"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"TX" ),"^",J)=$ P(IBND("TX "),"^",J) | |
4475 | Q | |
4476 | U F J=3,4, 6:1:17,20 I $P(IBND( "U"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"U") ,"^",J)=$P (IBND("U") ,"^",J) | |
4477 | Q | |
4478 | U1 F J=1:1 :3,15 I $P (IBND("U1" ),"^",J)]" " S $P(^DG CR(399,IBI FN,"U1")," ^",J)=$P(I BND("U1"), "^",J) | |
4479 | Q | |
4480 | U2 F J=1:1 :19 I $P(I BND("U2"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U2"),"^" ,J)=$P(IBN D("U2"),"^ ",J) | |
4481 | Q | |
4482 | U3 F J=1:1 :11 I $P(I BND("U3"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U3"),"^" ,J)=$P(IBN D("U3"),"^ ",J) | |
4483 | Q | |
4484 | UF2 F J=1, 3 I $P(IBN D("UF2")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "UF2"),"^" ,J)=$P(IBN D("UF2")," ^",J) | |
4485 | Q | |
4486 | UF3 F J=4: 1:6 I $P(I BND("UF3") ,"^",J)]"" S $P(^DGC R(399,IBIF N,"UF3")," ^",J)=$P(I BND("UF3") ,"^",J) | |
4487 | Q | |
4488 | U4 F J=1:1 :14 I $P(I BND("U4"), "^",J)]"" S $P(^DGCR (399,IBIFN ,"U4"),"^" ,J)=$P(IBN D("U4"),"^ ",J) | |
4489 | Q | |
4490 | U5 F J=1:1 :6 I $P(IB ND("U5")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U5"),"^", J)=$P(IBND ("U5"),"^" ,J) | |
4491 | Q | |
4492 | U6 F J=1:1 :6 I $P(IB ND("U6")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U6"),"^", J)=$P(IBND ("U6"),"^" ,J) | |
4493 | Q | |
4494 | U7 F J=1:1 :5 I $P(IB ND("U7")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U7"),"^", J)=$P(IBND ("U7"),"^" ,J) | |
4495 | Q | |
4496 | U8 F J=1:1 :3 I $P(IB ND("U8")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "U8"),"^", J)=$P(IBND ("U8"),"^" ,J) | |
4497 | Q | |
4498 | UF31 F J=3 I $P(IBND ("UF31")," ^",J)]"" S $P(^DGCR( 399,IBIFN, "UF31"),"^ ",J)=$P(IB ND("UF31") ,"^",J) | |
4499 | Q | |
4500 | UF32 F J=1 :1:3 I $P( IBND("UF32 "),"^",J)] "" S $P(^D GCR(399,IB IFN,"UF32" ),"^",J)=$ P(IBND("UF 32"),"^",J ) | |
4501 | Q | |
4502 | C F J=10 I $P(IBND(" C"),"^",J) ]"" S $P(^ DGCR(399,I BIFN,"C"), "^",J)=$P( IBND("C"), "^",J) | |
4503 | I '$D(^DG CR(399,IBI FN1,"CP")) D CP1 | |
4504 | Q | |
4505 | M F J=1:1: 9,11:1:14 I $P(IBND( "M"),"^",J )]"" S $P( ^DGCR(399, IBIFN,"M") ,"^",J)=$P (IBND("M") ,"^",J) | |
4506 | Q | |
4507 | CC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4508 | S IBDD=39 9.04 F J=0 :0 S J=$O( ^DGCR(399, IBIFN1,I,J )) Q:'J I $D(^(J,0) ) S ^DGCR( 399,IBIFN, I,J,0)=^DG CR(399,IBI FN1,I,J,0) ,X=$P(^(0) ,"^") | |
4509 | OP S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4510 | S IBDD=39 9.043 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4511 | Q | |
4512 | OC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4513 | S IBDD=39 9.041 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4514 | Q | |
4515 | OT S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4516 | S IBDD=39 9.048 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4517 | Q | |
4518 | CV ; Don't copy valu e codes fr om inpatie nt inst to inpatient prof bill s | |
4519 | I $$FT^IB CEF(IBIFN1 )'=2,$$FT^ IBCEF(IBIF N)=2 Q | |
4520 | S ^DGCR(3 99,IBIFN,I ,0)=^DGCR( 399,IBIFN1 ,I,0) | |
4521 | S IBDD=39 9.047 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S ^DGCR (399,IBIFN ,I,J,0)=^D GCR(399,IB IFN1,I,J,0 ),X=$P(^(0 ),"^") | |
4522 | Q | |
4523 | RC S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4524 | S IBDD=39 9.042 F J= 0:0 S J=$O (^DGCR(399 ,IBIFN1,I, J)) Q:'J I $D(^(J,0 )) S IBND( "RC")=^(0) F K=1:1:1 6 S $P(^DG CR(399,IBI FN,I,J,0), "^",K)=$P( IBND("RC") ,"^",K),X= $P(IBND("R C"),"^",K) | |
4525 | Q | |
4526 | CP S ^DGCR (399,IBIFN ,I,0)=^DGC R(399,IBIF N1,I,0) | |
4527 | I +$G(IBN OCPT) Q | |
4528 | S IBDD=39 9.0304 F J =0:0 S J=$ O(^DGCR(39 9,IBIFN1,I ,J)) Q:'J I $D(^(J, 0)) S IBND ("CP")=^(0 ),IBND("CP 1")=$G(^(1 )),IBND("C P-AUX")=$G (^("AUX")) D | |
4529 | . F K=1:1 :7,9:1:14, 16:1:22 S $P(^DGCR(3 99,IBIFN,I ,J,0),"^", K)=$P(IBND ("CP"),"^" ,K) | |
4530 | . ; IB*2. 0*432 add new 1 node | |
4531 | . ; MRD;I B*2.0*516 - Added pi eces 7 & 8 (NDC, Uni ts) to 1-n ode. | |
4532 | . F K=1:1 :8 S $P(^D GCR(399,IB IFN,I,J,1) ,"^",K)=$P (IBND("CP1 "),"^",K) | |
4533 | . ; esg - 11/2/06 - IB*2*348 - 50.09 fi eld was ad ded - AUX piece [9] | |
4534 | . I IBND( "CP-AUX")' ="" F K=1: 1:9 S $P(^ DGCR(399,I BIFN,I,J," AUX"),"^", K)=$P(IBND ("CP-AUX") ,"^",K) | |
4535 | . ; IB*2. 0*432 add new LNPRV multiple | |
4536 | . I $D(^D GCR(399,IB IFN1,I,J," LNPRV",0)) S ^DGCR(3 99,IBIFN,I ,J,"LNPRV" ,0)=^DGCR( 399,IBIFN1 ,I,J,"LNPR V",0) D | |
4537 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"LNPRV",K )) Q:'K D | |
4538 | ... S ^DG CR(399,IBI FN,I,J,"LN PRV",K,0)= ^DGCR(399, IBIFN1,I,J ,"LNPRV",K ,0) | |
4539 | . I $D(^D GCR(399,IB IFN1,I,J," MOD",0)) S ^DGCR(399 ,IBIFN,I,J ,"MOD",0)= ^DGCR(399, IBIFN1,I,J ,"MOD",0) D | |
4540 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"MOD",K)) Q:'K D | |
4541 | ... I $G( IBNOTC),$P ($$MOD^ICP TMOD(+$P($ G(^DGCR(39 9,IBIFN1,I ,J,"MOD",K ,0)),U,2), "I"),U,2)= "TC" Q ; Don't copy TC modifi er from in st to prof bill | |
4542 | ... S ^DG CR(399,IBI FN,I,J,"MO D",K,0)=^D GCR(399,IB IFN1,I,J," MOD",K,0) | |
4543 | . ;JWS;IB *2.0*592;a dd new Den tal claim form field s | |
4544 | . I $D(^D GCR(399,IB IFN1,I,J," DEN")) S ^ DGCR(399,I BIFN,I,J," DEN")=^DGC R(399,IBIF N1,I,J,"DE N") | |
4545 | . I $D(^D GCR(399,IB IFN1,I,J," DEN1",0)) S ^DGCR(39 9,IBIFN,I, J,"DEN1",0 )=^DGCR(39 9,IBIFN1,I ,J,"DEN1", 0) D | |
4546 | .. S K=0 F S K=$O( ^DGCR(399, IBIFN1,I,J ,"DEN1",K) ) Q:'K D | |
4547 | ... S ^DG CR(399,IBI FN,I,J,"DE N1",K,0)=^ DGCR(399,I BIFN1,I,J, "DEN1",K,0 ) | |
4548 | . ;JRA;IB *2.0*608 A dd CMN inf o - Node ' CMN-10126' contains data speci fic to onl y the CMS- 10126 form , node 'CM N-484' con tains data specific to | |
4549 | . ; only the CMN-48 4 form, an d node 'CM N' contain s data com mon to bot h forms. | |
4550 | . I $D(^D GCR(399,IB IFN1,I,J," CMN")) S ^ DGCR(399,I BIFN,I,J," CMN")=^DGC R(399,IBIF N1,I,J,"CM N") | |
4551 | . I $D(^D GCR(399,IB IFN1,I,J," CMN-10126" )) S ^DGCR (399,IBIFN ,I,J,"CMN- 10126")=^D GCR(399,IB IFN1,I,J," CMN-10126" ) | |
4552 | . I $D(^D GCR(399,IB IFN1,I,J," CMN-484")) S ^DGCR(3 99,IBIFN,I ,J,"CMN-48 4")=^DGCR( 399,IBIFN1 ,I,J,"CMN- 484") | |
4553 | CP1 S IBCO D=$P($G(^D GCR(399,IB IFN,0)),"^ ",9) Q:IBC OD=""!('$D (^DGCR(399 ,IBIFN1,"C "))) | |
4554 | I IBCOD=9 F DGI=4,5 ,6 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICD0(" ,DGPROCDT= $P(^("C"), "^",DGI+7) D FILE | |
4555 | I IBCOD=4 F DGI=1,2 ,3 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICPT(" ,DGPROCDT= $P(^("C"), "^",DGI+10 ) D FILE | |
4556 | I IBCOD=5 F DGI=7,8 ,9 I $P(^D GCR(399,IB IFN1,"C"), "^",DGI) S X=$P(^("C "),"^",DGI )_";ICPT(" ,DGPROCDT= $P(^("C"), "^",DGI+4) D FILE | |
4557 | Q | |
4558 | ; | |
4559 | PRV ; Copy providers for clone d claim | |
4560 | N Z,Z0,CN T | |
4561 | S Z=$P($G (^DGCR(399 ,IBIFN,0)) ,U,19),Z0= $P($G(^DGC R(399,IBIF N1,0)),U,1 9),CNT=0 | |
4562 | S IBDD=39 9.0222 F J =0:0 S J=$ O(^DGCR(39 9,IBIFN1,I ,J)) Q:'J I $D(^(J, 0)) D | |
4563 | . I $$GET NPI^IBCEF7 3A($P(^DGC R(399,IBIF N1,I,J,0), U,2))="" Q ;Don't f ile provid er if no N PI - IB*2* 516 | |
4564 | . S CNT=C NT+1,^DGCR (399,IBIFN ,I,CNT,0)= ^DGCR(399, IBIFN1,I,J ,0),X=$P(^ (0),"^") | |
4565 | . I Z'=Z0 ,$S(X=3:Z0 =3,X=4:Z0= 2,1:0) S $ P(^DGCR(39 9,IBIFN,I, CNT,0),U)= (Z0+1) | |
4566 | I CNT S ^ DGCR(399,I BIFN,I,0)= ^DGCR(399, IBIFN1,I,0 ),$P(^DGCR (399,IBIFN ,I,0),U,3) =CNT,$P(^D GCR(399,IB IFN,I,0),U ,4)=CNT | |
4567 | Q | |
4568 | ; | |
4569 | U9 ; Added for new d ata elemen ts in IB*2 .0*447 BI | |
4570 | M ^DGCR(3 99,IBIFN,I )=^DGCR(39 9,IBIFN1,I ) | |
4571 | Q | |
4572 | ; | |
4573 | COB S J=0 F S J=$O( IBCOB(I,J) ) Q:'J S $P(^DGCR(3 99,IBIFN,I ),U,J)=IBC OB(I,J) | |
4574 | Q | |
4575 | ; | |
4576 | FILE N DIC ,DIE,DR,DA ,X,Y,DLAYG O,DD,DO | |
4577 | I '$D(^DG CR(399,IBI FN,"CP",0) ) S DIC("P ")=$$GETSP EC^IBEFUNC (399,304) | |
4578 | S DIC(0)= "L",DLAYGO =399,DA(1) =IBIFN,DIC ="^DGCR(39 9,"_DA(1)_ ",""CP""," Q:X="" D FILE^DICN K DO,DD Q :+Y<1 S D A=+Y | |
4579 | S DIE="^D GCR(399,"_ DA(1)_","" CP"",",DR= "1///"_DGP ROCDT D ^D IE | |
4580 | K DGPROCD T | |
4581 | Q | |
4582 | ; | |
4583 | INDEX ;ind ex entire file (set logic) | |
4584 | N IBMAED D SAVERC(I BIFN,.IBMA ED) ; IB* 2.0*447 BI - Save th e value of piece 16 of each RC node befo re re-inde xing. | |
4585 | S DIK="^D GCR(399,", DA=IBIFN D IX1^DIK K DA,DIK | |
4586 | D RESTRC( IBIFN,.IBM AED) ; IB *2.0*447 B I - Restor e the valu e of piece 16 of eac h RC node before re- indexing. | |
4587 | Q | |
4588 | ; | |
4589 | PRIOR(IBIF N) ; set S econdary/T ertiary Bi ll #s on p rior bills , if the b ill is can celled rem ove it fro m prior bi lls | |
4590 | N IBSEQ,I BSEQN,IBM1 ,I,IBIFN1 | |
4591 | S IBSEQ=$ $COB^IBCEF (IBIFN) | |
4592 | S IBSEQN= $S(IBSEQ=" S":6,IBSEQ ="T":7,1:" ") Q:'IBSE QN | |
4593 | ; | |
4594 | S IBM1=$G (^DGCR(399 ,IBIFN,"M1 ")) I +$P( ^DGCR(399, IBIFN,0),U ,13)=7 S I BIFN="" | |
4595 | F I=5,6 I I<IBSEQN S IBIFN1= +$P(IBM1,U ,I) I +IBI FN1,$D(^DG CR(399,+IB IFN1,0)) S $P(^DGCR( 399,IBIFN1 ,"M1"),U,I BSEQN)=IBI FN | |
4596 | Q | |
4597 | ; | |
4598 | COBCHG(IBI FN,IBINS,I BCOB) ; Ma ke changes for a new COB payer for bill | |
4599 | ; IBIFN = ien of bi ll in file 399 | |
4600 | ; IBINS = ien of bi ll's curre nt insuran ce (option al) | |
4601 | ; IBCOB = array sub scripted b y node,pie ce of COB data field change | |
4602 | ; | |
4603 | N I,IBFRM TYP,IBTAXL ST | |
4604 | ; Subtrac t the Prio r Payments from the bill's Off set (these are re-ad ded by tri ggers) | |
4605 | F I=4,5,6 S $P(^DG CR(399,IBI FN,"U1"),U ,2)=$P($G( ^DGCR(399, IBIFN,"U1" )),U,2)-$P ($G(^DGCR( 399,IBIFN, "U2")),U,I ) | |
4606 | ; | |
4607 | I $G(IBIN S),$$MCRWN R^IBEFUNC( IBINS) D | |
4608 | . ;MCRWNR is curren t insuranc e ... move payer onl y | |
4609 | . N IBCOB N,IBX | |
4610 | . S IBCOB N=$$COBN^I BCEF(IBIFN ) | |
4611 | . S IBCOB (0,21)=$P( "S^T^",U,I BCOBN) | |
4612 | . S IBCOB ("M1",IBCO BN+4)=IBIF N | |
4613 | . S IBCOB ("TX",1)=" ",IBCOB("T X",2)="" | |
4614 | . S IBX=$ $REQMRA^IB EFUNC(IBIF N) | |
4615 | . I IBX=0 S IBCOB(" TX",5)=0 ; MRA n ot needed | |
4616 | . I IBX[" R" S IBCOB ("TX",5)=" A" ; MRA s kipped | |
4617 | . I IBX=1 ,$$CHK^IBC EMU1(IBIFN ) S IBCOB( "TX",5)="C " ; MRA o n file | |
4618 | . I $G(IB PRCOB) S I BCOB("TX", 5)="C" ; MRA b eing proc' d | |
4619 | . D PRIOR (IBIFN) | |
4620 | . Q | |
4621 | ; | |
4622 | ;reset fi elds for n ext Sequen ce Payer | |
4623 | F I=0,"M1 ","U2","TX " I $D(IBC OB(I)) D C OB | |
4624 | ; | |
4625 | ; IB*2.0* 211 | |
4626 | ; save of f Form Typ e | |
4627 | S IBFRMTY P=$P($G(^D GCR(399,IB IFN,0)),U, 19) | |
4628 | ; Save of f Taxonomi es for pro viders. | |
4629 | S I=0 F S I=$O(^DG CR(399,IBI FN,"PRV",I )) Q:'I S IBTAXLST( I)=$P($G(^ DGCR(399,I BIFN,"PRV" ,I,0)),U,1 5) | |
4630 | ; | |
4631 | ; fire xr efs set lo gic | |
4632 | D INDEX | |
4633 | ; | |
4634 | ; Restore Form Type if change d, but don 't restore Form Type if | |
4635 | ; creat ing CMS-15 00 claim f rom CTCOPY 1^IBCCCB | |
4636 | I $G(IBCT COPY)'=1,I BFRMTYP'=$ P($G(^DGCR (399,IBIFN ,0)),U,19) N DA,DIE, DR S DA=IB IFN,DIE="^ DGCR(399," ,DR=".19// //"_IBFRMT YP D ^DIE | |
4637 | ; | |
4638 | ; Restore Claim MRA Status fi eld since triggers i n fields 1 01 & 102 | |
4639 | ; will overwrite the correc t value wh en process ing the MR A/EOB. | |
4640 | ; If we'r e processi ng the MRA /EOB, then a valid M RA has bee n received . | |
4641 | I $G(IBPR COB) N DA, DIE,DR S D A=IBIFN,DI E="^DGCR(3 99,",DR="2 4////C" D ^DIE | |
4642 | ; | |
4643 | ; Only if cloning, then resto re Taxonom ies in fie lds 243 an d 244 and 252. | |
4644 | I '$G(IBI NS),'$G(IB PRCOB) D | |
4645 | . S I=$P( $G(IBND("U 3")),U,2) | |
4646 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,2 ) D | |
4647 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="24 3////"_$S( I'="":I,1: "@") D ^DI E | |
4648 | . ; | |
4649 | . S I=$P( $G(IBND("U 3")),U,3) | |
4650 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,3 ) D | |
4651 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="24 4////"_$S( I'="":I,1: "@") D ^DI E | |
4652 | . ; | |
4653 | . S I=$P( $G(IBND("U 3")),U,11) | |
4654 | . I I'=$P ($G(^DGCR( 399,IBIFN, "U3")),U,1 1) D | |
4655 | .. N DA,D IE,DR S DA =IBIFN,DIE ="^DGCR(39 9,",DR="25 2////"_$S( I'="":I,1: "@") D ^DI E | |
4656 | . Q | |
4657 | ; | |
4658 | ; Restore Taxonomie s in field .15 in su b-file 399 .0222. | |
4659 | S IBTAXLS T=0 F S I BTAXLST=$O (IBTAXLST( IBTAXLST)) Q:'IBTAXL ST D | |
4660 | . S I=IBT AXLST(IBTA XLST) | |
4661 | . I I=$P( $G(^DGCR(3 99,IBIFN," PRV",IBTAX LST,0)),U, 15) Q ; N o change | |
4662 | . N DA,DI E,DR | |
4663 | . S DA(1) =IBIFN,DA= IBTAXLST | |
4664 | . S DIE=" ^DGCR(399, "_DA(1)_", ""PRV"",", DR=".15/// /"_$S(I'=" ":I,1:"@") | |
4665 | . D ^DIE | |
4666 | . Q | |
4667 | ; | |
4668 | K IBCOB(" TX") | |
4669 | Q | |
4670 | ; | |
4671 | SAVERC(IBI FN,IBMAED) ; IB*2.0 *447 BI - Save the v alue of pi ece 16 of each RC no de before re-indexin g. | |
4672 | Q:$G(IBCT COPY)=1 Q :$G(IBCTCO PY)=2 | |
4673 | N IBCNT S IBCNT=0 | |
4674 | Q:'$G(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"RC ")) | |
4675 | F S IBCN T=$O(^DGCR (399,IBIFN ,"RC",IBCN T)) Q:+IBC NT=0 D | |
4676 | . S IBMAE D(IBCNT)=$ P($G(^DGCR (399,IBIFN ,"RC",IBCN T,0)),U,16 ) | |
4677 | Q | |
4678 | ; | |
4679 | RESTRC(IBI FN,IBMAED) ; IB*2.0 *447 BI - Restore th e value of piece 16 of each RC node afte r re-index ing. | |
4680 | Q:$G(IBCT COPY)=1 Q :$G(IBCTCO PY)=2 | |
4681 | N IBCNT S IBCNT=0 | |
4682 | Q:'$G(IBI FN) Q:'$D (^DGCR(399 ,IBIFN,"RC ")) | |
4683 | F S IBCN T=$O(IBMAE D(IBCNT)) Q:+IBCNT=0 D | |
4684 | . S $P(^D GCR(399,IB IFN,"RC",I BCNT,0),U, 16)=IBMAED (IBCNT) | |
4685 | Q | |
4686 | ||
4687 | IBJPS – Ma in entry f or IB Site Parameter s which ca lls IBJPS8 to set up CMN CPT I nclusion | |
4688 | Routines | |
4689 | Activities | |
4690 | Routine Na me | |
4691 | IBJPS | |
4692 | Enhancemen t Category | |
4693 | New | |
4694 | Modify | |
4695 | Delete | |
4696 | No Change | |
4697 | RTM | |
4698 | ||
4699 | Related Op tions | |
4700 | None | |
4701 | Related Ro utines | |
4702 | Routines “ Called By” | |
4703 | Routines “ Called” | |
4704 | ||
4705 | ||
4706 | ||
4707 | ||
4708 | Data Dicti onary (DD) Reference s | |
4709 | ||
4710 | Related Pr otocols | |
4711 | None | |
4712 | Related In tegration Control Re gistration s (ICRs) | |
4713 | None | |
4714 | Data Passi ng | |
4715 | Input | |
4716 | Output Re ference | |
4717 | Both | |
4718 | Global Re ference | |
4719 | Local | |
4720 | Input Attr ibute Name and Defin ition | |
4721 | Name: | |
4722 | Definition : | |
4723 | Output Att ribute Nam e and Defi nition | |
4724 | Name: | |
4725 | Definition : | |
4726 | Current Lo gic | |
4727 | IBJPS ;AL B/MAF,ARH - IBSP IB SITE PARAM ETER SCREE N ;22-DEC- 1995 | |
4728 | ;;2.0;INT EGRATED BI LLING;**39 ,52,70,115 ,143,51,13 7,161,155, 320,348,34 9,377,384, 400,432,49 4,461,516, 547,592**; 21-MAR-94; Build 40 | |
4729 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4730 | ; | |
4731 | EN ; -- ma in entry p oint for I BJP IB SIT E PARAMETE RS, displa y IB site parameters | |
4732 | D EN^VALM ("IBJP IB SITE PARAM ETERS") | |
4733 | Q | |
4734 | ; | |
4735 | HDR ; -- h eader code | |
4736 | S VALMHDR (1)="Only authorized persons m ay edit th is data." | |
4737 | Q | |
4738 | ; | |
4739 | INIT ; -- init varia bles and l ist array | |
4740 | K ^TMP("I BJPS",$J), ^TMP("IBJP SAX",$J) | |
4741 | D BLD^IBJ PS1 | |
4742 | Q | |
4743 | ; | |
4744 | HELP ; -- help code | |
4745 | S X="?" D DISP^XQOR M1 W !! | |
4746 | Q | |
4747 | ; | |
4748 | EXIT ; -- exit code | |
4749 | K ^TMP("I BJPS",$J), ^TMP("IBJP SAX",$J) | |
4750 | D CLEAR^V ALM1 | |
4751 | Q | |
4752 | ; | |
4753 | NXEDIT ; - - IBJP IB SITE PARAM ETER EDIT ACTION (EP ): Select data set t o edit, do edit | |
4754 | N VALMY,I BSELN,IBSE T | |
4755 | D EN^VALM 2($G(XQORN OD(0))) | |
4756 | I $D(VALM Y) S IBSEL N=0 F S I BSELN=$O(V ALMY(IBSEL N)) Q:'IBS ELN D | |
4757 | . S IBSET =$P($G(^TM P("IBJPSAX ",$J,IBSEL N)),U,1) Q :'IBSET | |
4758 | . D EDIT( IBSET) | |
4759 | S VALMBCK ="R" | |
4760 | Q | |
4761 | ; | |
4762 | EDIT(IBSET ) ; edit I B Site Par ameters | |
4763 | D FULL^VA LM1 | |
4764 | N DR | |
4765 | I IBSET'= "" D | |
4766 | . ; MRD;I B*2.0*516 - Added TR ICARE Pay- To Provide rs. | |
4767 | . ; WCJ;I B*2.0*547 - shifted the number s down to insert a n ew one | |
4768 | . I IBSET =8 D EN^IB JPS5 Q | |
4769 | . I IBSET =11 D EN^I BJPS3(0) Q | |
4770 | . I IBSET =12 D EN^I BJPS3(1) Q | |
4771 | . ;WCJ;IB *2.0*547 a dded defau lt Adminis trative co ntractors for billin g (medicar e and comm ercial) | |
4772 | . I IBSET =17 D EN^I BJPS6(1) Q ; medic are | |
4773 | . I IBSET =18 D EN^I BJPS6(2) Q ; comme rcial | |
4774 | . S DR=$P ($T(@IBSET ),";;",2,9 99) | |
4775 | . Q | |
4776 | ; WCJ;IB* 2.0*547 - shifted th e number d own to ins ert a new one | |
4777 | I IBSET=9 ,$$ICD9SYS ^IBACSV(DT )=30 S $P( DR,";",1)= 7.05 | |
4778 | ; | |
4779 | I $G(DR)' ="" S DIE= "^IBE(350. 9,",DA=1 D ^DIE K DA ,DR,DIE,DI C,X,Y | |
4780 | D INIT^IB JPS S VALM BCK="R" | |
4781 | Q | |
4782 | ; | |
4783 | ;WCJ;IB*2 .0*547 - c leared the spot for the new #8 , added 17 & 18, mov e 16 to 19 . | |
4784 | ;gef;IB*2 .0*547 - a dded 20 | |
4785 | ;JWS;IB*2 .0*592 - a dded field 8.2 to 16 | |
4786 | 1 ;;.09;.1 3;.14 | |
4787 | 2 ;;1.2;.1 5;.11;.12; 7.04 | |
4788 | 3 ;;1.09;1 .07;2.07 | |
4789 | 4 ;;4.04;6 .25;6.24 | |
4790 | 5 ;;.02;1. 14;1.25;1. 08 | |
4791 | 6 ;;1.23;1 .16;1.22;1 .19;1.15;1 .17 | |
4792 | 7 ;;1.33;1 .32;1.31;1 .27;8.14T; 8.15T;8.16 T;8.19T | |
4793 | 9 ;;1.29;1 .3;1.18;1. 28 | |
4794 | 10 ;;1.01; 1.02;1.05 | |
4795 | 13 ;;2.08; 2.09 | |
4796 | 14 ;;11.01 | |
4797 | 15 ;;10.02 ;10.03;10. 04;10.05;D INIT^IBAT FILE | |
4798 | 16 ;;2.11; 8.01;8.09; 8.03;8.06; 8.04;8.07; 8.02;8.12T ;8.11T;8.1 7T;8.2T | |
4799 | 19 ;;50.01 ;50.02;50. 05;50.06;5 0.03;50.04 ;50.07 | |
4800 | 20 ;;52.01 ;52.02 | |
4801 | ; | |
4802 | Modified L ogic (Chan ges are hi ghlighted in yellow) | |
4803 | IBJPS ;ALB /MAF,ARH - IBSP IB S ITE PARAME TER SCREEN ;22-DEC-1 995 | |
4804 | ;;2.0;INT EGRATED BI LLING;**39 ,52,70,115 ,143,51,13 7,161,155, 320,348,34 9,377,384, 400,432,49 4,461,516, 547,592,60 8**;21-MAR -94;Build 40 | |
4805 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4806 | ; | |
4807 | EN ; -- ma in entry p oint for I BJP IB SIT E PARAMETE RS, displa y IB site parameters | |
4808 | D EN^VALM ("IBJP IB SITE PARAM ETERS") | |
4809 | Q | |
4810 | ; | |
4811 | HDR ; -- h eader code | |
4812 | S VALMHDR (1)="Only authorized persons m ay edit th is data." | |
4813 | Q | |
4814 | ; | |
4815 | INIT ; -- init varia bles and l ist array | |
4816 | K ^TMP("I BJPS",$J), ^TMP("IBJP SAX",$J) | |
4817 | D BLD^IBJ PS1 | |
4818 | Q | |
4819 | ; | |
4820 | HELP ; -- help code | |
4821 | S X="?" D DISP^XQOR M1 W !! | |
4822 | Q | |
4823 | ; | |
4824 | EXIT ; -- exit code | |
4825 | K ^TMP("I BJPS",$J), ^TMP("IBJP SAX",$J) | |
4826 | D CLEAR^V ALM1 | |
4827 | Q | |
4828 | ; | |
4829 | NXEDIT ; - - IBJP IB SITE PARAM ETER EDIT ACTION (EP ): Select data set t o edit, do edit | |
4830 | N VALMY,I BSELN,IBSE T | |
4831 | D EN^VALM 2($G(XQORN OD(0))) | |
4832 | I $D(VALM Y) S IBSEL N=0 F S I BSELN=$O(V ALMY(IBSEL N)) Q:'IBS ELN D | |
4833 | . S IBSET =$P($G(^TM P("IBJPSAX ",$J,IBSEL N)),U,1) Q :'IBSET | |
4834 | . D EDIT( IBSET) | |
4835 | S VALMBCK ="R" | |
4836 | Q | |
4837 | ; | |
4838 | EDIT(IBSET ) ; edit I B Site Par ameters | |
4839 | D FULL^VA LM1 | |
4840 | N DR | |
4841 | I IBSET'= "" D | |
4842 | . ; MRD;I B*2.0*516 - Added TR ICARE Pay- To Provide rs. | |
4843 | . ; WCJ;I B*2.0*547 - shifted the number s down to insert a n ew one | |
4844 | . I IBSET =8 D EN^IB JPS5 Q | |
4845 | . I IBSET =11 D EN^I BJPS3(0) Q | |
4846 | . I IBSET =12 D EN^I BJPS3(1) Q | |
4847 | . ;WCJ;IB *2.0*547 a dded defau lt Adminis trative co ntractors for billin g (medicar e and comm ercial) | |
4848 | . I IBSET =17 D EN^I BJPS6(1) Q ; medic are | |
4849 | . I IBSET =18 D EN^I BJPS6(2) Q ; comme rcial | |
4850 | . I IBSET =21 D EN^I BJPS8 Q ; WCJ;IB*2 .0*608;US3 ; | |
4851 | . S DR=$P ($T(@IBSET ),";;",2,9 99) | |
4852 | . Q | |
4853 | ; WCJ;IB* 2.0*547 - shifted th e number d own to ins ert a new one | |
4854 | I IBSET=9 ,$$ICD9SYS ^IBACSV(DT )=30 S $P( DR,";",1)= 7.05 | |
4855 | ; | |
4856 | I $G(DR)' ="" S DIE= "^IBE(350. 9,",DA=1 D ^DIE K DA ,DR,DIE,DI C,X,Y | |
4857 | D INIT^IB JPS S VALM BCK="R" | |
4858 | Q | |
4859 | ; | |
4860 | ;WCJ;IB*2 .0*547 - c leared the spot for the new #8 , added 17 & 18, mov e 16 to 19 . | |
4861 | ;gef;IB*2 .0*547 - a dded 20 | |
4862 | ;JWS;IB*2 .0*592 - a dded field 8.2 to 16 | |
4863 | 1 ;;.09;.1 3;.14 | |
4864 | 2 ;;1.2;.1 5;.11;.12; 7.04 | |
4865 | 3 ;;1.09;1 .07;2.07 | |
4866 | 4 ;;4.04;6 .25;6.24 | |
4867 | 5 ;;.02;1. 14;1.25;1. 08 | |
4868 | 6 ;;1.23;1 .16;1.22;1 .19;1.15;1 .17 | |
4869 | 7 ;;1.33;1 .32;1.31;1 .27;8.14T; 8.15T;8.16 T;8.19T | |
4870 | 9 ;;1.29;1 .3;1.18;1. 28 | |
4871 | 10 ;;1.01; 1.02;1.05 | |
4872 | 13 ;;2.08; 2.09 | |
4873 | 14 ;;11.01 | |
4874 | 15 ;;10.02 ;10.03;10. 04;10.05;D INIT^IBAT FILE | |
4875 | 16 ;;2.11; 8.01;8.09; 8.03;8.06; 8.04;8.07; 8.02;8.12T ;8.11T;8.1 7T;8.2T | |
4876 | 19 ;;50.01 ;50.02;50. 05;50.06;5 0.03;50.04 ;50.07 | |
4877 | 20 ;;52.01 ;52.02 | |
4878 | ; | |
4879 | ||
4880 | IBJPS8 – S et up CMN CPT Inclus ions in IB System Pa rameters & check bef ore CMN pr ompt | |
4881 | Routines | |
4882 | Activities | |
4883 | Routine Na me | |
4884 | IBJPS8 | |
4885 | Enhancemen t Category | |
4886 | New | |
4887 | Modify | |
4888 | Delete | |
4889 | No Change | |
4890 | RTM | |
4891 | ||
4892 | Related Op tions | |
4893 | None | |
4894 | Related Ro utines | |
4895 | Routines “ Called By” | |
4896 | Routines “ Called” | |
4897 | ||
4898 | ||
4899 | ||
4900 | ||
4901 | Data Dicti onary (DD) Reference s | |
4902 | ||
4903 | Related Pr otocols | |
4904 | None | |
4905 | Related In tegration Control Re gistration s (ICRs) | |
4906 | None | |
4907 | Data Passi ng | |
4908 | Input | |
4909 | Output Re ference | |
4910 | Both | |
4911 | Global Re ference | |
4912 | Local | |
4913 | Input Attr ibute Name and Defin ition | |
4914 | Name: | |
4915 | Definition : | |
4916 | Output Att ribute Nam e and Defi nition | |
4917 | Name: | |
4918 | Definition : | |
4919 | Current Lo gic | |
4920 | IBJPS8 ;AI TC/WCJ - I B Site Par ameters, C MN CPT Inc lusions CP T Codes ;0 2-Feb-2018 | |
4921 | ;;2.0;INT EGRATED BI LLING;**60 8**;21-MAR -94;Build 40 | |
4922 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
4923 | ; | |
4924 | EN ; -- ma in entry p oint for I BJP IB CMN CPTS | |
4925 | D EN^VALM ("IBJPS CM N CPTS") | |
4926 | Q | |
4927 | ; | |
4928 | HDR ; -- h eader code | |
4929 | S VALMSG= "" | |
4930 | Q | |
4931 | ; | |
4932 | INIT ; -- init varia bles and l ist array | |
4933 | N ERROR,I BCNT,IBLN, IBSTR | |
4934 | N CPTDATA ,CIENS,CPT IEN,RTYDSC | |
4935 | ; | |
4936 | S (VALMCN T,IBCNT,IB LN)=0 | |
4937 | I $D(^IBE (350.9,1,1 6,"B")) D | |
4938 | . S CPTIE N=0 F S C PTIEN=$O(^ IBE(350.9, 1,16,"B",C PTIEN)) Q: 'CPTIEN D | |
4939 | . . ; | |
4940 | . . S CIE NS=CPTIEN_ "," | |
4941 | . . D GET S^DIQ(81,C IENS,".001 ;.01;2","I ","CPTDATA ","ERROR") | |
4942 | . . S IBC NT=IBCNT+1 | |
4943 | . . S IBS TR=$$SETST R^VALM1($J (IBCNT,4)_ ".","",2,6 ) | |
4944 | . . S IBS TR=$$SETST R^VALM1($G (CPTDATA(8 1,CIENS,.0 1,"I")),IB STR,10,10) | |
4945 | . . S IBS TR=$$SETST R^VALM1($G (CPTDATA(8 1,CIENS,2, "I")),IBST R,25,30) | |
4946 | . . S IBL N=$$SET(IB LN,IBSTR) | |
4947 | . . ;S @V ALMAR@("ZI DX",IBCNT, $G(CPTDATA (81,CIENS, .001,"I")) )="" | |
4948 | . . S @VA LMAR@("ZID X",IBCNT,+ CIENS)="" | |
4949 | . . Q | |
4950 | ; | |
4951 | I 'IBLN S IBLN=$$SE T(IBLN,$$S ETSTR^VALM 1("No CMN CPTs defin ed.","",13 ,40)) | |
4952 | ; | |
4953 | S VALMCNT =IBLN,VALM BG=1 | |
4954 | Q | |
4955 | ; | |
4956 | HELP ; -- help code | |
4957 | S X="?" D DISP^XQOR M1 W !! | |
4958 | Q | |
4959 | ; | |
4960 | EXIT ; -- exit code | |
4961 | D CLEAR^V ALM1,CLEAN ^VALM10 | |
4962 | Q | |
4963 | ; | |
4964 | EXPND ; -- expand co de | |
4965 | Q | |
4966 | ; | |
4967 | RTADD(IBTC FLAG) ; -- Add a new CPT Codes | |
4968 | N X,Y,DIE ,DIR,DIRUT ,DR,DTOUT, DUOUT,ERRM SG,FDA,RET IEN | |
4969 | ; | |
4970 | S VALMBCK ="R" | |
4971 | D FULL^VA LM1 | |
4972 | D RTADD1 | |
4973 | D INIT | |
4974 | Q | |
4975 | ; | |
4976 | RTADD1 ; L ooping tag for Addin g CPT Code s | |
4977 | K DA,DIE, DIR,DIRUT, DR,DTOUT,D UOUT,ERRMS G,FDA,RETI EN,X,Y | |
4978 | ; | |
4979 | S DIR(0)= "350.916,. 01" | |
4980 | S DIR("A" )="CPT Cod e" | |
4981 | D ^DIR | |
4982 | Q:'+Y | |
4983 | ; | |
4984 | I $D(^IBE (350.9,1,1 6,"B",+Y)) D G RTAD D1 | |
4985 | . D FULL^ VALM1 | |
4986 | . W @IOF | |
4987 | . W !,"Th is CPT Cod e already exists on the Inclus ion list." | |
4988 | . W !,"Pl ease enter another C PT Code." | |
4989 | . Q | |
4990 | ; | |
4991 | S FDA(350 .916,"+1,1 ,",.01)=+Y | |
4992 | D UPDATE^ DIE("","FD A","RETIEN ","ERRMSG" ) | |
4993 | G RTADD1 | |
4994 | ; | |
4995 | RTDEL ; -- Delete a CPT Coode | |
4996 | N DR | |
4997 | D RTDEL1 | |
4998 | S VALMBCK ="R" | |
4999 | Q | |
5000 | ; | |
5001 | RTDEL1 ; L ooping tag for delet ing CPT Co des | |
5002 | N Z,VALMY | |
5003 | D FULL^VA LM1 | |
5004 | D EN^VALM 2($G(XQORN OD(0))) | |
5005 | S Z=0 | |
5006 | F S Z=$O (VALMY(Z)) Q:'Z D | |
5007 | . N DIK,I EN,RIEN | |
5008 | . S IEN=$ O(@VALMAR@ ("ZIDX",Z, "")) | |
5009 | . Q:IEN=" " | |
5010 | . S RIEN= $O(^IBE(35 0.9,1,16," B",IEN,"") ) | |
5011 | . I +RIEN S DIK="^I BE(350.9,1 ,16,",DA(1 )=1,DA=RIE N D ^DIK | |
5012 | K @VALMAR | |
5013 | D INIT | |
5014 | Q | |
5015 | ; | |
5016 | SET(IBLN,I BSTR) ; -- Add a lin e to displ ay list | |
5017 | ; returns line numb er added | |
5018 | S IBLN=IB LN+1 D SET ^VALM10(IB LN,IBSTR,I BLN) | |
5019 | Q IBLN | |
5020 | ; | |
5021 | CMNPRMT(IB XIEN,IBPRO CP,CPTIEN) ;JRA Dete rmine if p rocedure r equires pr ompting fo r CMN Info | |
5022 | ;Basicall y checks i f CPTIEN i s in the " CMN CPT Co de Inclusi on" list | |
5023 | ; Input: IBXIEN = Internal bill/claim number | |
5024 | ; IBPROCP = Procedure line subs cript | |
5025 | ; CPTIEN = CPT code ien | |
5026 | ; | |
5027 | ; Output : 1 = Prom pt user fo r CMN info | |
5028 | ; 0 = Don' t prompt u ser for CM N info | |
5029 | ; | |
5030 | I '$G(IBX IEN)!('$G( IBPROCP)!( '$G(CPTIEN ))) Q 0 | |
5031 | ;Prompt i f the CPT is in IB S ite Parame ters "CMN CPT Code I nclusion" list -OR- if "CMN Re quired?" a lready set to "YES" | |
5032 | I $D(^IBE (350.9,1,1 6,"B",CPTI EN))>1!($$ CMNDATA^IB CEF31(IBXI EN,IBPROCP ,23,"I")) Q 1 | |
5033 | Q 0 | |
5034 | ; | |
5035 | ||
5036 | IBY608PR - The new e ntries for files 364 .5, 364.6, 364.7 and 350.8 are added | |
5037 | Routines | |
5038 | Activities | |
5039 | Routine Na me | |
5040 | IBY608PR | |
5041 | Enhancemen t Category | |
5042 | New | |
5043 | Modify | |
5044 | Delete | |
5045 | No Change | |
5046 | RTM | |
5047 | ||
5048 | Related Op tions | |
5049 | None | |
5050 | Related Ro utines | |
5051 | Routines “ Called By” | |
5052 | Routines “ Called” | |
5053 | ||
5054 | ||
5055 | ||
5056 | ||
5057 | Data Dicti onary (DD) Reference s | |
5058 | ||
5059 | Related Pr otocols | |
5060 | None | |
5061 | Related In tegration Control Re gistration s (ICRs) | |
5062 | None | |
5063 | Data Passi ng | |
5064 | Input | |
5065 | Output Re ference | |
5066 | Both | |
5067 | Global Re ference | |
5068 | Local | |
5069 | Input Attr ibute Name and Defin ition | |
5070 | Name: | |
5071 | Definition : | |
5072 | Output Att ribute Nam e and Defi nition | |
5073 | Name: | |
5074 | Definition : | |
5075 | Current Lo gic | |
5076 | IBY608PR ; EDE/JRA - Pre-Instal lation for IB patch 608 ; 10/1 2/17 2:12 pm | |
5077 | ;;2.0;INT EGRATED BI LLING;**60 8**;21-MAR -94;Build 40 | |
5078 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5079 | ; | |
5080 | ; delete all output formatter (O.F.) da ta element s included in build | |
5081 | D DELOF | |
5082 | Q | |
5083 | ; | |
5084 | INCLUDE(FI LE,Y) ; fu nction to determine if O.F. en try should be includ ed in the build | |
5085 | ; FILE=5, 6,7 indica ting file 364.x or F ILE=8 indi cating fil e 350.8 (I B ERROR) | |
5086 | ; Y=ien t o file | |
5087 | NEW OK,LN ,TAG,DATA | |
5088 | S OK=0 | |
5089 | F LN=2:1 S TAG="ENT "_FILE_"+" _LN,DATA=$ P($T(@TAG) ,";;",2) Q :DATA="" I $F(DATA, U_Y_U) S O K=1 Q | |
5090 | Q OK | |
5091 | ; | |
5092 | ;Delete e dited entr ies to ins ure clean install of new entri es | |
5093 | ;Delete o bsolete en tries. | |
5094 | DELOF ; Delete inc luded OF e ntries | |
5095 | NEW FILE, DIK,LN,TAG ,TAGLN,DAT A,PCE,DA,Y | |
5096 | F FILE=5: 1:8 S DIK= $S(FILE=8: "^IBE(350. ",1:"^IBA( 364.")_FIL E_"," D | |
5097 | . F TAG=" ENT"_FILE, "DEL"_FILE D | |
5098 | .. F LN=2 :1 S TAGLN =TAG_"+"_L N,DATA=$P( $T(@TAGLN) ,";;",2) Q :DATA="" D | |
5099 | ... F PCE =2:1 S DA= $P(DATA,U, PCE) Q:'DA D | |
5100 | .... I FI LE=8,$D(^I BE(350.8,D A,0)) D ^D IK | |
5101 | .... Q:FI LE=8 | |
5102 | .... I $D (^IBA("364 ."_FILE,DA ,0)) D ^DI K | |
5103 | Q | |
5104 | ; | |
5105 | ; Example for ENT5, ENT6, ENT 7, ENT8, D EL5, DEL6, and DEL7: | |
5106 | ;;^195^25 4^259^269^ 324^325^ | |
5107 | ; Note: Must have beginning and ending up-carat | |
5108 | ; | |
5109 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5110 | ; 364.5 O .F. entrie s added: | |
5111 | ; | |
5112 | ; 225 N -COB CLAIM LEVEL AMO UNTS 'COB1 -1.9' (US2 486) | |
5113 | ; 226 N -MEDICARE INPT CLAIM COB AMTS 'MIA1-1.9' (US2486) | |
5114 | ; 227 N -MEDICARE OUTPT CLAI M COB AMT 'MOA1-1.9' (US2486) | |
5115 | ; 228 N -COB CLAIM LEVEL ADJ USTMENTS ' CCAS-1.9' (US2486) | |
5116 | ; 396 N -CMN RECOR D ID 'LQ ' | |
5117 | ; 438 N -CMN RECOR D ID 'FRM ' | |
5118 | ; 440 N -CMN RECOR D ID 'CMN ' | |
5119 | ; 442 N -CMN RECOR D ID 'MEA ' | |
5120 | ; | |
5121 | ENT5 ;O.F. entries i n file 364 .5 to be a dded | |
5122 | ; | |
5123 | ;;^225^22 6^227^228^ 396^438^44 0^442^ | |
5124 | ; | |
5125 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5126 | ; 364.6 O .F. entrie s added: | |
5127 | ; | |
5128 | ; 2383 C MN RECORD ID 'LQ ' | |
5129 | ; 2384 C MN FORM TY PE QUALIFI ER | |
5130 | ; 2385 S ERVICE LIN E # | |
5131 | ; 2387 C MN INDUSTR Y CODE | |
5132 | ; 2388 C MN CERTIFI CATION TYP E | |
5133 | ; 2390 C MN CERTIFI CATION TYP E QUAL | |
5134 | ; 2392 C MN MEASURE MENT REFER ENCE ID CO DE | |
5135 | ; 2393 C MN PATIENT WEIGHT (L BS) | |
5136 | ; 2394 C MN PATIENT WEIGHT MO DIFIER | |
5137 | ; 2395 C MN MONTHS DME EQUIPM ENT NEEDED | |
5138 | ; 2396 C MN DATE TH ERAPY STAR TED | |
5139 | ; 2397 C MN DATE TH ERAPY STAR TED QUALIF IER | |
5140 | ; 2398 C MN LAST CE RTIFICATIO N DATE | |
5141 | ; 2399 C MN LAST CE RTIFICATIO N DATE QUA LIFIER | |
5142 | ; 2400 C MN RECERTI FICATION/R EVISION DA TE | |
5143 | ; 2401 C MN REPLACE MENT ITEM? | |
5144 | ; 2433 L Q DATA EXT RACT | |
5145 | ; 2436 F RM DATA EX TRACT | |
5146 | ; 2438 C MN RECORD ID 'FRM ' | |
5147 | ; 2439 S ERVICE LIN E # | |
5148 | ; 2442 C MN QUESTIO N NUMBER/L ETTER | |
5149 | ; 2443 C MN QUESTIO N RESPONSE Y/N | |
5150 | ; 2444 C MN QUESTIO N RESPONSE REF ID | |
5151 | ; 2445 C MN QUESTIO N RESPONSE DATE | |
5152 | ; 2446 C MN QUESTIO N RESPONSE % & DECIM AL | |
5153 | ; 2447 S ERVICE LIN E # | |
5154 | ; 2448 C MN DATA EX TRACT | |
5155 | ; 2449 C MN RECORD ID 'CMN ' | |
5156 | ; 2451 C MN UNIT OR BASIS FOR MEASUREME NT CODE | |
5157 | ; 2452 C MN CERTIFI CATION CON DITION IND ICATOR | |
5158 | ; 2453 C MN CONDITI ON INDICAT OR | |
5159 | ; 2454 C MN ATTACHM ENT REPORT TYPE CODE | |
5160 | ; 2455 C MN ATTACHM ENT TRANSM ISSION COD E | |
5161 | ; 2456 C MN CODE CA TEGORY | |
5162 | ; 2457 C MN RECORD ID 'MEA ' | |
5163 | ; 2458 M EA DATA EX TRACT | |
5164 | ; 2461 S ERVICE LIN E # | |
5165 | ; 2462 C MN MEASURE MENT QUALI FIER | |
5166 | ; 2463 C MN TEST RE SULTS | |
5167 | ; | |
5168 | ENT6 ;O.F. entries i n file 364 .6 to be a dded | |
5169 | ; | |
5170 | ;;^2383^2 384^2385^2 387^2388^2 390^2392^2 393^2394^2 395^2396^2 397^2398^ | |
5171 | ;;^2399^2 400^2401^2 433^2436^2 438^2439^2 442^2443^2 444^2445^2 446^2447^ | |
5172 | ;;^2448^2 449^2451^2 452^2453^2 454^2455^2 456^2457^2 458^2461^2 462^2463^ | |
5173 | ; | |
5174 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5175 | ; 364.7 O .F. entrie s added: | |
5176 | ; | |
5177 | ; 105 V C1 VALUE C ODE (837 T ransaction ) (PC 2) ( US9) | |
5178 | ; 176 I NS SERVICE LINE COUN TER (PC 2) (US9) | |
5179 | ; 178 I NS SERVICE UNIT COUN T (PC 5) ( US9) | |
5180 | ; 179 I NS BLANK ( PC 6) (US9 ) | |
5181 | ; 180 I NS SERVICE LINE CHAR GE AMT (PC 9) (US9) | |
5182 | ; 181 I NS PROCEDU RE MODIFIE R (1) (PC 7) (US9) | |
5183 | ; 189 I NS PROCEDU RE CODE (P C 4) (US9) | |
5184 | ; 478 B GN N-RECOR D ID (PC1) (US9) | |
5185 | ; 482 I NS SERVICE LINE NON- COVERED CH ARGE AMT ( PC 12) (US 9) | |
5186 | ; 805 I NS UNITS/B ASIS FOR M EASUREMENT CODE (PC 13) (US9) | |
5187 | ; 985 N -GET FROM PREVIOUS E XTRACT 'LC OB-1.9' - US2486 | |
5188 | ; 1015 G EN-7 | |
5189 | ; 1751 L DATE SERVI CE LINE CO UNTER (PC 2) | |
5190 | ; 1752 L DAT DATA E XTRACT (83 7 Transact ion) (PC 1 .9) (US9) | |
5191 | ; 1765 L DAT CLEANU P (837 Tra nsaction) (PC 99.9) (US9) | |
5192 | ; 1969 C MN RECORD ID 'LQ ' | |
5193 | ; 1970 S ERVICE LIN E # | |
5194 | ; 1971 C MN FORM TY PE QUALIFI ER | |
5195 | ; 1973 C MN INDUSTR Y CODE | |
5196 | ; 1974 C MN CERTIFI CATION TYP E | |
5197 | ; 1975 C MN CERTIFI CATION TYP E QUAL | |
5198 | ; 1977 C MN MEASURE MENT REFER ENCE ID CO DE | |
5199 | ; 1978 C MN PATIENT WEIGHT (L BS) | |
5200 | ; 1979 C MN PATIENT WEIGHT MO DIFIER | |
5201 | ; 1980 C MN MONTHS DME EQUIPM ENT NEEDED | |
5202 | ; 1981 C MN DATE TH ERAPY STAR TED | |
5203 | ; 1982 C MN DATE TH ERAPY STAR TED QUALIF IER | |
5204 | ; 1983 C MN LAST CE RTIFICATIO N DATE | |
5205 | ; 1984 C MN LAST CE RTIFICATIO N DATE QUA LIFIER | |
5206 | ; 1985 C MN RECERTI FICATION/R EVISION DA TE | |
5207 | ; 1986 C MN REPLACE MENT ITEM? | |
5208 | ; 2018 L Q DATA EXT RACT | |
5209 | ; 2019 F RM DATA EX TRACT | |
5210 | ; 2020 C MN RECORD ID 'FRM ' | |
5211 | ; 2021 C MN QUESTIO N NUMBER/L ETTER | |
5212 | ; 2022 C MN QUESTIO N RESPONSE Y/N | |
5213 | ; 2023 C MN QUESTIO N RESPONSE REF ID | |
5214 | ; 2024 C MN QUESTIO N RESPONSE DATE | |
5215 | ; 2025 C MN QUESTIO N RESPONSE % & DECIM AL | |
5216 | ; 2026 S ERVICE LIN E # | |
5217 | ; 2027 S ERVICE LIN E # | |
5218 | ; 2028 C MN DATA EX TRACT | |
5219 | ; 2029 C MN RECORD ID 'CMN ' | |
5220 | ; 2030 C MN UNIT OR BASIS FOR MEASUREME NT CODE | |
5221 | ; 2031 C MN CERTIFI CATION CON DITION IND ICATOR | |
5222 | ; 2032 C MN ATTACHM ENT REPORT TYPE CODE | |
5223 | ; 2033 C MN ATTACHM ENT TRANSM ISSION COD E | |
5224 | ; 2034 C MN CODE CA TEGORY | |
5225 | ; 2035 C MN CONDITI ON INDICAT OR | |
5226 | ; 2038 C MN RECORD ID 'MEA ' | |
5227 | ; 2039 M EA DATA EX TRACT | |
5228 | ; 2040 S ERVICE LIN E # | |
5229 | ; 2041 C MN MEASURE MENT QUALI FIER | |
5230 | ; 2042 C MN TEST RE SULTS | |
5231 | ; | |
5232 | ENT7 ; O.F . entries in file 36 4.7 to be added | |
5233 | ; | |
5234 | ;;^105^17 6^178^179^ 180^181^18 9^478^482^ 805^985^10 15^1751^17 52^1765^ | |
5235 | ;;^1969^1 970^1971^1 973^1974^1 975^1977^1 978^1979^1 980^1981^ | |
5236 | ;;^1982^1 983^1984^1 985^1986^2 018^2019^2 020^2021^2 022^2023^ | |
5237 | ;;^2024^2 025^2026^2 027^2028^2 029^2030^2 031^2032^2 033^2034^ | |
5238 | ;;^2035^2 038^2039^2 040^2041^2 042^ | |
5239 | ; | |
5240 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5241 | ; 350.8 O .F. entrie s added: | |
5242 | ; | |
5243 | ; 239 I B CMN NOT REQ BUT DA TA (IB901 ) | |
5244 | ; 240 I B CMN FORM TYPE (IB 902) | |
5245 | ; 241 I B CMN NO D ATA NODE (IB903) | |
5246 | ; 243 I B CMN BAD DATA NODE (IB904) | |
5247 | ; 244 I B CMN CERT TYPE (IB 905) | |
5248 | ; 246 I B CMN THER APY DT (I B907) | |
5249 | ; 247 I B CMN LAST CERT DT (IB908) | |
5250 | ; 248 I B CMN RECE RT/REVISIO N DT (IB9 09) | |
5251 | ; 259 I B CMN ABG SAT DT (I B912) | |
5252 | ; 271 I B CMN 4 LP M DATE (I B914) | |
5253 | ; 272 I B CMN ERRO RS HEADER (IB915) | |
5254 | ; 273 I B CMN PEB (IB906) | |
5255 | ; | |
5256 | ENT8 ;O.F. entries i n file 350 .8 to be a dded | |
5257 | ; | |
5258 | ;;^239^24 0^241^243^ 244^246^24 7^248^259^ 271^272^27 3^ | |
5259 | ; | |
5260 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5261 | ; 364.5 e ntries del eted: | |
5262 | ; | |
5263 | DEL5 ; remove O.F . entries in file 36 4.5 (not r e-added) | |
5264 | ; | |
5265 | ;; | |
5266 | ; | |
5267 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5268 | ; 364.6 e ntries del eted: | |
5269 | ; | |
5270 | DEL6 ; remove O.F . entries in file 36 4.6 (not r e-added) | |
5271 | ; | |
5272 | ;; | |
5273 | ; | |
5274 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5275 | ; 364.7 e ntries del eted: | |
5276 | ; | |
5277 | ; | |
5278 | DEL7 ; remove O.F . entries in file 36 4.7 (not r e-added) | |
5279 | ; | |
5280 | ;; | |
5281 | ; | |
5282 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- | |
5283 | ; 350.8 E ntries del eted: | |
5284 | ; | |
5285 | ; 238 I B CMN REQ | |
5286 | ; | |
5287 | DEL8 ; remove ent ries from 350.8 (IB ERROR) | |
5288 | ; | |
5289 | ;; | |
5290 | ; | |
5291 | ||
5292 | IBY608PO – Add 50 CP T codes to the CMN C PT Code In clusion li st in IB S ystem Para meters – i f one of t hese codes in entere d on a cla im, the us er will be prompted for CMN in fo. | |
5293 | Routines | |
5294 | Activities | |
5295 | Routine Na me | |
5296 | IBY608PO | |
5297 | Enhancemen t Category | |
5298 | New | |
5299 | Modify | |
5300 | Delete | |
5301 | No Change | |
5302 | RTM | |
5303 | ||
5304 | Related Op tions | |
5305 | None | |
5306 | Related Ro utines | |
5307 | Routines “ Called By” | |
5308 | Routines “ Called” | |
5309 | ||
5310 | ||
5311 | ||
5312 | ||
5313 | Data Dicti onary (DD) Reference s | |
5314 | ||
5315 | Related Pr otocols | |
5316 | None | |
5317 | Related In tegration Control Re gistration s (ICRs) | |
5318 | None | |
5319 | Data Passi ng | |
5320 | Input | |
5321 | Output Re ference | |
5322 | Both | |
5323 | Global Re ference | |
5324 | Local | |
5325 | Input Attr ibute Name and Defin ition | |
5326 | Name: | |
5327 | Definition : | |
5328 | Output Att ribute Nam e and Defi nition | |
5329 | Name: | |
5330 | Definition : | |
5331 | Current Lo gic | |
5332 | IBY608PO ; ALB/KDM - POST-INSTA LL FOR IB* 2.0*608 ;1 3-DEC-2017 | |
5333 | ;;2.0;INT EGRATED BI LLING;**60 8**;21-MAR -94;Build 40 | |
5334 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
5335 | ; | |
5336 | ;KDM 12/2 017 US1909 | |
5337 | ; run rep ort of all insurance companies that have the curre nt setting for Trans mit Electr onically s et to zero - which is NO | |
5338 | ; send em ail of rep ort to eBi z rapid re sponse gro up | |
5339 | N IBA,RNA ME | |
5340 | S RNAME=" IBY608PO" | |
5341 | K ^TMP(RN AME) | |
5342 | S IBA(2)= "IB*2*608 Post-Insta ll...",(IB A(1),IBA(3 ))=" " D M ES^XPDUTL( .IBA) K IB A | |
5343 | D MES^XPD UTL(">> Ru nning Insu rance Comp any EDI Pa rameter Re port...ple ase stand by....") | |
5344 | D RPT | |
5345 | D MES^XPD UTL(">> Re port Compl eted.") | |
5346 | D CMNCPT | |
5347 | D:$$PROD^ XUPROD(1) EMAIL ;LIVE | |
5348 | D EMAIL ;TESTIN G | |
5349 | S IBA(2)= "IB*2*608 Post-Insta ll Complet e.",(IBA(1 ),IBA(3))= " " D MES^ XPDUTL(.IB A) K IBA | |
5350 | Q | |
5351 | ; | |
5352 | RPT ; Get all Insura nce compan ies that h ave the 3. 01- transm it electro nically fi eld blank or set to No. | |
5353 | ;N IBADDR ESS,IBCITY ,IBNAME,IB PIEN,IBSTA TE,STATE,T RANSCD,TRA NSMIT | |
5354 | N IBADDRE SS,IBCITY, IBNAME,IBP IEN,IBSTAT E,INACTFLG ,STATE,TRA NSMIT | |
5355 | S IBNAME= "" | |
5356 | F S IBNA ME=$O(^DIC (36,"B",IB NAME)) Q:I BNAME="" D | |
5357 | . S IBPIE N=0 | |
5358 | . F S IB PIEN=$O(^D IC(36,"B", IBNAME,IBP IEN)) Q:'+ IBPIEN D | |
5359 | . . S TRA NSMIT=$$GE T1^DIQ(36, IBPIEN,3.0 1,"I") | |
5360 | . . Q:+TR ANSMIT ;O nly want t o report t he insuran ce compani es that ha ve a setti ng of 0 or NULL | |
5361 | . . S (IB ADDRESS,IB CITY,IBSTA TE,INACTFL G,STATE)=" " | |
5362 | . . S IBA DDRESS=$$G ET1^DIQ(36 ,IBPIEN,.1 11) | |
5363 | . . S IBC ITY=$$GET1 ^DIQ(36,IB PIEN,.114) | |
5364 | . . S IBS TATE=$$GET 1^DIQ(36,I BPIEN,.115 ,"I") | |
5365 | . . I +IB STATE S ST ATE=$$GET1 ^DIQ(5,+IB STATE,1) | |
5366 | . . S INA CTFLG=$$GE T1^DIQ(36, IBPIEN,.05 ) | |
5367 | . . I INA CTFLG="" S INACTFLG= "" | |
5368 | . . S ^TM P(RNAME,$J ,IBNAME,IB PIEN)=IBAD DRESS_U_IB CITY_U_STA TE_U_INACT FLG_U_$S(T RANSMIT="" :"",1:"NO" ) | |
5369 | Q | |
5370 | ; | |
5371 | EMAIL ; Se nd an emai l message to eBiz Ra pid Respon se group w ith the re port. | |
5372 | N ADDRESS ,CITY,DATA ,FULLADD,I BNAME,IBNA MEX,IBPIEN ,INACTFLG, LN,MSG | |
5373 | N SPACES, SITE,SITEN AME,SITENO ,STATE,STA TION,SUBJ, TOTAL,TRAN S,TRANSCD, XMINSTR,XM TO | |
5374 | D BMES^XP DUTL(">> S ending Ema il...") | |
5375 | D MES^XPD UTL("----- --------") | |
5376 | D MES^XPD UTL("Sendi ng email n otificatio n to eBiz Rapid resp onse group ... ") | |
5377 | ;S SPACES =$J(" ",10 0) | |
5378 | S $P(SPAC ES,"_",100 )="_" | |
5379 | S SITE=$$ SITE^VASIT E,SITENAME =$P(SITE,U ,2),SITENO =$P(SITE,U ,1),STATIO N=$P(SITE, U,3) | |
5380 | S SUBJ="P ATCH IB*2. 0*608 - In surance Co mpany EDI Report"_" for Statio n# "_$P(SI TE,U,3)_" - "_$P(SIT E,U,2) | |
5381 | S SUBJ=$E (SUBJ,1,65 ) | |
5382 | S MSG(1)= "PATCH IB* 2.0*608 - Insurance Company ED I Paramete r Report" | |
5383 | S MSG(2)= "" | |
5384 | S MSG(3)= "Site: "_S ITENO_" "_ SITENAME_" - Station "_STATION | |
5385 | S MSG(4)= "Domain: " _$G(^XMB(" NETNAME")) | |
5386 | S MSG(5)= "Date/Time : "_$$FMTE ^XLFDT($$N OW^XLFDT) | |
5387 | S MSG(6)= "" | |
5388 | S MSG(7)= "INSURANCE COMPANY__ __________ ______ADDR ESS_______ __________ __________ __________ __________ __________ _INACTIVE_ ___EDI-TRA NSMIT" | |
5389 | S MSG(8)= "========= ========== ========== ========== ========== ========== ========== ========== ========== ========== ========== ========== =====" | |
5390 | S MSG(9)= "" | |
5391 | S LN=10,I BNAME="",T OTAL=0 | |
5392 | F S IBNA ME=$O(^TMP (RNAME,$J, IBNAME)) Q :IBNAME="" D | |
5393 | . S IBPIE N="" | |
5394 | . F S IB PIEN=$O(^T MP(RNAME,$ J,IBNAME,I BPIEN)) Q: IBPIEN="" D | |
5395 | . . S DAT A=^TMP(RNA ME,$J,IBNA ME,IBPIEN) | |
5396 | . . S IBN AMEX=$$UNS PACE($E(IB NAME,1,30) ) | |
5397 | . . S ADD RESS=$$UNS PACE($E($P (DATA,U,1) ,1,30)),CI TY=$$UNSPA CE($E($P(D ATA,U,2),1 ,25)),STAT E=$$UNSPAC E($P(DATA, U,3)) | |
5398 | . . S FUL LADD=ADDRE SS_", "_CI TY_", "_ST ATE | |
5399 | . . I '$L (ADDRESS), '$L(CITY), '$L(STATE) S FULLADD ="" | |
5400 | . . S INA CTFLG=$P(D ATA,U,4) | |
5401 | . . S TRA NS=$P(DATA ,U,5) | |
5402 | . . S LN= LN+1,MSG(L N)=IBNAMEX _$E(SPACES ,1,35-$L(I BNAMEX))_F ULLADD_$E( SPACES,1,6 8-$L(FULLA DD)) | |
5403 | . . S MSG (LN)=MSG(L N)_INACTFL G_$E(SPACE S,1,15-$L( INACTFLG)) _TRANS | |
5404 | . . S TOT AL=TOTAL+1 | |
5405 | S LN=LN+1 ,MSG(LN)=" " | |
5406 | S LN=LN+1 ,MSG(LN)=" Total: "_+ TOTAL | |
5407 | S LN=LN+1 ,MSG(LN)=" " | |
5408 | S LN=LN+1 ,MSG(LN)=" End of Rep ort" | |
5409 | ; | |
5410 | ; ***test ing email to vito,an ne,cj,jane vs live** * must cha nge back t o live bef ore puttin g in build *** | |
5411 | ;S XMTO(" vito.d'ami co@va.gov" )="" | |
5412 | ;S XMTO(" anne.debac ker@va.gov ")="" | |
5413 | ;S XMTO(" cherie.min ch@va.gov" )="" | |
5414 | ;S XMTO(" jane.balch unas@va.go v")="" | |
5415 | ;S XMTO(" william.ju tzi@va.gov ")="" | |
5416 | S XMTO("V HAeBilling RR@va.gov" )="" | |
5417 | ; | |
5418 | S XMINSTR ("FROM")=" VistA-eBil ling" | |
5419 | D SENDMSG ^XMXAPI(DU Z,SUBJ,"MS G",.XMTO,. XMINSTR) | |
5420 | ; | |
5421 | EMAILX ; | |
5422 | D MES^XPD UTL(" Done .") | |
5423 | D CLEAN^D ILF | |
5424 | Q | |
5425 | ; | |
5426 | UNSPACE(FL DX) ; Elim inate spac es at the end of the field. | |
5427 | N I | |
5428 | F S I=$L (FLDX) Q:( $E(FLDX,I) '=" ") I $E(FLDX,I) =" " S FLD X=$E(FLDX, 1,I-1) | |
5429 | Q FLDX | |
5430 | ; | |
5431 | CMNCPT ;Se t CMN CPT CODES in I B System P arameters | |
5432 | D MES^XPD UTL("Setti ng CMN CPT Codes in IB SITE PA RAMETER fi le.....") | |
5433 | N CODES,C PTCD,CPTIE N,CPTS,DA, DIC,DIE,DR ,ERRMSG,FD A,I,RETIEN | |
5434 | S CODES=" " | |
5435 | F I=1:1 S CPTS=$P($ T(CPTCD+I) ,";;",2) Q :CPTS="" S CODES=$S (CODES="": CPTS,1:COD ES_U_CPTS) | |
5436 | F I=1:1 S CPTCD=$P( CODES,U,I) Q:CPTCD=" " D | |
5437 | . S CPTIE N=$$FIND1^ DIC(81,,"X ",CPTCD) Q :'CPTIEN | |
5438 | . I $D(^I BE(350.9,1 ,16,"B",CP TIEN)) Q | |
5439 | . K FDA,E RRMSG,RETI EN | |
5440 | . S FDA(3 50.916,"+1 ,1,",.01)= CPTIEN | |
5441 | . D UPDAT E^DIE(""," FDA","RETI EN","ERRMS G") | |
5442 | D MES^XPD UTL("..... CMN CPT Co des set. " ) | |
5443 | Q | |
5444 | ; | |
5445 | CPTCD ; | |
5446 | ;;B4102^B 4103^B4104 ^B4149^B41 50^B4152^B 4153^B4154 ^B4155^B41 57^B4158^B 4159^B4160 ^B4161^B41 62^B4164^B 4168 | |
5447 | ;;B4172^B 4176^B4178 ^B4180^B41 85^B4189^B 4193^B4197 ^B4199^B42 16^B5000^B 5100^B5200 ^B9002^B90 04^B9006^E 0424 | |
5448 | ;;E0431^E 0433^E0434 ^E0439^E04 41^E0442^E 0443^E0444 ^E0776^E07 91^E1390^E 1391^E1392 ^E1405^E14 06^K0738 | |
5449 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.