Produced by Araxis Merge on 9/28/2018 12:31:18 PM 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 | MCCF_EDI_TAS_IB_2.0_621.zip | IB-2-0-621.KID.txt | Wed Sep 26 20:10:21 2018 UTC |
| 2 | MCCF_EDI_TAS_IB_2.0_621.zip | IB-2-0-621.KID.txt | Fri Sep 28 13:48:24 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 6 | 26274 |
| Changed | 5 | 10 |
| 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 | $KID IB*2. 0*621 | |
| 2 | **INSTALL NAME** | |
| 3 | IB*2.0*621 | |
| 4 | "BLD",1097 2,0) | |
| 5 | IB*2.0*621 ^INTEGRATE D BILLING^ 0^3180718^ y | |
| 6 | "BLD",1097 2,1,0) | |
| 7 | ^^1^1^3180 612^ | |
| 8 | "BLD",1097 2,1,1,0) | |
| 9 | This is IB Build-7 | |
| 10 | "BLD",1097 2,4,0) | |
| 11 | ^9.64PA^2^ 4 | |
| 12 | "BLD",1097 2,4,2,0) | |
| 13 | 2 | |
| 14 | "BLD",1097 2,4,2,2,0) | |
| 15 | ^9.641^2^1 | |
| 16 | "BLD",1097 2,4,2,2,2, 0) | |
| 17 | PATIENT ( File-top l evel) | |
| 18 | "BLD",1097 2,4,2,2,2, 1,0) | |
| 19 | ^9.6411^20 01^1 | |
| 20 | "BLD",1097 2,4,2,2,2, 1,2001,0) | |
| 21 | DATE LAST EICD RUN | |
| 22 | "BLD",1097 2,4,2,222) | |
| 23 | y^n^p^^^^n ^^n | |
| 24 | "BLD",1097 2,4,2,224) | |
| 25 | ||
| 26 | "BLD",1097 2,4,350.9, 0) | |
| 27 | 350.9 | |
| 28 | "BLD",1097 2,4,350.9, 2,0) | |
| 29 | ^9.641^350 .9002^2 | |
| 30 | "BLD",1097 2,4,350.9, 2,350.9,0) | |
| 31 | IB SITE PA RAMETERS (File-top level) | |
| 32 | "BLD",1097 2,4,350.9, 2,350.9,1, 0) | |
| 33 | ^9.6411^51 .31^1 | |
| 34 | "BLD",1097 2,4,350.9, 2,350.9,1, 51.31,0) | |
| 35 | EICD PAYER | |
| 36 | "BLD",1097 2,4,350.9, 2,350.9002 ,0) | |
| 37 | BATCH EXTR ACTS (sub -file) | |
| 38 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,0) | |
| 39 | ^9.6411^.0 5^5 | |
| 40 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,.01,0) | |
| 41 | BATCH EXTR ACTS | |
| 42 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,.05,0) | |
| 43 | MAXIMUM EX TRACT NUMB ER | |
| 44 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,.07,0) | |
| 45 | START DAYS | |
| 46 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,.08,0) | |
| 47 | DAYS AFTER START | |
| 48 | "BLD",1097 2,4,350.9, 2,350.9002 ,1,.09,0) | |
| 49 | FREQUENCY | |
| 50 | "BLD",1097 2,4,350.9, 222) | |
| 51 | y^n^p^^^^n ^^n | |
| 52 | "BLD",1097 2,4,350.9, 224) | |
| 53 | ||
| 54 | "BLD",1097 2,4,365.1, 0) | |
| 55 | 365.1 | |
| 56 | "BLD",1097 2,4,365.1, 2,0) | |
| 57 | ^9.641^365 .1^1 | |
| 58 | "BLD",1097 2,4,365.1, 2,365.1,0) | |
| 59 | IIV TRANSM ISSION QUE UE (File- top level) | |
| 60 | "BLD",1097 2,4,365.1, 2,365.1,1, 0) | |
| 61 | ^9.6411^.2 1^2 | |
| 62 | "BLD",1097 2,4,365.1, 2,365.1,1, .1,0) | |
| 63 | WHICH EXTR ACT | |
| 64 | "BLD",1097 2,4,365.1, 2,365.1,1, .21,0) | |
| 65 | EICD INS-F ND IEN | |
| 66 | "BLD",1097 2,4,365.1, 222) | |
| 67 | y^n^p^^^^n ^^n | |
| 68 | "BLD",1097 2,4,365.1, 224) | |
| 69 | ||
| 70 | "BLD",1097 2,4,365.18 ,0) | |
| 71 | 365.18 | |
| 72 | "BLD",1097 2,4,365.18 ,222) | |
| 73 | y^n^f^^^^n | |
| 74 | "BLD",1097 2,4,"APDD" ,2,2) | |
| 75 | ||
| 76 | "BLD",1097 2,4,"APDD" ,2,2,2001) | |
| 77 | ||
| 78 | "BLD",1097 2,4,"APDD" ,350.9,350 .9) | |
| 79 | ||
| 80 | "BLD",1097 2,4,"APDD" ,350.9,350 .9,51.31) | |
| 81 | ||
| 82 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002) | |
| 83 | ||
| 84 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002,.01) | |
| 85 | ||
| 86 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002,.05) | |
| 87 | ||
| 88 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002,.07) | |
| 89 | ||
| 90 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002,.08) | |
| 91 | ||
| 92 | "BLD",1097 2,4,"APDD" ,350.9,350 .9002,.09) | |
| 93 | ||
| 94 | "BLD",1097 2,4,"APDD" ,365.1,365 .1) | |
| 95 | ||
| 96 | "BLD",1097 2,4,"APDD" ,365.1,365 .1,.1) | |
| 97 | ||
| 98 | "BLD",1097 2,4,"APDD" ,365.1,365 .1,.21) | |
| 99 | ||
| 100 | "BLD",1097 2,4,"B",2, 2) | |
| 101 | ||
| 102 | "BLD",1097 2,4,"B",35 0.9,350.9) | |
| 103 | ||
| 104 | "BLD",1097 2,4,"B",36 5.1,365.1) | |
| 105 | ||
| 106 | "BLD",1097 2,4,"B",36 5.18,365.1 8) | |
| 107 | ||
| 108 | "BLD",1097 2,6.3) | |
| 109 | 8 | |
| 110 | "BLD",1097 2,"ABPKG") | |
| 111 | n | |
| 112 | "BLD",1097 2,"INID") | |
| 113 | n^n^n | |
| 114 | "BLD",1097 2,"INIT") | |
| 115 | IBY621PO | |
| 116 | "BLD",1097 2,"KRN",0) | |
| 117 | ^9.67PA^77 9.2^20 | |
| 118 | "BLD",1097 2,"KRN",.4 ,0) | |
| 119 | .4 | |
| 120 | "BLD",1097 2,"KRN",.4 ,"NM",0) | |
| 121 | ^9.68A^^ | |
| 122 | "BLD",1097 2,"KRN",.4 01,0) | |
| 123 | .401 | |
| 124 | "BLD",1097 2,"KRN",.4 02,0) | |
| 125 | .402 | |
| 126 | "BLD",1097 2,"KRN",.4 02,"NM",0) | |
| 127 | ^9.68A^1^1 | |
| 128 | "BLD",1097 2,"KRN",.4 02,"NM",1, 0) | |
| 129 | IBEDIT INS CO1 FI LE #36^36^ 0 | |
| 130 | "BLD",1097 2,"KRN",.4 02,"NM","B ","IBEDIT INS CO1 FILE #36" ,1) | |
| 131 | ||
| 132 | "BLD",1097 2,"KRN",.4 03,0) | |
| 133 | .403 | |
| 134 | "BLD",1097 2,"KRN",.5 ,0) | |
| 135 | .5 | |
| 136 | "BLD",1097 2,"KRN",.8 4,0) | |
| 137 | .84 | |
| 138 | "BLD",1097 2,"KRN",3. 6,0) | |
| 139 | 3.6 | |
| 140 | "BLD",1097 2,"KRN",3. 8,0) | |
| 141 | 3.8 | |
| 142 | "BLD",1097 2,"KRN",9. 2,0) | |
| 143 | 9.2 | |
| 144 | "BLD",1097 2,"KRN",9. 8,0) | |
| 145 | 9.8 | |
| 146 | "BLD",1097 2,"KRN",9. 8,"NM",0) | |
| 147 | ^9.68A^27^ 27 | |
| 148 | "BLD",1097 2,"KRN",9. 8,"NM",1,0 ) | |
| 149 | IBCNEDE^^0 ^B50050843 | |
| 150 | "BLD",1097 2,"KRN",9. 8,"NM",2,0 ) | |
| 151 | IBCNEDE4^^ 0^B6008969 4 | |
| 152 | "BLD",1097 2,"KRN",9. 8,"NM",3,0 ) | |
| 153 | IBCNEDE5^^ 0^B1439277 5 | |
| 154 | "BLD",1097 2,"KRN",9. 8,"NM",4,0 ) | |
| 155 | IBCNEDE6^^ 0^B7201517 | |
| 156 | "BLD",1097 2,"KRN",9. 8,"NM",5,0 ) | |
| 157 | IBCNEDE7^^ 0^B3258687 3 | |
| 158 | "BLD",1097 2,"KRN",9. 8,"NM",6,0 ) | |
| 159 | IBCNEDEP^^ 0^B1064701 56 | |
| 160 | "BLD",1097 2,"KRN",9. 8,"NM",7,0 ) | |
| 161 | IBCNEHLM^^ 0^B2409643 0 | |
| 162 | "BLD",1097 2,"KRN",9. 8,"NM",8,0 ) | |
| 163 | IBCNEHLQ^^ 0^B1001406 77 | |
| 164 | "BLD",1097 2,"KRN",9. 8,"NM",9,0 ) | |
| 165 | IBCNEHLT^^ 0^B9586524 9 | |
| 166 | "BLD",1097 2,"KRN",9. 8,"NM",10, 0) | |
| 167 | IBCNEKIT^^ 0^B1470728 33 | |
| 168 | "BLD",1097 2,"KRN",9. 8,"NM",11, 0) | |
| 169 | IBCNEMS1^^ 0^B7021261 | |
| 170 | "BLD",1097 2,"KRN",9. 8,"NM",12, 0) | |
| 171 | IBCNEPM^^0 ^B15435667 | |
| 172 | "BLD",1097 2,"KRN",9. 8,"NM",13, 0) | |
| 173 | IBJPI^^0^B 54110191 | |
| 174 | "BLD",1097 2,"KRN",9. 8,"NM",14, 0) | |
| 175 | IBY621PO^^ 0^B1684770 3 | |
| 176 | "BLD",1097 2,"KRN",9. 8,"NM",15, 0) | |
| 177 | IBCNEHL1^^ 0^B1917247 17 | |
| 178 | "BLD",1097 2,"KRN",9. 8,"NM",16, 0) | |
| 179 | IBCNEHL2^^ 0^B7561304 8 | |
| 180 | "BLD",1097 2,"KRN",9. 8,"NM",17, 0) | |
| 181 | IBCNEHL4^^ 0^B2096696 93 | |
| 182 | "BLD",1097 2,"KRN",9. 8,"NM",18, 0) | |
| 183 | IBCNEHL7^^ 0^B3394781 3 | |
| 184 | "BLD",1097 2,"KRN",9. 8,"NM",19, 0) | |
| 185 | IBCNEHLI^^ 0^B1118336 6 | |
| 186 | "BLD",1097 2,"KRN",9. 8,"NM",20, 0) | |
| 187 | IBCNEHL3^^ 0^B1721541 52 | |
| 188 | "BLD",1097 2,"KRN",9. 8,"NM",21, 0) | |
| 189 | IBCNEHL6^^ 0^B7440508 | |
| 190 | "BLD",1097 2,"KRN",9. 8,"NM",22, 0) | |
| 191 | IBCNERP7^^ 0^B3546390 3 | |
| 192 | "BLD",1097 2,"KRN",9. 8,"NM",23, 0) | |
| 193 | IBCNERP8^^ 0^B1104755 63 | |
| 194 | "BLD",1097 2,"KRN",9. 8,"NM",24, 0) | |
| 195 | IBCNERP9^^ 0^B1831722 18 | |
| 196 | "BLD",1097 2,"KRN",9. 8,"NM",25, 0) | |
| 197 | IBCNEUT5^^ 0^B6325282 1 | |
| 198 | "BLD",1097 2,"KRN",9. 8,"NM",26, 0) | |
| 199 | IBCNEBF^^0 ^B48497431 | |
| 200 | "BLD",1097 2,"KRN",9. 8,"NM",27, 0) | |
| 201 | IBCNERP0^^ 0^B5584263 | |
| 202 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEBF" ,26) | |
| 203 | ||
| 204 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDE" ,1) | |
| 205 | ||
| 206 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDE4 ",2) | |
| 207 | ||
| 208 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDE5 ",3) | |
| 209 | ||
| 210 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDE6 ",4) | |
| 211 | ||
| 212 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDE7 ",5) | |
| 213 | ||
| 214 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEDEP ",6) | |
| 215 | ||
| 216 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL1 ",15) | |
| 217 | ||
| 218 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL2 ",16) | |
| 219 | ||
| 220 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL3 ",20) | |
| 221 | ||
| 222 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL4 ",17) | |
| 223 | ||
| 224 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL6 ",21) | |
| 225 | ||
| 226 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHL7 ",18) | |
| 227 | ||
| 228 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHLI ",19) | |
| 229 | ||
| 230 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHLM ",7) | |
| 231 | ||
| 232 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHLQ ",8) | |
| 233 | ||
| 234 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEHLT ",9) | |
| 235 | ||
| 236 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEKIT ",10) | |
| 237 | ||
| 238 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEMS1 ",11) | |
| 239 | ||
| 240 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEPM" ,12) | |
| 241 | ||
| 242 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNERP0 ",27) | |
| 243 | ||
| 244 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNERP7 ",22) | |
| 245 | ||
| 246 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNERP8 ",23) | |
| 247 | ||
| 248 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNERP9 ",24) | |
| 249 | ||
| 250 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBCNEUT5 ",25) | |
| 251 | ||
| 252 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBJPI",1 3) | |
| 253 | ||
| 254 | "BLD",1097 2,"KRN",9. 8,"NM","B" ,"IBY621PO ",14) | |
| 255 | ||
| 256 | "BLD",1097 2,"KRN",19 ,0) | |
| 257 | 19 | |
| 258 | "BLD",1097 2,"KRN",19 ,"NM",0) | |
| 259 | ^9.68A^^ | |
| 260 | "BLD",1097 2,"KRN",19 .1,0) | |
| 261 | 19.1 | |
| 262 | "BLD",1097 2,"KRN",10 1,0) | |
| 263 | 101 | |
| 264 | "BLD",1097 2,"KRN",10 1,"NM",0) | |
| 265 | ^9.68A^4^4 | |
| 266 | "BLD",1097 2,"KRN",10 1,"NM",1,0 ) | |
| 267 | IBCNE EIV RPI IN^^0 | |
| 268 | "BLD",1097 2,"KRN",10 1,"NM",2,0 ) | |
| 269 | IBCNE EIV RQP OUT^^0 | |
| 270 | "BLD",1097 2,"KRN",10 1,"NM",3,0 ) | |
| 271 | IBCNE EIV ID REQUEST ^^0 | |
| 272 | "BLD",1097 2,"KRN",10 1,"NM",4,0 ) | |
| 273 | IBCNE EIV ID RESPONS E^^0 | |
| 274 | "BLD",1097 2,"KRN",10 1,"NM","B" ,"IBCNE EI V ID REQUE ST",3) | |
| 275 | ||
| 276 | "BLD",1097 2,"KRN",10 1,"NM","B" ,"IBCNE EI V ID RESPO NSE",4) | |
| 277 | ||
| 278 | "BLD",1097 2,"KRN",10 1,"NM","B" ,"IBCNE EI V RPI IN", 1) | |
| 279 | ||
| 280 | "BLD",1097 2,"KRN",10 1,"NM","B" ,"IBCNE EI V RQP OUT" ,2) | |
| 281 | ||
| 282 | "BLD",1097 2,"KRN",40 9.61,0) | |
| 283 | 409.61 | |
| 284 | "BLD",1097 2,"KRN",77 1,0) | |
| 285 | 771 | |
| 286 | "BLD",1097 2,"KRN",77 9.2,0) | |
| 287 | 779.2 | |
| 288 | "BLD",1097 2,"KRN",87 0,0) | |
| 289 | 870 | |
| 290 | "BLD",1097 2,"KRN",89 89.51,0) | |
| 291 | 8989.51 | |
| 292 | "BLD",1097 2,"KRN",89 89.52,0) | |
| 293 | 8989.52 | |
| 294 | "BLD",1097 2,"KRN",89 94,0) | |
| 295 | 8994 | |
| 296 | "BLD",1097 2,"KRN","B ",.4,.4) | |
| 297 | ||
| 298 | "BLD",1097 2,"KRN","B ",.401,.40 1) | |
| 299 | ||
| 300 | "BLD",1097 2,"KRN","B ",.402,.40 2) | |
| 301 | ||
| 302 | "BLD",1097 2,"KRN","B ",.403,.40 3) | |
| 303 | ||
| 304 | "BLD",1097 2,"KRN","B ",.5,.5) | |
| 305 | ||
| 306 | "BLD",1097 2,"KRN","B ",.84,.84) | |
| 307 | ||
| 308 | "BLD",1097 2,"KRN","B ",3.6,3.6) | |
| 309 | ||
| 310 | "BLD",1097 2,"KRN","B ",3.8,3.8) | |
| 311 | ||
| 312 | "BLD",1097 2,"KRN","B ",9.2,9.2) | |
| 313 | ||
| 314 | "BLD",1097 2,"KRN","B ",9.8,9.8) | |
| 315 | ||
| 316 | "BLD",1097 2,"KRN","B ",19,19) | |
| 317 | ||
| 318 | "BLD",1097 2,"KRN","B ",19.1,19. 1) | |
| 319 | ||
| 320 | "BLD",1097 2,"KRN","B ",101,101) | |
| 321 | ||
| 322 | "BLD",1097 2,"KRN","B ",409.61,4 09.61) | |
| 323 | ||
| 324 | "BLD",1097 2,"KRN","B ",771,771) | |
| 325 | ||
| 326 | "BLD",1097 2,"KRN","B ",779.2,77 9.2) | |
| 327 | ||
| 328 | "BLD",1097 2,"KRN","B ",870,870) | |
| 329 | ||
| 330 | "BLD",1097 2,"KRN","B ",8989.51, 8989.51) | |
| 331 | ||
| 332 | "BLD",1097 2,"KRN","B ",8989.52, 8989.52) | |
| 333 | ||
| 334 | "BLD",1097 2,"KRN","B ",8994,899 4) | |
| 335 | ||
| 336 | "BLD",1097 2,"QDEF") | |
| 337 | ^^^^NO^^^^ NO^^NO | |
| 338 | "BLD",1097 2,"QUES",0 ) | |
| 339 | ^9.62^^ | |
| 340 | "BLD",1097 2,"REQB",0 ) | |
| 341 | ^9.611^2^2 | |
| 342 | "BLD",1097 2,"REQB",1 ,0) | |
| 343 | IB*2.0*595 ^1 | |
| 344 | "BLD",1097 2,"REQB",2 ,0) | |
| 345 | IB*2.0*519 ^1 | |
| 346 | "BLD",1097 2,"REQB"," B","IB*2.0 *519",2) | |
| 347 | ||
| 348 | "BLD",1097 2,"REQB"," B","IB*2.0 *595",1) | |
| 349 | ||
| 350 | "FIA",2) | |
| 351 | PATIENT | |
| 352 | "FIA",2,0) | |
| 353 | ^DPT( | |
| 354 | "FIA",2,0, 0) | |
| 355 | 2I | |
| 356 | "FIA",2,0, 1) | |
| 357 | y^n^p^^^^n ^^n | |
| 358 | "FIA",2,0, 10) | |
| 359 | ||
| 360 | "FIA",2,0, 11) | |
| 361 | ||
| 362 | "FIA",2,0, "RLRO") | |
| 363 | ||
| 364 | "FIA",2,0, "VR") | |
| 365 | 2.0^IB | |
| 366 | "FIA",2,2) | |
| 367 | 1 | |
| 368 | "FIA",2,2, 2001) | |
| 369 | ||
| 370 | "FIA",350. 9) | |
| 371 | IB SITE PA RAMETERS | |
| 372 | "FIA",350. 9,0) | |
| 373 | ^IBE(350.9 , | |
| 374 | "FIA",350. 9,0,0) | |
| 375 | 350.9I | |
| 376 | "FIA",350. 9,0,1) | |
| 377 | y^n^p^^^^n ^^n | |
| 378 | "FIA",350. 9,0,10) | |
| 379 | ||
| 380 | "FIA",350. 9,0,11) | |
| 381 | ||
| 382 | "FIA",350. 9,0,"RLRO" ) | |
| 383 | ||
| 384 | "FIA",350. 9,0,"VR") | |
| 385 | 2.0^IB | |
| 386 | "FIA",350. 9,350.9) | |
| 387 | 1 | |
| 388 | "FIA",350. 9,350.9,51 .17) | |
| 389 | ||
| 390 | "FIA",350. 9,350.9,51 .31) | |
| 391 | ||
| 392 | "FIA",350. 9,350.9002 ) | |
| 393 | 1 | |
| 394 | "FIA",350. 9,350.9002 ,.01) | |
| 395 | ||
| 396 | "FIA",350. 9,350.9002 ,.05) | |
| 397 | ||
| 398 | "FIA",350. 9,350.9002 ,.07) | |
| 399 | ||
| 400 | "FIA",350. 9,350.9002 ,.08) | |
| 401 | ||
| 402 | "FIA",350. 9,350.9002 ,.09) | |
| 403 | ||
| 404 | "FIA",365. 1) | |
| 405 | IIV TRANSM ISSION QUE UE | |
| 406 | "FIA",365. 1,0) | |
| 407 | ^IBCN(365. 1, | |
| 408 | "FIA",365. 1,0,0) | |
| 409 | 365.1 | |
| 410 | "FIA",365. 1,0,1) | |
| 411 | y^n^p^^^^n ^^n | |
| 412 | "FIA",365. 1,0,10) | |
| 413 | ||
| 414 | "FIA",365. 1,0,11) | |
| 415 | ||
| 416 | "FIA",365. 1,0,"RLRO" ) | |
| 417 | ||
| 418 | "FIA",365. 1,0,"VR") | |
| 419 | 2.0^IB | |
| 420 | "FIA",365. 1,365.1) | |
| 421 | 1 | |
| 422 | "FIA",365. 1,365.1,.1 ) | |
| 423 | ||
| 424 | "FIA",365. 1,365.1,.2 1) | |
| 425 | ||
| 426 | "FIA",365. 18) | |
| 427 | EIV EICD T RACKING | |
| 428 | "FIA",365. 18,0) | |
| 429 | ^IBCN(365. 18, | |
| 430 | "FIA",365. 18,0,0) | |
| 431 | 365.18P | |
| 432 | "FIA",365. 18,0,1) | |
| 433 | y^n^f^^^^n | |
| 434 | "FIA",365. 18,0,10) | |
| 435 | ||
| 436 | "FIA",365. 18,0,11) | |
| 437 | ||
| 438 | "FIA",365. 18,0,"RLRO ") | |
| 439 | ||
| 440 | "FIA",365. 18,0,"VR") | |
| 441 | 2.0^IB | |
| 442 | "FIA",365. 18,365.18) | |
| 443 | 0 | |
| 444 | "FIA",365. 18,365.185 ) | |
| 445 | 0 | |
| 446 | "INIT") | |
| 447 | IBY621PO | |
| 448 | "KRN",.402 ,1838,-1) | |
| 449 | 0^1 | |
| 450 | "KRN",.402 ,1838,0) | |
| 451 | IBEDIT INS CO1^31805 24.1255^^3 6^^^318071 6 | |
| 452 | "KRN",.402 ,1838,"DIA B",1,0,36, 8) | |
| 453 | EDI INST S ECONDARY I D(2);"EDI - 2ND Inst Payer Sec . ID" | |
| 454 | "KRN",.402 ,1838,"DIA B",1,0,36, 9) | |
| 455 | EDI ID NUM BER - PROF ;"EDI - Pr of Payer P rimary ID" | |
| 456 | "KRN",.402 ,1838,"DIA B",1,0,36, 13) | |
| 457 | EDI PROF S ECONDARY I D QUAL(2); "EDI - 2ND Prof Paye r Sec. ID Qualifier" | |
| 458 | "KRN",.402 ,1838,"DIA B",1,0,36, 19) | |
| 459 | ATT/REND I D BILL SEC ID INST// NO;"Use At t/Rend ID as Billing Provider Sec. ID (U B)?" | |
| 460 | "KRN",.402 ,1838,"DIA B",1,1,36. 015,0) | |
| 461 | .01;"EDI - Alt Inst Payer Prim ary ID Typ e" | |
| 462 | "KRN",.402 ,1838,"DIA B",1,1,36. 016,0) | |
| 463 | .01;"EDI - Alt Prof Payer Prim ary ID Typ e" | |
| 464 | "KRN",.402 ,1838,"DIA B",1,1,36. 03,0) | |
| 465 | ALL | |
| 466 | "KRN",.402 ,1838,"DIA B",2,0,36, 10) | |
| 467 | EDI PROF S ECONDARY I D QUAL(1); "EDI - 1ST Prof Paye r Sec. ID Qualifier" | |
| 468 | "KRN",.402 ,1838,"DIA B",2,0,36, 17) | |
| 469 | MAX NUMBER TEST BILL S PER DAY; "MAX # TES T BILLS TO TRANSMIT PER DAY" | |
| 470 | "KRN",.402 ,1838,"DIA B",2,0,36, 18) | |
| 471 | REF PROV S EC ID DEF CMS-1500// UPIN;"Defa ult ID (15 00)" | |
| 472 | "KRN",.402 ,1838,"DIA B",2,0,36, 23) | |
| 473 | ANOTHER CO . PROCESS INQUIRIES? ;T | |
| 474 | "KRN",.402 ,1838,"DIA B",2,1,36. 015,0) | |
| 475 | .02;"EDI - Alt Inst Payer Prim ary ID" | |
| 476 | "KRN",.402 ,1838,"DIA B",2,1,36. 016,0) | |
| 477 | .02;"EDI - Alt Prof Payer Prim ary ID" | |
| 478 | "KRN",.402 ,1838,"DIA B",3,0,36, 1) | |
| 479 | ANOTHER CO . PROCESS PRECERTS?; T | |
| 480 | "KRN",.402 ,1838,"DIA B",3,0,36, 18) | |
| 481 | REF PROV S EC ID REQ ON CLAIMS; "Require I D on Claim " | |
| 482 | "KRN",.402 ,1838,"DIA B",3,0,36, 24) | |
| 483 | INS COMPAN Y LINK TYP E;T | |
| 484 | "KRN",.402 ,1838,"DIA B",4,0,36, 3) | |
| 485 | 15;"EDI - Alt Inst P ayer Prima ry ID Type " | |
| 486 | "KRN",.402 ,1838,"DIA B",4,0,36, 20) | |
| 487 | ANOTHER CO . PROCESS IP CLAIMS? ;T | |
| 488 | "KRN",.402 ,1838,"DIA B",5,0,36, 5) | |
| 489 | EDI INST S ECONDARY I D(1);"EDI - 1ST Inst Payer Sec . ID" | |
| 490 | "KRN",.402 ,1838,"DIA B",5,0,36, 16) | |
| 491 | BIN NUMBER ;"EDI - Bi n Number" | |
| 492 | "KRN",.402 ,1838,"DIA B",5,0,36, 18) | |
| 493 | ATT/REND I D BILL SEC ID PROF// NO;"Use At t/Rend ID as Billing Provider Sec. ID (1 500)?" | |
| 494 | "KRN",.402 ,1838,"DIA B",6,0,36, 2) | |
| 495 | EDI ID NUM BER - INST ;"EDI - In st Payer P rimary ID" | |
| 496 | "KRN",.402 ,1838,"DIA B",6,0,36, 3) | |
| 497 | EDI INST S ECONDARY I D QUAL(1); "EDI - 1ST Inst Paye r Sec. ID Qualifier" | |
| 498 | "KRN",.402 ,1838,"DIA B",6,0,36, 6) | |
| 499 | EDI INST S ECONDARY I D QUAL(2); "EDI - 2ND Inst Paye r Sec. ID Qualifier" | |
| 500 | "KRN",.402 ,1838,"DIA B",6,0,36, 14) | |
| 501 | EDI PROF S ECONDARY I D(2);"EDI - 2ND Prof Payer Sec . ID" | |
| 502 | "KRN",.402 ,1838,"DIA B",6,0,36, 17) | |
| 503 | PERF PROV SECOND ID TYPE 1500; "Default I D (1500)" | |
| 504 | "KRN",.402 ,1838,"DIA B",6,0,36, 25) | |
| 505 | INS COMPAN Y LINK PAR ENT;T | |
| 506 | "KRN",.402 ,1838,"DIA B",7,0,36, 9) | |
| 507 | 16;"EDI - Alt Prof P ayer Prima ry ID Type " | |
| 508 | "KRN",.402 ,1838,"DIA B",7,0,36, 11) | |
| 509 | EDI PROF S ECONDARY I D(1);"EDI - 1ST Prof Payer Sec . ID" | |
| 510 | "KRN",.402 ,1838,"DIA B",7,0,36, 15) | |
| 511 | ELECTRONIC INSURANCE TYPE;"EDI - Insuran ce Type" | |
| 512 | "KRN",.402 ,1838,"DIA B",7,0,36, 17) | |
| 513 | PERF PROV SECOND ID TYPE UB;"D efault ID (UB)" | |
| 514 | "KRN",.402 ,1838,"DIA B",8,0,36, 17) | |
| 515 | SECONDARY ID REQUIRE MENTS;"Req uire ID on Claim" | |
| 516 | "KRN",.402 ,1838,"DIA B",9,0,36, 16) | |
| 517 | PRINT SEC/ TERT AUTO CLAIMS?;"E DI - Print Sec/Tert Auto Claim s?" | |
| 518 | "KRN",.402 ,1838,"DIA B",10,0,36 ,16) | |
| 519 | PRINT SEC MED CLAIMS W/O MRA;" EDI - Prin t Medicare Sec Claim s w/o MRA? " | |
| 520 | "KRN",.402 ,1838,"DIA B",11,0,36 ,1) | |
| 521 | TRANSMIT E LECTRONICA LLY;"EDI - Transmit? " | |
| 522 | "KRN",.402 ,1838,"DIA B",12,0,36 ,22) | |
| 523 | ANOTHER CO . PROCESS APPEALS?;T | |
| 524 | "KRN",.402 ,1838,"DIA B",13,0,36 ,0) | |
| 525 | STANDARD F TF;"STANDA RD FILING TIME FRAME " | |
| 526 | "KRN",.402 ,1838,"DIA B",16,0,36 ,0) | |
| 527 | STANDARD F TF VALUE;" STANDARD F ILING TIME FRAME VAL UE" | |
| 528 | "KRN",.402 ,1838,"DIA B",20,0,36 ,21) | |
| 529 | ANOTHER CO . PROCESS RX CLAIMS? ;T | |
| 530 | "KRN",.402 ,1838,"DIA B",24,0,36 ,20) | |
| 531 | ANOTHER CO . PROCESS OP CLAIMS? ;T | |
| 532 | "KRN",.402 ,1838,"DR" ,1,36) | |
| 533 | S:",6,"'[I BY Y="@0"; .01;@0;S:" ,0,1,6,12, "'[IBY Y=" @10";S:",1 2,"[IBY Y= "@18";2;1; .06;.07;.0 8;.09;.15; .18STANDAR D FILING T IME FRAME~ ;I 'X S Y= "@016";I ' $$FTFV^IBC NSU31(X) S Y="@016"; .19STANDAR D FILING T IME FRAME VALUE~;@01 6;.12;.13; | |
| 534 | "KRN",.402 ,1838,"DR" ,1,36,1) | |
| 535 | .132;.134; .178T~;S:' X Y="@11"; .139;S Y=" @16";@11;. 133;@16;I '$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@171"; 3.01EDI - Transmit?~ ;S DIPA("I BTX")=X;I X=$G(IBEDI KEY(1))!$$ KCHK^XUSRB ("IB EDI I NSURANCE E DIT") S Y= "@1721"; | |
| 536 | "KRN",.402 ,1838,"DR" ,1,36,2) | |
| 537 | 3.01////^S X=$G(IBED IKEY(1));I $$EDIKEY^ IBCNSC();S Y="@171"; @1721;I '$ G(DIPA("IB TX")) S Y= "@17";3.04 EDI - Inst Payer Pri mary ID~;I X=$G(IBED IKEY(4))!$ $KCHK^XUSR B("IB EDI INSURANCE EDIT") S Y ="@17211"; 3.04////^S X=$G(IBED IKEY(4)); | |
| 538 | "KRN",.402 ,1838,"DR" ,1,36,3) | |
| 539 | I $$EDIKEY ^IBCNSC(); S Y="@171" ;@17211;15 EDI - Alt Inst Payer Primary I D Type~;I '$G(DIPA(" IBTX")) S Y="@17";6. 01EDI - 1S T Inst Pay er Sec. ID Qualifier ~; | |
| 540 | "KRN",.402 ,1838,"DR" ,1,36,4) | |
| 541 | I X=""&($G (IBEDIKEY( 3,6))="")& $$KCHK^XUS RB("IB EDI INSURANCE EDIT") S Y="@1722"; I X=$G(IBE DIKEY(1,6) )!$$KCHK^X USRB("IB E DI INSURAN CE EDIT") S Y="@1721 2";6.01/// /^S X=$G(I BEDIKEY(1, 6));6.02// //^S X=$G( IBEDIKEY(2 ,6)); | |
| 542 | "KRN",.402 ,1838,"DR" ,1,36,5) | |
| 543 | I $$EDIKEY ^IBCNSC(); S Y="@171" ;@17212;I '$G(DIPA(" IBTX")) S Y="@17";6. 02EDI - 1S T Inst Pay er Sec. ID ~;I X=$G(I BEDIKEY(2, 6))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y="@17 213";6.02/ ///^S X=$G (IBEDIKEY( 2,6)); | |
| 544 | "KRN",.402 ,1838,"DR" ,1,36,6) | |
| 545 | 6.01////^S X=$G(IBED IKEY(1,6)) ;I $$EDIKE Y^IBCNSC() ;S Y="@171 ";@17213;I '$G(DIPA( "IBTX")) S Y="@17";6 .03EDI - 2 ND Inst Pa yer Sec. I D Qualifie r~;I X=""& $$KCHK^XUS RB("IB EDI INSURANCE EDIT") S Y="@1722"; | |
| 546 | "KRN",.402 ,1838,"DR" ,1,36,7) | |
| 547 | I X=$G(IBE DIKEY(3,6) )!$$KCHK^X USRB("IB E DI INSURAN CE EDIT") S Y="@1721 4";6.03/// /^S X=$G(I BEDIKEY(3, 6));6.04// //^S X=$G( IBEDIKEY(4 ,6));I $$E DIKEY^IBCN SC();S Y=" @171";@172 14;I '$G(D IPA("IBTX" )) S Y="@1 7"; | |
| 548 | "KRN",.402 ,1838,"DR" ,1,36,8) | |
| 549 | 6.04EDI - 2ND Inst P ayer Sec. ID~;I X=$G (IBEDIKEY( 4,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y="@ 1722";6.04 ////^S X=$ G(IBEDIKEY (4,6));6.0 3////^S X= $G(IBEDIKE Y(3,6));I $$EDIKEY^I BCNSC();S Y="@171";@ 1722; | |
| 550 | "KRN",.402 ,1838,"DR" ,1,36,9) | |
| 551 | 3.02EDI - Prof Payer Primary I D~;I X=$G( IBEDIKEY(2 ))!$$KCHK^ XUSRB("IB EDI INSURA NCE EDIT") S Y="@172 21";3.02// //^S X=$G( IBEDIKEY(2 ));I $$EDI KEY^IBCNSC ();S Y="@1 71";@17221 ;16EDI - A lt Prof Pa yer Primar y ID Type~ ; | |
| 552 | "KRN",.402 ,1838,"DR" ,1,36,10) | |
| 553 | I '$G(DIPA ("IBTX")) S Y="@17"; 6.05EDI - 1ST Prof P ayer Sec. ID Qualifi er~;I X="" &($G(IBEDI KEY(7,6))= "")&$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y="@17 23";I X=$G (IBEDIKEY( 5,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y="@ 17222"; | |
| 554 | "KRN",.402 ,1838,"DR" ,1,36,11) | |
| 555 | 6.05////^S X=$G(IBED IKEY(5,6)) ;6.06////^ S X=$G(IBE DIKEY(6,6) );I $$EDIK EY^IBCNSC( );S Y="@17 1";@17222; I '$G(DIPA ("IBTX")) S Y="@17"; 6.06EDI - 1ST Prof P ayer Sec. ID~; | |
| 556 | "KRN",.402 ,1838,"DR" ,1,36,12) | |
| 557 | I X=$G(IBE DIKEY(6,6) )!$$KCHK^X USRB("IB E DI INSURAN CE EDIT") S Y="@1722 3";6.06/// /^S X=$G(I BEDIKEY(6, 6));6.05// //^S X=$G( IBEDIKEY(5 ,6));I $$E DIKEY^IBCN SC();S Y=" @171";@172 23;I '$G(D IPA("IBTX" )) S Y="@1 7"; | |
| 558 | "KRN",.402 ,1838,"DR" ,1,36,13) | |
| 559 | 6.07EDI - 2ND Prof P ayer Sec. ID Qualifi er~;I X="" &$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@1723" ;I X=$G(IB EDIKEY(7,6 ))!$$KCHK^ XUSRB("IB EDI INSURA NCE EDIT") S Y="@172 24";6.07// //^S X=$G( IBEDIKEY(7 ,6)); | |
| 560 | "KRN",.402 ,1838,"DR" ,1,36,14) | |
| 561 | 6.08////^S X=$G(IBED IKEY(8,6)) ;I $$EDIKE Y^IBCNSC() ;S Y="@171 ";@17224;I '$G(DIPA( "IBTX")) S Y="@17";6 .08EDI - 2 ND Prof Pa yer Sec. I D~;I X=$G( IBEDIKEY(8 ,6))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y="@1 723"; | |
| 562 | "KRN",.402 ,1838,"DR" ,1,36,15) | |
| 563 | 6.08////^S X=$G(IBED IKEY(8,6)) ;6.07////^ S X=$G(IBE DIKEY(7,6) );I $$EDIK EY^IBCNSC( );S Y="@17 1";@1723;@ 17;3.09EDI - Insuran ce Type~;I X=$G(IBED IKEY(9))!$ $KCHK^XUSR B("IB EDI INSURANCE EDIT") S Y ="@1724";3 .09////^S X=$G(IBEDI KEY(9)); | |
| 564 | "KRN",.402 ,1838,"DR" ,1,36,16) | |
| 565 | I $$EDIKEY ^IBCNSC(); S Y="@171" ;@1724;@17 1;3.03EDI - Bin Numb er~;I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @1725";7.0 1;@1725;6. 09EDI - Pr int Sec/Te rt Auto Cl aims?~;6.1 EDI - Prin t Medicare Sec Claim s w/o MRA? ~; | |
| 566 | "KRN",.402 ,1838,"DR" ,1,36,17) | |
| 567 | I $G(DIPA( "IBTX"))'= 2 S Y="@18 ";3.06MAX # TEST BIL LS TO TRAN SMIT PER D AY~;@18;S: ",6,12,"'[ IBY Y="@18 1";W !!,"A ttending/R endering P rovider Se condary ID ";4.01Defa ult ID (15 00)~;4.02D efault ID (UB)~;4.03 Require ID on Claim~ ; | |
| 568 | "KRN",.402 ,1838,"DR" ,1,36,18) | |
| 569 | W !!,"Refe rring Prov ider Secon dary ID";4 .04Default ID (1500) ~//UPIN;4. 05Require ID on Clai m~;W !!,"B illing Pro vider Seco ndary IDs" ;4.06Use A tt/Rend ID as Billin g Provider Sec. ID ( 1500)?~//N O; | |
| 570 | "KRN",.402 ,1838,"DR" ,1,36,19) | |
| 571 | 4.08Use At t/Rend ID as Billing Provider Sec. ID (U B)?~//NO;W !!,"Billi ng Provide r/Service Facility"; @181;S:IBY ["1" Y="@9 9";@10;S:" ,0,2,6,"'[ IBY Y="@20 ";.111;S:X ="" Y="@1" ;.112;S:X= "" Y="@1"; .113;@1;.1 14;.115;.1 16;.131;.1 19; | |
| 572 | "KRN",.402 ,1838,"DR" ,1,36,20) | |
| 573 | S:(IBY["0" )!(IBY["2" ) Y="@99"; @20;S:",3, 6,"'[IBY Y ="@30";.12 8T~;S:'X Y ="@21";.12 7;S Y="@26 ";@21;.121 ;S:X="" Y= "@2";.122; S:X="" Y=" @2";.123;@ 2;.124;.12 5;.126;.13 5;.129;@26 ;S:IBY["3" Y="@99";@ 30;S:",10, 6,"'[IBY Y ="@80";.16 8T~; | |
| 574 | "KRN",.402 ,1838,"DR" ,1,36,21) | |
| 575 | S:'X Y="@3 1";.167;S Y="@36";@3 1;.161;S:X ="" Y="@5" ;.162;S:X= "" Y="@5"; .163;@5;.1 64;.165;.1 66;.136;.1 69;@36;S:I BY["10" Y= "@99";@80; S:",11,6," '[IBY Y="@ 90";.188T~ ;S:'X Y="@ 81";.187;S Y="@86";@ 81;.181;S: X="" Y="@6 ";.182;S:X ="" Y="@6" ; | |
| 576 | "KRN",.402 ,1838,"DR" ,1,36,22) | |
| 577 | .183;@6;.1 84;.185;.1 86;.1311;. 189;@86;S: IBY["11" Y ="@99";@90 ;S:",4,6," '[IBY Y="@ 40";.148T~ ;S:'X Y="@ 41";.147;S Y="@46";@ 41;.141;S: X="" Y="@3 ";.142;S:X ="" Y="@3" ;.143;@3;. 144;.145;. 146;.137;. 149;@46;S: IBY["4" Y= "@99";@40; | |
| 578 | "KRN",.402 ,1838,"DR" ,1,36,23) | |
| 579 | S:",5,6,"' [IBY Y="@5 5";.158T~; S:'X Y="@5 1";.157;S Y="@56";@5 1;.151;S:X ="" Y="@4" ;.152;S:X= "" Y="@4"; .153;@4;.1 54;.155;.1 56;.138;.1 59;@56;S:I BY["5" Y=" @99";@55;S :",13,6,"' [IBY Y="@6 0"; | |
| 580 | "KRN",.402 ,1838,"DR" ,1,36,24) | |
| 581 | I '$$KCHK^ XUSRB("IB EDI INSURA NCE EDIT") S Y="@551 ";I $D(^DI C(36,"APC" ,+$G(DA))) ,$P($G(^DI C(36,+$G(D A),3)),U,1 3)="P" S Y ="@551";3. 13T~;S DIP A("IBLNK") =X;I X=$G( IBEDIKEY(1 3))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y="@55 2"; | |
| 582 | "KRN",.402 ,1838,"DR" ,1,36,25) | |
| 583 | 3.13////^S X=$G(IBED IKEY(13)); I $$EDIKEY ^IBCNSC(); S Y="@551" ;@552;I $G (DIPA("IBL NK"))'="C" S Y="@551 ";3.14T~;I X=$G(IBED IKEY(14))! $$KCHK^XUS RB("IB EDI INSURANCE EDIT") S Y="@553";3 .14////^S X=$G(IBEDI KEY(14));I $$EDIKEY^ IBCNSC(); | |
| 584 | "KRN",.402 ,1838,"DR" ,1,36,26) | |
| 585 | S Y="@551" ;@553;D CO PY^IBCEPCI D(+$G(DA)) ;@551;S:IB Y=",13," Y ="@99";@60 ;S IBPI=$$ GET1^DIQ(3 6,DA,3.1," I");S:",7, 6,"'[IBY Y ="@50";3.1 ;I X="" S Y="@50";S IBPJ=X;I + $$GET1^DIQ (350.9,"1, ",51.30,"I ")'=IBPJ S Y="@605"; 3.1///@; | |
| 586 | "KRN",.402 ,1838,"DR" ,1,36,27) | |
| 587 | 3.1///^S X =IBPI;W !, "LINKING T O THE MBI PAYER IS N OT ALLOWED ";S Y="@60 ";@605;I + $$GET1^DIQ (350.9,"1, ",51.31,"I ")'=IBPJ S Y="@50";3 .1///@;3.1 ///^S X=IB PI; | |
| 588 | "KRN",.402 ,1838,"DR" ,1,36,28) | |
| 589 | W !,"LINKI NG TO THE ELECTRONIC INSURANCE COVERAGE DISCOVERY PAYER IS N OT ALLOWED ";S Y="@60 ";@50;K IB PI,IBPJ;S: ",8,6,"'[I BY Y="@70" ;11;S:IBY[ "8" Y="@99 ";@70;S:", 9,6,"'[IBY Y="@99";1 0;@99; | |
| 590 | "KRN",.402 ,1838,"DR" ,2,36.015) | |
| 591 | .01EDI - A lt Inst Pa yer Primar y ID Type~ ;.02EDI - Alt Inst P ayer Prima ry ID~; | |
| 592 | "KRN",.402 ,1838,"DR" ,2,36.016) | |
| 593 | .01EDI - A lt Prof Pa yer Primar y ID Type~ ;.02EDI - Alt Prof P ayer Prima ry ID~; | |
| 594 | "KRN",.402 ,1838,"DR" ,2,36.03) | |
| 595 | .01 | |
| 596 | "KRN",101, 8342,-1) | |
| 597 | 0^2 | |
| 598 | "KRN",101, 8342,0) | |
| 599 | IBCNE EIV RQP OUT^EI V EICD IDE NTIFICATIO N OUT^^E^^ ^^^^^^ | |
| 600 | "KRN",101, 8342,1,0) | |
| 601 | ^101.06^1^ 1^3180628^ ^ | |
| 602 | "KRN",101, 8342,1,1,0 ) | |
| 603 | This proto col is for Identific ation mess ages | |
| 604 | "KRN",101, 8342,99) | |
| 605 | 64803,4529 6 | |
| 606 | "KRN",101, 8342,770) | |
| 607 | IIV VISTA^ ^RQP^I04^^ ^^AL^NE^2. 4^ | |
| 608 | "KRN",101, 8342,772) | |
| 609 | D ^IBCNEHL I | |
| 610 | "KRN",101, 8342,775,0 ) | |
| 611 | ^101.0775P A^1^1 | |
| 612 | "KRN",101, 8342,775,1 ,0) | |
| 613 | 8343 | |
| 614 | "KRN",101, 8342,775,1 ,"^") | |
| 615 | IBCNE EIV ID REQUEST | |
| 616 | "KRN",101, 8343,-1) | |
| 617 | 0^3 | |
| 618 | "KRN",101, 8343,0) | |
| 619 | IBCNE EIV ID REQUEST ^EIV EICD IDENTIFICA TION REQUE ST^^S^^^^^ ^^^ | |
| 620 | "KRN",101, 8343,1,0) | |
| 621 | ^101.06^2^ 2^3180628^ ^ | |
| 622 | "KRN",101, 8343,1,1,0 ) | |
| 623 | This proto col is for the outbo und messag e associat ed with th e EICD | |
| 624 | "KRN",101, 8343,1,2,0 ) | |
| 625 | Identifica tion Reque st for ins urance. | |
| 626 | "KRN",101, 8343,99) | |
| 627 | 64803,4577 6 | |
| 628 | "KRN",101, 8343,770) | |
| 629 | ^IIV EC^^I 04^^^IIV E C^^^2.4^AC K | |
| 630 | "KRN",101, 8343,771) | |
| 631 | Q | |
| 632 | "KRN",101, 8343,773) | |
| 633 | 1^1^0 | |
| 634 | "KRN",101, 8382,-1) | |
| 635 | 0^1 | |
| 636 | "KRN",101, 8382,0) | |
| 637 | IBCNE EIV RPI IN^EIV EICD IDEN TIFICATION IN^^E^^^^ ^^^^ | |
| 638 | "KRN",101, 8382,1,0) | |
| 639 | ^^3^3^3180 604^ | |
| 640 | "KRN",101, 8382,1,1,0 ) | |
| 641 | This proto col is for EICD Iden tification Responses . Incomin g response s | |
| 642 | "KRN",101, 8382,1,2,0 ) | |
| 643 | to EICD Id entificati on Inquiri es. Refer to protoc ol "IBCNE EIV RQP OU T" | |
| 644 | "KRN",101, 8382,1,3,0 ) | |
| 645 | for EICD I dentificat ion Inquir ies. | |
| 646 | "KRN",101, 8382,99) | |
| 647 | 64803,4450 0 | |
| 648 | "KRN",101, 8382,770) | |
| 649 | IIV EC^^RP I^I04^^^^^ ^2.4^ | |
| 650 | "KRN",101, 8382,771) | |
| 651 | ||
| 652 | "KRN",101, 8382,772) | |
| 653 | D ^IBCNEHL I | |
| 654 | "KRN",101, 8382,775,0 ) | |
| 655 | ^101.0775P A^1^1 | |
| 656 | "KRN",101, 8382,775,1 ,0) | |
| 657 | 8383 | |
| 658 | "KRN",101, 8382,775,1 ,"^") | |
| 659 | IBCNE EIV ID RESPONS E | |
| 660 | "KRN",101, 8383,-1) | |
| 661 | 0^4 | |
| 662 | "KRN",101, 8383,0) | |
| 663 | IBCNE EIV ID RESPONS E^EIV EICD IDENTIFIC ATION RESP ONSE^^S^^^ ^^^^^ | |
| 664 | "KRN",101, 8383,99) | |
| 665 | 64803,4602 3 | |
| 666 | "KRN",101, 8383,770) | |
| 667 | ^IIV VISTA ^^I04^^^^^ ^^ACK | |
| 668 | "KRN",101, 8383,771) | |
| 669 | D ^IBCNEHL I | |
| 670 | "MBREQ") | |
| 671 | 0 | |
| 672 | "ORD",7,.4 02) | |
| 673 | .402;7;;;E DEOUT^DIFR OMSO(.402, DA,"",XPDA );FPRE^DIF ROMSI(.402 ,"",XPDA); EPRE^DIFRO MSI(.402,D A,$E("N",$ G(XPDNEW)) ,XPDA,"",O LDA);;EPOS T^DIFROMSI (.402,DA," ",XPDA);DE L^DIFROMSK (.402,"",% ) | |
| 674 | "ORD",7,.4 02,0) | |
| 675 | INPUT TEMP LATE | |
| 676 | "ORD",15,1 01) | |
| 677 | 101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA | |
| 678 | "ORD",15,1 01,0) | |
| 679 | PROTOCOL | |
| 680 | "PKG",230, -1) | |
| 681 | 1^1 | |
| 682 | "PKG",230, 0) | |
| 683 | INTEGRATED BILLING^I B^INTEGRAT ED BILLING | |
| 684 | "PKG",230, 20,0) | |
| 685 | ^9.402P^1^ 1 | |
| 686 | "PKG",230, 20,1,0) | |
| 687 | 2^^IBAXDR | |
| 688 | "PKG",230, 20,1,1) | |
| 689 | ||
| 690 | "PKG",230, 20,"B",2,1 ) | |
| 691 | ||
| 692 | "PKG",230, 22,0) | |
| 693 | ^9.49I^1^1 | |
| 694 | "PKG",230, 22,1,0) | |
| 695 | 2.0^294032 1^2940525 | |
| 696 | "PKG",230, 22,1,"PAH" ,1,0) | |
| 697 | 621^318071 8 | |
| 698 | "PKG",230, 22,1,"PAH" ,1,1,0) | |
| 699 | ^^1^1^3180 718 | |
| 700 | "PKG",230, 22,1,"PAH" ,1,1,1,0) | |
| 701 | This is IB Build-7 | |
| 702 | "QUES","XP F1",0) | |
| 703 | Y | |
| 704 | "QUES","XP F1","??") | |
| 705 | ^D REP^XPD H | |
| 706 | "QUES","XP F1","A") | |
| 707 | Shall I wr ite over y our |FLAG| File | |
| 708 | "QUES","XP F1","B") | |
| 709 | YES | |
| 710 | "QUES","XP F1","M") | |
| 711 | D XPF1^XPD IQ | |
| 712 | "QUES","XP F2",0) | |
| 713 | Y | |
| 714 | "QUES","XP F2","??") | |
| 715 | ^D DTA^XPD H | |
| 716 | "QUES","XP F2","A") | |
| 717 | Want my da ta |FLAG| yours | |
| 718 | "QUES","XP F2","B") | |
| 719 | YES | |
| 720 | "QUES","XP F2","M") | |
| 721 | D XPF2^XPD IQ | |
| 722 | "QUES","XP I1",0) | |
| 723 | YO | |
| 724 | "QUES","XP I1","??") | |
| 725 | ^D INHIBIT ^XPDH | |
| 726 | "QUES","XP I1","A") | |
| 727 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
| 728 | "QUES","XP I1","B") | |
| 729 | NO | |
| 730 | "QUES","XP I1","M") | |
| 731 | D XPI1^XPD IQ | |
| 732 | "QUES","XP M1",0) | |
| 733 | PO^VA(200, :EM | |
| 734 | "QUES","XP M1","??") | |
| 735 | ^D MG^XPDH | |
| 736 | "QUES","XP M1","A") | |
| 737 | Enter the Coordinato r for Mail Group '|F LAG|' | |
| 738 | "QUES","XP M1","B") | |
| 739 | ||
| 740 | "QUES","XP M1","M") | |
| 741 | D XPM1^XPD IQ | |
| 742 | "QUES","XP O1",0) | |
| 743 | Y | |
| 744 | "QUES","XP O1","??") | |
| 745 | ^D MENU^XP DH | |
| 746 | "QUES","XP O1","A") | |
| 747 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
| 748 | "QUES","XP O1","B") | |
| 749 | NO | |
| 750 | "QUES","XP O1","M") | |
| 751 | D XPO1^XPD IQ | |
| 752 | "QUES","XP Z1",0) | |
| 753 | Y | |
| 754 | "QUES","XP Z1","??") | |
| 755 | ^D OPT^XPD H | |
| 756 | "QUES","XP Z1","A") | |
| 757 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
| 758 | "QUES","XP Z1","B") | |
| 759 | NO | |
| 760 | "QUES","XP Z1","M") | |
| 761 | D XPZ1^XPD IQ | |
| 762 | "QUES","XP Z2",0) | |
| 763 | Y | |
| 764 | "QUES","XP Z2","??") | |
| 765 | ^D RTN^XPD H | |
| 766 | "QUES","XP Z2","A") | |
| 767 | Want to MO VE routine s to other CPUs | |
| 768 | "QUES","XP Z2","B") | |
| 769 | NO | |
| 770 | "QUES","XP Z2","M") | |
| 771 | D XPZ2^XPD IQ | |
| 772 | "RTN") | |
| 773 | 27 | |
| 774 | "RTN","IBC NEBF") | |
| 775 | 0^26^B4849 7431^B4638 5823 | |
| 776 | "RTN","IBC NEBF",1,0) | |
| 777 | IBCNEBF ;D AOU/ALA - Create an Entry in t he Buffer File ;20-J UN-2002 | |
| 778 | "RTN","IBC NEBF",2,0) | |
| 779 | ;;2.0;INT EGRATED BI LLING;**18 4,271,361, 371,416,43 8,497,621* *;21-MAR-9 4;Build 8 | |
| 780 | "RTN","IBC NEBF",3,0) | |
| 781 | ;;Per VHA Directive 6402, thi s routine should not be modifi ed. | |
| 782 | "RTN","IBC NEBF",4,0) | |
| 783 | ; | |
| 784 | "RTN","IBC NEBF",5,0) | |
| 785 | ;**Progra m Descript ion** | |
| 786 | "RTN","IBC NEBF",6,0) | |
| 787 | ; This p rogram wil l create a Buffer en try based upon input values | |
| 788 | "RTN","IBC NEBF",7,0) | |
| 789 | ; | |
| 790 | "RTN","IBC NEBF",8,0) | |
| 791 | Q | |
| 792 | "RTN","IBC NEBF",9,0) | |
| 793 | ; | |
| 794 | "RTN","IBC NEBF",10,0 ) | |
| 795 | PT(DFN,IRI EN,SYMBOL, OVRRIDE,AD D,IBERROR) ; Get da ta | |
| 796 | "RTN","IBC NEBF",11,0 ) | |
| 797 | ; from a specific patient a nd insuran ce record entry | |
| 798 | "RTN","IBC NEBF",12,0 ) | |
| 799 | ; | |
| 800 | "RTN","IBC NEBF",13,0 ) | |
| 801 | ; Input Parameters | |
| 802 | "RTN","IBC NEBF",14,0 ) | |
| 803 | ; DFN = Patient IEN | |
| 804 | "RTN","IBC NEBF",15,0 ) | |
| 805 | ; IRIE N = Patien t Insuranc e Record I EN | |
| 806 | "RTN","IBC NEBF",16,0 ) | |
| 807 | ; SYMB OL = eIV S ymbol IEN | |
| 808 | "RTN","IBC NEBF",17,0 ) | |
| 809 | ; OVRR IDE = Over ride flag for ins. b uffer reco rd (0 or 1) | |
| 810 | "RTN","IBC NEBF",18,0 ) | |
| 811 | ; ADD = If defin ed, then i t will add a new Buf fer entry | |
| 812 | "RTN","IBC NEBF",19,0 ) | |
| 813 | ; IBER ROR = If d efined, th en it will be update d with err or info. | |
| 814 | "RTN","IBC NEBF",20,0 ) | |
| 815 | ; OPTI ONALLY PAS SED BY REF ERENCE | |
| 816 | "RTN","IBC NEBF",21,0 ) | |
| 817 | ; | |
| 818 | "RTN","IBC NEBF",22,0 ) | |
| 819 | I DFN=""! (IRIEN="") Q ; * d o not requ ire SYMBOL or OVRRID E | |
| 820 | "RTN","IBC NEBF",23,0 ) | |
| 821 | ; | |
| 822 | "RTN","IBC NEBF",24,0 ) | |
| 823 | ; | |
| 824 | "RTN","IBC NEBF",25,0 ) | |
| 825 | N VBUF,ID ATA0,IDATA 3,IDATA7,I EN,INAME,P NAME,IIEN, GNUMB,GNAM E,SUBID,PP HONE,PATID | |
| 826 | "RTN","IBC NEBF",26,0 ) | |
| 827 | N BPHONE, EFFDT,EXPD T,WHO,REL, IDOB,ISSN, COB,TQIEN, RDATA,ISEX ,NAME | |
| 828 | "RTN","IBC NEBF",27,0 ) | |
| 829 | N MSG,XMS UB,MSGP,IN SDATA,PCE, BFD,BFN,IN SPCE,ESGHP ARR | |
| 830 | "RTN","IBC NEBF",28,0 ) | |
| 831 | N SUBADDR 1,SUBADDR2 ,SUBCITY,S UBSTATE,SU BZIP,SUBCN TRY,SUBCND IV | |
| 832 | "RTN","IBC NEBF",29,0 ) | |
| 833 | ; | |
| 834 | "RTN","IBC NEBF",30,0 ) | |
| 835 | S IDATA0= $G(^DPT(DF N,.312,IRI EN,0)),IDA TA3=$G(^DP T(DFN,.312 ,IRIEN,3)) | |
| 836 | "RTN","IBC NEBF",31,0 ) | |
| 837 | S IDATA7= $G(^DPT(DF N,.312,IRI EN,7)) | |
| 838 | "RTN","IBC NEBF",32,0 ) | |
| 839 | S IIEN=$P (IDATA0,U, 1),INAME=$ $GET1^DIQ( 36,IIEN,.0 1,"E") | |
| 840 | "RTN","IBC NEBF",33,0 ) | |
| 841 | S PPHONE= $P($G(^DIC (36,IIEN,. 13)),U,3), BPHONE=$P( $G(^DIC(36 ,IIEN,.13) ),U,2) | |
| 842 | "RTN","IBC NEBF",34,0 ) | |
| 843 | S NAME=$P (IDATA7,U, 1),SUBID=$ P(IDATA7,U ,2) | |
| 844 | "RTN","IBC NEBF",35,0 ) | |
| 845 | S PATID=$ P($G(^DPT( DFN,.312,I RIEN,5)),U ,1) | |
| 846 | "RTN","IBC NEBF",36,0 ) | |
| 847 | S WHO=$P( IDATA0,U,6 ),COB=$P(I DATA0,U,20 ) | |
| 848 | "RTN","IBC NEBF",37,0 ) | |
| 849 | S IDOB=$P (IDATA3,U, 1),ISSN=$P (IDATA3,U, 5),ISEX=$P (IDATA3,U, 12) | |
| 850 | "RTN","IBC NEBF",38,0 ) | |
| 851 | S EFFDT=$ P(IDATA0,U ,8),EXPDT= $P(IDATA0, U,4) | |
| 852 | "RTN","IBC NEBF",39,0 ) | |
| 853 | S REL=$P( $G(^DPT(DF N,.312,IRI EN,4)),U,3 ) | |
| 854 | "RTN","IBC NEBF",40,0 ) | |
| 855 | S SUBADDR 1=$P(IDATA 3,U,6),SUB ADDR2=$P(I DATA3,U,7) | |
| 856 | "RTN","IBC NEBF",41,0 ) | |
| 857 | S SUBCITY =$P(IDATA3 ,U,8),SUBS TATE=$P(ID ATA3,U,9), SUBZIP=$P( IDATA3,U,1 0) | |
| 858 | "RTN","IBC NEBF",42,0 ) | |
| 859 | S SUBCNTR Y=$P(IDATA 3,U,13),SU BCNDIV=$P( IDATA3,U,1 4) | |
| 860 | "RTN","IBC NEBF",43,0 ) | |
| 861 | ; | |
| 862 | "RTN","IBC NEBF",44,0 ) | |
| 863 | S IENS=IR IEN_","_DF N_"," | |
| 864 | "RTN","IBC NEBF",45,0 ) | |
| 865 | S GNUMB=$ $GET1^DIQ( 2.312,IENS ,21,"E") | |
| 866 | "RTN","IBC NEBF",46,0 ) | |
| 867 | S GNAME=$ $GET1^DIQ( 2.312,IENS ,20,"E") | |
| 868 | "RTN","IBC NEBF",47,0 ) | |
| 869 | ; | |
| 870 | "RTN","IBC NEBF",48,0 ) | |
| 871 | ; Capture the emplo yer sponso red insura nce fields into arra y | |
| 872 | "RTN","IBC NEBF",49,0 ) | |
| 873 | ; ESGHP ARR(buffer field num ber) = dat a | |
| 874 | "RTN","IBC NEBF",50,0 ) | |
| 875 | ; | |
| 876 | "RTN","IBC NEBF",51,0 ) | |
| 877 | S INSDATA =$G(^DPT(D FN,.312,IR IEN,2)),PC E=0 | |
| 878 | "RTN","IBC NEBF",52,0 ) | |
| 879 | F BFD=5:1 :12,2,1,3, 4 S PCE=PC E+1,BFN=BF D/100+61,I NSPCE=$P(I NSDATA,U,P CE) I INSP CE'="" S E SGHPARR(BF N)=INSPCE | |
| 880 | "RTN","IBC NEBF",53,0 ) | |
| 881 | ; | |
| 882 | "RTN","IBC NEBF",54,0 ) | |
| 883 | D FIL | |
| 884 | "RTN","IBC NEBF",55,0 ) | |
| 885 | K ADD | |
| 886 | "RTN","IBC NEBF",56,0 ) | |
| 887 | Q | |
| 888 | "RTN","IBC NEBF",57,0 ) | |
| 889 | ; | |
| 890 | "RTN","IBC NEBF",58,0 ) | |
| 891 | RP(IEN,ADD ,BUFF) ; Get data f rom a spec ific respo nse record | |
| 892 | "RTN","IBC NEBF",59,0 ) | |
| 893 | ; | |
| 894 | "RTN","IBC NEBF",60,0 ) | |
| 895 | ; Input Parameter | |
| 896 | "RTN","IBC NEBF",61,0 ) | |
| 897 | ; IEN = Interna l entry nu mber of th e Response | |
| 898 | "RTN","IBC NEBF",62,0 ) | |
| 899 | ; ADD = If defi ned, then it will ad d a new Bu ffer entry | |
| 900 | "RTN","IBC NEBF",63,0 ) | |
| 901 | ; BUFF = IEN of the Buffer Entry to be updated (optional ) | |
| 902 | "RTN","IBC NEBF",64,0 ) | |
| 903 | ; | |
| 904 | "RTN","IBC NEBF",65,0 ) | |
| 905 | S BUFF=$G (BUFF) ; I nitialize optional p arameter | |
| 906 | "RTN","IBC NEBF",66,0 ) | |
| 907 | ; | |
| 908 | "RTN","IBC NEBF",67,0 ) | |
| 909 | N BPHONE, COB,DFN,EF FDT,EXPDT, GNAME,GNUM B,IBSOURCE ,IDOB,IIEN ,INAME,IRI EN,ISEX,IS SN,NAME | |
| 910 | "RTN","IBC NEBF",68,0 ) | |
| 911 | N PATID,P IEN,PNAME, PPHONE,RDA TA,RDATA5, RDATA13,RD ATA14,REL, RSTYPE,SUB ID,TQIEN,W HO | |
| 912 | "RTN","IBC NEBF",69,0 ) | |
| 913 | N SUBADDR 1,SUBADDR2 ,SUBCITY,S UBSTATE,SU BZIP,SUBCN TRY,SUBCND IV | |
| 914 | "RTN","IBC NEBF",70,0 ) | |
| 915 | ; | |
| 916 | "RTN","IBC NEBF",71,0 ) | |
| 917 | S DFN=$P( ^IBCN(365, IEN,0),U,2 ),TQIEN=$P (^IBCN(365 ,IEN,0),U, 5) | |
| 918 | "RTN","IBC NEBF",72,0 ) | |
| 919 | S PIEN=$P (^IBCN(365 ,IEN,0),U, 3),RSTYPE= $P(^(0),U, 10) | |
| 920 | "RTN","IBC NEBF",73,0 ) | |
| 921 | I PIEN'=" " S PNAME= $P(^IBE(36 5.12,PIEN, 0),U,1) | |
| 922 | "RTN","IBC NEBF",74,0 ) | |
| 923 | I TQIEN'= "" S IRIEN =$P($G(^IB CN(365.1,T QIEN,0)),U ,13),IBSOU RCE=$$GET1 ^DIQ(365.1 ,TQIEN_"," ,3.02,"I") ; IB*2.0* 621 IBSOUR CE | |
| 924 | "RTN","IBC NEBF",75,0 ) | |
| 925 | I $G(IRIE N)'="" S I NAME="" D | |
| 926 | "RTN","IBC NEBF",76,0 ) | |
| 927 | . S IIEN= $P($G(^DPT (DFN,.312, IRIEN,0)), U,1) | |
| 928 | "RTN","IBC NEBF",77,0 ) | |
| 929 | . I IIEN= "" Q | |
| 930 | "RTN","IBC NEBF",78,0 ) | |
| 931 | . S INAME =$P(^DIC(3 6,IIEN,0), U,1) | |
| 932 | "RTN","IBC NEBF",79,0 ) | |
| 933 | S RDATA=$ G(^IBCN(36 5,IEN,1)), RDATA5=$G( ^IBCN(365, IEN,5)) | |
| 934 | "RTN","IBC NEBF",80,0 ) | |
| 935 | S RDATA13 =$G(^IBCN( 365,IEN,13 )),RDATA14 =$G(^IBCN( 365,IEN,14 )) | |
| 936 | "RTN","IBC NEBF",81,0 ) | |
| 937 | S NAME=$P (RDATA13,U ,1) | |
| 938 | "RTN","IBC NEBF",82,0 ) | |
| 939 | S INAME=$ S($G(INAME )'=""&(RST YPE="O"):I NAME,1:$G( PNAME)) | |
| 940 | "RTN","IBC NEBF",83,0 ) | |
| 941 | S IDOB=$P (RDATA,U,2 ) | |
| 942 | "RTN","IBC NEBF",84,0 ) | |
| 943 | S ISSN=$P (RDATA,U,3 ) | |
| 944 | "RTN","IBC NEBF",85,0 ) | |
| 945 | S ISEX=$P (RDATA,U,4 ) | |
| 946 | "RTN","IBC NEBF",86,0 ) | |
| 947 | S COB=$P( RDATA,U,13 ) | |
| 948 | "RTN","IBC NEBF",87,0 ) | |
| 949 | S SUBID=$ P(RDATA13, U,2) | |
| 950 | "RTN","IBC NEBF",88,0 ) | |
| 951 | S PATID=$ P(RDATA,U, 18) | |
| 952 | "RTN","IBC NEBF",89,0 ) | |
| 953 | S GNAME=$ P(RDATA14, U,1) | |
| 954 | "RTN","IBC NEBF",90,0 ) | |
| 955 | S GNUMB=$ P(RDATA14, U,2) | |
| 956 | "RTN","IBC NEBF",91,0 ) | |
| 957 | S WHO=$P( RDATA,U,8) | |
| 958 | "RTN","IBC NEBF",92,0 ) | |
| 959 | S REL=$$P REL^IBCNEH LU(355.33, 60.14,$$GE T1^DIQ(365 ,IEN,8.01) ) ; IB*2* 497 VALUE FROM 365, 8.01 needs evaluatio n and poss ible conve rsion | |
| 960 | "RTN","IBC NEBF",93,0 ) | |
| 961 | S EFFDT=$ P(RDATA,U, 11) | |
| 962 | "RTN","IBC NEBF",94,0 ) | |
| 963 | S EXPDT=$ P(RDATA,U, 12) | |
| 964 | "RTN","IBC NEBF",95,0 ) | |
| 965 | S SUBADDR 1=$P(RDATA 5,U),SUBAD DR2=$P(RDA TA5,U,2),S UBCITY=$P( RDATA5,U,3 ) | |
| 966 | "RTN","IBC NEBF",96,0 ) | |
| 967 | S SUBSTAT E=$P(RDATA 5,U,4),SUB ZIP=$P(RDA TA5,U,5),S UBCNTRY=$P (RDATA5,U, 6) | |
| 968 | "RTN","IBC NEBF",97,0 ) | |
| 969 | S SUBCNDI V=$P(RDATA 5,U,7) | |
| 970 | "RTN","IBC NEBF",98,0 ) | |
| 971 | S PPHONE= "",BPHONE= "" | |
| 972 | "RTN","IBC NEBF",99,0 ) | |
| 973 | ; | |
| 974 | "RTN","IBC NEBF",100, 0) | |
| 975 | D FIL | |
| 976 | "RTN","IBC NEBF",101, 0) | |
| 977 | K DFN,VBU F,IEN,IRIE N,INAME,PN AME,IIEN,G NUMB,GNAME ,SUBID,PPH ONE,PATID | |
| 978 | "RTN","IBC NEBF",102, 0) | |
| 979 | K BPHONE, EFFDT,EXPD T,WHO,REL, IDOB,ISSN, COB,TQIEN, RDATA,ISEX ,NAME | |
| 980 | "RTN","IBC NEBF",103, 0) | |
| 981 | K ADD,%DT ,D0,DG,DIC ,DISYS,DIW ,IENS,IBEI STC | |
| 982 | "RTN","IBC NEBF",104, 0) | |
| 983 | Q | |
| 984 | "RTN","IBC NEBF",105, 0) | |
| 985 | ; | |
| 986 | "RTN","IBC NEBF",106, 0) | |
| 987 | FIL ; Fil e Buffer D ata | |
| 988 | "RTN","IBC NEBF",107, 0) | |
| 989 | ; | |
| 990 | "RTN","IBC NEBF",108, 0) | |
| 991 | S MSGP=$$ MGRP^IBCNE UT5() | |
| 992 | "RTN","IBC NEBF",109, 0) | |
| 993 | ; | |
| 994 | "RTN","IBC NEBF",110, 0) | |
| 995 | ; Variabl e IDUZ is optionally set by th e calling routine. If it is | |
| 996 | "RTN","IBC NEBF",111, 0) | |
| 997 | ; not def ined, it w ill be set to the sp ecific, no n-human us er. | |
| 998 | "RTN","IBC NEBF",112, 0) | |
| 999 | ; | |
| 1000 | "RTN","IBC NEBF",113, 0) | |
| 1001 | I $G(IDUZ )="" S IDU Z=$$FIND1^ DIC(200,"" ,"X","INTE RFACE,IB E IV") | |
| 1002 | "RTN","IBC NEBF",114, 0) | |
| 1003 | ; | |
| 1004 | "RTN","IBC NEBF",115, 0) | |
| 1005 | I $G(ADD) S VBUF(.0 2)=IDUZ ; Entered B y | |
| 1006 | "RTN","IBC NEBF",116, 0) | |
| 1007 | S VBUF(.1 2)=$G(SYMB OL) ; Bu ffer Symbo l | |
| 1008 | "RTN","IBC NEBF",117, 0) | |
| 1009 | S VBUF(.1 3)=$G(OVRR IDE) ; Ove rride fres hness flag | |
| 1010 | "RTN","IBC NEBF",118, 0) | |
| 1011 | S VBUF(.1 8)=$G(IBEL IGDT) ; el igibility date, only comes fro m ^IBCNEQU (real tim e eIV inqu iry) | |
| 1012 | "RTN","IBC NEBF",119, 0) | |
| 1013 | I '$G(ERA CT) D ; O nly file i f not an e rror | |
| 1014 | "RTN","IBC NEBF",120, 0) | |
| 1015 | . S VBUF( 20.01)=INA ME ; Insu rance Comp any/Payer Name | |
| 1016 | "RTN","IBC NEBF",121, 0) | |
| 1017 | . S VBUF( 60.01)=DFN ; Patien t IEN | |
| 1018 | "RTN","IBC NEBF",122, 0) | |
| 1019 | . S VBUF( 90.02)=GNU MB ; Grou p Number | |
| 1020 | "RTN","IBC NEBF",123, 0) | |
| 1021 | . S VBUF( 90.01)=GNA ME ; Grou p Name | |
| 1022 | "RTN","IBC NEBF",124, 0) | |
| 1023 | . S VBUF( 91.01)=NAM E ; Name of Insured | |
| 1024 | "RTN","IBC NEBF",125, 0) | |
| 1025 | . S VBUF( 90.03)=SUB ID ; Subs criber ID | |
| 1026 | "RTN","IBC NEBF",126, 0) | |
| 1027 | . S VBUF( 62.01)=PAT ID ; Pati ent/Member ID | |
| 1028 | "RTN","IBC NEBF",127, 0) | |
| 1029 | . S VBUF( 20.04)=PPH ONE ; Pre certificat ion Phone | |
| 1030 | "RTN","IBC NEBF",128, 0) | |
| 1031 | . S VBUF( 20.03)=BPH ONE ; Bil ling Phone | |
| 1032 | "RTN","IBC NEBF",129, 0) | |
| 1033 | . S VBUF( 60.02)=EFF DT ; Effe ctive Date | |
| 1034 | "RTN","IBC NEBF",130, 0) | |
| 1035 | . S VBUF( 60.03)=EXP DT ; Expi ration Dat e | |
| 1036 | "RTN","IBC NEBF",131, 0) | |
| 1037 | . S VBUF( 60.05)=WHO ; Whose Insurance | |
| 1038 | "RTN","IBC NEBF",132, 0) | |
| 1039 | . S VBUF( 60.14)=REL ; Patie nt Relatio nship | |
| 1040 | "RTN","IBC NEBF",133, 0) | |
| 1041 | . S VBUF( 60.08)=IDO B ; Insu red's DOB | |
| 1042 | "RTN","IBC NEBF",134, 0) | |
| 1043 | . S VBUF( 60.09)=ISS N ; Insu red's SSN | |
| 1044 | "RTN","IBC NEBF",135, 0) | |
| 1045 | . S VBUF( 60.12)=COB ; Coord ination of Benefits | |
| 1046 | "RTN","IBC NEBF",136, 0) | |
| 1047 | . S VBUF( 60.13)=ISE X ; Insu red's Sex | |
| 1048 | "RTN","IBC NEBF",137, 0) | |
| 1049 | . S VBUF( 62.02)=SUB ADDR1 ; Su bscriber a ddress lin e 1 | |
| 1050 | "RTN","IBC NEBF",138, 0) | |
| 1051 | . S VBUF( 62.03)=SUB ADDR2 ; Su bscriber a ddress lin e 2 | |
| 1052 | "RTN","IBC NEBF",139, 0) | |
| 1053 | . S VBUF( 62.04)=SUB CITY ; Sub scriber ad dress city | |
| 1054 | "RTN","IBC NEBF",140, 0) | |
| 1055 | . S VBUF( 62.05)=SUB STATE ; Su bscriber a ddress sta te | |
| 1056 | "RTN","IBC NEBF",141, 0) | |
| 1057 | . S VBUF( 62.06)=SUB ZIP ; Subs criber add ress zip c ode | |
| 1058 | "RTN","IBC NEBF",142, 0) | |
| 1059 | . S VBUF( 62.07)=SUB CNTRY ; Su bscriber a ddress cou ntry code | |
| 1060 | "RTN","IBC NEBF",143, 0) | |
| 1061 | . S VBUF( 62.08)=SUB CNDIV ; Su bscriber a ddress cou ntry subdi vision cod e | |
| 1062 | "RTN","IBC NEBF",144, 0) | |
| 1063 | . ; | |
| 1064 | "RTN","IBC NEBF",145, 0) | |
| 1065 | . ; Defin e Service Type Code (STC) to b e sent wit h Insuranc e Inquiry | |
| 1066 | "RTN","IBC NEBF",146, 0) | |
| 1067 | . ; IBEIS TC contain s the STC defined by User usin g option E I, otherwi se default is sent | |
| 1068 | "RTN","IBC NEBF",147, 0) | |
| 1069 | . I +$G(I BEISTC) S VBUF(80.01 )=IBEISTC | |
| 1070 | "RTN","IBC NEBF",148, 0) | |
| 1071 | . K IBEIS TC | |
| 1072 | "RTN","IBC NEBF",149, 0) | |
| 1073 | . ; | |
| 1074 | "RTN","IBC NEBF",150, 0) | |
| 1075 | . ; If th e employer sponsored insurance array exi sts, then merge it i n | |
| 1076 | "RTN","IBC NEBF",151, 0) | |
| 1077 | . I $D(ES GHPARR) M VBUF=ESGHP ARR | |
| 1078 | "RTN","IBC NEBF",152, 0) | |
| 1079 | ; | |
| 1080 | "RTN","IBC NEBF",153, 0) | |
| 1081 | ; Do not overwrite the existi ng insuran ce co. nam e if it al ready exis ts | |
| 1082 | "RTN","IBC NEBF",154, 0) | |
| 1083 | I $G(ADD) ="",$G(BUF F)'="" K V BUF(20.01) | |
| 1084 | "RTN","IBC NEBF",155, 0) | |
| 1085 | ; | |
| 1086 | "RTN","IBC NEBF",156, 0) | |
| 1087 | ; ** init ialize IBE RROR | |
| 1088 | "RTN","IBC NEBF",157, 0) | |
| 1089 | S IBERROR ="" | |
| 1090 | "RTN","IBC NEBF",158, 0) | |
| 1091 | ; | |
| 1092 | "RTN","IBC NEBF",159, 0) | |
| 1093 | ; If nee d to add a new Buffe r entry .. . | |
| 1094 | "RTN","IBC NEBF",160, 0) | |
| 1095 | ; | |
| 1096 | "RTN","IBC NEBF",161, 0) | |
| 1097 | ; Variab le IBFDA i s returned to the ca lling rout ine as the IEN of | |
| 1098 | "RTN","IBC NEBF",162, 0) | |
| 1099 | ; the bu ffer entry that was just added . | |
| 1100 | "RTN","IBC NEBF",163, 0) | |
| 1101 | ; | |
| 1102 | "RTN","IBC NEBF",164, 0) | |
| 1103 | I $G(ADD) D | |
| 1104 | "RTN","IBC NEBF",165, 0) | |
| 1105 | . S IBSOU RCE=$G(IBS OURCE,5) ; IB*2.0*62 1 Added IB SOURCE to replace ha rd coded e IV | |
| 1106 | "RTN","IBC NEBF",166, 0) | |
| 1107 | . S IBFDA =$$ADDSTF^ IBCNBES(IB SOURCE,DFN ,.VBUF) | |
| 1108 | "RTN","IBC NEBF",167, 0) | |
| 1109 | . ; Error Message i s 2nd piec e of resul t | |
| 1110 | "RTN","IBC NEBF",168, 0) | |
| 1111 | . S IBERR OR=$P(IBFD A,U,2) | |
| 1112 | "RTN","IBC NEBF",169, 0) | |
| 1113 | . S IBFDA =$P(IBFDA, U,1) | |
| 1114 | "RTN","IBC NEBF",170, 0) | |
| 1115 | ; | |
| 1116 | "RTN","IBC NEBF",171, 0) | |
| 1117 | ; If an error, sen d an email message | |
| 1118 | "RTN","IBC NEBF",172, 0) | |
| 1119 | I IBERROR '="" D Q | |
| 1120 | "RTN","IBC NEBF",173, 0) | |
| 1121 | . S MSG(1 )="Error r eturned by $$ADDSTF^ IBCNBES:" | |
| 1122 | "RTN","IBC NEBF",174, 0) | |
| 1123 | . S MSG(2 )=IBERROR | |
| 1124 | "RTN","IBC NEBF",175, 0) | |
| 1125 | . S MSG(3 )="Values: " | |
| 1126 | "RTN","IBC NEBF",176, 0) | |
| 1127 | . S MSG(4 )=" Patien t DFN = "_ $G(DFN) | |
| 1128 | "RTN","IBC NEBF",177, 0) | |
| 1129 | . S MSG(5 )=" Pt Ins Record IE N = "_$G(I RIEN) | |
| 1130 | "RTN","IBC NEBF",178, 0) | |
| 1131 | . S MSG(6 )="Please log a Reme dy Ticket for this p roblem." | |
| 1132 | "RTN","IBC NEBF",179, 0) | |
| 1133 | . S XMSUB ="Error cr eating Buf fer Entry. " | |
| 1134 | "RTN","IBC NEBF",180, 0) | |
| 1135 | . D MSG^I BCNEUT5(MS GP,XMSUB," MSG(") | |
| 1136 | "RTN","IBC NEBF",181, 0) | |
| 1137 | . K MSGP, MSG,XMSUB, IBERR | |
| 1138 | "RTN","IBC NEBF",182, 0) | |
| 1139 | ; | |
| 1140 | "RTN","IBC NEBF",183, 0) | |
| 1141 | ; If nee d to updat e a new Bu ffer Entry ... | |
| 1142 | "RTN","IBC NEBF",184, 0) | |
| 1143 | ; | |
| 1144 | "RTN","IBC NEBF",185, 0) | |
| 1145 | ; Variab le BUFF is passed in to this ro utine when ever the b uffer | |
| 1146 | "RTN","IBC NEBF",186, 0) | |
| 1147 | ; entry is known a nd the ADD flag is o ff. The e xisting bu ffer entry | |
| 1148 | "RTN","IBC NEBF",187, 0) | |
| 1149 | ; is edi ted in thi s case. | |
| 1150 | "RTN","IBC NEBF",188, 0) | |
| 1151 | ; | |
| 1152 | "RTN","IBC NEBF",189, 0) | |
| 1153 | I $G(ADD) ="" D EDIT STF^IBCNBE S(BUFF,.VB UF) | |
| 1154 | "RTN","IBC NEBF",190, 0) | |
| 1155 | ; | |
| 1156 | "RTN","IBC NEBF",191, 0) | |
| 1157 | ; If an error occu rred in ED ITSTF, the error arr ay is not returned | |
| 1158 | "RTN","IBC NEBF",192, 0) | |
| 1159 | ; | |
| 1160 | "RTN","IBC NEBF",193, 0) | |
| 1161 | Q | |
| 1162 | "RTN","IBC NEDE") | |
| 1163 | 0^1^B50050 843^B48578 031 | |
| 1164 | "RTN","IBC NEDE",1,0) | |
| 1165 | IBCNEDE ;D AOU/DAC - eIV DATA E XTRACTS ;0 7-MAY-2015 | |
| 1166 | "RTN","IBC NEDE",2,0) | |
| 1167 | ;;2.0;INT EGRATED BI LLING;**18 4,271,300, 416,438,49 7,549,593, 595,621**; 21-MAR-94; Build 8 | |
| 1168 | "RTN","IBC NEDE",3,0) | |
| 1169 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 1170 | "RTN","IBC NEDE",4,0) | |
| 1171 | ; | |
| 1172 | "RTN","IBC NEDE",5,0) | |
| 1173 | ;**Progra m Descript ion** | |
| 1174 | "RTN","IBC NEDE",6,0) | |
| 1175 | ; This p rogram is the main d river for all data e xtracts as sociated | |
| 1176 | "RTN","IBC NEDE",7,0) | |
| 1177 | ; with t he electro nic Insura nce Verifi cation int erface. | |
| 1178 | "RTN","IBC NEDE",8,0) | |
| 1179 | ; This p rogram wil l run each extract i n the spec ified orde r, which | |
| 1180 | "RTN","IBC NEDE",9,0) | |
| 1181 | ; popula tes the eI V Transmis sion File (sometimes it create s/updates | |
| 1182 | "RTN","IBC NEDE",10,0 ) | |
| 1183 | ; an ent ry in the insurance buffer as well). It then begi ns to | |
| 1184 | "RTN","IBC NEDE",11,0 ) | |
| 1185 | ; proces s the inqu iries in t he eIV Tra nsmission File. | |
| 1186 | "RTN","IBC NEDE",12,0 ) | |
| 1187 | ; 08-08- 2002 | |
| 1188 | "RTN","IBC NEDE",13,0 ) | |
| 1189 | ; As thi s program will run i n the back ground the variable ZTSTOP | |
| 1190 | "RTN","IBC NEDE",14,0 ) | |
| 1191 | ; can be returned from any o f the extr acts shoul d a TaskMa n stop | |
| 1192 | "RTN","IBC NEDE",15,0 ) | |
| 1193 | ; reques t occur. Also, clea r out the task recor d before e xiting. | |
| 1194 | "RTN","IBC NEDE",16,0 ) | |
| 1195 | ; 08-09-2 002 | |
| 1196 | "RTN","IBC NEDE",17,0 ) | |
| 1197 | ; Added check for "~NO PAYER ", if it d oes not ex ist, build it | |
| 1198 | "RTN","IBC NEDE",18,0 ) | |
| 1199 | ; | |
| 1200 | "RTN","IBC NEDE",19,0 ) | |
| 1201 | Q | |
| 1202 | "RTN","IBC NEDE",20,0 ) | |
| 1203 | ; | |
| 1204 | "RTN","IBC NEDE",21,0 ) | |
| 1205 | EN ; Entry Point | |
| 1206 | "RTN","IBC NEDE",22,0 ) | |
| 1207 | ; Prevent simultane ous runs | |
| 1208 | "RTN","IBC NEDE",23,0 ) | |
| 1209 | ; Set err or trap to ensure th at lock is released | |
| 1210 | "RTN","IBC NEDE",24,0 ) | |
| 1211 | ; | |
| 1212 | "RTN","IBC NEDE",25,0 ) | |
| 1213 | ; IB*2.0* 549 - Quit if Nightl y Extract Master swi tch is off | |
| 1214 | "RTN","IBC NEDE",26,0 ) | |
| 1215 | Q:$$GET1^ DIQ(350.9, "1,",51.28 ,"I")="N" | |
| 1216 | "RTN","IBC NEDE",27,0 ) | |
| 1217 | ; | |
| 1218 | "RTN","IBC NEDE",28,0 ) | |
| 1219 | N $ES,$ET | |
| 1220 | "RTN","IBC NEDE",29,0 ) | |
| 1221 | S $ET="D ER^IBCNEDE " | |
| 1222 | "RTN","IBC NEDE",30,0 ) | |
| 1223 | ; Check l ock | |
| 1224 | "RTN","IBC NEDE",31,0 ) | |
| 1225 | L +^TMP(" IBCNEDE"): 1 I '$T D G ENX | |
| 1226 | "RTN","IBC NEDE",32,0 ) | |
| 1227 | . I '$D(Z TSK) W !!, "The eIV N ightly Tas k is alrea dy running , please r etry later ." D PAUSE ^VALM1 | |
| 1228 | "RTN","IBC NEDE",33,0 ) | |
| 1229 | ; Reset r eg ack fla g | |
| 1230 | "RTN","IBC NEDE",34,0 ) | |
| 1231 | S $P(^IBE (350.9,1,5 1),U,22)=" " | |
| 1232 | "RTN","IBC NEDE",35,0 ) | |
| 1233 | ; If "~NO PAYER" is not a val id Payer F ile entry, rebuild i t from | |
| 1234 | "RTN","IBC NEDE",36,0 ) | |
| 1235 | ; the ex isting uti lity | |
| 1236 | "RTN","IBC NEDE",37,0 ) | |
| 1237 | I '$$FIND 1^DIC(365. 12,,"X","~ NO PAYER") D PAYR^IB CNEUT2 | |
| 1238 | "RTN","IBC NEDE",38,0 ) | |
| 1239 | ; | |
| 1240 | "RTN","IBC NEDE",39,0 ) | |
| 1241 | D CHKPER ; IB*2.0*5 95/DM Chec k for New Person (#2 00) EIV en tries | |
| 1242 | "RTN","IBC NEDE",40,0 ) | |
| 1243 | ; | |
| 1244 | "RTN","IBC NEDE",41,0 ) | |
| 1245 | ; Confirm that all necessary tables hav e been loa ded | |
| 1246 | "RTN","IBC NEDE",42,0 ) | |
| 1247 | ; before the extrac t is run | |
| 1248 | "RTN","IBC NEDE",43,0 ) | |
| 1249 | I '$$TBLC HK() G EN1 | |
| 1250 | "RTN","IBC NEDE",44,0 ) | |
| 1251 | ; | |
| 1252 | "RTN","IBC NEDE",45,0 ) | |
| 1253 | ;IB*2.0*5 93/TAZ/HAN - Add job to update Covered b y Health I nsurance f lag | |
| 1254 | "RTN","IBC NEDE",46,0 ) | |
| 1255 | D EN^IBCN ERTC($P($$ NOW^XLFDT, ".")) | |
| 1256 | "RTN","IBC NEDE",47,0 ) | |
| 1257 | ; | |
| 1258 | "RTN","IBC NEDE",48,0 ) | |
| 1259 | D AMCHECK ^IBCNEUT6 ; ensu re Auto Ma tch entrie s are vali d | |
| 1260 | "RTN","IBC NEDE",49,0 ) | |
| 1261 | ; | |
| 1262 | "RTN","IBC NEDE",50,0 ) | |
| 1263 | ; Run All 3 extract s and laun ch IBCNEDE P(Inquirie s) | |
| 1264 | "RTN","IBC NEDE",51,0 ) | |
| 1265 | D EN^IBCN EDE1 ; Ins urance Buf fer Extrac t | |
| 1266 | "RTN","IBC NEDE",52,0 ) | |
| 1267 | ; Check t o see if b ackground process ha s been sto pped, if s o quit. | |
| 1268 | "RTN","IBC NEDE",53,0 ) | |
| 1269 | I $G(ZTST OP) G ENX | |
| 1270 | "RTN","IBC NEDE",54,0 ) | |
| 1271 | D EN^IBCN EDE2 ; Pre Reg Extra ct | |
| 1272 | "RTN","IBC NEDE",55,0 ) | |
| 1273 | ; Check t o see if b ackground process ha s been sto pped, if s o quit. | |
| 1274 | "RTN","IBC NEDE",56,0 ) | |
| 1275 | I $G(ZTST OP) G ENX | |
| 1276 | "RTN","IBC NEDE",57,0 ) | |
| 1277 | D EN^IBCN EDE4 ; IB* 2.0*621/DM add the E ICD extrac t (formerl y No Insur ance) | |
| 1278 | "RTN","IBC NEDE",58,0 ) | |
| 1279 | ; Check t o see if b ackground process ha s been sto pped, if s o quit. | |
| 1280 | "RTN","IBC NEDE",59,0 ) | |
| 1281 | EN1 I $G(Z TSTOP) G E NX | |
| 1282 | "RTN","IBC NEDE",60,0 ) | |
| 1283 | ; Send en rollment m essage | |
| 1284 | "RTN","IBC NEDE",61,0 ) | |
| 1285 | D ^IBCNEH LM | |
| 1286 | "RTN","IBC NEDE",62,0 ) | |
| 1287 | I $G(ZTST OP) G ENX | |
| 1288 | "RTN","IBC NEDE",63,0 ) | |
| 1289 | I '$G(QFL ) D | |
| 1290 | "RTN","IBC NEDE",64,0 ) | |
| 1291 | . ; Wait for 'AA' a cknowledge ment | |
| 1292 | "RTN","IBC NEDE",65,0 ) | |
| 1293 | . D WAIT Q:'+QFL | |
| 1294 | "RTN","IBC NEDE",66,0 ) | |
| 1295 | . KILL QF L | |
| 1296 | "RTN","IBC NEDE",67,0 ) | |
| 1297 | . ; | |
| 1298 | "RTN","IBC NEDE",68,0 ) | |
| 1299 | . D ^IBCN EDEP ; In quiries Pr ocessing | |
| 1300 | "RTN","IBC NEDE",69,0 ) | |
| 1301 | ; | |
| 1302 | "RTN","IBC NEDE",70,0 ) | |
| 1303 | ; Check t o see if b ackground process ha s been sto pped, if s o quit. | |
| 1304 | "RTN","IBC NEDE",71,0 ) | |
| 1305 | I $G(ZTST OP) G ENX | |
| 1306 | "RTN","IBC NEDE",72,0 ) | |
| 1307 | D MMQ ; Que ue the Dai ly MailMan message | |
| 1308 | "RTN","IBC NEDE",73,0 ) | |
| 1309 | D DSTQ ; que ue daily s tatistical message t o FSC | |
| 1310 | "RTN","IBC NEDE",74,0 ) | |
| 1311 | ; Send Ma ilMan mess age if fir st of mont h to repor t on recor ds | |
| 1312 | "RTN","IBC NEDE",75,0 ) | |
| 1313 | ; eligib le to be p urged | |
| 1314 | "RTN","IBC NEDE",76,0 ) | |
| 1315 | I +$E($P( $$NOW^XLFD T(),"."),6 ,7)=1 D MM PURGE^IBCN EKI2 | |
| 1316 | "RTN","IBC NEDE",77,0 ) | |
| 1317 | ; | |
| 1318 | "RTN","IBC NEDE",78,0 ) | |
| 1319 | ENX ; Purg e task rec ord - if q ueued | |
| 1320 | "RTN","IBC NEDE",79,0 ) | |
| 1321 | I $D(ZTQU EUED) S ZT REQ="@" | |
| 1322 | "RTN","IBC NEDE",80,0 ) | |
| 1323 | L -^TMP(" IBCNEDE") | |
| 1324 | "RTN","IBC NEDE",81,0 ) | |
| 1325 | Q | |
| 1326 | "RTN","IBC NEDE",82,0 ) | |
| 1327 | ; | |
| 1328 | "RTN","IBC NEDE",83,0 ) | |
| 1329 | TBLCHK() ; | |
| 1330 | "RTN","IBC NEDE",84,0 ) | |
| 1331 | ; Confirm that at l east one e IV payer a nd that al l X12 tabl es | |
| 1332 | "RTN","IBC NEDE",85,0 ) | |
| 1333 | ; have be en loaded | |
| 1334 | "RTN","IBC NEDE",86,0 ) | |
| 1335 | N PAY,PAY IEN,PAYOK, TBLOK,II | |
| 1336 | "RTN","IBC NEDE",87,0 ) | |
| 1337 | S (PAY,PA YIEN,PAYOK )="",TBLOK =1 | |
| 1338 | "RTN","IBC NEDE",88,0 ) | |
| 1339 | F S PAY= $O(^IBE(36 5.12,"B",P AY)) Q:PAY =""!PAYOK I PAY'="~ NO PAYER" D | |
| 1340 | "RTN","IBC NEDE",89,0 ) | |
| 1341 | . F S P AYIEN=$O(^ IBE(365.12 ,"B",PAY,P AYIEN)) Q: PAYIEN=""! PAYOK D | |
| 1342 | "RTN","IBC NEDE",90,0 ) | |
| 1343 | .. I $ $PYRAPP^IB CNEUT5("II V",PAYIEN) S PAYOK=1 Q | |
| 1344 | "RTN","IBC NEDE",91,0 ) | |
| 1345 | I PAYOK D | |
| 1346 | "RTN","IBC NEDE",92,0 ) | |
| 1347 | . F II=11 :1:18,21 I $O(^IBE(I I*.001+365 ,"B",""))= "" S TBLOK ="" Q | |
| 1348 | "RTN","IBC NEDE",93,0 ) | |
| 1349 | Q PAYOK&T BLOK | |
| 1350 | "RTN","IBC NEDE",94,0 ) | |
| 1351 | ; | |
| 1352 | "RTN","IBC NEDE",95,0 ) | |
| 1353 | WAIT ; Wa it for ack nowledgeme nt comes b ack from E C | |
| 1354 | "RTN","IBC NEDE",96,0 ) | |
| 1355 | ; Hang f or 60 seco nds and ch eck status again | |
| 1356 | "RTN","IBC NEDE",97,0 ) | |
| 1357 | ; Try 36 0 times fo r a total of 21600 s econds (6 hours) | |
| 1358 | "RTN","IBC NEDE",98,0 ) | |
| 1359 | S QFL=0,C T=0 | |
| 1360 | "RTN","IBC NEDE",99,0 ) | |
| 1361 | F D Q:Q FL'=""!(CT >360) | |
| 1362 | "RTN","IBC NEDE",100, 0) | |
| 1363 | . S QFL=$ $GET1^DIQ( 350.9,"1," ,51.22,"I" ) | |
| 1364 | "RTN","IBC NEDE",101, 0) | |
| 1365 | . Q:QFL'= "" | |
| 1366 | "RTN","IBC NEDE",102, 0) | |
| 1367 | . HANG 60 S CT=CT+1 | |
| 1368 | "RTN","IBC NEDE",103, 0) | |
| 1369 | KILL CT | |
| 1370 | "RTN","IBC NEDE",104, 0) | |
| 1371 | Q | |
| 1372 | "RTN","IBC NEDE",105, 0) | |
| 1373 | ; | |
| 1374 | "RTN","IBC NEDE",106, 0) | |
| 1375 | FRESHDT(EX T,STALEDYS ) ; Calcu late Fresh ness | |
| 1376 | "RTN","IBC NEDE",107, 0) | |
| 1377 | ; Ext - ien of ext ract for f uture purp oses | |
| 1378 | "RTN","IBC NEDE",108, 0) | |
| 1379 | ; Staled ys - # of days in th e past in which an i nsurance v erificatio n | |
| 1380 | "RTN","IBC NEDE",109, 0) | |
| 1381 | ; is con sidered st ill valid/ current | |
| 1382 | "RTN","IBC NEDE",110, 0) | |
| 1383 | N STALEDT | |
| 1384 | "RTN","IBC NEDE",111, 0) | |
| 1385 | S STALEDT =$$FMADD^X LFDT(DT,-S TALEDYS) | |
| 1386 | "RTN","IBC NEDE",112, 0) | |
| 1387 | Q STALEDT | |
| 1388 | "RTN","IBC NEDE",113, 0) | |
| 1389 | ; | |
| 1390 | "RTN","IBC NEDE",114, 0) | |
| 1391 | ; ------- ---------- ---------- ---------- ---------- ---- | |
| 1392 | "RTN","IBC NEDE",115, 0) | |
| 1393 | MMQ ; This procedure is respon sible for scheduling the creat ion and | |
| 1394 | "RTN","IBC NEDE",116, 0) | |
| 1395 | ; sending of the da ily MailMa n statisti cal messag e if the s ite has | |
| 1396 | "RTN","IBC NEDE",117, 0) | |
| 1397 | ; defined this appr opriately in the eIV site para meters. | |
| 1398 | "RTN","IBC NEDE",118, 0) | |
| 1399 | ; | |
| 1400 | "RTN","IBC NEDE",119, 0) | |
| 1401 | NEW IIV,C URRTIME,MT IME,MSG,Y, MGRP | |
| 1402 | "RTN","IBC NEDE",120, 0) | |
| 1403 | NEW ZTRTN ,ZTDESC,ZT DTH,ZTIO,Z TUCI,ZTCPU ,ZTPRI,ZTS AVE,ZTKIL, ZTSYNC,ZTS K | |
| 1404 | "RTN","IBC NEDE",121, 0) | |
| 1405 | ; | |
| 1406 | "RTN","IBC NEDE",122, 0) | |
| 1407 | S IIV=$G( ^IBE(350.9 ,1,51)) | |
| 1408 | "RTN","IBC NEDE",123, 0) | |
| 1409 | I '$P(IIV ,U,2) G MM QX ; site d oes not wa nt daily m essages | |
| 1410 | "RTN","IBC NEDE",124, 0) | |
| 1411 | I '$P(IIV ,U,3) G MM QX ; MM mes sage time is not def ined | |
| 1412 | "RTN","IBC NEDE",125, 0) | |
| 1413 | I '$P(IIV ,U,4) G MM QX ; Mail G roup is no t defined | |
| 1414 | "RTN","IBC NEDE",126, 0) | |
| 1415 | ; | |
| 1416 | "RTN","IBC NEDE",127, 0) | |
| 1417 | S CURRTIM E=$P($H,", ",2) ; curren t $H time | |
| 1418 | "RTN","IBC NEDE",128, 0) | |
| 1419 | S MTIME=D T_"."_$P(I IV,U,3) ; build a FileMan date/time | |
| 1420 | "RTN","IBC NEDE",129, 0) | |
| 1421 | S MTIME=$ $FMTH^XLFD T(MTIME) ; conver t to $H fo rmat | |
| 1422 | "RTN","IBC NEDE",130, 0) | |
| 1423 | S MTIME=$ P(MTIME,", ",2) ; $H tim e of MM me ssage | |
| 1424 | "RTN","IBC NEDE",131, 0) | |
| 1425 | ; | |
| 1426 | "RTN","IBC NEDE",132, 0) | |
| 1427 | ; If the current ti me is afte r the Mail Man messag e time, th en | |
| 1428 | "RTN","IBC NEDE",133, 0) | |
| 1429 | ; schedul e the MM m essage for tomorrow at that ti me. | |
| 1430 | "RTN","IBC NEDE",134, 0) | |
| 1431 | I CURRTIM E>MTIME S ZTDTH=($H+ 1)_","_MTI ME | |
| 1432 | "RTN","IBC NEDE",135, 0) | |
| 1433 | ; | |
| 1434 | "RTN","IBC NEDE",136, 0) | |
| 1435 | ; Otherwi se, schedu le it for later toda y | |
| 1436 | "RTN","IBC NEDE",137, 0) | |
| 1437 | E S ZTDT H=+$H_","_ MTIME | |
| 1438 | "RTN","IBC NEDE",138, 0) | |
| 1439 | ; | |
| 1440 | "RTN","IBC NEDE",139, 0) | |
| 1441 | ; Set up the other TaskManage r variable s | |
| 1442 | "RTN","IBC NEDE",140, 0) | |
| 1443 | S ZTRTN=" MAILMSG^IB CNERP7" | |
| 1444 | "RTN","IBC NEDE",141, 0) | |
| 1445 | S ZTDESC= "eIV Daily Statistic s E-Mail" | |
| 1446 | "RTN","IBC NEDE",142, 0) | |
| 1447 | S ZTIO="" | |
| 1448 | "RTN","IBC NEDE",143, 0) | |
| 1449 | D ^%ZTLOA D ; Call TaskManage r | |
| 1450 | "RTN","IBC NEDE",144, 0) | |
| 1451 | I $G(ZTSK ) G MMQX ; Task# is OK so get out | |
| 1452 | "RTN","IBC NEDE",145, 0) | |
| 1453 | ; | |
| 1454 | "RTN","IBC NEDE",146, 0) | |
| 1455 | ; Send a MailMan me ssage if t his Task c ould not g et schedul ed | |
| 1456 | "RTN","IBC NEDE",147, 0) | |
| 1457 | S MSG(1)= "TaskManag er could n ot schedul e the dail y eIV Mail Man messag e" | |
| 1458 | "RTN","IBC NEDE",148, 0) | |
| 1459 | S MSG(2)= "at the sp ecified ti me of "_$E ($P(IIV,U, 3),1,2)_": "_$E($P(II V,U,3),3,4 )_"." | |
| 1460 | "RTN","IBC NEDE",149, 0) | |
| 1461 | S MSG(3)= "This is d efined in the eIV Si te Paramet ers option ." | |
| 1462 | "RTN","IBC NEDE",150, 0) | |
| 1463 | ; Set to IB site pa rameter MA ILGROUP | |
| 1464 | "RTN","IBC NEDE",151, 0) | |
| 1465 | S MGRP=$$ MGRP^IBCNE UT5() | |
| 1466 | "RTN","IBC NEDE",152, 0) | |
| 1467 | D MSG^IBC NEUT5(MGRP ,"eIV Stat istical Me ssage Not Sent","MSG (") | |
| 1468 | "RTN","IBC NEDE",153, 0) | |
| 1469 | ; | |
| 1470 | "RTN","IBC NEDE",154, 0) | |
| 1471 | MMQX ; | |
| 1472 | "RTN","IBC NEDE",155, 0) | |
| 1473 | Q | |
| 1474 | "RTN","IBC NEDE",156, 0) | |
| 1475 | ; | |
| 1476 | "RTN","IBC NEDE",157, 0) | |
| 1477 | ER ; Unloc k the eIV Nightly Ta sk and ret urn to log error | |
| 1478 | "RTN","IBC NEDE",158, 0) | |
| 1479 | L -^TMP(" IBCNEDE") | |
| 1480 | "RTN","IBC NEDE",159, 0) | |
| 1481 | D ^%ZTER | |
| 1482 | "RTN","IBC NEDE",160, 0) | |
| 1483 | D UNWIND^ %ZTER | |
| 1484 | "RTN","IBC NEDE",161, 0) | |
| 1485 | Q | |
| 1486 | "RTN","IBC NEDE",162, 0) | |
| 1487 | ; | |
| 1488 | "RTN","IBC NEDE",163, 0) | |
| 1489 | DSTQ ; Thi s procedur e is respo nsible for schedulin g the crea tion and | |
| 1490 | "RTN","IBC NEDE",164, 0) | |
| 1491 | ; sending of the da ily statis tical mess age to FSC . | |
| 1492 | "RTN","IBC NEDE",165, 0) | |
| 1493 | ; | |
| 1494 | "RTN","IBC NEDE",166, 0) | |
| 1495 | N IIV,CUR RTIME,MTIM E,MSG,MGRP | |
| 1496 | "RTN","IBC NEDE",167, 0) | |
| 1497 | N ZTRTN,Z TDESC,ZTDT H,ZTIO,ZTU CI,ZTCPU,Z TPRI,ZTSAV E,ZTKIL,ZT SYNC,ZTSK | |
| 1498 | "RTN","IBC NEDE",168, 0) | |
| 1499 | ; | |
| 1500 | "RTN","IBC NEDE",169, 0) | |
| 1501 | S IIV=$G( ^IBE(350.9 ,1,51)) | |
| 1502 | "RTN","IBC NEDE",170, 0) | |
| 1503 | I '$P(IIV ,U,3) G DS TQX ; MM me ssage time is not de fined | |
| 1504 | "RTN","IBC NEDE",171, 0) | |
| 1505 | ; | |
| 1506 | "RTN","IBC NEDE",172, 0) | |
| 1507 | S CURRTIM E=$P($H,", ",2) ; curren t $H time | |
| 1508 | "RTN","IBC NEDE",173, 0) | |
| 1509 | S MTIME=D T_"."_$P(I IV,U,3) ; build a FileMan date/time | |
| 1510 | "RTN","IBC NEDE",174, 0) | |
| 1511 | S MTIME=$ $FMTH^XLFD T(MTIME) ; conver t to $H fo rmat | |
| 1512 | "RTN","IBC NEDE",175, 0) | |
| 1513 | S MTIME=$ P(MTIME,", ",2) ; $H tim e of MM me ssage | |
| 1514 | "RTN","IBC NEDE",176, 0) | |
| 1515 | ; | |
| 1516 | "RTN","IBC NEDE",177, 0) | |
| 1517 | ; If the current ti me is afte r the Mail Man messag e time, th en schedul e the mess age for to morrow at that time. | |
| 1518 | "RTN","IBC NEDE",178, 0) | |
| 1519 | ; Otherwi se, schedu le it for later toda y. | |
| 1520 | "RTN","IBC NEDE",179, 0) | |
| 1521 | S ZTDTH=$ S(CURRTIME >MTIME:$H+ 1,1:+$H)_" ,"_MTIME | |
| 1522 | "RTN","IBC NEDE",180, 0) | |
| 1523 | ; | |
| 1524 | "RTN","IBC NEDE",181, 0) | |
| 1525 | ; Set up the other TaskManage r variable s | |
| 1526 | "RTN","IBC NEDE",182, 0) | |
| 1527 | S ZTRTN=" EN1^IBCNEH LM" | |
| 1528 | "RTN","IBC NEDE",183, 0) | |
| 1529 | S ZTDESC= "eIV Daily Statistic s HL7 Mess age" | |
| 1530 | "RTN","IBC NEDE",184, 0) | |
| 1531 | S ZTIO="" | |
| 1532 | "RTN","IBC NEDE",185, 0) | |
| 1533 | D ^%ZTLOA D ; Call TaskManage r | |
| 1534 | "RTN","IBC NEDE",186, 0) | |
| 1535 | I $G(ZTSK ) G DSTQX ; Task# is OK so get out | |
| 1536 | "RTN","IBC NEDE",187, 0) | |
| 1537 | ; | |
| 1538 | "RTN","IBC NEDE",188, 0) | |
| 1539 | ; Send a MailMan me ssage if t his Task c ould not g et schedul ed | |
| 1540 | "RTN","IBC NEDE",189, 0) | |
| 1541 | S MSG(1)= "TaskManag er could n ot schedul e the dail y eIV Stat istics HL7 message" | |
| 1542 | "RTN","IBC NEDE",190, 0) | |
| 1543 | S MSG(2)= "at the sp ecified ti me of "_$E ($P(IIV,U, 3),1,2)_": "_$E($P(II V,U,3),3,4 )_"." | |
| 1544 | "RTN","IBC NEDE",191, 0) | |
| 1545 | S MSG(3)= "This is d efined in the eIV Si te Paramet ers option ." | |
| 1546 | "RTN","IBC NEDE",192, 0) | |
| 1547 | ; Set to IB site pa rameter MA ILGROUP | |
| 1548 | "RTN","IBC NEDE",193, 0) | |
| 1549 | S MGRP=$$ MGRP^IBCNE UT5() I MG RP'="" D M SG^IBCNEUT 5(MGRP,"eI V Statisti cal HL7 Me ssage Not Sent","MSG (") | |
| 1550 | "RTN","IBC NEDE",194, 0) | |
| 1551 | ; | |
| 1552 | "RTN","IBC NEDE",195, 0) | |
| 1553 | DSTQX ; | |
| 1554 | "RTN","IBC NEDE",196, 0) | |
| 1555 | Q | |
| 1556 | "RTN","IBC NEDE",197, 0) | |
| 1557 | ; | |
| 1558 | "RTN","IBC NEDE",198, 0) | |
| 1559 | CHKPER ; I B*2.0*595/ DM | |
| 1560 | "RTN","IBC NEDE",199, 0) | |
| 1561 | ; check f or the exi stence of New Person : "INTERFA CE,IB EIV" and/or "A UTOUPDATE, IBEIV" | |
| 1562 | "RTN","IBC NEDE",200, 0) | |
| 1563 | ; send a mailman me ssage to " PII " if eithe r/both are missing. | |
| 1564 | "RTN","IBC NEDE",201, 0) | |
| 1565 | ; | |
| 1566 | "RTN","IBC NEDE",202, 0) | |
| 1567 | N IBA,IBI ,WKDT,IBMC T,MSG,MGRP ,IBXMY | |
| 1568 | "RTN","IBC NEDE",203, 0) | |
| 1569 | ; | |
| 1570 | "RTN","IBC NEDE",204, 0) | |
| 1571 | S IBA=+$$ FIND1^DIC( 200,,"MX", "AUTOUPDAT E,IBEIV"), IBI=+$$FIN D1^DIC(200 ,,"MX","IN TERFACE,IB EIV") | |
| 1572 | "RTN","IBC NEDE",205, 0) | |
| 1573 | I IBA,IBI Q | |
| 1574 | "RTN","IBC NEDE",206, 0) | |
| 1575 | ; | |
| 1576 | "RTN","IBC NEDE",207, 0) | |
| 1577 | S WKDT=$$ SITE^VASIT E() | |
| 1578 | "RTN","IBC NEDE",208, 0) | |
| 1579 | S MSG(1)= "Missing E IV New Per son entrie s, for sta tion "_$P( WKDT,U,3)_ ":"_$P(WKD T,U,2) | |
| 1580 | "RTN","IBC NEDE",209, 0) | |
| 1581 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- " | |
| 1582 | "RTN","IBC NEDE",210, 0) | |
| 1583 | S IBMCT=2 | |
| 1584 | "RTN","IBC NEDE",211, 0) | |
| 1585 | I 'IBA S MSG(IBMCT) ="Entry fo r 'AUTOUPD ATE,IBEIV' is missin g",IBMCT=I BMCT+1 | |
| 1586 | "RTN","IBC NEDE",212, 0) | |
| 1587 | I 'IBI S MSG(IBMCT) ="Entry fo r 'INTERFA CE,IB EIV' is missin g",IBMCT=I BMCT+1 | |
| 1588 | "RTN","IBC NEDE",213, 0) | |
| 1589 | S MSG(IBM CT)="----- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----" | |
| 1590 | "RTN","IBC NEDE",214, 0) | |
| 1591 | S MGRP=$$ MGRP^IBCNE UT5() | |
| 1592 | "RTN","IBC NEDE",215, 0) | |
| 1593 | S IBXMY(" PII ")="" | |
| 1594 | "RTN","IBC NEDE",216, 0) | |
| 1595 | D MSG^IBC NEUT5(MGRP ,"Missing EIV New Pe rson entri es ("_$P(W KDT,U,3)_" )","MSG(", ,.IBXMY) | |
| 1596 | "RTN","IBC NEDE",217, 0) | |
| 1597 | Q | |
| 1598 | "RTN","IBC NEDE4") | |
| 1599 | 0^2^B60089 694^B81971 988 | |
| 1600 | "RTN","IBC NEDE4",1,0 ) | |
| 1601 | IBCNEDE4 ; AITC/DM - EICD (Elec tronic Ins urance Cov erage Disc overy) ext ract;24-JU N-2002 | |
| 1602 | "RTN","IBC NEDE4",2,0 ) | |
| 1603 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 621**;21-M AR-94;Buil d 8 | |
| 1604 | "RTN","IBC NEDE4",3,0 ) | |
| 1605 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 1606 | "RTN","IBC NEDE4",4,0 ) | |
| 1607 | ; | |
| 1608 | "RTN","IBC NEDE4",5,0 ) | |
| 1609 | ; **Progr am Descrip tion** | |
| 1610 | "RTN","IBC NEDE4",6,0 ) | |
| 1611 | ; The Ele ctronic In surance Co verage Dis covery a.k .a EICD ex tract (#4) | |
| 1612 | "RTN","IBC NEDE4",7,0 ) | |
| 1613 | ; is call ed from th e nightly job - IBCN EDE. | |
| 1614 | "RTN","IBC NEDE4",8,0 ) | |
| 1615 | ; | |
| 1616 | "RTN","IBC NEDE4",9,0 ) | |
| 1617 | ; Formerl y known as "No Insur ance", we are rework ing the en tire logic for | |
| 1618 | "RTN","IBC NEDE4",10, 0) | |
| 1619 | ; determi ning insur ance for t hose who d on't have active pol icies with patch IB* 2.0*621. | |
| 1620 | "RTN","IBC NEDE4",11, 0) | |
| 1621 | ; | |
| 1622 | "RTN","IBC NEDE4",12, 0) | |
| 1623 | Q | |
| 1624 | "RTN","IBC NEDE4",13, 0) | |
| 1625 | ; | |
| 1626 | "RTN","IBC NEDE4",14, 0) | |
| 1627 | EN ; EICD extract en try | |
| 1628 | "RTN","IBC NEDE4",15, 0) | |
| 1629 | N CLNC,DA TA1,DATA2, DATA5,DFN, EACTIVE,EL G,FRESHDT, IBACTV,IBA PPTDT | |
| 1630 | "RTN","IBC NEDE4",16, 0) | |
| 1631 | N IBBEGDT ,IBCSIEN,I BDFNDONE,I BEFF,IBEIC DPAY,IBEND DT,IBERR,I BEXP,IBFDA | |
| 1632 | "RTN","IBC NEDE4",17, 0) | |
| 1633 | N IBFREQ, IBIDX,IBIN SNM,IBMSG, IBSDA,IBTA SKTOT,IBTO PIEN,IBTQC NT,IBTQIEN | |
| 1634 | "RTN","IBC NEDE4",18, 0) | |
| 1635 | N IBTQSTA T,IBWK1,IB WK2,IBWKIE N,MAXCNT,O K | |
| 1636 | "RTN","IBC NEDE4",19, 0) | |
| 1637 | ; | |
| 1638 | "RTN","IBC NEDE4",20, 0) | |
| 1639 | ; Get Ex tract para meters | |
| 1640 | "RTN","IBC NEDE4",21, 0) | |
| 1641 | S EACTIVE =$$SETTING S^IBCNEDE7 (4) | |
| 1642 | "RTN","IBC NEDE4",22, 0) | |
| 1643 | I 'EACTIV E G ENQQ ; not activ e, or requ ired field s missing | |
| 1644 | "RTN","IBC NEDE4",23, 0) | |
| 1645 | S MAXCNT= $P(EACTIVE ,U,4) ; th rottle dai ly extract queries | |
| 1646 | "RTN","IBC NEDE4",24, 0) | |
| 1647 | S:MAXCNT= "" MAXCNT= 9999999999 | |
| 1648 | "RTN","IBC NEDE4",25, 0) | |
| 1649 | S IBWK1=$ P(EACTIVE, U,6) ; sta rt days | |
| 1650 | "RTN","IBC NEDE4",26, 0) | |
| 1651 | S IBBEGDT =$$FMADD^X LFDT(DT,IB WK1) ; beg in date = today + st art days | |
| 1652 | "RTN","IBC NEDE4",27, 0) | |
| 1653 | S IBENDDT =$$FMADD^X LFDT(DT,IB WK1+$P(EAC TIVE,U,7)) ; end dat e = today + start da ys + days after star t | |
| 1654 | "RTN","IBC NEDE4",28, 0) | |
| 1655 | S IBFREQ= $P(EACTIVE ,U,8) ; fr equency | |
| 1656 | "RTN","IBC NEDE4",29, 0) | |
| 1657 | S FRESHDT =$$FMADD^X LFDT(DT,-I BFREQ) | |
| 1658 | "RTN","IBC NEDE4",30, 0) | |
| 1659 | S IBCSIEN =$$FIND1^D IC(355.12, ,"X","CONT RACT SERVI CES","C") | |
| 1660 | "RTN","IBC NEDE4",31, 0) | |
| 1661 | S IBTQSTA T=$$FIND1^ DIC(365.14 ,,"X","Rea dy to Tran smit","B") | |
| 1662 | "RTN","IBC NEDE4",32, 0) | |
| 1663 | ; | |
| 1664 | "RTN","IBC NEDE4",33, 0) | |
| 1665 | ; see if the EICD P AYER site parameter has been p opulated | |
| 1666 | "RTN","IBC NEDE4",34, 0) | |
| 1667 | ; and is nationally and local ly active, if not, q uietly qui t | |
| 1668 | "RTN","IBC NEDE4",35, 0) | |
| 1669 | S IBEICDP AY=+$$GET1 ^DIQ(350.9 ,"1,",51.3 1,"I") ; " EICD PAYER " | |
| 1670 | "RTN","IBC NEDE4",36, 0) | |
| 1671 | I 'IBEICD PAY G ENQQ | |
| 1672 | "RTN","IBC NEDE4",37, 0) | |
| 1673 | I '($$GET 1^DIQ(365. 121,"1,"_I BEICDPAY_" ,",.02,"I" )) G ENQQ ; "NATIONA L ACTIVE" | |
| 1674 | "RTN","IBC NEDE4",38, 0) | |
| 1675 | I '($$GET 1^DIQ(365. 121,"1,"_I BEICDPAY_" ,",.03,"I" )) G ENQQ ; "LOCAL A CTIVE" | |
| 1676 | "RTN","IBC NEDE4",39, 0) | |
| 1677 | ; | |
| 1678 | "RTN","IBC NEDE4",40, 0) | |
| 1679 | ; gather the non-ac tive insur ance compa ny names | |
| 1680 | "RTN","IBC NEDE4",41, 0) | |
| 1681 | ; we will strip all blanks fr om the nam es, so das hes ('-') are treate d properly for a com pare | |
| 1682 | "RTN","IBC NEDE4",42, 0) | |
| 1683 | F IBIDX=2 :1 S IBWK1 =$P($T(NAI NSCO+IBIDX ),";;",2) Q:IBWK1="" S IBINSN M($TR(IBWK 1," ","")) ="" | |
| 1684 | "RTN","IBC NEDE4",43, 0) | |
| 1685 | ; | |
| 1686 | "RTN","IBC NEDE4",44, 0) | |
| 1687 | ; gather the non-ac tive type of plan ie ns | |
| 1688 | "RTN","IBC NEDE4",45, 0) | |
| 1689 | F IBIDX=2 :1 S IBWK1 =$P($T(NAT PLANS+IBID X),";;",2) Q:IBWK1=" " D | |
| 1690 | "RTN","IBC NEDE4",46, 0) | |
| 1691 | . S IBWK2 =+$$FIND1^ DIC(355.1, ,"BQX",IBW K1) | |
| 1692 | "RTN","IBC NEDE4",47, 0) | |
| 1693 | . Q:'IBWK 2 | |
| 1694 | "RTN","IBC NEDE4",48, 0) | |
| 1695 | . S IBTOP IEN(IBWK2) ="" | |
| 1696 | "RTN","IBC NEDE4",49, 0) | |
| 1697 | ; | |
| 1698 | "RTN","IBC NEDE4",50, 0) | |
| 1699 | S IBTASKT OT=0 ; Tas kman check | |
| 1700 | "RTN","IBC NEDE4",51, 0) | |
| 1701 | S IBTQCNT =0 ; TQ en try count | |
| 1702 | "RTN","IBC NEDE4",52, 0) | |
| 1703 | K ^TMP($J ,"SDAMA301 "),^TMP($J ,"IBCNEDE4 "),IBDFNDO NE | |
| 1704 | "RTN","IBC NEDE4",53, 0) | |
| 1705 | ; | |
| 1706 | "RTN","IBC NEDE4",54, 0) | |
| 1707 | ; Loop th rough clin ics | |
| 1708 | "RTN","IBC NEDE4",55, 0) | |
| 1709 | S CLNC=0 F S CLNC= $O(^SC(CLN C)) Q:'CLN C D | |
| 1710 | "RTN","IBC NEDE4",56, 0) | |
| 1711 | . D CLINI CEX^IBCNED E2 Q:'OK ; clinic e xcluded | |
| 1712 | "RTN","IBC NEDE4",57, 0) | |
| 1713 | . S ^TMP( $J,"IBCNED E4",CLNC)= "" | |
| 1714 | "RTN","IBC NEDE4",58, 0) | |
| 1715 | ; | |
| 1716 | "RTN","IBC NEDE4",59, 0) | |
| 1717 | ; Set up variables for schedu ling api a nd call | |
| 1718 | "RTN","IBC NEDE4",60, 0) | |
| 1719 | S IBSDA(" FLDS")=8 | |
| 1720 | "RTN","IBC NEDE4",61, 0) | |
| 1721 | S IBSDA(1 )=IBBEGDT_ ";"_IBENDD T | |
| 1722 | "RTN","IBC NEDE4",62, 0) | |
| 1723 | S IBSDA(2 )="^TMP($J ,""IBCNEDE 4""," | |
| 1724 | "RTN","IBC NEDE4",63, 0) | |
| 1725 | S IBSDA(3 )="R" | |
| 1726 | "RTN","IBC NEDE4",64, 0) | |
| 1727 | S OK=$$SD API^SDAMA3 01(.IBSDA) I OK<1 D: OK<0 ERRMS G G ENQQ | |
| 1728 | "RTN","IBC NEDE4",65, 0) | |
| 1729 | ; | |
| 1730 | "RTN","IBC NEDE4",66, 0) | |
| 1731 | ; loop th rough retu rned clini cs | |
| 1732 | "RTN","IBC NEDE4",67, 0) | |
| 1733 | S CLNC=0 | |
| 1734 | "RTN","IBC NEDE4",68, 0) | |
| 1735 | F S CLNC =$O(^TMP($ J,"SDAMA30 1",CLNC)) Q:'CLNC D G ENQQ:$ G(ZTSTOP)! (IBTQCNT'< MAXCNT) | |
| 1736 | "RTN","IBC NEDE4",69, 0) | |
| 1737 | . ; | |
| 1738 | "RTN","IBC NEDE4",70, 0) | |
| 1739 | . ; Loop through pa tients ret urned | |
| 1740 | "RTN","IBC NEDE4",71, 0) | |
| 1741 | . S DFN=0 | |
| 1742 | "RTN","IBC NEDE4",72, 0) | |
| 1743 | . F S DF N=$O(^TMP( $J,"SDAMA3 01",CLNC,D FN)) Q:'DF N D Q:$G (ZTSTOP)!( IBTQCNT'<M AXCNT) | |
| 1744 | "RTN","IBC NEDE4",73, 0) | |
| 1745 | .. ; | |
| 1746 | "RTN","IBC NEDE4",74, 0) | |
| 1747 | .. ; CHEC K DFN STUF F | |
| 1748 | "RTN","IBC NEDE4",75, 0) | |
| 1749 | .. Q:$D(I BDFNDONE(D FN)) ; DF N has been handled | |
| 1750 | "RTN","IBC NEDE4",76, 0) | |
| 1751 | .. ; | |
| 1752 | "RTN","IBC NEDE4",77, 0) | |
| 1753 | .. S OK=1 | |
| 1754 | "RTN","IBC NEDE4",78, 0) | |
| 1755 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",.6,"I" ) ; "TEST PATIENT IN DICATOR" | |
| 1756 | "RTN","IBC NEDE4",79, 0) | |
| 1757 | .. S:IBWK 1 OK=0 | |
| 1758 | "RTN","IBC NEDE4",80, 0) | |
| 1759 | .. ; | |
| 1760 | "RTN","IBC NEDE4",81, 0) | |
| 1761 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",2001," I") ; "DAT E LAST EIC D RUN" fro m PATIENT INS node | |
| 1762 | "RTN","IBC NEDE4",82, 0) | |
| 1763 | .. I IBWK 1,(IBWK1>F RESHDT) S OK=0 | |
| 1764 | "RTN","IBC NEDE4",83, 0) | |
| 1765 | .. ; | |
| 1766 | "RTN","IBC NEDE4",84, 0) | |
| 1767 | .. S IBWK 1=+$$GET1^ DIQ(2,DFN_ ",",.351," I") ; "DAT E OF DEATH " | |
| 1768 | "RTN","IBC NEDE4",85, 0) | |
| 1769 | .. S:IBWK 1 OK=0 | |
| 1770 | "RTN","IBC NEDE4",86, 0) | |
| 1771 | .. ; | |
| 1772 | "RTN","IBC NEDE4",87, 0) | |
| 1773 | .. ; any value for CITY is va lid, HL7 w ill replac e a "" wit h "UNKNOWN " | |
| 1774 | "RTN","IBC NEDE4",88, 0) | |
| 1775 | .. S IBWK 1=$$GET1^D IQ(2,DFN_" ,",.115) ; "STATE" | |
| 1776 | "RTN","IBC NEDE4",89, 0) | |
| 1777 | .. S:IBWK 1="" OK=0 | |
| 1778 | "RTN","IBC NEDE4",90, 0) | |
| 1779 | .. S IBWK 1=$$GET1^D IQ(2,DFN_" ,",.116) ; "ZIP CODE " | |
| 1780 | "RTN","IBC NEDE4",91, 0) | |
| 1781 | .. S:IBWK 1="" OK=0 | |
| 1782 | "RTN","IBC NEDE4",92, 0) | |
| 1783 | .. ; | |
| 1784 | "RTN","IBC NEDE4",93, 0) | |
| 1785 | .. I 'OK S IBDFNDON E(DFN)="" Q ; patie nt require ments not met | |
| 1786 | "RTN","IBC NEDE4",94, 0) | |
| 1787 | .. ; | |
| 1788 | "RTN","IBC NEDE4",95, 0) | |
| 1789 | .. ; Loop through d ates in ra nge at cli nic | |
| 1790 | "RTN","IBC NEDE4",96, 0) | |
| 1791 | .. S IBAP PTDT=IBBEG DT | |
| 1792 | "RTN","IBC NEDE4",97, 0) | |
| 1793 | .. F S I BAPPTDT=$O (^TMP($J," SDAMA301", CLNC,DFN,I BAPPTDT)) Q:('IBAPPT DT)!((IBAP PTDT\1)>IB ENDDT) D Q:$G(ZTST OP)!(IBTQC NT'<MAXCNT ) | |
| 1794 | "RTN","IBC NEDE4",98, 0) | |
| 1795 | ... ; | |
| 1796 | "RTN","IBC NEDE4",99, 0) | |
| 1797 | ... ; Upd ate count for period ic check | |
| 1798 | "RTN","IBC NEDE4",100 ,0) | |
| 1799 | ... S IBT ASKTOT=IBT ASKTOT+1 | |
| 1800 | "RTN","IBC NEDE4",101 ,0) | |
| 1801 | ... ; Che ck for req uest to st op backgro und job, p eriodicall y | |
| 1802 | "RTN","IBC NEDE4",102 ,0) | |
| 1803 | ... I $D( ZTQUEUED), IBTASKTOT# 100=0,$$S^ %ZTLOAD() S ZTSTOP=1 Q | |
| 1804 | "RTN","IBC NEDE4",103 ,0) | |
| 1805 | ... ; | |
| 1806 | "RTN","IBC NEDE4",104 ,0) | |
| 1807 | ... Q:$D( IBDFNDONE( DFN)) ; w e've alrea dy seen th is DFN | |
| 1808 | "RTN","IBC NEDE4",105 ,0) | |
| 1809 | ... ; | |
| 1810 | "RTN","IBC NEDE4",106 ,0) | |
| 1811 | ... S IBW K1=$G(^TMP ($J,"SDAMA 301",CLNC, DFN,IBAPPT DT)) | |
| 1812 | "RTN","IBC NEDE4",107 ,0) | |
| 1813 | ... S ELG =$P(IBWK1, U,8) | |
| 1814 | "RTN","IBC NEDE4",108 ,0) | |
| 1815 | ... S:ELG ="" ELG=$$ GET1^DIQ(2 ,DFN_",",. 361) ; "PR IMARY ELIG IBILITY CO DE" | |
| 1816 | "RTN","IBC NEDE4",109 ,0) | |
| 1817 | ... D ELG ^IBCNEDE2 Q:'OK ; e ligibility exclusion | |
| 1818 | "RTN","IBC NEDE4",110 ,0) | |
| 1819 | ... ; | |
| 1820 | "RTN","IBC NEDE4",111 ,0) | |
| 1821 | ... ; ski p any pati ent with " active" in surance | |
| 1822 | "RTN","IBC NEDE4",112 ,0) | |
| 1823 | ... S IBA CTV=0 | |
| 1824 | "RTN","IBC NEDE4",113 ,0) | |
| 1825 | ... S IBI DX=0 ; che ck policie s for "act ive" insur ance | |
| 1826 | "RTN","IBC NEDE4",114 ,0) | |
| 1827 | ... F S IBIDX=$O(^ DPT(DFN,.3 12,IBIDX)) Q:('IBIDX )!IBACTV D | |
| 1828 | "RTN","IBC NEDE4",115 ,0) | |
| 1829 | .... S IB WKIEN=IBID X_","_DFN_ "," | |
| 1830 | "RTN","IBC NEDE4",116 ,0) | |
| 1831 | .... S IB EFF=+$$GET 1^DIQ(2.31 2,IBWKIEN, 8,"I") ; e ffective d ate | |
| 1832 | "RTN","IBC NEDE4",117 ,0) | |
| 1833 | .... S IB EXP=+$$GET 1^DIQ(2.31 2,IBWKIEN, 3,"I") ; e xpiration date | |
| 1834 | "RTN","IBC NEDE4",118 ,0) | |
| 1835 | .... I 'I BEFF Q ; non-active | |
| 1836 | "RTN","IBC NEDE4",119 ,0) | |
| 1837 | .... I IB EXP,(IBEXP <(IBAPPTDT \1)) Q ; non-active | |
| 1838 | "RTN","IBC NEDE4",120 ,0) | |
| 1839 | .... ; | |
| 1840 | "RTN","IBC NEDE4",121 ,0) | |
| 1841 | .... S IB WK1=$$GET1 ^DIQ(2.312 ,IBWKIEN,. 01,"E") ; insurance company na me | |
| 1842 | "RTN","IBC NEDE4",122 ,0) | |
| 1843 | .... Q:$D (IBINSNM($ TR(IBWK1," ",""))) ; matches non-active insurance | |
| 1844 | "RTN","IBC NEDE4",123 ,0) | |
| 1845 | .... S IB WK1=$$GET1 ^DIQ(2.312 ,IBWKIEN,. 18,"I") ; group pl an ien | |
| 1846 | "RTN","IBC NEDE4",124 ,0) | |
| 1847 | .... S IB WK2=$$GET1 ^DIQ(355.3 ,IBWK1_"," ,.09,"I") ; type of plan ien | |
| 1848 | "RTN","IBC NEDE4",125 ,0) | |
| 1849 | .... ; no type of p lan is con sidered ac tive | |
| 1850 | "RTN","IBC NEDE4",126 ,0) | |
| 1851 | .... I IB WK2'="",$D (IBTOPIEN( IBWK2)) Q ; matches non-activ e type of plan | |
| 1852 | "RTN","IBC NEDE4",127 ,0) | |
| 1853 | .... ; | |
| 1854 | "RTN","IBC NEDE4",128 ,0) | |
| 1855 | .... ; 'I BEXP is co nsidered a ctive at t his point | |
| 1856 | "RTN","IBC NEDE4",129 ,0) | |
| 1857 | .... S IB ACTV=1 Q ; active | |
| 1858 | "RTN","IBC NEDE4",130 ,0) | |
| 1859 | ... ; | |
| 1860 | "RTN","IBC NEDE4",131 ,0) | |
| 1861 | ... I IBA CTV Q ; n ext clinic appt | |
| 1862 | "RTN","IBC NEDE4",132 ,0) | |
| 1863 | ... ; | |
| 1864 | "RTN","IBC NEDE4",133 ,0) | |
| 1865 | ... ; Thi s DFN is c onsidered non-active , we'll at tempt a TQ entry | |
| 1866 | "RTN","IBC NEDE4",134 ,0) | |
| 1867 | ... S IBD FNDONE(DFN )="" ; ok to flag D FN as hand led now | |
| 1868 | "RTN","IBC NEDE4",135 ,0) | |
| 1869 | ... ; the re should be no TQ e ntry for t his DFN, c onsider it a safety check | |
| 1870 | "RTN","IBC NEDE4",136 ,0) | |
| 1871 | ... I '$$ ADDTQ^IBCN EUT5(DFN,I BEICDPAY,D T,IBFREQ,1 ) Q | |
| 1872 | "RTN","IBC NEDE4",137 ,0) | |
| 1873 | ... ; SET prepare a nd file th e TQ | |
| 1874 | "RTN","IBC NEDE4",138 ,0) | |
| 1875 | ... ; DFN :Patient I EN | |
| 1876 | "RTN","IBC NEDE4",139 ,0) | |
| 1877 | ... ; IBE ICDPAY:EIC D payer IE N | |
| 1878 | "RTN","IBC NEDE4",140 ,0) | |
| 1879 | ... ; IBT QSTAT:TQ S TATUS IEN - Ready to Transmit | |
| 1880 | "RTN","IBC NEDE4",141 ,0) | |
| 1881 | ... ; FRE SHDT:Fresh ness date | |
| 1882 | "RTN","IBC NEDE4",142 ,0) | |
| 1883 | ... ; 4:E ICD data e xtract (#4 ) | |
| 1884 | "RTN","IBC NEDE4",143 ,0) | |
| 1885 | ... ; I:I dentificat ion | |
| 1886 | "RTN","IBC NEDE4",144 ,0) | |
| 1887 | ... ; DT: Todays dat e | |
| 1888 | "RTN","IBC NEDE4",145 ,0) | |
| 1889 | ... ; IBC SIEN:Sourc e of Infor mation IEN - Contrac t Services | |
| 1890 | "RTN","IBC NEDE4",146 ,0) | |
| 1891 | ... S DAT A1=DFN_U_I BEICDPAY_U _IBTQSTAT_ U_""_U_""_ U_FRESHDT | |
| 1892 | "RTN","IBC NEDE4",147 ,0) | |
| 1893 | ... S DAT A2=4_U_"I" _U_DT | |
| 1894 | "RTN","IBC NEDE4",148 ,0) | |
| 1895 | ... S DAT A5=IBCSIEN | |
| 1896 | "RTN","IBC NEDE4",149 ,0) | |
| 1897 | ... S IBT QIEN=$$SET TQ^IBCNEDE 7(DATA1,DA TA2,,,DATA 5) ; Sets in TQ | |
| 1898 | "RTN","IBC NEDE4",150 ,0) | |
| 1899 | ... I IBT QIEN="" K IBDFNDONE( DFN) Q ; didn't fi le, unmark DFN | |
| 1900 | "RTN","IBC NEDE4",151 ,0) | |
| 1901 | ... S IBT QCNT=IBTQC NT+1 ; increment the TQ co unt | |
| 1902 | "RTN","IBC NEDE4",152 ,0) | |
| 1903 | ... ; pla ce a stub into EIV E ICD TRACKI NG (#365.1 8) | |
| 1904 | "RTN","IBC NEDE4",153 ,0) | |
| 1905 | ... K IBF DA,IBERR | |
| 1906 | "RTN","IBC NEDE4",154 ,0) | |
| 1907 | ... ; EIV EICD TRAC KING, .01: TRANSMISSI ON .02:DAT E CREATED .03:PAYER .05:PATIEN T | |
| 1908 | "RTN","IBC NEDE4",155 ,0) | |
| 1909 | ... S IBF DA(365.18, "+1,",.01) =IBTQIEN,I BFDA(365.1 8,"+1,",.0 2)=DT | |
| 1910 | "RTN","IBC NEDE4",156 ,0) | |
| 1911 | ... S IBF DA(365.18, "+1,",.03) =IBEICDPAY ,IBFDA(365 .18,"+1,", .05)=DFN | |
| 1912 | "RTN","IBC NEDE4",157 ,0) | |
| 1913 | ... D UPD ATE^DIE(," IBFDA",,"I BERR") | |
| 1914 | "RTN","IBC NEDE4",158 ,0) | |
| 1915 | ... I $G( IBERR("DIE RR",1,"TEX T",1))'="" D Q | |
| 1916 | "RTN","IBC NEDE4",159 ,0) | |
| 1917 | .... S IB MSG="" | |
| 1918 | "RTN","IBC NEDE4",160 ,0) | |
| 1919 | .... D MS G002^IBCNE MS1(.IBMSG ,.IBERR,IB TQIEN) | |
| 1920 | "RTN","IBC NEDE4",161 ,0) | |
| 1921 | .... D MS G^IBCNEUT5 ($$MGRP^IB CNEUT5()," eIV Proble m: Error w riting EIV EICD TRAC KING (#365 .18)","IBM SG(") | |
| 1922 | "RTN","IBC NEDE4",162 ,0) | |
| 1923 | ... Q ; next clini c appt | |
| 1924 | "RTN","IBC NEDE4",163 ,0) | |
| 1925 | ... ; | |
| 1926 | "RTN","IBC NEDE4",164 ,0) | |
| 1927 | ENQQ ; cle an and qui t | |
| 1928 | "RTN","IBC NEDE4",165 ,0) | |
| 1929 | K ^TMP($J ,"SDAMA301 "),^TMP($J ,"IBCNEDE2 ") | |
| 1930 | "RTN","IBC NEDE4",166 ,0) | |
| 1931 | Q | |
| 1932 | "RTN","IBC NEDE4",167 ,0) | |
| 1933 | ; | |
| 1934 | "RTN","IBC NEDE4",168 ,0) | |
| 1935 | ERRMSG ; S end a mess age indica ting an ex tract erro r has occu rred | |
| 1936 | "RTN","IBC NEDE4",169 ,0) | |
| 1937 | S IBMSG=" " | |
| 1938 | "RTN","IBC NEDE4",170 ,0) | |
| 1939 | D MSG001^ IBCNEMS1(. IBMSG,"EIC D") | |
| 1940 | "RTN","IBC NEDE4",171 ,0) | |
| 1941 | D MSG^IBC NEUT5($$MG RP^IBCNEUT 5(),"eIV P roblem: EI CD Extract ","IBMSG(" ) | |
| 1942 | "RTN","IBC NEDE4",172 ,0) | |
| 1943 | ; | |
| 1944 | "RTN","IBC NEDE4",173 ,0) | |
| 1945 | Q | |
| 1946 | "RTN","IBC NEDE4",174 ,0) | |
| 1947 | ; | |
| 1948 | "RTN","IBC NEDE4",175 ,0) | |
| 1949 | NAINSCO ; Non-active Insurance companies | |
| 1950 | "RTN","IBC NEDE4",176 ,0) | |
| 1951 | ; | |
| 1952 | "RTN","IBC NEDE4",177 ,0) | |
| 1953 | ;;MEDICAR E (WNR) | |
| 1954 | "RTN","IBC NEDE4",178 ,0) | |
| 1955 | ;;VACAA-W NR | |
| 1956 | "RTN","IBC NEDE4",179 ,0) | |
| 1957 | ;;CAMP LE JEUNE - WN R | |
| 1958 | "RTN","IBC NEDE4",180 ,0) | |
| 1959 | ;;IVF - W NR | |
| 1960 | "RTN","IBC NEDE4",181 ,0) | |
| 1961 | ;;VHA DIR ECTIVE 102 9 WNR | |
| 1962 | "RTN","IBC NEDE4",182 ,0) | |
| 1963 | ; | |
| 1964 | "RTN","IBC NEDE4",183 ,0) | |
| 1965 | NATPLANS ; Non-activ e Type of Plans | |
| 1966 | "RTN","IBC NEDE4",184 ,0) | |
| 1967 | ; | |
| 1968 | "RTN","IBC NEDE4",185 ,0) | |
| 1969 | ;;ACCIDEN T AND HEAL TH INSURAN CE | |
| 1970 | "RTN","IBC NEDE4",186 ,0) | |
| 1971 | ;;AUTOMOB ILE | |
| 1972 | "RTN","IBC NEDE4",187 ,0) | |
| 1973 | ;;AVIATIO N TRIP INS URANCE | |
| 1974 | "RTN","IBC NEDE4",188 ,0) | |
| 1975 | ;;CATASTR OPHIC INSU RANCE | |
| 1976 | "RTN","IBC NEDE4",189 ,0) | |
| 1977 | ;;CHAMPVA | |
| 1978 | "RTN","IBC NEDE4",190 ,0) | |
| 1979 | ;;COINSUR ANCE | |
| 1980 | "RTN","IBC NEDE4",191 ,0) | |
| 1981 | ;;DENTAL INSURANCE | |
| 1982 | "RTN","IBC NEDE4",192 ,0) | |
| 1983 | ;;DUAL CO VERAGE | |
| 1984 | "RTN","IBC NEDE4",193 ,0) | |
| 1985 | ;;INCOME PROTECTION (INDEMNIT Y) | |
| 1986 | "RTN","IBC NEDE4",194 ,0) | |
| 1987 | ;;KEY-MAN HEALTH IN SURANCE | |
| 1988 | "RTN","IBC NEDE4",195 ,0) | |
| 1989 | ;;LABS, P ROCEDURES, X-RAY, ET C. (ONLY) | |
| 1990 | "RTN","IBC NEDE4",196 ,0) | |
| 1991 | ;;MEDI-CA L | |
| 1992 | "RTN","IBC NEDE4",197 ,0) | |
| 1993 | ;;MEDICAI D | |
| 1994 | "RTN","IBC NEDE4",198 ,0) | |
| 1995 | ;;MEDICAR E (M) | |
| 1996 | "RTN","IBC NEDE4",199 ,0) | |
| 1997 | ;;MEDICAR E/MEDICAID (MEDI-CAL ) | |
| 1998 | "RTN","IBC NEDE4",200 ,0) | |
| 1999 | ;;MENTAL HEALTH | |
| 2000 | "RTN","IBC NEDE4",201 ,0) | |
| 2001 | ;;NO-FAUL T INSURANC E | |
| 2002 | "RTN","IBC NEDE4",202 ,0) | |
| 2003 | ;;PRESCRI PTION | |
| 2004 | "RTN","IBC NEDE4",203 ,0) | |
| 2005 | ;;QUALIFI ED IMPAIRM ENT INSURA NCE | |
| 2006 | "RTN","IBC NEDE4",204 ,0) | |
| 2007 | ;;SPECIAL CLASS INS URANCE | |
| 2008 | "RTN","IBC NEDE4",205 ,0) | |
| 2009 | ;;SPECIAL RISK INSU RANCE | |
| 2010 | "RTN","IBC NEDE4",206 ,0) | |
| 2011 | ;;SPECIFI ED DISEASE INSURANCE | |
| 2012 | "RTN","IBC NEDE4",207 ,0) | |
| 2013 | ;;Substan ce abuse o nly | |
| 2014 | "RTN","IBC NEDE4",208 ,0) | |
| 2015 | ;;TORT FE ASOR | |
| 2016 | "RTN","IBC NEDE4",209 ,0) | |
| 2017 | ;;TRICARE | |
| 2018 | "RTN","IBC NEDE4",210 ,0) | |
| 2019 | ;;TRICARE SUPPLEMEN TAL | |
| 2020 | "RTN","IBC NEDE4",211 ,0) | |
| 2021 | ;;VA SPEC IAL CLASS | |
| 2022 | "RTN","IBC NEDE4",212 ,0) | |
| 2023 | ;;VISION | |
| 2024 | "RTN","IBC NEDE4",213 ,0) | |
| 2025 | ;;WORKERS ' COMPENSA TION INSUR ANCE | |
| 2026 | "RTN","IBC NEDE4",214 ,0) | |
| 2027 | ; | |
| 2028 | "RTN","IBC NEDE4",215 ,0) | |
| 2029 | Q | |
| 2030 | "RTN","IBC NEDE4",216 ,0) | |
| 2031 | ; | |
| 2032 | "RTN","IBC NEDE5") | |
| 2033 | 0^3^B14392 775^B29541 392 | |
| 2034 | "RTN","IBC NEDE5",1,0 ) | |
| 2035 | IBCNEDE5 ; DAOU/DAC - eIV DATA EXTRACTS ; 15-OCT-200 2 | |
| 2036 | "RTN","IBC NEDE5",2,0 ) | |
| 2037 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 497,549,62 1**;21-MAR -94;Build 8 | |
| 2038 | "RTN","IBC NEDE5",3,0 ) | |
| 2039 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 2040 | "RTN","IBC NEDE5",4,0 ) | |
| 2041 | ; | |
| 2042 | "RTN","IBC NEDE5",5,0 ) | |
| 2043 | Q ; no direct ca lls allowe d | |
| 2044 | "RTN","IBC NEDE5",6,0 ) | |
| 2045 | ; IB*2.0* 621 - Remo ved tag "S IDCHK2" | |
| 2046 | "RTN","IBC NEDE5",7,0 ) | |
| 2047 | ; | |
| 2048 | "RTN","IBC NEDE5",8,0 ) | |
| 2049 | SIDCHK(PIE N,DFN,BSID ,SIDARRAY, FRESHDT) ; Checks th e flag set ting of | |
| 2050 | "RTN","IBC NEDE5",9,0 ) | |
| 2051 | ; 'Identi fication R equires Su bscriber I D'. The fu nction ret urns a "^" | |
| 2052 | "RTN","IBC NEDE5",10, 0) | |
| 2053 | ; delimit ed string. The firs t value is between 1 and 5 tel ling the | |
| 2054 | "RTN","IBC NEDE5",11, 0) | |
| 2055 | ; calling program w hat action (s) it sho uld perfor m. The 2nd piece | |
| 2056 | "RTN","IBC NEDE5",12, 0) | |
| 2057 | ; indicat es the Sub criber ID that the c alling pro gram shoul d use for | |
| 2058 | "RTN","IBC NEDE5",13, 0) | |
| 2059 | ; setting the Subsc riber IDs in the eIV Transmiss ion Queue file (365. 1). | |
| 2060 | "RTN","IBC NEDE5",14, 0) | |
| 2061 | ; The cal ling progr am is to a ddress the blank Sub IDs. | |
| 2062 | "RTN","IBC NEDE5",15, 0) | |
| 2063 | ; | |
| 2064 | "RTN","IBC NEDE5",16, 0) | |
| 2065 | ; PIEN - Payer's IE N (file 36 5.12) | |
| 2066 | "RTN","IBC NEDE5",17, 0) | |
| 2067 | ; DFN - P atient's I EN (file 2 ) | |
| 2068 | "RTN","IBC NEDE5",18, 0) | |
| 2069 | ; INREC - Insurance IEN of Pa tients rec ord (subfi le 2.312) | |
| 2070 | "RTN","IBC NEDE5",19, 0) | |
| 2071 | ; BSID - Subscriber ID from b uffer file (file 355 .33 field 60.04) | |
| 2072 | "RTN","IBC NEDE5",20, 0) | |
| 2073 | ; SIDARRA Y - Array of active subscriber s | |
| 2074 | "RTN","IBC NEDE5",21, 0) | |
| 2075 | ; FRESHDT - Freshne ss Date - used for c hecking ve rified dat e | |
| 2076 | "RTN","IBC NEDE5",22, 0) | |
| 2077 | ; | |
| 2078 | "RTN","IBC NEDE5",23, 0) | |
| 2079 | ; Logic t o follow: | |
| 2080 | "RTN","IBC NEDE5",24, 0) | |
| 2081 | ; | |
| 2082 | "RTN","IBC NEDE5",25, 0) | |
| 2083 | ; Id. Req .| Sub ID| Action| | |
| 2084 | "RTN","IBC NEDE5",26, 0) | |
| 2085 | ; Sub ID | found | # | Cr eate | |
| 2086 | "RTN","IBC NEDE5",27, 0) | |
| 2087 | ; _______ _|_______| ______|___ _____ | |
| 2088 | "RTN","IBC NEDE5",28, 0) | |
| 2089 | ; YES YES 1 1 Verificati on TQ entr y w/ Sub I D | |
| 2090 | "RTN","IBC NEDE5",29, 0) | |
| 2091 | ; YES NO 3 ne w buffer e ntry or mo dify exist ing saying manual ve rification required | |
| 2092 | "RTN","IBC NEDE5",30, 0) | |
| 2093 | ; NO NO 4 1 Ver. TQ en try w/ bla nk Sub ID | |
| 2094 | "RTN","IBC NEDE5",31, 0) | |
| 2095 | ; | |
| 2096 | "RTN","IBC NEDE5",32, 0) | |
| 2097 | ; * Note: The insur ance recor d found wi th the pro per PIEN w ill only b e | |
| 2098 | "RTN","IBC NEDE5",33, 0) | |
| 2099 | ; picked up if the in surance po licy is ac tive, and if the ins urance | |
| 2100 | "RTN","IBC NEDE5",34, 0) | |
| 2101 | ; policy ha sn't been verified w ithin the Freshness period. | |
| 2102 | "RTN","IBC NEDE5",35, 0) | |
| 2103 | ; | |
| 2104 | "RTN","IBC NEDE5",36, 0) | |
| 2105 | N SIDACT, SID,APPIEN ,SIDSTR,SI DREQ | |
| 2106 | "RTN","IBC NEDE5",37, 0) | |
| 2107 | N INSSTR, INSSTR1,IN SSTR7,SYMB OL,EXP,SUB ID,SUBIDS, SIDCNT,INR EC,MVER,VF LG,MCRTQ | |
| 2108 | "RTN","IBC NEDE5",38, 0) | |
| 2109 | ; | |
| 2110 | "RTN","IBC NEDE5",39, 0) | |
| 2111 | S FRESHDT =$G(FRESHD T),VFLG=0 | |
| 2112 | "RTN","IBC NEDE5",40, 0) | |
| 2113 | ; | |
| 2114 | "RTN","IBC NEDE5",41, 0) | |
| 2115 | ; if the subscriber ID from t he buffer extract ex ists, this is the on ly entry | |
| 2116 | "RTN","IBC NEDE5",42, 0) | |
| 2117 | I $G(BSID )'="" D G SIDCHKX | |
| 2118 | "RTN","IBC NEDE5",43, 0) | |
| 2119 | . S SID=B SID,(SIDAC T,SIDCNT)= 1 | |
| 2120 | "RTN","IBC NEDE5",44, 0) | |
| 2121 | . S SIDAR RAY($$STRI P(SID,,DFN )_"_")="" | |
| 2122 | "RTN","IBC NEDE5",45, 0) | |
| 2123 | . Q | |
| 2124 | "RTN","IBC NEDE5",46, 0) | |
| 2125 | ; | |
| 2126 | "RTN","IBC NEDE5",47, 0) | |
| 2127 | S APPIEN= $$PYRAPP^I BCNEUT5("I IV",PIEN) | |
| 2128 | "RTN","IBC NEDE5",48, 0) | |
| 2129 | S SIDSTR= $G(^IBE(36 5.12,PIEN, 1,APPIEN,0 )) | |
| 2130 | "RTN","IBC NEDE5",49, 0) | |
| 2131 | S SIDREQ= $P(SIDSTR, U,8) | |
| 2132 | "RTN","IBC NEDE5",50, 0) | |
| 2133 | ; | |
| 2134 | "RTN","IBC NEDE5",51, 0) | |
| 2135 | S INSSTR= "",SIDCNT= 0,INREC=$O (^DPT(DFN, .312,0)),M CRTQ=0 S:' INREC INRE C=1 | |
| 2136 | "RTN","IBC NEDE5",52, 0) | |
| 2137 | ; | |
| 2138 | "RTN","IBC NEDE5",53, 0) | |
| 2139 | I $D(BSID ),BSID="" G SIDC1 | |
| 2140 | "RTN","IBC NEDE5",54, 0) | |
| 2141 | ; | |
| 2142 | "RTN","IBC NEDE5",55, 0) | |
| 2143 | I $G(^DPT (DFN,.312, INREC,0)) F D Q:'I NREC | |
| 2144 | "RTN","IBC NEDE5",56, 0) | |
| 2145 | . S INSST R=$G(^DPT( DFN,.312,I NREC,0)) | |
| 2146 | "RTN","IBC NEDE5",57, 0) | |
| 2147 | . S INSST R1=$G(^DPT (DFN,.312, INREC,1)) | |
| 2148 | "RTN","IBC NEDE5",58, 0) | |
| 2149 | . S INSST R7=$G(^DPT (DFN,.312, INREC,7)) ; IB*2. 0*497 (vd) | |
| 2150 | "RTN","IBC NEDE5",59, 0) | |
| 2151 | . S SYMBO L=$$INSERR OR^IBCNEUT 3("I",+INS STR) | |
| 2152 | "RTN","IBC NEDE5",60, 0) | |
| 2153 | . I $P(SY MBOL,U)="" D ; no e IV related error w/ ins. compa ny | |
| 2154 | "RTN","IBC NEDE5",61, 0) | |
| 2155 | .. N MCRP YR | |
| 2156 | "RTN","IBC NEDE5",62, 0) | |
| 2157 | .. I PIEN '=$P(SYMBO L,U,2) Q ; wron g payer ie n | |
| 2158 | "RTN","IBC NEDE5",63, 0) | |
| 2159 | .. ; | |
| 2160 | "RTN","IBC NEDE5",64, 0) | |
| 2161 | .. S MCRP YR=0 ; M edicare pa yer flag | |
| 2162 | "RTN","IBC NEDE5",65, 0) | |
| 2163 | .. I PIEN =+$P($G(^I BE(350.9,1 ,51)),U,25 ) S MCRPYR =1 ; t his is the Medicare payer | |
| 2164 | "RTN","IBC NEDE5",66, 0) | |
| 2165 | .. I MCRP YR,MCRTQ Q ; th e Medicare payer is already in the array | |
| 2166 | "RTN","IBC NEDE5",67, 0) | |
| 2167 | .. ; | |
| 2168 | "RTN","IBC NEDE5",68, 0) | |
| 2169 | .. S SUBI D=$P(INSST R7,U,2) ; IB*2. 0*497 (vd) | |
| 2170 | "RTN","IBC NEDE5",69, 0) | |
| 2171 | .. I SUBI D="" Q ; missi ng Subscri ber ID | |
| 2172 | "RTN","IBC NEDE5",70, 0) | |
| 2173 | .. I $P(I NSSTR,U,8) >DT Q ; futur e effectiv e date | |
| 2174 | "RTN","IBC NEDE5",71, 0) | |
| 2175 | .. S EXP= $P(INSSTR, U,4) I EXP ,EXP<DT Q ; expir ed | |
| 2176 | "RTN","IBC NEDE5",72, 0) | |
| 2177 | .. S MVER =$P(INSSTR 1,U,3) ; last verified d ate | |
| 2178 | "RTN","IBC NEDE5",73, 0) | |
| 2179 | .. I MVER '="",FRESH DT'="",MVE R>FRESHDT S VFLG=1 Q ; ver ified rece ntly | |
| 2180 | "RTN","IBC NEDE5",74, 0) | |
| 2181 | .. S SUBI DS=$$STRIP (SUBID,,DF N) | |
| 2182 | "RTN","IBC NEDE5",75, 0) | |
| 2183 | .. I $D(S IDARRAY(SU BIDS_"_"_I NREC)) Q ; already in the arr ay | |
| 2184 | "RTN","IBC NEDE5",76, 0) | |
| 2185 | .. S SIDA RRAY(SUBID S_"_"_INRE C)="",SIDC NT=SIDCNT+ 1 | |
| 2186 | "RTN","IBC NEDE5",77, 0) | |
| 2187 | .. I MCRP YR S MCRTQ =1 ; f lag indica ting Medic are payer is in the array | |
| 2188 | "RTN","IBC NEDE5",78, 0) | |
| 2189 | .. Q | |
| 2190 | "RTN","IBC NEDE5",79, 0) | |
| 2191 | . ; | |
| 2192 | "RTN","IBC NEDE5",80, 0) | |
| 2193 | . S INREC =$O(^DPT(D FN,.312,IN REC)) | |
| 2194 | "RTN","IBC NEDE5",81, 0) | |
| 2195 | . Q | |
| 2196 | "RTN","IBC NEDE5",82, 0) | |
| 2197 | ; | |
| 2198 | "RTN","IBC NEDE5",83, 0) | |
| 2199 | I SIDCNT S SIDACT=1 G SIDCHKX | |
| 2200 | "RTN","IBC NEDE5",84, 0) | |
| 2201 | I 'SIDCNT ,VFLG S SI DACT=1 G S IDCHKX | |
| 2202 | "RTN","IBC NEDE5",85, 0) | |
| 2203 | SIDC1 ; | |
| 2204 | "RTN","IBC NEDE5",86, 0) | |
| 2205 | S SIDACT= $S(SIDREQ: 3,1:4) | |
| 2206 | "RTN","IBC NEDE5",87, 0) | |
| 2207 | ; | |
| 2208 | "RTN","IBC NEDE5",88, 0) | |
| 2209 | SIDCHKX ; EXIT POINT | |
| 2210 | "RTN","IBC NEDE5",89, 0) | |
| 2211 | ; | |
| 2212 | "RTN","IBC NEDE5",90, 0) | |
| 2213 | Q SIDACT_ U_SIDCNT | |
| 2214 | "RTN","IBC NEDE5",91, 0) | |
| 2215 | ; | |
| 2216 | "RTN","IBC NEDE5",92, 0) | |
| 2217 | SSN(DFN) ; Get Patie nt SSN and update SI DARRAY, if needed | |
| 2218 | "RTN","IBC NEDE5",93, 0) | |
| 2219 | S SSN=$$G ETSSN(DFN) | |
| 2220 | "RTN","IBC NEDE5",94, 0) | |
| 2221 | N SSNS | |
| 2222 | "RTN","IBC NEDE5",95, 0) | |
| 2223 | S SSNS=$$ STRIP(SSN, 1,DFN) | |
| 2224 | "RTN","IBC NEDE5",96, 0) | |
| 2225 | I $P($O(S IDARRAY(SS NS_"_"))," _")=SSNS Q | |
| 2226 | "RTN","IBC NEDE5",97, 0) | |
| 2227 | I SSNS'=" ",'$D(SIDA RRAY(SSNS_ "_")) S SI DARRAY(SSN S_"_")="", SIDCNT=SID CNT+1 | |
| 2228 | "RTN","IBC NEDE5",98, 0) | |
| 2229 | Q | |
| 2230 | "RTN","IBC NEDE5",99, 0) | |
| 2231 | ; | |
| 2232 | "RTN","IBC NEDE5",100 ,0) | |
| 2233 | GETSSN(DFN ) ; Get Pa tient SSN | |
| 2234 | "RTN","IBC NEDE5",101 ,0) | |
| 2235 | Q:'$G(DFN ) "" | |
| 2236 | "RTN","IBC NEDE5",102 ,0) | |
| 2237 | Q $P($G(^ DPT(DFN,0) ),U,9) | |
| 2238 | "RTN","IBC NEDE5",103 ,0) | |
| 2239 | ; | |
| 2240 | "RTN","IBC NEDE5",104 ,0) | |
| 2241 | STRIP(ID,S S,DFN) ; S trip dashe s and spac es if ssn | |
| 2242 | "RTN","IBC NEDE5",105 ,0) | |
| 2243 | ; ID can be ssn or su bid | |
| 2244 | "RTN","IBC NEDE5",106 ,0) | |
| 2245 | ; if SS, ss n is being passed | |
| 2246 | "RTN","IBC NEDE5",107 ,0) | |
| 2247 | N SSN,IDS ,IDB | |
| 2248 | "RTN","IBC NEDE5",108 ,0) | |
| 2249 | S SS=$G(S S) | |
| 2250 | "RTN","IBC NEDE5",109 ,0) | |
| 2251 | ; If a ss n is passe d, strip d ashes and spaces | |
| 2252 | "RTN","IBC NEDE5",110 ,0) | |
| 2253 | I SS Q $T R(ID,"- ") | |
| 2254 | "RTN","IBC NEDE5",111 ,0) | |
| 2255 | ; If not ssn format , do not s trip | |
| 2256 | "RTN","IBC NEDE5",112 ,0) | |
| 2257 | S IDB=$TR (ID," ") | |
| 2258 | "RTN","IBC NEDE5",113 ,0) | |
| 2259 | I IDB'?3N 1"-"2N1"-" 4N,IDB'?9N Q ID | |
| 2260 | "RTN","IBC NEDE5",114 ,0) | |
| 2261 | ; Compare w/SSN - i f it match es, strip dashes and spaces | |
| 2262 | "RTN","IBC NEDE5",115 ,0) | |
| 2263 | S IDS=$TR (ID,"- ") | |
| 2264 | "RTN","IBC NEDE5",116 ,0) | |
| 2265 | S SSN=$TR ($$GETSSN( DFN),"- ") | |
| 2266 | "RTN","IBC NEDE5",117 ,0) | |
| 2267 | I SSN=IDS Q IDS | |
| 2268 | "RTN","IBC NEDE5",118 ,0) | |
| 2269 | Q ID | |
| 2270 | "RTN","IBC NEDE5",119 ,0) | |
| 2271 | ; | |
| 2272 | "RTN","IBC NEDE6") | |
| 2273 | 0^4^B72015 17^B338166 21 | |
| 2274 | "RTN","IBC NEDE6",1,0 ) | |
| 2275 | IBCNEDE6 ; DAOU/DAC - eIV DATA EXTRACTS ; 15-OCT-200 2 | |
| 2276 | "RTN","IBC NEDE6",2,0 ) | |
| 2277 | ;;2.0;INT EGRATED BI LLING;**18 4,271,345, 416,497,50 6,621**;21 -MAR-94;Bu ild 8 | |
| 2278 | "RTN","IBC NEDE6",3,0 ) | |
| 2279 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 2280 | "RTN","IBC NEDE6",4,0 ) | |
| 2281 | ; | |
| 2282 | "RTN","IBC NEDE6",5,0 ) | |
| 2283 | Q ; no direct ca lls allowe d | |
| 2284 | "RTN","IBC NEDE6",6,0 ) | |
| 2285 | ; | |
| 2286 | "RTN","IBC NEDE6",7,0 ) | |
| 2287 | ; IB*2*41 6 removed the abilit y to perfo rm Identif ication in quiries. | |
| 2288 | "RTN","IBC NEDE6",8,0 ) | |
| 2289 | ; However , this cod e is being left as i s for futu re changes . | |
| 2290 | "RTN","IBC NEDE6",9,0 ) | |
| 2291 | ; | |
| 2292 | "RTN","IBC NEDE6",10, 0) | |
| 2293 | ; IB*2*62 1 removed old code a ssociated with a pre vious extr act that | |
| 2294 | "RTN","IBC NEDE6",11, 0) | |
| 2295 | ; is now replaced w ith EICD e xtract log ic | |
| 2296 | "RTN","IBC NEDE6",12, 0) | |
| 2297 | ; | |
| 2298 | "RTN","IBC NEDE6",13, 0) | |
| 2299 | UPDDTS(PIE N,SVDT,FRD T) ; Upda te service date and freshness date per p ayer | |
| 2300 | "RTN","IBC NEDE6",14, 0) | |
| 2301 | ; date pa rameters F UTURE SERV ICE DAYS ( 365.121,.1 4) and PAS T SERVICE | |
| 2302 | "RTN","IBC NEDE6",15, 0) | |
| 2303 | ; DAYS (3 65.121,.15 ) | |
| 2304 | "RTN","IBC NEDE6",16, 0) | |
| 2305 | ; Output: | |
| 2306 | "RTN","IBC NEDE6",17, 0) | |
| 2307 | ; SVDT - passed by reference - updates service d ate | |
| 2308 | "RTN","IBC NEDE6",18, 0) | |
| 2309 | ; FRDT - passed by reference - updates freshness date - ex cept for | |
| 2310 | "RTN","IBC NEDE6",19, 0) | |
| 2311 | ; INAC wher e it is op tional | |
| 2312 | "RTN","IBC NEDE6",20, 0) | |
| 2313 | N FDAYS,P DAYS,DIFF, AIEN,DATA, OSVDT,EDTF LG | |
| 2314 | "RTN","IBC NEDE6",21, 0) | |
| 2315 | ; | |
| 2316 | "RTN","IBC NEDE6",22, 0) | |
| 2317 | ; Init va rs - save original s ervice dat e to calc diff | |
| 2318 | "RTN","IBC NEDE6",23, 0) | |
| 2319 | S (FDAYS, PDAYS,EDTF LG)=0,OSVD T=SVDT | |
| 2320 | "RTN","IBC NEDE6",24, 0) | |
| 2321 | ; Determi ne Payer A pp IEN | |
| 2322 | "RTN","IBC NEDE6",25, 0) | |
| 2323 | S AIEN=$$ PYRAPP^IBC NEUT5("IIV ",PIEN) | |
| 2324 | "RTN","IBC NEDE6",26, 0) | |
| 2325 | I AIEN="" Q ; Quit without c hanging if app is no t defined | |
| 2326 | "RTN","IBC NEDE6",27, 0) | |
| 2327 | S DATA=$G (^IBE(365. 12,PIEN,1, AIEN,0)) | |
| 2328 | "RTN","IBC NEDE6",28, 0) | |
| 2329 | I DATA="" Q ; Quit without c hanging if node is n ot defined | |
| 2330 | "RTN","IBC NEDE6",29, 0) | |
| 2331 | S FDAYS=$ P(DATA,U,1 4),PDAYS=$ P(DATA,U,1 5) | |
| 2332 | "RTN","IBC NEDE6",30, 0) | |
| 2333 | ; Process past serv ice days i f not null | |
| 2334 | "RTN","IBC NEDE6",31, 0) | |
| 2335 | I PDAYS'= "" D | |
| 2336 | "RTN","IBC NEDE6",32, 0) | |
| 2337 | . ; If ze ro and Ser vice Date is less th an today, reset to t oday | |
| 2338 | "RTN","IBC NEDE6",33, 0) | |
| 2339 | . I PDAYS =0&(SVDT<D T) S SVDT= $$DT^XLFDT ,EDTFLG=1 | |
| 2340 | "RTN","IBC NEDE6",34, 0) | |
| 2341 | . ; If no n-zero and service d ate is ear lier than the allowe d | |
| 2342 | "RTN","IBC NEDE6",35, 0) | |
| 2343 | . ; paye r service date range , reset se rvice date to earlie st allowed | |
| 2344 | "RTN","IBC NEDE6",36, 0) | |
| 2345 | . ; date for the p ayer | |
| 2346 | "RTN","IBC NEDE6",37, 0) | |
| 2347 | . I PDAYS ,(SVDT<$$F MADD^XLFDT ($$DT^XLFD T,-PDAYS)) D | |
| 2348 | "RTN","IBC NEDE6",38, 0) | |
| 2349 | . . S SVD T=$$FMADD^ XLFDT($$DT ^XLFDT,-PD AYS),EDTFL G=1 | |
| 2350 | "RTN","IBC NEDE6",39, 0) | |
| 2351 | ; Process future se rvice days if not ed ited and i f not null | |
| 2352 | "RTN","IBC NEDE6",40, 0) | |
| 2353 | I EDTFLG= 0,FDAYS'=" " D | |
| 2354 | "RTN","IBC NEDE6",41, 0) | |
| 2355 | . ; If ze ro and Ser vice Date is greater than toda y, reset t o today | |
| 2356 | "RTN","IBC NEDE6",42, 0) | |
| 2357 | . I FDAYS =0&(SVDT>D T) S SVDT= $$DT^XLFDT ,EDTFLG=1 | |
| 2358 | "RTN","IBC NEDE6",43, 0) | |
| 2359 | . ; If no n-zero and service d ate is lat er than th e allowed | |
| 2360 | "RTN","IBC NEDE6",44, 0) | |
| 2361 | . ; paye r service date range , reset se rvice date to latest allowed | |
| 2362 | "RTN","IBC NEDE6",45, 0) | |
| 2363 | . ; date for the p ayer | |
| 2364 | "RTN","IBC NEDE6",46, 0) | |
| 2365 | . I FDAYS ,(SVDT>$$F MADD^XLFDT ($$DT^XLFD T,FDAYS)) D | |
| 2366 | "RTN","IBC NEDE6",47, 0) | |
| 2367 | . . S SVD T=$$FMADD^ XLFDT($$DT ^XLFDT,FDA YS),EDTFLG =1 | |
| 2368 | "RTN","IBC NEDE6",48, 0) | |
| 2369 | ; | |
| 2370 | "RTN","IBC NEDE6",49, 0) | |
| 2371 | ; Determi ne if diff erence exi sts | |
| 2372 | "RTN","IBC NEDE6",50, 0) | |
| 2373 | I EDTFLG, $G(FRDT)'= "" S FRDT= $$FMADD^XL FDT(FRDT,$ $FMDIFF^XL FDT(SVDT,O SVDT)) | |
| 2374 | "RTN","IBC NEDE6",51, 0) | |
| 2375 | ; | |
| 2376 | "RTN","IBC NEDE6",52, 0) | |
| 2377 | Q | |
| 2378 | "RTN","IBC NEDE6",53, 0) | |
| 2379 | ; | |
| 2380 | "RTN","IBC NEDE6",54, 0) | |
| 2381 | TFL(DFN) ; Examines treating f acility li st, | |
| 2382 | "RTN","IBC NEDE6",55, 0) | |
| 2383 | ; value r eturned is 1 if pati ent has vi sited at l east one o ther site | |
| 2384 | "RTN","IBC NEDE6",56, 0) | |
| 2385 | N IBC,IBZ ,IBS | |
| 2386 | "RTN","IBC NEDE6",57, 0) | |
| 2387 | D TFL^VAF CTFU1(.IBZ ,DFN) Q:-$ G(IBZ(1))= 1 0 | |
| 2388 | "RTN","IBC NEDE6",58, 0) | |
| 2389 | S IBS=+$P ($$SITE^VA SITE,"^",3 ),(IBZ,IBC )=0 | |
| 2390 | "RTN","IBC NEDE6",59, 0) | |
| 2391 | ; Look fo r remote f acilities of type VA MC: | |
| 2392 | "RTN","IBC NEDE6",60, 0) | |
| 2393 | F S IBZ= $O(IBZ(IBZ )) Q:IBZ<1 I +IBZ(I BZ)>0,+IBZ (IBZ)'=IBS ,$P(IBZ(IB Z),U,5)="V AMC" S IBC =1 Q | |
| 2394 | "RTN","IBC NEDE6",61, 0) | |
| 2395 | Q IBC | |
| 2396 | "RTN","IBC NEDE7") | |
| 2397 | 0^5^B32586 873^B28965 288 | |
| 2398 | "RTN","IBC NEDE7",1,0 ) | |
| 2399 | IBCNEDE7 ; DAOU/DAC - eIV DATA EXTRACTS ; 04-JUN-200 2 | |
| 2400 | "RTN","IBC NEDE7",2,0 ) | |
| 2401 | ;;2.0;INT EGRATED BI LLING;**27 1,416,438, 497,601,62 1**;21-MAR -94;Build 8 | |
| 2402 | "RTN","IBC NEDE7",3,0 ) | |
| 2403 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 2404 | "RTN","IBC NEDE7",4,0 ) | |
| 2405 | ; | |
| 2406 | "RTN","IBC NEDE7",5,0 ) | |
| 2407 | Q ; no direct ca lls allowe d | |
| 2408 | "RTN","IBC NEDE7",6,0 ) | |
| 2409 | ; | |
| 2410 | "RTN","IBC NEDE7",7,0 ) | |
| 2411 | SETTINGS(E XTNUM) ; C heck site parameter settings f or the ext racts | |
| 2412 | "RTN","IBC NEDE7",8,0 ) | |
| 2413 | ; Input P arameter: | |
| 2414 | "RTN","IBC NEDE7",9,0 ) | |
| 2415 | ; | |
| 2416 | "RTN","IBC NEDE7",10, 0) | |
| 2417 | ; IB*2.0* 621/DM rei mplement e xtract (#4 ), now EIC D, formerl y No Insur ance | |
| 2418 | "RTN","IBC NEDE7",11, 0) | |
| 2419 | ; EXTNUM is either 1, 2, 3, 4 to repres ent the di fferent ex tracts | |
| 2420 | "RTN","IBC NEDE7",12, 0) | |
| 2421 | ; 1 - Ins urance Buf fer extrac t | |
| 2422 | "RTN","IBC NEDE7",13, 0) | |
| 2423 | ; 2 - Pre -Reg (appo intments) | |
| 2424 | "RTN","IBC NEDE7",14, 0) | |
| 2425 | ; 3 - Non Verified | |
| 2426 | "RTN","IBC NEDE7",15, 0) | |
| 2427 | ; 4 - EIC D | |
| 2428 | "RTN","IBC NEDE7",16, 0) | |
| 2429 | ; | |
| 2430 | "RTN","IBC NEDE7",17, 0) | |
| 2431 | ; Output parameters : | |
| 2432 | "RTN","IBC NEDE7",18, 0) | |
| 2433 | ; Returns a "^" del imited str ing passin g back: | |
| 2434 | "RTN","IBC NEDE7",19, 0) | |
| 2435 | ; EACT IVE - A fl ag of whet her to con sider the extract ac tive | |
| 2436 | "RTN","IBC NEDE7",20, 0) | |
| 2437 | ; XDAY S - Number of days t o look bac k in the p ast when e xtracting data | |
| 2438 | "RTN","IBC NEDE7",21, 0) | |
| 2439 | ; STAL EDYS - "st ale days": number of days from today to determine the | |
| 2440 | "RTN","IBC NEDE7",22, 0) | |
| 2441 | ; freshnes s. This is only used for the n on-verifie d extract. | |
| 2442 | "RTN","IBC NEDE7",23, 0) | |
| 2443 | ; The "Buf fer" and " Appt" extr act get th eir days f rom the IB SITE PARA METER | |
| 2444 | "RTN","IBC NEDE7",24, 0) | |
| 2445 | ; file wit hin their specific e xtract rou tine. | |
| 2446 | "RTN","IBC NEDE7",25, 0) | |
| 2447 | ; MAXC NT - Max N umber of e ntries you are allow ed to set into the e IV | |
| 2448 | "RTN","IBC NEDE7",26, 0) | |
| 2449 | ; Transmis sion Queue file. If null, # o f entries allowed is unlimited . | |
| 2450 | "RTN","IBC NEDE7",27, 0) | |
| 2451 | ; SUPP BUFF - Sup press Buff er Flag - Either '0' (No) or ' 1' (Yes) | |
| 2452 | "RTN","IBC NEDE7",28, 0) | |
| 2453 | ; 1 will s uppress th e creation of buffer entries | |
| 2454 | "RTN","IBC NEDE7",29, 0) | |
| 2455 | ; 0 will n ot | |
| 2456 | "RTN","IBC NEDE7",30, 0) | |
| 2457 | ; Applies to #2 (Pre Reg), #3 (Non verif ied) and # 4 (EICD) | |
| 2458 | "RTN","IBC NEDE7",31, 0) | |
| 2459 | ; | |
| 2460 | "RTN","IBC NEDE7",32, 0) | |
| 2461 | ; For now, the n ext three parameters are only used by th e EICD (#4 ) extract | |
| 2462 | "RTN","IBC NEDE7",33, 0) | |
| 2463 | ; STAR TDYS - num ber of day s from tod ay to form the extra ct's start date | |
| 2464 | "RTN","IBC NEDE7",34, 0) | |
| 2465 | ; DYSA FTER - num ber of day s added to the start date to f orm the ex tract's en d date | |
| 2466 | "RTN","IBC NEDE7",35, 0) | |
| 2467 | ; FREQ - how lon g the extr act must w ait before an attemp t to re-ve rify for t he patient | |
| 2468 | "RTN","IBC NEDE7",36, 0) | |
| 2469 | ; | |
| 2470 | "RTN","IBC NEDE7",37, 0) | |
| 2471 | N DIC,DIS YS,DA,X,Y, EACTIVE,XD AYS,STALED YS,MAXCNT, OK,SUPPBUF F | |
| 2472 | "RTN","IBC NEDE7",38, 0) | |
| 2473 | N STARTDY S,DYSAFTER ,FREQ | |
| 2474 | "RTN","IBC NEDE7",39, 0) | |
| 2475 | S EACTIVE =0,(XDAYS, STALEDYS,M AXCNT,SUPP BUFF,START DYS,DYSAFT ER,FREQ)=" " | |
| 2476 | "RTN","IBC NEDE7",40, 0) | |
| 2477 | S OK=$S(E XTNUM=1:1, EXTNUM=2:1 ,EXTNUM=3: 1,EXTNUM=4 :1,1:0) | |
| 2478 | "RTN","IBC NEDE7",41, 0) | |
| 2479 | I 'OK G E XIT | |
| 2480 | "RTN","IBC NEDE7",42, 0) | |
| 2481 | S DA=1,DI C="^IBE(35 0.9,"_DA_" ,51.17,",D IC(0)="X", X=EXTNUM D ^DIC | |
| 2482 | "RTN","IBC NEDE7",43, 0) | |
| 2483 | ; | |
| 2484 | "RTN","IBC NEDE7",44, 0) | |
| 2485 | I Y<1 G E XIT ; ext ract not d efined in the IB Sit e Paramete r | |
| 2486 | "RTN","IBC NEDE7",45, 0) | |
| 2487 | ; | |
| 2488 | "RTN","IBC NEDE7",46, 0) | |
| 2489 | S EACTIVE =$G(^IBE(3 50.9,1,51. 17,+Y,0)) | |
| 2490 | "RTN","IBC NEDE7",47, 0) | |
| 2491 | S XDAYS=$ P(EACTIVE, U,3) | |
| 2492 | "RTN","IBC NEDE7",48, 0) | |
| 2493 | S STALEDY S=$P(EACTI VE,U,4) | |
| 2494 | "RTN","IBC NEDE7",49, 0) | |
| 2495 | S MAXCNT= $P(EACTIVE ,U,5) | |
| 2496 | "RTN","IBC NEDE7",50, 0) | |
| 2497 | S SUPPBUF F=$P(EACTI VE,U,6) | |
| 2498 | "RTN","IBC NEDE7",51, 0) | |
| 2499 | S STARTDY S=$P(EACTI VE,U,7) | |
| 2500 | "RTN","IBC NEDE7",52, 0) | |
| 2501 | S DYSAFTE R=$P(EACTI VE,U,8) | |
| 2502 | "RTN","IBC NEDE7",53, 0) | |
| 2503 | S FREQ=$P (EACTIVE,U ,9) | |
| 2504 | "RTN","IBC NEDE7",54, 0) | |
| 2505 | I SUPPBUF F="" S SUP PBUFF=0 | |
| 2506 | "RTN","IBC NEDE7",55, 0) | |
| 2507 | S EACTIVE =$P(EACTIV E,U,2) | |
| 2508 | "RTN","IBC NEDE7",56, 0) | |
| 2509 | EXIT ; | |
| 2510 | "RTN","IBC NEDE7",57, 0) | |
| 2511 | I EXTNUM= 2,(XDAYS=" ") S EACTI VE=0 ; mi ssing requ ired data | |
| 2512 | "RTN","IBC NEDE7",58, 0) | |
| 2513 | I EXTNUM= 3 D | |
| 2514 | "RTN","IBC NEDE7",59, 0) | |
| 2515 | . I XDAYS =""!(STALE DYS="") S EACTIVE=0 ; missin g required data | |
| 2516 | "RTN","IBC NEDE7",60, 0) | |
| 2517 | I EXTNUM= 4,((STARTD YS="")!(DY SAFTER="") !(FREQ="") ) S EACTIV E=0 ; mis sing requi red data | |
| 2518 | "RTN","IBC NEDE7",61, 0) | |
| 2519 | Q EACTIVE _U_XDAYS_U _STALEDYS_ U_MAXCNT_U _SUPPBUFF_ U_STARTDYS _U_DYSAFTE R_U_FREQ | |
| 2520 | "RTN","IBC NEDE7",62, 0) | |
| 2521 | ; | |
| 2522 | "RTN","IBC NEDE7",63, 0) | |
| 2523 | SETTQ(DATA 1,DATA2,OR IG,OVERRID E,DATA5) ; Set extrac t data in TQ file 36 5.1 | |
| 2524 | "RTN","IBC NEDE7",64, 0) | |
| 2525 | ; | |
| 2526 | "RTN","IBC NEDE7",65, 0) | |
| 2527 | ; DATA1, DATA2, ORI G & DATA5 are "^" de limited va riables co ntaining t he data | |
| 2528 | "RTN","IBC NEDE7",66, 0) | |
| 2529 | ; listed below | |
| 2530 | "RTN","IBC NEDE7",67, 0) | |
| 2531 | ; | |
| 2532 | "RTN","IBC NEDE7",68, 0) | |
| 2533 | ; OVERRID E - flag i ndicates t hat this e ntry is a result of the | |
| 2534 | "RTN","IBC NEDE7",69, 0) | |
| 2535 | ; 'Request Re-Verific ation' men u option. | |
| 2536 | "RTN","IBC NEDE7",70, 0) | |
| 2537 | ; | |
| 2538 | "RTN","IBC NEDE7",71, 0) | |
| 2539 | N BUFFIEN ,FDA,IENAR RAY,ERROR, TRANSNO,DF N,SRVCODE | |
| 2540 | "RTN","IBC NEDE7",72, 0) | |
| 2541 | ; do not allow "NO PAYER" ent ries | |
| 2542 | "RTN","IBC NEDE7",73, 0) | |
| 2543 | I $P(DATA 1,U,2)=$$F IND1^DIC(3 65.12,""," X","~NO PA YER") Q | |
| 2544 | "RTN","IBC NEDE7",74, 0) | |
| 2545 | S BUFFIEN =$P(DATA1, U,4),SRVCO DE=0 | |
| 2546 | "RTN","IBC NEDE7",75, 0) | |
| 2547 | ;IB*2.0*6 21/DM make sure SRVC ODE is pop ulated | |
| 2548 | "RTN","IBC NEDE7",76, 0) | |
| 2549 | S:BUFFIEN SRVCODE=+ $$GET1^DIQ (355.33,BU FFIEN_",", 80.01,"I") ; "INQ SE RVICE TYPE CODE 1" | |
| 2550 | "RTN","IBC NEDE7",77, 0) | |
| 2551 | S:'SRVCOD E SRVCODE= +$$GET1^DI Q(350.9,"1 ,",60.01," I") ; "DEFAUL T SERVICE TYPE CODE 1" | |
| 2552 | "RTN","IBC NEDE7",78, 0) | |
| 2553 | S TRANSNO =$P($G(^IB CN(365.1,0 )),U,3)+1 | |
| 2554 | "RTN","IBC NEDE7",79, 0) | |
| 2555 | S FDA(365 .1,"+1,",. 01)=TRANSN O ; Tran saction # | |
| 2556 | "RTN","IBC NEDE7",80, 0) | |
| 2557 | ; | |
| 2558 | "RTN","IBC NEDE7",81, 0) | |
| 2559 | S DFN=$P( DATA1,U) | |
| 2560 | "RTN","IBC NEDE7",82, 0) | |
| 2561 | S FDA(365 .1,"+1,",. 02)=DFN ; pati ent DFN | |
| 2562 | "RTN","IBC NEDE7",83, 0) | |
| 2563 | S FDA(365 .1,"+1,",. 03)=$P(DAT A1,U,2) ; ien of payer | |
| 2564 | "RTN","IBC NEDE7",84, 0) | |
| 2565 | S FDA(365 .1,"+1,",. 04)=$P(DAT A1,U,3) ; ien of transmi ssion stat us | |
| 2566 | "RTN","IBC NEDE7",85, 0) | |
| 2567 | S FDA(365 .1,"+1,",. 15)=DT ; tran s status d ate | |
| 2568 | "RTN","IBC NEDE7",86, 0) | |
| 2569 | S FDA(365 .1,"+1,",. 05)=BUFFIE N ; ien of buffer | |
| 2570 | "RTN","IBC NEDE7",87, 0) | |
| 2571 | ; | |
| 2572 | "RTN","IBC NEDE7",88, 0) | |
| 2573 | S FDA(365 .1,"+1,",. 06)=$$NOW^ XLFDT ; crea tion date/ time | |
| 2574 | "RTN","IBC NEDE7",89, 0) | |
| 2575 | S FDA(365 .1,"+1,",. 07)=0 ; tran smission r etries | |
| 2576 | "RTN","IBC NEDE7",90, 0) | |
| 2577 | S FDA(365 .1,"+1,",. 08)=0 ; numb er of retr ies | |
| 2578 | "RTN","IBC NEDE7",91, 0) | |
| 2579 | I $D(OVER RIDE) S FD A(365.1,"+ 1,",.14)=O VERRIDE ; override flag | |
| 2580 | "RTN","IBC NEDE7",92, 0) | |
| 2581 | S FDA(365 .1,"+1,",. 16)=$P(DAT A1,U,5) ; Sub . ID | |
| 2582 | "RTN","IBC NEDE7",93, 0) | |
| 2583 | S FDA(365 .1,"+1,",. 17)=$P(DAT A1,U,6) ; Fre shness Dat e | |
| 2584 | "RTN","IBC NEDE7",94, 0) | |
| 2585 | S FDA(365 .1,"+1,",. 18)=$P(DAT A1,U,7) ; Pas s Buffer i en? | |
| 2586 | "RTN","IBC NEDE7",95, 0) | |
| 2587 | S FDA(365 .1,"+1,",. 19)=$P(DAT A1,U,8) ; Pat ient ID | |
| 2588 | "RTN","IBC NEDE7",96, 0) | |
| 2589 | S FDA(365 .1,"+1,",. 2)=SRVCODE ; Ser vice code | |
| 2590 | "RTN","IBC NEDE7",97, 0) | |
| 2591 | ; | |
| 2592 | "RTN","IBC NEDE7",98, 0) | |
| 2593 | I $D(DATA 2) D | |
| 2594 | "RTN","IBC NEDE7",99, 0) | |
| 2595 | . S FDA(3 65.1,"+1," ,.1)=$P(DA TA2,U) ; wh ich extrac t (ien) | |
| 2596 | "RTN","IBC NEDE7",100 ,0) | |
| 2597 | . S FDA(3 65.1,"+1," ,.11)=$P(D ATA2,U,2) ; qu ery flag | |
| 2598 | "RTN","IBC NEDE7",101 ,0) | |
| 2599 | . S FDA(3 65.1,"+1," ,.12)=$P(D ATA2,U,3) ; se rvice date | |
| 2600 | "RTN","IBC NEDE7",102 ,0) | |
| 2601 | . S FDA(3 65.1,"+1," ,.13)=$P(D ATA2,U,4) ; pa tient insu r. ien | |
| 2602 | "RTN","IBC NEDE7",103 ,0) | |
| 2603 | ; | |
| 2604 | "RTN","IBC NEDE7",104 ,0) | |
| 2605 | I $D(ORIG ) D | |
| 2606 | "RTN","IBC NEDE7",105 ,0) | |
| 2607 | . S FDA(3 65.1,"+1," ,1.02)=$P( ORIG,U) ; original ins co (i n buffer) | |
| 2608 | "RTN","IBC NEDE7",106 ,0) | |
| 2609 | . S FDA(3 65.1,"+1," ,1.03)=$P( ORIG,U,2) ; origin al grp # ( in buffer) | |
| 2610 | "RTN","IBC NEDE7",107 ,0) | |
| 2611 | . S FDA(3 65.1,"+1," ,1.04)=$P( ORIG,U,3) ; origin al grp nam e (in buff er) | |
| 2612 | "RTN","IBC NEDE7",108 ,0) | |
| 2613 | . S FDA(3 65.1,"+1," ,1.05)=$P( ORIG,U,4) ; origin al subscri ber ID | |
| 2614 | "RTN","IBC NEDE7",109 ,0) | |
| 2615 | ; | |
| 2616 | "RTN","IBC NEDE7",110 ,0) | |
| 2617 | I $D(DATA 5) D | |
| 2618 | "RTN","IBC NEDE7",111 ,0) | |
| 2619 | . S FDA(3 65.1,"+1," ,3.02)=$P( DATA5,U) ; source of informa tion ien, IB*2*601/D M | |
| 2620 | "RTN","IBC NEDE7",112 ,0) | |
| 2621 | . S FDA(3 65.1,"+1," ,.21)=$P(D ATA5,U,2) ; EICD IN S-FND IEN, IB*2*621/ DM | |
| 2622 | "RTN","IBC NEDE7",113 ,0) | |
| 2623 | ; | |
| 2624 | "RTN","IBC NEDE7",114 ,0) | |
| 2625 | D UPDATE^ DIE("","FD A","IENARR AY","ERROR ") | |
| 2626 | "RTN","IBC NEDE7",115 ,0) | |
| 2627 | ; | |
| 2628 | "RTN","IBC NEDE7",116 ,0) | |
| 2629 | I $G(ERRO R("DIERR", 1,"TEXT",1 ))'="" D ; MailMan msg | |
| 2630 | "RTN","IBC NEDE7",117 ,0) | |
| 2631 | . N MGRP, XMSUB,MSG | |
| 2632 | "RTN","IBC NEDE7",118 ,0) | |
| 2633 | . ; | |
| 2634 | "RTN","IBC NEDE7",119 ,0) | |
| 2635 | . ; Set t o IB site parameter MAILGROUP | |
| 2636 | "RTN","IBC NEDE7",120 ,0) | |
| 2637 | . S MGRP= $$MGRP^IBC NEUT5() | |
| 2638 | "RTN","IBC NEDE7",121 ,0) | |
| 2639 | . ; | |
| 2640 | "RTN","IBC NEDE7",122 ,0) | |
| 2641 | . S XMSUB ="eIV Prob lem: Troub le setting entry in File 365.1 " | |
| 2642 | "RTN","IBC NEDE7",123 ,0) | |
| 2643 | . S MSG(1 )="Tried t o create a n entry in the eIV T ransmissio n Queue Fi le #365.1 without" | |
| 2644 | "RTN","IBC NEDE7",124 ,0) | |
| 2645 | . S MSG(2 )="success ." | |
| 2646 | "RTN","IBC NEDE7",125 ,0) | |
| 2647 | . S MSG(3 )="" | |
| 2648 | "RTN","IBC NEDE7",126 ,0) | |
| 2649 | . S MSG(4 )="Error e ncountered : "_$G(ERR OR("DIERR" ,1,"TEXT", 1)) | |
| 2650 | "RTN","IBC NEDE7",127 ,0) | |
| 2651 | . S MSG(5 )="" | |
| 2652 | "RTN","IBC NEDE7",128 ,0) | |
| 2653 | . S MSG(6 )="The dat a that was to be sto red is as follows:" | |
| 2654 | "RTN","IBC NEDE7",129 ,0) | |
| 2655 | . S MSG(7 )="" | |
| 2656 | "RTN","IBC NEDE7",130 ,0) | |
| 2657 | . S MSG(8 )="Transac tion #: "_ TRANSNO | |
| 2658 | "RTN","IBC NEDE7",131 ,0) | |
| 2659 | . S MSG(9 )="Patient : "_$P($G( ^DPT(DFN,0 )),U)_$$SS N^IBCNEDEQ (DFN) | |
| 2660 | "RTN","IBC NEDE7",132 ,0) | |
| 2661 | . S MSG(1 0)="Extrac t: "_$P($G (DATA2),U, 1) | |
| 2662 | "RTN","IBC NEDE7",133 ,0) | |
| 2663 | . S MSG(1 1)="Payer: " | |
| 2664 | "RTN","IBC NEDE7",134 ,0) | |
| 2665 | . S:$P(DA TA1,U,2)'= "" MSG(11) =MSG(11)_$ P($G(^IBE( 365.12,$P( DATA1,U,2) ,0)),U,1) | |
| 2666 | "RTN","IBC NEDE7",135 ,0) | |
| 2667 | . S MSG(1 2)="Please call the Help Desk about this problem." | |
| 2668 | "RTN","IBC NEDE7",136 ,0) | |
| 2669 | . D MSG^I BCNEUT5(MG RP,XMSUB," MSG(") | |
| 2670 | "RTN","IBC NEDE7",137 ,0) | |
| 2671 | ; | |
| 2672 | "RTN","IBC NEDE7",138 ,0) | |
| 2673 | Q $G(IENA RRAY(1)) | |
| 2674 | "RTN","IBC NEDE7",139 ,0) | |
| 2675 | ; | |
| 2676 | "RTN","IBC NEDE7",140 ,0) | |
| 2677 | PYRACTV(PI EN) ; chec k if given payer is nationally active fo r eIV | |
| 2678 | "RTN","IBC NEDE7",141 ,0) | |
| 2679 | ; returns 1 if paye r is natio nally acti ve, 0 othe rwise | |
| 2680 | "RTN","IBC NEDE7",142 ,0) | |
| 2681 | N APPIEN, RES | |
| 2682 | "RTN","IBC NEDE7",143 ,0) | |
| 2683 | S RES=0 | |
| 2684 | "RTN","IBC NEDE7",144 ,0) | |
| 2685 | I +$G(PIE N)'>0 G PY RACTVX | |
| 2686 | "RTN","IBC NEDE7",145 ,0) | |
| 2687 | S APPIEN= $$PYRAPP^I BCNEUT5("I IV",PIEN) | |
| 2688 | "RTN","IBC NEDE7",146 ,0) | |
| 2689 | I +$G(APP IEN)'>0 G PYRACTVX | |
| 2690 | "RTN","IBC NEDE7",147 ,0) | |
| 2691 | I $P($G(^ IBE(365.12 ,PIEN,1,AP PIEN,0)),U ,2)=1 S RE S=1 | |
| 2692 | "RTN","IBC NEDE7",148 ,0) | |
| 2693 | PYRACTVX ; | |
| 2694 | "RTN","IBC NEDE7",149 ,0) | |
| 2695 | Q RES | |
| 2696 | "RTN","IBC NEDEP") | |
| 2697 | 0^6^B10647 0156^B9437 4860 | |
| 2698 | "RTN","IBC NEDEP",1,0 ) | |
| 2699 | IBCNEDEP ; DAOU/ALA - Process T ransaction Records ; 14-OCT-201 5 | |
| 2700 | "RTN","IBC NEDEP",2,0 ) | |
| 2701 | ;;2.0;INT EGRATED BI LLING;**18 4,271,300, 416,438,50 6,533,549, 601,621**; 21-MAR-94; Build 8 | |
| 2702 | "RTN","IBC NEDEP",3,0 ) | |
| 2703 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 2704 | "RTN","IBC NEDEP",4,0 ) | |
| 2705 | ; | |
| 2706 | "RTN","IBC NEDEP",5,0 ) | |
| 2707 | ; This p rogram fin ds records needing H L7 msg cre ation | |
| 2708 | "RTN","IBC NEDEP",6,0 ) | |
| 2709 | ; Period ically che ck for sto p request for backgr ound task | |
| 2710 | "RTN","IBC NEDEP",7,0 ) | |
| 2711 | ; | |
| 2712 | "RTN","IBC NEDEP",8,0 ) | |
| 2713 | ; Variab les | |
| 2714 | "RTN","IBC NEDEP",9,0 ) | |
| 2715 | ; RETR = # retri es allowed | |
| 2716 | "RTN","IBC NEDEP",10, 0) | |
| 2717 | ; RETR YFLG = det ermines if a Transmi tted messa ge can be resent | |
| 2718 | "RTN","IBC NEDEP",11, 0) | |
| 2719 | ; MGRP = Msg Mai lgroup | |
| 2720 | "RTN","IBC NEDEP",12, 0) | |
| 2721 | ; FAIL = # of da ys before failure | |
| 2722 | "RTN","IBC NEDEP",13, 0) | |
| 2723 | ; FMSG = Failure Mailman f lag | |
| 2724 | "RTN","IBC NEDEP",14, 0) | |
| 2725 | ; TMSG = Timeout Mailman f lag | |
| 2726 | "RTN","IBC NEDEP",15, 0) | |
| 2727 | ; FLDT = Failure date | |
| 2728 | "RTN","IBC NEDEP",16, 0) | |
| 2729 | ; FUTD T = Future transmiss ion date | |
| 2730 | "RTN","IBC NEDEP",17, 0) | |
| 2731 | ; DFN = Patient IEN | |
| 2732 | "RTN","IBC NEDEP",18, 0) | |
| 2733 | ; PAYR = Payer I EN | |
| 2734 | "RTN","IBC NEDEP",19, 0) | |
| 2735 | ; DTCR T = Date C reated | |
| 2736 | "RTN","IBC NEDEP",20, 0) | |
| 2737 | ; BUFF = Buffer File IEN | |
| 2738 | "RTN","IBC NEDEP",21, 0) | |
| 2739 | ; NRET R = # of r etries acc omplished | |
| 2740 | "RTN","IBC NEDEP",22, 0) | |
| 2741 | ; IHCN T = Count of success ful HL7 ms gs | |
| 2742 | "RTN","IBC NEDEP",23, 0) | |
| 2743 | ; QUER Y = Type o f msg | |
| 2744 | "RTN","IBC NEDEP",24, 0) | |
| 2745 | ; EXT = Which e xtract pro duced reco rd | |
| 2746 | "RTN","IBC NEDEP",25, 0) | |
| 2747 | ; SRVD T = Servic e Date | |
| 2748 | "RTN","IBC NEDEP",26, 0) | |
| 2749 | ; IRIE N = Insura nce Record IEN | |
| 2750 | "RTN","IBC NEDEP",27, 0) | |
| 2751 | ; NTRA N = # of t ransmissio ns accompl ished | |
| 2752 | "RTN","IBC NEDEP",28, 0) | |
| 2753 | ; OVRI DE = Overr ide Flag | |
| 2754 | "RTN","IBC NEDEP",29, 0) | |
| 2755 | ; BNDL = Bundle Verificati on Flag | |
| 2756 | "RTN","IBC NEDEP",30, 0) | |
| 2757 | ; | |
| 2758 | "RTN","IBC NEDEP",31, 0) | |
| 2759 | EN ; Entr y point | |
| 2760 | "RTN","IBC NEDEP",32, 0) | |
| 2761 | ; | |
| 2762 | "RTN","IBC NEDEP",33, 0) | |
| 2763 | ; Start processing of data | |
| 2764 | "RTN","IBC NEDEP",34, 0) | |
| 2765 | K ^TMP("H LS",$J),^T MP("IBQUER Y",$J) | |
| 2766 | "RTN","IBC NEDEP",35, 0) | |
| 2767 | ; Initial ize count for period ic TaskMan check | |
| 2768 | "RTN","IBC NEDEP",36, 0) | |
| 2769 | ;IB*533 R RA CREATE VARIABLES TO ACCOUNT FOR MAX S ENT LIMITA TIONS | |
| 2770 | "RTN","IBC NEDEP",37, 0) | |
| 2771 | N IBMAXCN T,IBSENT | |
| 2772 | "RTN","IBC NEDEP",38, 0) | |
| 2773 | S IBCNETO T=0,IBSENT =0 | |
| 2774 | "RTN","IBC NEDEP",39, 0) | |
| 2775 | ; | |
| 2776 | "RTN","IBC NEDEP",40, 0) | |
| 2777 | S C1CODE= $O(^IBE(36 5.15,"B"," C1","")) | |
| 2778 | "RTN","IBC NEDEP",41, 0) | |
| 2779 | ; Get IB Site Para meters | |
| 2780 | "RTN","IBC NEDEP",42, 0) | |
| 2781 | S IBCNEP= $G(^IBE(35 0.9,1,51)) | |
| 2782 | "RTN","IBC NEDEP",43, 0) | |
| 2783 | S RETR=+$ P(IBCNEP,U ,6),BNDL=$ P(IBCNEP,U ,23) | |
| 2784 | "RTN","IBC NEDEP",44, 0) | |
| 2785 | S MGRP=$$ MGRP^IBCNE UT5() | |
| 2786 | "RTN","IBC NEDEP",45, 0) | |
| 2787 | S FAIL=$P (IBCNEP,U, 5),TMSG=$P (IBCNEP,U, 7),FMSG=$P (IBCNEP,U, 20) | |
| 2788 | "RTN","IBC NEDEP",46, 0) | |
| 2789 | S RETRYFL G=$P(IBCNE P,U,26) ;set value to ( #350.9, 51 .26) - IB* 2.0*506 | |
| 2790 | "RTN","IBC NEDEP",47, 0) | |
| 2791 | S IBMAXCN T=$P(IBCNE P,U,15) ;get HL7 M AXIMUM NUM BER - IB*5 33 | |
| 2792 | "RTN","IBC NEDEP",48, 0) | |
| 2793 | S FLDT=$$ FMADD^XLFD T(DT,-FAIL ) | |
| 2794 | "RTN","IBC NEDEP",49, 0) | |
| 2795 | ; Statuse s | |
| 2796 | "RTN","IBC NEDEP",50, 0) | |
| 2797 | ; 1 = R eady To Tr ansmit | |
| 2798 | "RTN","IBC NEDEP",51, 0) | |
| 2799 | ; 2 = T ransmitted | |
| 2800 | "RTN","IBC NEDEP",52, 0) | |
| 2801 | ; 4 = H old | |
| 2802 | "RTN","IBC NEDEP",53, 0) | |
| 2803 | ; 6 = R etry | |
| 2804 | "RTN","IBC NEDEP",54, 0) | |
| 2805 | ; | |
| 2806 | "RTN","IBC NEDEP",55, 0) | |
| 2807 | ; If the status is 'HOLD' is this a 'Re try'? - IB*2.0*50 6 | |
| 2808 | "RTN","IBC NEDEP",56, 0) | |
| 2809 | ; DO HLD ; this is not to be called unless the status of HOLD is r einstated. ..see HLD tag | |
| 2810 | "RTN","IBC NEDEP",57, 0) | |
| 2811 | ; below and the co de within ERROR^IBCN EHL3 | |
| 2812 | "RTN","IBC NEDEP",58, 0) | |
| 2813 | ; | |
| 2814 | "RTN","IBC NEDEP",59, 0) | |
| 2815 | ; Exit ba sed on sto p request | |
| 2816 | "RTN","IBC NEDEP",60, 0) | |
| 2817 | I $G(ZTST OP) G EXIT | |
| 2818 | "RTN","IBC NEDEP",61, 0) | |
| 2819 | ; | |
| 2820 | "RTN","IBC NEDEP",62, 0) | |
| 2821 | TMT ; If the status is 'Trans mitted' - is this a 'Retry' or | |
| 2822 | "RTN","IBC NEDEP",63, 0) | |
| 2823 | ; 'Comm Failure' | |
| 2824 | "RTN","IBC NEDEP",64, 0) | |
| 2825 | S IEN="" | |
| 2826 | "RTN","IBC NEDEP",65, 0) | |
| 2827 | F S IEN= $O(^IBCN(3 65.1,"AC", 2,IEN)) Q: IEN="" D Q:$G(ZTST OP) | |
| 2828 | "RTN","IBC NEDEP",66, 0) | |
| 2829 | . ; Updat e count fo r periodic check | |
| 2830 | "RTN","IBC NEDEP",67, 0) | |
| 2831 | . S IBCNE TOT=IBCNET OT+1 | |
| 2832 | "RTN","IBC NEDEP",68, 0) | |
| 2833 | . ; Check for reque st to stop backgroun d job, per iodically | |
| 2834 | "RTN","IBC NEDEP",69, 0) | |
| 2835 | . I $D(ZT QUEUED),IB CNETOT#100 =0,$$S^%ZT LOAD() S Z TSTOP=1 Q | |
| 2836 | "RTN","IBC NEDEP",70, 0) | |
| 2837 | . ; | |
| 2838 | "RTN","IBC NEDEP",71, 0) | |
| 2839 | . NEW TDA TA,DTCRT,B UFF,DFN,PA YR,XMSUB,V ERID,EXT | |
| 2840 | "RTN","IBC NEDEP",72, 0) | |
| 2841 | . S TDATA =$G(^IBCN( 365.1,IEN, 0)) | |
| 2842 | "RTN","IBC NEDEP",73, 0) | |
| 2843 | . S DFN=$ P(TDATA,U, 2),PAYR=$P (TDATA,U,3 ) | |
| 2844 | "RTN","IBC NEDEP",74, 0) | |
| 2845 | . S DTCRT =$P(TDATA, U,6)\1,BUF F=$P(TDATA ,U,5) | |
| 2846 | "RTN","IBC NEDEP",75, 0) | |
| 2847 | . S VERID =$P(TDATA, U,11) | |
| 2848 | "RTN","IBC NEDEP",76, 0) | |
| 2849 | . S EXT=$ P(TDATA,U, 10) | |
| 2850 | "RTN","IBC NEDEP",77, 0) | |
| 2851 | . ; | |
| 2852 | "RTN","IBC NEDEP",78, 0) | |
| 2853 | . ; Chec k against the Failur e Date | |
| 2854 | "RTN","IBC NEDEP",79, 0) | |
| 2855 | . I (VERI D="I")&(EX T=4) Q:DT< $$FMADD^XL FDT(DTCRT+ 30) ; IB* 2.0*621 ; HAN | |
| 2856 | "RTN","IBC NEDEP",80, 0) | |
| 2857 | . I (VERI D'="I")&(E XT'=4)&(DT CRT>FLDT) Q | |
| 2858 | "RTN","IBC NEDEP",81, 0) | |
| 2859 | . ; | |
| 2860 | "RTN","IBC NEDEP",82, 0) | |
| 2861 | . ; If r etries are defined | |
| 2862 | "RTN","IBC NEDEP",83, 0) | |
| 2863 | . I (VERI D'="I"&(EX T'=4))&(RE TRYFLG="Y" ) D Q ; IB*2.0* 506 ; IB*2 .0*621 | |
| 2864 | "RTN","IBC NEDEP",84, 0) | |
| 2865 | .. ; | |
| 2866 | "RTN","IBC NEDEP",85, 0) | |
| 2867 | .. I '$$P YRACTV^IBC NEDE7(PAYR ) Q ; I f Payer is not Natio nally Acti ve skip re cord - I B*2.0*506 | |
| 2868 | "RTN","IBC NEDEP",86, 0) | |
| 2869 | .. ; | |
| 2870 | "RTN","IBC NEDEP",87, 0) | |
| 2871 | .. D SST^ IBCNEUT2(I EN,6) ; mark TQ e ntry statu s as 'retr y' | |
| 2872 | "RTN","IBC NEDEP",88, 0) | |
| 2873 | .. Q | |
| 2874 | "RTN","IBC NEDEP",89, 0) | |
| 2875 | . ; | |
| 2876 | "RTN","IBC NEDEP",90, 0) | |
| 2877 | . D SST^I BCNEUT2(IE N,5) ; if RETRYF LG=NO set TQ record to 'commun ication fa ilure' | |
| 2878 | "RTN","IBC NEDEP",91, 0) | |
| 2879 | . ; | |
| 2880 | "RTN","IBC NEDEP",92, 0) | |
| 2881 | . ; For msg in the Response file set t he status to | |
| 2882 | "RTN","IBC NEDEP",93, 0) | |
| 2883 | . ; 'Comm Failure' | |
| 2884 | "RTN","IBC NEDEP",94, 0) | |
| 2885 | . D RSTA^ IBCNEUT7(I EN) | |
| 2886 | "RTN","IBC NEDEP",95, 0) | |
| 2887 | . I (VERI D="I")&(EX T=4) D | |
| 2888 | "RTN","IBC NEDEP",96, 0) | |
| 2889 | .. N IENS ,RSUPDT,TR KIEN | |
| 2890 | "RTN","IBC NEDEP",97, 0) | |
| 2891 | .. S TRKI EN=$O(^IBC N(365.18," B",IEN,"") ),IENS=TRK IEN_"," | |
| 2892 | "RTN","IBC NEDEP",98, 0) | |
| 2893 | .. S RSUP DT(365.18, IENS,.06)= $$GET1^DIQ (365.16,"1 ,"_IEN_"," ,.03) ;The re is only one occur ance for E ICD Identi fication | |
| 2894 | "RTN","IBC NEDEP",99, 0) | |
| 2895 | .. S RSUP DT(365.18, IENS,.07)= 0 ;Set st atus to "E rror" | |
| 2896 | "RTN","IBC NEDEP",100 ,0) | |
| 2897 | .. D FILE ^DIE("","R SUPDT","ER ROR") | |
| 2898 | "RTN","IBC NEDEP",101 ,0) | |
| 2899 | . ; | |
| 2900 | "RTN","IBC NEDEP",102 ,0) | |
| 2901 | . ; Set Buffer sym bol to 'C1 ' (Comm Fa ilure) ; used to be 'B12' - ien of 15 | |
| 2902 | "RTN","IBC NEDEP",103 ,0) | |
| 2903 | . I BUFF' ="" D BUFF ^IBCNEUT2( BUFF,C1COD E) ; set to " #" communi cation fai lure - IB* 2.0*506 | |
| 2904 | "RTN","IBC NEDEP",104 ,0) | |
| 2905 | . ; | |
| 2906 | "RTN","IBC NEDEP",105 ,0) | |
| 2907 | . I PAYR= $$FIND1^DI C(365.12," ","X","~NO PAYER") Q | |
| 2908 | "RTN","IBC NEDEP",106 ,0) | |
| 2909 | . ; | |
| 2910 | "RTN","IBC NEDEP",107 ,0) | |
| 2911 | . ; Issue comm fail MailMan m sg only fo r ver'ns | |
| 2912 | "RTN","IBC NEDEP",108 ,0) | |
| 2913 | . I VERID ="V" D CER R^IBCNEDEQ | |
| 2914 | "RTN","IBC NEDEP",109 ,0) | |
| 2915 | ; | |
| 2916 | "RTN","IBC NEDEP",110 ,0) | |
| 2917 | ; Exit fo r stop req uest | |
| 2918 | "RTN","IBC NEDEP",111 ,0) | |
| 2919 | I $G(ZTST OP) G EXIT | |
| 2920 | "RTN","IBC NEDEP",112 ,0) | |
| 2921 | ; | |
| 2922 | "RTN","IBC NEDEP",113 ,0) | |
| 2923 | RET ; If status is 'Retry' ; retrie s only exi st if the RETRYFLG=Y ES - IB*2. 0*506 | |
| 2924 | "RTN","IBC NEDEP",114 ,0) | |
| 2925 | S IEN="" | |
| 2926 | "RTN","IBC NEDEP",115 ,0) | |
| 2927 | F S IEN= $O(^IBCN(3 65.1,"AC", 6,IEN)) Q: IEN="" D Q:$G(ZTST OP) | |
| 2928 | "RTN","IBC NEDEP",116 ,0) | |
| 2929 | . ; Updat e count fo r periodic check | |
| 2930 | "RTN","IBC NEDEP",117 ,0) | |
| 2931 | . S IBCNE TOT=IBCNET OT+1 | |
| 2932 | "RTN","IBC NEDEP",118 ,0) | |
| 2933 | . ; Check for reque st to stop backgroun d job, per iodically | |
| 2934 | "RTN","IBC NEDEP",119 ,0) | |
| 2935 | . I $D(ZT QUEUED),IB CNETOT#100 =0,$$S^%ZT LOAD() S Z TSTOP=1 Q | |
| 2936 | "RTN","IBC NEDEP",120 ,0) | |
| 2937 | . ; | |
| 2938 | "RTN","IBC NEDEP",121 ,0) | |
| 2939 | . NEW TDA TA,NRETR,P AYR,BUFF,D FN,MSG,RIE N,HIEN,XMS UB,VERID | |
| 2940 | "RTN","IBC NEDEP",122 ,0) | |
| 2941 | . S TDATA =$G(^IBCN( 365.1,IEN, 0)) | |
| 2942 | "RTN","IBC NEDEP",123 ,0) | |
| 2943 | . S NRETR =$P(TDATA, U,8),PAYR= $P(TDATA,U ,3) | |
| 2944 | "RTN","IBC NEDEP",124 ,0) | |
| 2945 | . S BUFF= $P(TDATA,U ,5),DFN=$P (TDATA,U,2 ) | |
| 2946 | "RTN","IBC NEDEP",125 ,0) | |
| 2947 | . S VERID =$P(TDATA, U,11) | |
| 2948 | "RTN","IBC NEDEP",126 ,0) | |
| 2949 | . S NRETR =NRETR+1 | |
| 2950 | "RTN","IBC NEDEP",127 ,0) | |
| 2951 | . ; | |
| 2952 | "RTN","IBC NEDEP",128 ,0) | |
| 2953 | . ; If r etries are finished, set to co mmunicatio n failure - IB*2.0* 506 | |
| 2954 | "RTN","IBC NEDEP",129 ,0) | |
| 2955 | . I NRETR >RETR D Q | |
| 2956 | "RTN","IBC NEDEP",130 ,0) | |
| 2957 | .. D SST^ IBCNEUT2(I EN,5) | |
| 2958 | "RTN","IBC NEDEP",131 ,0) | |
| 2959 | .. ; | |
| 2960 | "RTN","IBC NEDEP",132 ,0) | |
| 2961 | .. ; Set Buffer sy mbol to 'C 1' (Comm F ailure) ; used to be 'B12' - ien of 1 5 | |
| 2962 | "RTN","IBC NEDEP",133 ,0) | |
| 2963 | .. I BUFF '="" D BUF F^IBCNEUT2 (BUFF,C1CO DE) ; set to "#" commun ication fa ilure - IB *2.0*506 | |
| 2964 | "RTN","IBC NEDEP",134 ,0) | |
| 2965 | .. ; | |
| 2966 | "RTN","IBC NEDEP",135 ,0) | |
| 2967 | .. ; For msg in th e Response file set the status to | |
| 2968 | "RTN","IBC NEDEP",136 ,0) | |
| 2969 | .. ; 'Com m Failure' | |
| 2970 | "RTN","IBC NEDEP",137 ,0) | |
| 2971 | .. D RSTA ^IBCNEUT7( IEN) | |
| 2972 | "RTN","IBC NEDEP",138 ,0) | |
| 2973 | .. I PAYR =$$FIND1^D IC(365.12, "","X","~N O PAYER") Q | |
| 2974 | "RTN","IBC NEDEP",139 ,0) | |
| 2975 | .. ; | |
| 2976 | "RTN","IBC NEDEP",140 ,0) | |
| 2977 | .. ;I VER ID="V" D C ERE^IBCNED EQ ; removed IB *2.0*506 | |
| 2978 | "RTN","IBC NEDEP",141 ,0) | |
| 2979 | . ; If ge nerating r etry, set eIV status to comm f ailure (5) for | |
| 2980 | "RTN","IBC NEDEP",142 ,0) | |
| 2981 | . ; remai ning relat ed respons es | |
| 2982 | "RTN","IBC NEDEP",143 ,0) | |
| 2983 | . D RSTA^ IBCNEUT7(I EN) | |
| 2984 | "RTN","IBC NEDEP",144 ,0) | |
| 2985 | ; | |
| 2986 | "RTN","IBC NEDEP",145 ,0) | |
| 2987 | ; Exit fo r stop req uest | |
| 2988 | "RTN","IBC NEDEP",146 ,0) | |
| 2989 | I $G(ZTST OP) G EXIT | |
| 2990 | "RTN","IBC NEDEP",147 ,0) | |
| 2991 | ; | |
| 2992 | "RTN","IBC NEDEP",148 ,0) | |
| 2993 | FIN ; Prio ritize req uests for statuses ' Retry' and 'Ready to Transmit' | |
| 2994 | "RTN","IBC NEDEP",149 ,0) | |
| 2995 | ; | |
| 2996 | "RTN","IBC NEDEP",150 ,0) | |
| 2997 | ; Separa te inquiri es into ve rification s, identif ications, | |
| 2998 | "RTN","IBC NEDEP",151 ,0) | |
| 2999 | ; and "f ishes" - V NUM = Prio rity of ou tput | |
| 3000 | "RTN","IBC NEDEP",152 ,0) | |
| 3001 | F STA=1,6 S IEN="" D | |
| 3002 | "RTN","IBC NEDEP",153 ,0) | |
| 3003 | . F S IE N=$O(^IBCN (365.1,"AC ",STA,IEN) ) Q:IEN="" D | |
| 3004 | "RTN","IBC NEDEP",154 ,0) | |
| 3005 | .. S IBDA TA=$G(^IBC N(365.1,IE N,0)) Q:IB DATA="" | |
| 3006 | "RTN","IBC NEDEP",155 ,0) | |
| 3007 | .. S QUER Y=$P(IBDAT A,U,11),DF N=$P(IBDAT A,U,2),OVR IDE=$P(IBD ATA,U,14) | |
| 3008 | "RTN","IBC NEDEP",156 ,0) | |
| 3009 | .. S PAYR =$P(IBDATA ,U,3) | |
| 3010 | "RTN","IBC NEDEP",157 ,0) | |
| 3011 | .. I QUER Y="V" S VN UM=3 | |
| 3012 | "RTN","IBC NEDEP",158 ,0) | |
| 3013 | .. I QUER Y'="V" D | |
| 3014 | "RTN","IBC NEDEP",159 ,0) | |
| 3015 | ... ;I PA YR=$$FIND1 ^DIC(365.1 2,,"X","~N O PAYER") S VNUM=5 Q ; IB*601 - HAN | |
| 3016 | "RTN","IBC NEDEP",160 ,0) | |
| 3017 | ... S VNU M=4 | |
| 3018 | "RTN","IBC NEDEP",161 ,0) | |
| 3019 | .. I OVRI DE'="" D | |
| 3020 | "RTN","IBC NEDEP",162 ,0) | |
| 3021 | ... I PAY R=$$FIND1^ DIC(365.12 ,,"X","~NO PAYER") S VNUM=2 Q | |
| 3022 | "RTN","IBC NEDEP",163 ,0) | |
| 3023 | ... S VNU M=1 | |
| 3024 | "RTN","IBC NEDEP",164 ,0) | |
| 3025 | .. S ^TMP ("IBQUERY" ,$J,VNUM,D FN,IEN)="" | |
| 3026 | "RTN","IBC NEDEP",165 ,0) | |
| 3027 | ; | |
| 3028 | "RTN","IBC NEDEP",166 ,0) | |
| 3029 | LP ; Loop through p riorities, process a s either v erificatio ns | |
| 3030 | "RTN","IBC NEDEP",167 ,0) | |
| 3031 | ; or ide ntificatio ns | |
| 3032 | "RTN","IBC NEDEP",168 ,0) | |
| 3033 | N IHCNT,I BSTOP | |
| 3034 | "RTN","IBC NEDEP",169 ,0) | |
| 3035 | S VNUM="" ,IHCNT=0 | |
| 3036 | "RTN","IBC NEDEP",170 ,0) | |
| 3037 | F S VNUM =$O(^TMP(" IBQUERY",$ J,VNUM)) Q :VNUM="" D Q:$G(ZT STOP)!$G(Q FL)=1!($G( IBSTOP)=1) | |
| 3038 | "RTN","IBC NEDEP",171 ,0) | |
| 3039 | . I VNUM= 1!(VNUM=3) D VER Q | |
| 3040 | "RTN","IBC NEDEP",172 ,0) | |
| 3041 | . D ID | |
| 3042 | "RTN","IBC NEDEP",173 ,0) | |
| 3043 | ; | |
| 3044 | "RTN","IBC NEDEP",174 ,0) | |
| 3045 | EXIT ; Fi nish | |
| 3046 | "RTN","IBC NEDEP",175 ,0) | |
| 3047 | K BUFF,CN T,D,D0,DA, DFN,DI,DIC ,DIE,DISYS ,DQ,DR,DTC RT,EICDVIE N,EXT,FAIL ,FLDT,FUTD T | |
| 3048 | "RTN","IBC NEDEP",176 ,0) | |
| 3049 | K FRDT,FM SG,GT1,HCT ,HIEN,HL,H LCDOM,HLCI NS,HLCS,HL CSTCP,HLDO M,HLECH,%I ,%H | |
| 3050 | "RTN","IBC NEDEP",177 ,0) | |
| 3051 | K HLEID,H LFS,HLHDR, HLINST,HLI P,HLN,HLPA RAM,HLPROD ,HLQ,HLRES LT,XMSUB | |
| 3052 | "RTN","IBC NEDEP",178 ,0) | |
| 3053 | K HLSAN,H LTYPE,HLX, IBCNEP,IBC NHLP,IEN,I HCNT,IN1,I RIEN,MDTM, MGRP,MSGID ,TOT | |
| 3054 | "RTN","IBC NEDEP",179 ,0) | |
| 3055 | K NRETR,N TRAN,OVRID E,PAYR,PID ,QFL,QUERY ,RETR,RETR YFLG,RSIEN ,SRVDT,STA ,TRANSR,X | |
| 3056 | "RTN","IBC NEDEP",180 ,0) | |
| 3057 | K ZMID,^T MP("IBQUER Y",$J),Y,D OD,DGREL,T MSG,RSTYPE ,OMSGID,QF L | |
| 3058 | "RTN","IBC NEDEP",181 ,0) | |
| 3059 | K IBCNETO T,HLP,SUBI D,VNUM,BND L,IBDATA,P ATID,C1COD E | |
| 3060 | "RTN","IBC NEDEP",182 ,0) | |
| 3061 | Q | |
| 3062 | "RTN","IBC NEDEP",183 ,0) | |
| 3063 | ; | |
| 3064 | "RTN","IBC NEDEP",184 ,0) | |
| 3065 | VER ; Ini tialize HL 7 variable s protocol for Verif ications | |
| 3066 | "RTN","IBC NEDEP",185 ,0) | |
| 3067 | S IBCNHLP ="IBCNE II V RQV OUT" | |
| 3068 | "RTN","IBC NEDEP",186 ,0) | |
| 3069 | D INIT^IB CNEHLO | |
| 3070 | "RTN","IBC NEDEP",187 ,0) | |
| 3071 | ; | |
| 3072 | "RTN","IBC NEDEP",188 ,0) | |
| 3073 | S DFN="" | |
| 3074 | "RTN","IBC NEDEP",189 ,0) | |
| 3075 | F S DFN= $O(^TMP("I BQUERY",$J ,VNUM,DFN) ) Q:DFN="" D Q:$G( ZTSTOP)!($ G(IBSTOP)= 1) | |
| 3076 | "RTN","IBC NEDEP",190 ,0) | |
| 3077 | . ; | |
| 3078 | "RTN","IBC NEDEP",191 ,0) | |
| 3079 | . ; If t he INQUIRE SECONDARY INSURANCE S flag is 'yes', | |
| 3080 | "RTN","IBC NEDEP",192 ,0) | |
| 3081 | . ; bund le verific ations tog ether, sen d a contin uation poi nter | |
| 3082 | "RTN","IBC NEDEP",193 ,0) | |
| 3083 | . I VNUM= 3,BNDL D Q:QFL | |
| 3084 | "RTN","IBC NEDEP",194 ,0) | |
| 3085 | .. S TOT= 0,IEN="",Q FL=0 | |
| 3086 | "RTN","IBC NEDEP",195 ,0) | |
| 3087 | .. F S I EN=$O(^TMP ("IBQUERY" ,$J,VNUM,D FN,IEN)) Q :IEN="" S TOT=TOT+1 | |
| 3088 | "RTN","IBC NEDEP",196 ,0) | |
| 3089 | . ; | |
| 3090 | "RTN","IBC NEDEP",197 ,0) | |
| 3091 | . S IEN=" ",OMSGID=" ",QFL=0,CN T=0 | |
| 3092 | "RTN","IBC NEDEP",198 ,0) | |
| 3093 | . F S IE N=$O(^TMP( "IBQUERY", $J,VNUM,DF N,IEN)) Q: IEN="" D Q:$G(ZTST OP)!($G(IB STOP)=1) | |
| 3094 | "RTN","IBC NEDEP",199 ,0) | |
| 3095 | .. ; | |
| 3096 | "RTN","IBC NEDEP",200 ,0) | |
| 3097 | .. ; IB*2 .0*549 - q uit if tes t site and not a val id test ca se | |
| 3098 | "RTN","IBC NEDEP",201 ,0) | |
| 3099 | .. Q:'$$X MITOK^IBCN ETST(IEN) | |
| 3100 | "RTN","IBC NEDEP",202 ,0) | |
| 3101 | .. ; Upda te count f or periodi c check | |
| 3102 | "RTN","IBC NEDEP",203 ,0) | |
| 3103 | .. S IBCN ETOT=IBCNE TOT+1 | |
| 3104 | "RTN","IBC NEDEP",204 ,0) | |
| 3105 | .. ; Chec k for requ est to sto p backgrou nd job, pe riodically | |
| 3106 | "RTN","IBC NEDEP",205 ,0) | |
| 3107 | .. I $D(Z TQUEUED),I BCNETOT#10 0=0,$$S^%Z TLOAD() S ZTSTOP=1 Q | |
| 3108 | "RTN","IBC NEDEP",206 ,0) | |
| 3109 | .. ; | |
| 3110 | "RTN","IBC NEDEP",207 ,0) | |
| 3111 | .. D PROC I PID="" Q | |
| 3112 | "RTN","IBC NEDEP",208 ,0) | |
| 3113 | .. ; | |
| 3114 | "RTN","IBC NEDEP",209 ,0) | |
| 3115 | .. I BNDL S HLP("CO NTPTR")=$G (OMSGID) | |
| 3116 | "RTN","IBC NEDEP",210 ,0) | |
| 3117 | .. D GENE RATE^HLMA( IBCNHLP,"G M",1,.HLRE SLT,"",.HL P) | |
| 3118 | "RTN","IBC NEDEP",211 ,0) | |
| 3119 | .. K ^TMP ("HLS",$J) ,HLP | |
| 3120 | "RTN","IBC NEDEP",212 ,0) | |
| 3121 | .. ; | |
| 3122 | "RTN","IBC NEDEP",213 ,0) | |
| 3123 | .. ; If not succes sful | |
| 3124 | "RTN","IBC NEDEP",214 ,0) | |
| 3125 | .. I $P(H LRESLT,U,2 )]"" D HLE R^IBCNEDEQ Q | |
| 3126 | "RTN","IBC NEDEP",215 ,0) | |
| 3127 | .. ; If successful | |
| 3128 | "RTN","IBC NEDEP",216 ,0) | |
| 3129 | .. ; incr ement coun ter and qu it if reac hed IBMAXC NT IB*533 | |
| 3130 | "RTN","IBC NEDEP",217 ,0) | |
| 3131 | .. S IBSE NT=IBSENT+ 1 | |
| 3132 | "RTN","IBC NEDEP",218 ,0) | |
| 3133 | .. I IBMA XCNT'="",I BSENT+1>IB MAXCNT S I BSTOP=1 | |
| 3134 | "RTN","IBC NEDEP",219 ,0) | |
| 3135 | .. D SCC^ IBCNEDEQ | |
| 3136 | "RTN","IBC NEDEP",220 ,0) | |
| 3137 | .. I BNDL D | |
| 3138 | "RTN","IBC NEDEP",221 ,0) | |
| 3139 | ... I CNT =1 S OMSGI D=MSGID | |
| 3140 | "RTN","IBC NEDEP",222 ,0) | |
| 3141 | ; | |
| 3142 | "RTN","IBC NEDEP",223 ,0) | |
| 3143 | K HL,IN1, GT1,PID,DF N,^TMP($J, "HLS") | |
| 3144 | "RTN","IBC NEDEP",224 ,0) | |
| 3145 | Q | |
| 3146 | "RTN","IBC NEDEP",225 ,0) | |
| 3147 | ; | |
| 3148 | "RTN","IBC NEDEP",226 ,0) | |
| 3149 | ID ; Send Identific ation Msgs | |
| 3150 | "RTN","IBC NEDEP",227 ,0) | |
| 3151 | ; | |
| 3152 | "RTN","IBC NEDEP",228 ,0) | |
| 3153 | ; Initia lize the H L7 variabl es based o n the HL7 protocol | |
| 3154 | "RTN","IBC NEDEP",229 ,0) | |
| 3155 | S IBCNHLP ="IBCNE EI V RQP OUT" | |
| 3156 | "RTN","IBC NEDEP",230 ,0) | |
| 3157 | D INIT^IB CNEHLO | |
| 3158 | "RTN","IBC NEDEP",231 ,0) | |
| 3159 | ; | |
| 3160 | "RTN","IBC NEDEP",232 ,0) | |
| 3161 | S DFN="" | |
| 3162 | "RTN","IBC NEDEP",233 ,0) | |
| 3163 | F S DFN= $O(^TMP("I BQUERY",$J ,VNUM,DFN) ) Q:DFN="" D Q:$G( ZTSTOP)!QF L | |
| 3164 | "RTN","IBC NEDEP",234 ,0) | |
| 3165 | . ; Updat e count fo r periodic check | |
| 3166 | "RTN","IBC NEDEP",235 ,0) | |
| 3167 | . S IBCNE TOT=IBCNET OT+1 | |
| 3168 | "RTN","IBC NEDEP",236 ,0) | |
| 3169 | . ; Check for reque st to stop backgroun d job, per iodically | |
| 3170 | "RTN","IBC NEDEP",237 ,0) | |
| 3171 | . I $D(ZT QUEUED),IB CNETOT#100 =0,$$S^%ZT LOAD() S Z TSTOP=1 Q | |
| 3172 | "RTN","IBC NEDEP",238 ,0) | |
| 3173 | . ; | |
| 3174 | "RTN","IBC NEDEP",239 ,0) | |
| 3175 | . S TOT=0 ,IEN="",CN T=0,OMSGID ="",QFL=0 | |
| 3176 | "RTN","IBC NEDEP",240 ,0) | |
| 3177 | . ; | |
| 3178 | "RTN","IBC NEDEP",241 ,0) | |
| 3179 | . ; Get the total # of ident ification msgs for a patient | |
| 3180 | "RTN","IBC NEDEP",242 ,0) | |
| 3181 | . F S IE N=$O(^TMP( "IBQUERY", $J,VNUM,DF N,IEN)) Q: IEN="" S TOT=TOT+1 | |
| 3182 | "RTN","IBC NEDEP",243 ,0) | |
| 3183 | . ; | |
| 3184 | "RTN","IBC NEDEP",244 ,0) | |
| 3185 | . ; For each ident ification transactio n generate an HL7 ms g | |
| 3186 | "RTN","IBC NEDEP",245 ,0) | |
| 3187 | . F S IE N=$O(^TMP( "IBQUERY", $J,VNUM,DF N,IEN)) Q: IEN="" D | |
| 3188 | "RTN","IBC NEDEP",246 ,0) | |
| 3189 | .. ;IB*2. 0*621 - qu it if test site and not a vali d test cas e | |
| 3190 | "RTN","IBC NEDEP",247 ,0) | |
| 3191 | .. Q:'$$X MITOK^IBCN ETST(IEN) | |
| 3192 | "RTN","IBC NEDEP",248 ,0) | |
| 3193 | .. ; | |
| 3194 | "RTN","IBC NEDEP",249 ,0) | |
| 3195 | .. D PROC | |
| 3196 | "RTN","IBC NEDEP",250 ,0) | |
| 3197 | .. ; | |
| 3198 | "RTN","IBC NEDEP",251 ,0) | |
| 3199 | .. ;I VNU M=4 S HLP( "CONTPTR") =$G(OMSGID ) ; IB*621 - HAN | |
| 3200 | "RTN","IBC NEDEP",252 ,0) | |
| 3201 | .. D GENE RATE^HLMA( IBCNHLP,"G M",1,.HLRE SLT,"",.HL P) | |
| 3202 | "RTN","IBC NEDEP",253 ,0) | |
| 3203 | .. K ^TMP ("HLS",$J) ,HLP | |
| 3204 | "RTN","IBC NEDEP",254 ,0) | |
| 3205 | .. ; | |
| 3206 | "RTN","IBC NEDEP",255 ,0) | |
| 3207 | .. ; If not succes sful | |
| 3208 | "RTN","IBC NEDEP",256 ,0) | |
| 3209 | .. I $P(H LRESLT,U,2 )]"" D HLE R^IBCNEDEQ Q | |
| 3210 | "RTN","IBC NEDEP",257 ,0) | |
| 3211 | .. ; | |
| 3212 | "RTN","IBC NEDEP",258 ,0) | |
| 3213 | .. ; If successful | |
| 3214 | "RTN","IBC NEDEP",259 ,0) | |
| 3215 | .. D SCC^ IBCNEDEQ | |
| 3216 | "RTN","IBC NEDEP",260 ,0) | |
| 3217 | .. ; IB*6 21 - HAN S et DATE LA ST EICD RU N | |
| 3218 | "RTN","IBC NEDEP",261 ,0) | |
| 3219 | .. S DA=D FN,DIE="^D PT(",DR="2 001///"_DT | |
| 3220 | "RTN","IBC NEDEP",262 ,0) | |
| 3221 | .. D ^DIE | |
| 3222 | "RTN","IBC NEDEP",263 ,0) | |
| 3223 | ; | |
| 3224 | "RTN","IBC NEDEP",264 ,0) | |
| 3225 | Q | |
| 3226 | "RTN","IBC NEDEP",265 ,0) | |
| 3227 | ; | |
| 3228 | "RTN","IBC NEDEP",266 ,0) | |
| 3229 | PROC ; Pr ocess TQ r ecord | |
| 3230 | "RTN","IBC NEDEP",267 ,0) | |
| 3231 | S TRANSR= $G(^IBCN(3 65.1,IEN,0 )) | |
| 3232 | "RTN","IBC NEDEP",268 ,0) | |
| 3233 | S DFN=$P( TRANSR,U,2 ),PAYR=$P( TRANSR,U,3 ),BUFF=$P( TRANSR,U,5 ) | |
| 3234 | "RTN","IBC NEDEP",269 ,0) | |
| 3235 | S QUERY=$ P(TRANSR,U ,11),EXT=$ P(TRANSR,U ,10),SRVDT =$P(TRANSR ,U,12) | |
| 3236 | "RTN","IBC NEDEP",270 ,0) | |
| 3237 | S IRIEN=$ P(TRANSR,U ,13),HCT=0 ,NTRAN=$P( TRANSR,U,7 ),NRETR=$P (TRANSR,U, 8) | |
| 3238 | "RTN","IBC NEDEP",271 ,0) | |
| 3239 | S SUBID=$ P(TRANSR,U ,16),OVRID E=$P(TRANS R,U,14),ST A=$P(TRANS R,U,4) | |
| 3240 | "RTN","IBC NEDEP",272 ,0) | |
| 3241 | S FRDT=$P (TRANSR,U, 17),PATID= $P(TRANSR, U,19),EICD VIEN=$P(TR ANSR,U,21) | |
| 3242 | "RTN","IBC NEDEP",273 ,0) | |
| 3243 | ; | |
| 3244 | "RTN","IBC NEDEP",274 ,0) | |
| 3245 | ; Build the HL7 ms g | |
| 3246 | "RTN","IBC NEDEP",275 ,0) | |
| 3247 | S HCT=HCT +1,^TMP("H LS",$J,HCT )="PRD|NA" | |
| 3248 | "RTN","IBC NEDEP",276 ,0) | |
| 3249 | D PID^IBC NEHLQ I PI D=""!(PID? ."*") Q | |
| 3250 | "RTN","IBC NEDEP",277 ,0) | |
| 3251 | S HCT=HCT +1,^TMP("H LS",$J,HCT )=$TR(PID, "*","") | |
| 3252 | "RTN","IBC NEDEP",278 ,0) | |
| 3253 | D GT1^IBC NEHLQ I GT 1'="",GT1' ?."*" S HC T=HCT+1,^T MP("HLS",$ J,HCT)=$TR (GT1,"*"," ") | |
| 3254 | "RTN","IBC NEDEP",279 ,0) | |
| 3255 | D IN1^IBC NEHLQ I IN 1'="",IN1' ?."*" D | |
| 3256 | "RTN","IBC NEDEP",280 ,0) | |
| 3257 | . S HCT=H CT+1 | |
| 3258 | "RTN","IBC NEDEP",281 ,0) | |
| 3259 | . I VNUM= 1 S ^TMP(" HLS",$J,HC T)=$TR(IN1 ,"*","") Q | |
| 3260 | "RTN","IBC NEDEP",282 ,0) | |
| 3261 | . I VNUM= 2,'BNDL S ^TMP("HLS" ,$J,HCT)=$ TR(IN1,"*" ,"") Q | |
| 3262 | "RTN","IBC NEDEP",283 ,0) | |
| 3263 | . S CNT=C NT+1 I TOT =0 S TOT=1 | |
| 3264 | "RTN","IBC NEDEP",284 ,0) | |
| 3265 | . S $P(IN 1,HLFS,22) =TOT,$P(IN 1,HLFS,21) =CNT | |
| 3266 | "RTN","IBC NEDEP",285 ,0) | |
| 3267 | . S ^TMP( "HLS",$J,H CT)=$TR(IN 1,"*","") | |
| 3268 | "RTN","IBC NEDEP",286 ,0) | |
| 3269 | ; | |
| 3270 | "RTN","IBC NEDEP",287 ,0) | |
| 3271 | ; Build multi-fiel d NTE segm ent | |
| 3272 | "RTN","IBC NEDEP",288 ,0) | |
| 3273 | D NTE^IBC NEHLQ(1) | |
| 3274 | "RTN","IBC NEDEP",289 ,0) | |
| 3275 | ; If bui ld success ful | |
| 3276 | "RTN","IBC NEDEP",290 ,0) | |
| 3277 | I NTE'="" ,$E(NTE,1) '="*" S HC T=HCT+1,^T MP("HLS",$ J,HCT)=$TR (NTE,"*"," ") | |
| 3278 | "RTN","IBC NEDEP",291 ,0) | |
| 3279 | ; IB*2.0* 601 - Adde d NTE 2 & 3 | |
| 3280 | "RTN","IBC NEDEP",292 ,0) | |
| 3281 | D NTE^IBC NEHLQ(2) | |
| 3282 | "RTN","IBC NEDEP",293 ,0) | |
| 3283 | ; If buil d successf ul Second NTE segmen t | |
| 3284 | "RTN","IBC NEDEP",294 ,0) | |
| 3285 | I NTE'="" ,$E(NTE,1) '="*" S HC T=HCT+1,^T MP("HLS",$ J,HCT)=$TR (NTE,"*"," ") | |
| 3286 | "RTN","IBC NEDEP",295 ,0) | |
| 3287 | D NTE^IBC NEHLQ(3) | |
| 3288 | "RTN","IBC NEDEP",296 ,0) | |
| 3289 | ; set the third NTE segment | |
| 3290 | "RTN","IBC NEDEP",297 ,0) | |
| 3291 | I NTE'="" ,$E(NTE,1) '="*" S HC T=HCT+1,^T MP("HLS",$ J,HCT)=$TR (NTE,"*"," ") | |
| 3292 | "RTN","IBC NEDEP",298 ,0) | |
| 3293 | ; IB*601 - End HAN | |
| 3294 | "RTN","IBC NEDEP",299 ,0) | |
| 3295 | ; IB*2.0* 621 | |
| 3296 | "RTN","IBC NEDEP",300 ,0) | |
| 3297 | D NTE^IBC NEHLQ(4) | |
| 3298 | "RTN","IBC NEDEP",301 ,0) | |
| 3299 | ; set the fourth NT E segment | |
| 3300 | "RTN","IBC NEDEP",302 ,0) | |
| 3301 | S HCT=HCT +1,^TMP("H LS",$J,HCT )=$TR(NTE, "*","") | |
| 3302 | "RTN","IBC NEDEP",303 ,0) | |
| 3303 | D NTE^IBC NEHLQ(5) | |
| 3304 | "RTN","IBC NEDEP",304 ,0) | |
| 3305 | ; set the fifth NTE segment | |
| 3306 | "RTN","IBC NEDEP",305 ,0) | |
| 3307 | S HCT=HCT +1,^TMP("H LS",$J,HCT )=$TR(NTE, "*","") | |
| 3308 | "RTN","IBC NEDEP",306 ,0) | |
| 3309 | ; IB*621 - End HAN | |
| 3310 | "RTN","IBC NEDEP",307 ,0) | |
| 3311 | K NTE | |
| 3312 | "RTN","IBC NEDEP",308 ,0) | |
| 3313 | Q | |
| 3314 | "RTN","IBC NEDEP",309 ,0) | |
| 3315 | ; | |
| 3316 | "RTN","IBC NEDEP",310 ,0) | |
| 3317 | ; The tag HLD was f ound at th e top of t his routin e. It was moved | |
| 3318 | "RTN","IBC NEDEP",311 ,0) | |
| 3319 | ; to its own proced ure becaus e it isn't needed an ymore at t his time. | |
| 3320 | "RTN","IBC NEDEP",312 ,0) | |
| 3321 | ; Respons es will no t have the status of HOLD star ting with patch IB*2 .0*506. | |
| 3322 | "RTN","IBC NEDEP",313 ,0) | |
| 3323 | ; If HOLD is reinst ated, then the logic below mus t be rewri tten for t he | |
| 3324 | "RTN","IBC NEDEP",314 ,0) | |
| 3325 | ; appropr iate retry logic at that time. | |
| 3326 | "RTN","IBC NEDEP",315 ,0) | |
| 3327 | HLD ; Go through th e 'Hold' s tatuses, s ee if read y to be 'r etried' | |
| 3328 | "RTN","IBC NEDEP",316 ,0) | |
| 3329 | Q ; Quit added as safety val ve | |
| 3330 | "RTN","IBC NEDEP",317 ,0) | |
| 3331 | ;S IEN="" | |
| 3332 | "RTN","IBC NEDEP",318 ,0) | |
| 3333 | ;F S IEN =$O(^IBCN( 365.1,"AC" ,4,IEN)) Q :IEN="" D Q:$G(ZTS TOP) | |
| 3334 | "RTN","IBC NEDEP",319 ,0) | |
| 3335 | ;. ; Upda te count f or periodi c check | |
| 3336 | "RTN","IBC NEDEP",320 ,0) | |
| 3337 | ;. S IBCN ETOT=IBCNE TOT+1 | |
| 3338 | "RTN","IBC NEDEP",321 ,0) | |
| 3339 | ;. ; Chec k for requ est to sto p backgrou nd job, pe riodically | |
| 3340 | "RTN","IBC NEDEP",322 ,0) | |
| 3341 | ;. I $D(Z TQUEUED),I BCNETOT#10 0=0,$$S^%Z TLOAD() S ZTSTOP=1 Q | |
| 3342 | "RTN","IBC NEDEP",323 ,0) | |
| 3343 | ;. ; | |
| 3344 | "RTN","IBC NEDEP",324 ,0) | |
| 3345 | ;. S FUTD T=$P($G(^I BCN(365.1, IEN,0)),U, 9) | |
| 3346 | "RTN","IBC NEDEP",325 ,0) | |
| 3347 | ;. ; | |
| 3348 | "RTN","IBC NEDEP",326 ,0) | |
| 3349 | ;. ; If the future date is t oday, set status to 'Retry', | |
| 3350 | "RTN","IBC NEDEP",327 ,0) | |
| 3351 | ;. ; DON 'T clear f uture tran smission d ate. (Need date to s ee if this is the fi rst | |
| 3352 | "RTN","IBC NEDEP",328 ,0) | |
| 3353 | ;. ; tim e that the payer ask ed us to r esubmit th is inquiry .) | |
| 3354 | "RTN","IBC NEDEP",329 ,0) | |
| 3355 | ;. I FUTD T'>DT D SS T^IBCNEUT2 (IEN,6) ;D | |
| 3356 | "RTN","IBC NEDEP",330 ,0) | |
| 3357 | ;. ;. NEW DA,DIE,DR | |
| 3358 | "RTN","IBC NEDEP",331 ,0) | |
| 3359 | ;. ;. S D A=IEN,DIE= "^IBCN(365 .1,",DR=". 09///@" D ^DIE | |
| 3360 | "RTN","IBC NEDEP",332 ,0) | |
| 3361 | ;.. ; | |
| 3362 | "RTN","IBC NEDEP",333 ,0) | |
| 3363 | ;.. D SST ^IBCNEUT2( IEN,6) ; set TQ status to 'retry' | |
| 3364 | "RTN","IBC NEDEP",334 ,0) | |
| 3365 | Q | |
| 3366 | "RTN","IBC NEHL1") | |
| 3367 | 0^15^B1917 24717^B169 495376 | |
| 3368 | "RTN","IBC NEHL1",1,0 ) | |
| 3369 | IBCNEHL1 ; DAOU/ALA - HL7 Proce ss Incomin g RPI Mess ages ;26-J UN-2002 | |
| 3370 | "RTN","IBC NEHL1",2,0 ) | |
| 3371 | ;;2.0;INT EGRATED BI LLING;**30 0,345,416, 444,438,49 7,506,549, 593,601,59 5,621**;21 -MAR-94;Bu ild 8 | |
| 3372 | "RTN","IBC NEHL1",3,0 ) | |
| 3373 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 3374 | "RTN","IBC NEHL1",4,0 ) | |
| 3375 | ; | |
| 3376 | "RTN","IBC NEHL1",5,0 ) | |
| 3377 | ;**Progra m Descript ion** | |
| 3378 | "RTN","IBC NEHL1",6,0 ) | |
| 3379 | ; This p rogram wil l process incoming I IV respons e messages . | |
| 3380 | "RTN","IBC NEHL1",7,0 ) | |
| 3381 | ; This i ncludes up dating the record in the IIV R esponse Fi le, | |
| 3382 | "RTN","IBC NEHL1",8,0 ) | |
| 3383 | ; updati ng the Buf fer record (if there is one an d creating a new | |
| 3384 | "RTN","IBC NEHL1",9,0 ) | |
| 3385 | ; one if there isn 't) with t he appropr iate Buffe r Symbol a nd data | |
| 3386 | "RTN","IBC NEHL1",10, 0) | |
| 3387 | ; | |
| 3388 | "RTN","IBC NEHL1",11, 0) | |
| 3389 | ; Variab les | |
| 3390 | "RTN","IBC NEHL1",12, 0) | |
| 3391 | ; ACK - Ac knowledgme nt (AA=Acc epted, AE= Error) | |
| 3392 | "RTN","IBC NEHL1",13, 0) | |
| 3393 | ; ERAC T - Er ror Action | |
| 3394 | "RTN","IBC NEHL1",14, 0) | |
| 3395 | ; ERCO N - Er ror Condit ion | |
| 3396 | "RTN","IBC NEHL1",15, 0) | |
| 3397 | ; ERFL G - Er ror quit f lag | |
| 3398 | "RTN","IBC NEHL1",16, 0) | |
| 3399 | ; ERTX T - Er ror Messag e Text | |
| 3400 | "RTN","IBC NEHL1",17, 0) | |
| 3401 | ; HL - Ar ray of HL7 variables | |
| 3402 | "RTN","IBC NEHL1",18, 0) | |
| 3403 | ; IBSE G - Op tional, ar ray of fie lds in seg ment | |
| 3404 | "RTN","IBC NEHL1",19, 0) | |
| 3405 | ; IIVS TAT - EC generated flag inte rpreting s tatus of r esponse | |
| 3406 | "RTN","IBC NEHL1",20, 0) | |
| 3407 | ; 1 = + (auto -update re quirement) | |
| 3408 | "RTN","IBC NEHL1",21, 0) | |
| 3409 | ; 6 = - | |
| 3410 | "RTN","IBC NEHL1",22, 0) | |
| 3411 | ; V = # | |
| 3412 | "RTN","IBC NEHL1",23, 0) | |
| 3413 | ; M BI% = % ; will not receive f rom FSC, d erived in FIL^IBCNEH L6 | |
| 3414 | "RTN","IBC NEHL1",24, 0) | |
| 3415 | ; M BI# = # ; will not receive f rom FSC, d erived in FIL^IBCNEH L6 | |
| 3416 | "RTN","IBC NEHL1",25, 0) | |
| 3417 | ; MAP - Ar ray that m aps EC's I IV status flag to II V STATUS T ABLE (#365 .15) IEN | |
| 3418 | "RTN","IBC NEHL1",26, 0) | |
| 3419 | ; MSGI D - Or iginal Mes sage Contr ol ID | |
| 3420 | "RTN","IBC NEHL1",27, 0) | |
| 3421 | ; RIEN - Re sponse Rec ord IEN | |
| 3422 | "RTN","IBC NEHL1",28, 0) | |
| 3423 | ; SEG - HL 7 Segment Name | |
| 3424 | "RTN","IBC NEHL1",29, 0) | |
| 3425 | ; | |
| 3426 | "RTN","IBC NEHL1",30, 0) | |
| 3427 | ;IB*2.0*6 21/TAZ - A dded to in sure that routine is called vi a entry po int EN wit h the even t type. | |
| 3428 | "RTN","IBC NEHL1",31, 0) | |
| 3429 | Q ;No di rect entry to routin e. Call l abel EN wi th paramet er | |
| 3430 | "RTN","IBC NEHL1",32, 0) | |
| 3431 | ; | |
| 3432 | "RTN","IBC NEHL1",33, 0) | |
| 3433 | ;IB*2.0*6 21/TAZ - A dded EVENT YP to cont rol type o f event pr ocessing. | |
| 3434 | "RTN","IBC NEHL1",34, 0) | |
| 3435 | EN(EVENTYP ) ; Entry Point | |
| 3436 | "RTN","IBC NEHL1",35, 0) | |
| 3437 | ;EVENTYP= 1 > EICD Identifica tion Respo nse (RPI^I O4) | |
| 3438 | "RTN","IBC NEHL1",36, 0) | |
| 3439 | ;EVENTYP= 2 > Norma l 271 Resp onse (RPI^ IO1) | |
| 3440 | "RTN","IBC NEHL1",37, 0) | |
| 3441 | N ACK,AUT O,EBDA,ERA CT,ERCON,E RFLG,ERROR ,ERTXT,G2O FLG,HCT,HL CMP,HLREP, HLSCMP,IBT RACK | |
| 3442 | "RTN","IBC NEHL1",38, 0) | |
| 3443 | N IIVSTAT ,IRIEN,MAP ,MGRP,RIEN ,RSUPDT,SE G,SUBID,TR ACE,TRKIEN ,UP | |
| 3444 | "RTN","IBC NEHL1",39, 0) | |
| 3445 | S (ERFLG, G2OFLG)=0, MGRP=$$MGR P^IBCNEUT5 (),HCT=1,S UBID="",II VSTAT="" | |
| 3446 | "RTN","IBC NEHL1",40, 0) | |
| 3447 | ; | |
| 3448 | "RTN","IBC NEHL1",41, 0) | |
| 3449 | S HLCMP=$ E(HL("ECH" )) ; HL7 c omponent s eparator | |
| 3450 | "RTN","IBC NEHL1",42, 0) | |
| 3451 | S HLSCMP= $E(HL("ECH "),4) ; HL 7 subcompo nent separ ator | |
| 3452 | "RTN","IBC NEHL1",43, 0) | |
| 3453 | S HLREP=$ E(HL("ECH" ),2) ; HL7 repetitio n separato r | |
| 3454 | "RTN","IBC NEHL1",44, 0) | |
| 3455 | ; Create map from E C to VistA | |
| 3456 | "RTN","IBC NEHL1",45, 0) | |
| 3457 | S MAP(1)= 8,MAP(6)=9 ,MAP("V")= 21 ; The se are X12 codes map ped from E C to VistA | |
| 3458 | "RTN","IBC NEHL1",46, 0) | |
| 3459 | S MAP("MB I%")=26,MA P("MBI#")= 27 ; The se are NOT X12 codes from FSC - we deriv e them onl y for MBI responses | |
| 3460 | "RTN","IBC NEHL1",47, 0) | |
| 3461 | ; | |
| 3462 | "RTN","IBC NEHL1",48, 0) | |
| 3463 | ; Loop t hrough the message a nd find ea ch segment for proce ssing | |
| 3464 | "RTN","IBC NEHL1",49, 0) | |
| 3465 | F S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT="" D Q:ERFLG | |
| 3466 | "RTN","IBC NEHL1",50, 0) | |
| 3467 | .D SPAR^I BCNEHLU | |
| 3468 | "RTN","IBC NEHL1",51, 0) | |
| 3469 | .S SEG=$G (IBSEG(1)) | |
| 3470 | "RTN","IBC NEHL1",52, 0) | |
| 3471 | .; check if we are inside G2O group of segments | |
| 3472 | "RTN","IBC NEHL1",53, 0) | |
| 3473 | .I SEG="Z TY" S G2OF LG=1 | |
| 3474 | "RTN","IBC NEHL1",54, 0) | |
| 3475 | .I G2OFLG ,SEG'="ZTY ",SEG'="CT D" S G2OFL G=0 | |
| 3476 | "RTN","IBC NEHL1",55, 0) | |
| 3477 | .; If we are outsid e of Z_Ben efit_group , kill EB multiple i en | |
| 3478 | "RTN","IBC NEHL1",56, 0) | |
| 3479 | .; I +$G( EBDA),".MS H.MSA.PRD. PID.GT1.IN 1.IN3."[(" ."_SEG_"." )!('G2OFLG &(SEG="CTD ")) K EBDA | |
| 3480 | "RTN","IBC NEHL1",57, 0) | |
| 3481 | .; | |
| 3482 | "RTN","IBC NEHL1",58, 0) | |
| 3483 | .Q:SEG="P RD" ; IB* 2*497 PRD segment i s not proc essed | |
| 3484 | "RTN","IBC NEHL1",59, 0) | |
| 3485 | .; | |
| 3486 | "RTN","IBC NEHL1",60, 0) | |
| 3487 | .I SEG="M SA" D MSA^ IBCNEHL2(. ERACT,.ERC ON,.ERROR, .ERTXT,.IB SEG,MGRP,. RIEN,.TRAC E,EVENTYP) Q | |
| 3488 | "RTN","IBC NEHL1",61, 0) | |
| 3489 | .; | |
| 3490 | "RTN","IBC NEHL1",62, 0) | |
| 3491 | .; Conta ct Segment | |
| 3492 | "RTN","IBC NEHL1",63, 0) | |
| 3493 | .I SEG="C TD",'G2OFL G D CTD^IB CNEHL2(.ER ROR,.IBSEG ,RIEN) Q | |
| 3494 | "RTN","IBC NEHL1",64, 0) | |
| 3495 | .; | |
| 3496 | "RTN","IBC NEHL1",65, 0) | |
| 3497 | .; Patie nt Segment | |
| 3498 | "RTN","IBC NEHL1",66, 0) | |
| 3499 | .I SEG="P ID" D PID^ IBCNEHL2(. ERFLG,.ERR OR,.IBSEG, RIEN) Q | |
| 3500 | "RTN","IBC NEHL1",67, 0) | |
| 3501 | .; | |
| 3502 | "RTN","IBC NEHL1",68, 0) | |
| 3503 | .; Guara ntor Segme nt | |
| 3504 | "RTN","IBC NEHL1",69, 0) | |
| 3505 | .;IB*2.0* 621/TAZ Pa ss EVENTYP along | |
| 3506 | "RTN","IBC NEHL1",70, 0) | |
| 3507 | .I SEG="G T1" D GT1^ IBCNEHL2(. ERROR,.IBS EG,RIEN,.S UBID,EVENT YP) Q | |
| 3508 | "RTN","IBC NEHL1",71, 0) | |
| 3509 | .; | |
| 3510 | "RTN","IBC NEHL1",72, 0) | |
| 3511 | .; Insur ance Segme nt | |
| 3512 | "RTN","IBC NEHL1",73, 0) | |
| 3513 | .;IB*2.0* 621/TAZ Pa ss EVENTYP along | |
| 3514 | "RTN","IBC NEHL1",74, 0) | |
| 3515 | .I SEG="I N1" D IN1^ IBCNEHL2(. ERROR,.IBS EG,RIEN,SU BID,EVENTY P) Q | |
| 3516 | "RTN","IBC NEHL1",75, 0) | |
| 3517 | .; | |
| 3518 | "RTN","IBC NEHL1",76, 0) | |
| 3519 | .; Addt' l Insuranc e Segment | |
| 3520 | "RTN","IBC NEHL1",77, 0) | |
| 3521 | .;I SEG=" IN2" ; for future ex pansion, a dd IN2 tag to IBCNEH L2 | |
| 3522 | "RTN","IBC NEHL1",78, 0) | |
| 3523 | .; | |
| 3524 | "RTN","IBC NEHL1",79, 0) | |
| 3525 | .; Addt' l Insuranc e - Cert S egment | |
| 3526 | "RTN","IBC NEHL1",80, 0) | |
| 3527 | .I SEG="I N3" D IN3^ IBCNEHL2(. ERROR,.IBS EG,RIEN) Q | |
| 3528 | "RTN","IBC NEHL1",81, 0) | |
| 3529 | .; | |
| 3530 | "RTN","IBC NEHL1",82, 0) | |
| 3531 | .; IB*2*4 97 GROUP L EVEL REFER ENCE ID se gment (x12 loops 210 0C and 210 0D) | |
| 3532 | "RTN","IBC NEHL1",83, 0) | |
| 3533 | . I SEG=" ZRF",'$D(E BDA) D GZR F^IBCNEHL5 (.ERROR,.I BSEG,RIEN) Q | |
| 3534 | "RTN","IBC NEHL1",84, 0) | |
| 3535 | .; | |
| 3536 | "RTN","IBC NEHL1",85, 0) | |
| 3537 | .; Eligi bility/Ben efit Segme nt | |
| 3538 | "RTN","IBC NEHL1",86, 0) | |
| 3539 | .I SEG="Z EB" D ZEB^ IBCNEHL2(. EBDA,.ERRO R,.IBSEG,R IEN) Q | |
| 3540 | "RTN","IBC NEHL1",87, 0) | |
| 3541 | .; | |
| 3542 | "RTN","IBC NEHL1",88, 0) | |
| 3543 | .; Health care Deliv ery Segmen t | |
| 3544 | "RTN","IBC NEHL1",89, 0) | |
| 3545 | .I SEG="Z HS" D ZHS^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3546 | "RTN","IBC NEHL1",90, 0) | |
| 3547 | .; | |
| 3548 | "RTN","IBC NEHL1",91, 0) | |
| 3549 | .; Benefi t level Re ference ID Segment (X12 loops 2110C and 2110D) | |
| 3550 | "RTN","IBC NEHL1",92, 0) | |
| 3551 | .I SEG="Z RF",+$G(EB DA) D ZRF^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q ;IB *2*497 add check to make sure z benefit group | |
| 3552 | "RTN","IBC NEHL1",93, 0) | |
| 3553 | .; | |
| 3554 | "RTN","IBC NEHL1",94, 0) | |
| 3555 | .; Subscr iber Date Segment | |
| 3556 | "RTN","IBC NEHL1",95, 0) | |
| 3557 | .I SEG="Z SD" D ZSD^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3558 | "RTN","IBC NEHL1",96, 0) | |
| 3559 | .; | |
| 3560 | "RTN","IBC NEHL1",97, 0) | |
| 3561 | .; Subscr iber Addit ional Info Segment | |
| 3562 | "RTN","IBC NEHL1",98, 0) | |
| 3563 | .I SEG="Z II" D ZII^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3564 | "RTN","IBC NEHL1",99, 0) | |
| 3565 | .; | |
| 3566 | "RTN","IBC NEHL1",100 ,0) | |
| 3567 | .; Benefi t Related Entity Seg ment | |
| 3568 | "RTN","IBC NEHL1",101 ,0) | |
| 3569 | .I SEG="Z TY" D ZTY^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3570 | "RTN","IBC NEHL1",102 ,0) | |
| 3571 | .; | |
| 3572 | "RTN","IBC NEHL1",103 ,0) | |
| 3573 | .; Benefi t Related Entity Con tact Segme nt | |
| 3574 | "RTN","IBC NEHL1",104 ,0) | |
| 3575 | .I SEG="C TD",G2OFLG D G2OCTD^ IBCNEHL4(E BDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3576 | "RTN","IBC NEHL1",105 ,0) | |
| 3577 | .; | |
| 3578 | "RTN","IBC NEHL1",106 ,0) | |
| 3579 | .; Benefi t Related Entity Not es Segment | |
| 3580 | "RTN","IBC NEHL1",107 ,0) | |
| 3581 | .I SEG="N TE",+$G(EB DA) D EBNT E^IBCNEHL2 (EBDA,.IBS EG,RIEN) Q | |
| 3582 | "RTN","IBC NEHL1",108 ,0) | |
| 3583 | .; | |
| 3584 | "RTN","IBC NEHL1",109 ,0) | |
| 3585 | .; Reject Reasons S egment | |
| 3586 | "RTN","IBC NEHL1",110 ,0) | |
| 3587 | .I SEG="E RR" K ERDA D ERR^IBC NEHL4(.ERD A,.ERROR,. IBSEG,RIEN ) Q | |
| 3588 | "RTN","IBC NEHL1",111 ,0) | |
| 3589 | .; | |
| 3590 | "RTN","IBC NEHL1",112 ,0) | |
| 3591 | .; Notes Segment | |
| 3592 | "RTN","IBC NEHL1",113 ,0) | |
| 3593 | .I SEG="N TE",'$D(EB DA),+$G(ER DA) D NTE^ IBCNEHL4(E RDA,.ERROR ,.IBSEG,RI EN) Q | |
| 3594 | "RTN","IBC NEHL1",114 ,0) | |
| 3595 | .; | |
| 3596 | "RTN","IBC NEHL1",115 ,0) | |
| 3597 | .; Subscr iber date segment (s ubscriber level) | |
| 3598 | "RTN","IBC NEHL1",116 ,0) | |
| 3599 | .I SEG="Z TP" D ZTP^ IBCNEHL4(. ERROR,.IBS EG,RIEN) Q | |
| 3600 | "RTN","IBC NEHL1",117 ,0) | |
| 3601 | . ; ib*2* 497 - ad d processi ng for ROL , DG1, and ZMP segme nts | |
| 3602 | "RTN","IBC NEHL1",118 ,0) | |
| 3603 | . ; Provi der Code s egment | |
| 3604 | "RTN","IBC NEHL1",119 ,0) | |
| 3605 | . I SEG=" ROL" D ROL ^IBCNEHL5( .ERROR,.IB SEG,RIEN) Q | |
| 3606 | "RTN","IBC NEHL1",120 ,0) | |
| 3607 | . ; | |
| 3608 | "RTN","IBC NEHL1",121 ,0) | |
| 3609 | . ; Healt h Care Dia gnosis Cod e segment | |
| 3610 | "RTN","IBC NEHL1",122 ,0) | |
| 3611 | . I SEG=" DG1" D DG1 ^IBCNEHL5( .ERROR,.IB SEG,RIEN) Q | |
| 3612 | "RTN","IBC NEHL1",123 ,0) | |
| 3613 | .; | |
| 3614 | "RTN","IBC NEHL1",124 ,0) | |
| 3615 | .; Milita ry Personn el Informa tion segme nt | |
| 3616 | "RTN","IBC NEHL1",125 ,0) | |
| 3617 | . I SEG=" ZMP" D ZMP ^IBCNEHL5( .ERROR,.IB SEG,RIEN) | |
| 3618 | "RTN","IBC NEHL1",126 ,0) | |
| 3619 | ; | |
| 3620 | "RTN","IBC NEHL1",127 ,0) | |
| 3621 | ;IB*2.0*6 21/TAZ - F ile EICD I dentificat ion Respon se | |
| 3622 | "RTN","IBC NEHL1",128 ,0) | |
| 3623 | I EVENTYP =1 S TRKIE N=$$SVEICD ^IBCNEHL7( ) | |
| 3624 | "RTN","IBC NEHL1",129 ,0) | |
| 3625 | ;IB*2.0*6 21/TAZ - U pdate EIV EICD TRACK ING FILE f or EICD ve rification Response | |
| 3626 | "RTN","IBC NEHL1",130 ,0) | |
| 3627 | I EVENTYP =2 D | |
| 3628 | "RTN","IBC NEHL1",131 ,0) | |
| 3629 | . N D0,D1 ,FDA,IENS, TQN,EXT | |
| 3630 | "RTN","IBC NEHL1",132 ,0) | |
| 3631 | . S TQN=$ $GET1^DIQ( 365,RIEN_" ,",.05,"I" ) | |
| 3632 | "RTN","IBC NEHL1",133 ,0) | |
| 3633 | . S EXT=$ $GET1^DIQ( 365.1,TQN_ ",",.1,"I" ) | |
| 3634 | "RTN","IBC NEHL1",134 ,0) | |
| 3635 | . I EXT'= 4 Q | |
| 3636 | "RTN","IBC NEHL1",135 ,0) | |
| 3637 | . S D0=$O (^IBCN(365 .18,"C",TQ N,"")) Q:' D0 S D1=$ O(^IBCN(36 5.18,"C",T QN,D0,"")) Q:'D1 | |
| 3638 | "RTN","IBC NEHL1",136 ,0) | |
| 3639 | . S IENS= D1_","_D0_ "," | |
| 3640 | "RTN","IBC NEHL1",137 ,0) | |
| 3641 | . S FDA(3 65.185,IEN S,1.03)=RI EN | |
| 3642 | "RTN","IBC NEHL1",138 ,0) | |
| 3643 | . I ERACT '=""!(ERTX T'="") S F DA(365.185 ,IENS,1.04 )=0 ;Erro r response | |
| 3644 | "RTN","IBC NEHL1",139 ,0) | |
| 3645 | . I IIVST AT=1 S FDA (365.185,I ENS,1.04)= 1 ;Active | |
| 3646 | "RTN","IBC NEHL1",140 ,0) | |
| 3647 | . I IIVST AT=6 S FDA (365.185,I ENS,1.04)= 2 ;Inacti ve | |
| 3648 | "RTN","IBC NEHL1",141 ,0) | |
| 3649 | . I IIVST AT="V" S F DA(365.185 ,IENS,1.04 )=3 ;Ambi guous | |
| 3650 | "RTN","IBC NEHL1",142 ,0) | |
| 3651 | . D FILE^ DIE("","FD A"),CLEAN^ DILF | |
| 3652 | "RTN","IBC NEHL1",143 ,0) | |
| 3653 | ; | |
| 3654 | "RTN","IBC NEHL1",144 ,0) | |
| 3655 | S AUTO=$$ AUTOUPD(RI EN) | |
| 3656 | "RTN","IBC NEHL1",145 ,0) | |
| 3657 | I $G(ACK) '="AE",$G( ERACT)="", $G(ERTXT)= "",'$D(ERR OR),+AUTO D Q | |
| 3658 | "RTN","IBC NEHL1",146 ,0) | |
| 3659 | .D:$P(AUT O,U,3)'="" AUTOFIL($ P(AUTO,U,2 ),$P(AUTO, U,3),$P(AU TO,U,6)) | |
| 3660 | "RTN","IBC NEHL1",147 ,0) | |
| 3661 | .D:$P(AUT O,U,4)'="" AUTOFIL($ P(AUTO,U,2 ),$P(AUTO, U,4),$P(AU TO,U,6)) | |
| 3662 | "RTN","IBC NEHL1",148 ,0) | |
| 3663 | .Q | |
| 3664 | "RTN","IBC NEHL1",149 ,0) | |
| 3665 | D FIL | |
| 3666 | "RTN","IBC NEHL1",150 ,0) | |
| 3667 | ; | |
| 3668 | "RTN","IBC NEHL1",151 ,0) | |
| 3669 | ENX ; | |
| 3670 | "RTN","IBC NEHL1",152 ,0) | |
| 3671 | Q | |
| 3672 | "RTN","IBC NEHL1",153 ,0) | |
| 3673 | ; | |
| 3674 | "RTN","IBC NEHL1",154 ,0) | |
| 3675 | ; ======= ========== ========== ========== ========== ========== ======== | |
| 3676 | "RTN","IBC NEHL1",155 ,0) | |
| 3677 | AUTOFIL(DF N,IEN312,I SSUB) ; Fi nish proce ssing the response m essage - f ile direct ly into pa tient insu rance | |
| 3678 | "RTN","IBC NEHL1",156 ,0) | |
| 3679 | ; | |
| 3680 | "RTN","IBC NEHL1",157 ,0) | |
| 3681 | N BUFF,DA TA,ERROR,I ENS,MIL,OK AY,PREL,RD ATA0,RDATA 1,RDATA5,R DATA13,RST YPE,TQN,TS TAMP,XX ; IB*2.0*4 97 (vd) | |
| 3682 | "RTN","IBC NEHL1",158 ,0) | |
| 3683 | ; | |
| 3684 | "RTN","IBC NEHL1",159 ,0) | |
| 3685 | Q:$G(RIEN )="" | |
| 3686 | "RTN","IBC NEHL1",160 ,0) | |
| 3687 | S TSTAMP= $$NOW^XLFD T(),IENS=I EN312_","_ DFN_"," | |
| 3688 | "RTN","IBC NEHL1",161 ,0) | |
| 3689 | S RDATA0= $G(^IBCN(3 65,RIEN,0) ),RDATA1=$ G(^IBCN(36 5,RIEN,1)) ,RDATA5=$G (^IBCN(365 ,RIEN,5)) | |
| 3690 | "RTN","IBC NEHL1",162 ,0) | |
| 3691 | S RDATA13 =$G(^IBCN( 365,RIEN,1 3)) ; IB*2.0 *497 (vd) | |
| 3692 | "RTN","IBC NEHL1",163 ,0) | |
| 3693 | S TQN=$P( RDATA0,U,5 ),RSTYPE=$ P(RDATA0,U ,10) | |
| 3694 | "RTN","IBC NEHL1",164 ,0) | |
| 3695 | ;\Beginni ng IB*2.0* 549 - Modi fied the f ollowing l ines | |
| 3696 | "RTN","IBC NEHL1",165 ,0) | |
| 3697 | S XX=$$GE T1^DIQ(2.3 12,IENS,7. 01,"I") | |
| 3698 | "RTN","IBC NEHL1",166 ,0) | |
| 3699 | I ISSUB,X X="" S DAT A(2.312,IE NS,7.01)=$ P(RDATA13, U) ; Na me | |
| 3700 | "RTN","IBC NEHL1",167 ,0) | |
| 3701 | S XX=$$GE T1^DIQ(2.3 12,IENS,3. 01,"I") | |
| 3702 | "RTN","IBC NEHL1",168 ,0) | |
| 3703 | I XX="" S DATA(2.31 2,IENS,3.0 1)=$P(RDAT A1,U,2) ; DO B | |
| 3704 | "RTN","IBC NEHL1",169 ,0) | |
| 3705 | S XX=$$GE T1^DIQ(2.3 12,IENS,3. 05,"I") | |
| 3706 | "RTN","IBC NEHL1",170 ,0) | |
| 3707 | I XX="" S DATA(2.31 2,IENS,3.0 5)=$P(RDAT A1,U,3) ; SS N | |
| 3708 | "RTN","IBC NEHL1",171 ,0) | |
| 3709 | S XX=$$GE T1^DIQ(2.3 12,IENS,6, "I") | |
| 3710 | "RTN","IBC NEHL1",172 ,0) | |
| 3711 | I ISSUB,X X="" S DAT A(2.312,IE NS,6)=$P(R DATA1,U,8) ; Wh ose insura nce | |
| 3712 | "RTN","IBC NEHL1",173 ,0) | |
| 3713 | ; pt. rel ationship (365,8.01) IB*2*497 code from 365,8.01 n eeds evalu ation and possible c onversion | |
| 3714 | "RTN","IBC NEHL1",174 ,0) | |
| 3715 | S PREL=$$ GET1^DIQ(3 65,RIEN,8. 01) | |
| 3716 | "RTN","IBC NEHL1",175 ,0) | |
| 3717 | S XX=$$GE T1^DIQ(2.3 12,IENS,4. 03,"I") | |
| 3718 | "RTN","IBC NEHL1",176 ,0) | |
| 3719 | I ISSUB,X X="",PREL' ="" D | |
| 3720 | "RTN","IBC NEHL1",177 ,0) | |
| 3721 | . S DATA( 2.312,IENS ,4.03)=$$P REL^IBCNEH LU(2.312,4 .03,PREL) | |
| 3722 | "RTN","IBC NEHL1",178 ,0) | |
| 3723 | ;\End of IB*2.0*549 changes. | |
| 3724 | "RTN","IBC NEHL1",179 ,0) | |
| 3725 | ; IB*2*59 5/DM moved the follo wing 4 lin es below | |
| 3726 | "RTN","IBC NEHL1",180 ,0) | |
| 3727 | ;S DATA(2 .312,IENS, 1.03)=TSTA MP ; D ate last v erified | |
| 3728 | "RTN","IBC NEHL1",181 ,0) | |
| 3729 | ;S DATA(2 .312,IENS, 1.04)="" ; La st verifie d by | |
| 3730 | "RTN","IBC NEHL1",182 ,0) | |
| 3731 | ;S DATA(2 .312,IENS, 1.05)=TSTA MP ; D ate last e dited | |
| 3732 | "RTN","IBC NEHL1",183 ,0) | |
| 3733 | ;S DATA(2 .312,IENS, 1.06)="" ; La st edited by | |
| 3734 | "RTN","IBC NEHL1",184 ,0) | |
| 3735 | ;S DATA(2 .312,IENS, 1.09)=5 ; Source of info = eIV | |
| 3736 | "RTN","IBC NEHL1",185 ,0) | |
| 3737 | ;IB*2.0*5 95/DM pers ist the or iginal Sou rce of Inf ormation | |
| 3738 | "RTN","IBC NEHL1",186 ,0) | |
| 3739 | ;note: ex ternal val ues are us ed to popu late DATA | |
| 3740 | "RTN","IBC NEHL1",187 ,0) | |
| 3741 | I $$GET1^ DIQ(2.312, IENS,1.09, "I")="" D | |
| 3742 | "RTN","IBC NEHL1",188 ,0) | |
| 3743 | . S XX=$$ GET1^DIQ(3 65.1,TQN_" ,1,",3.02) | |
| 3744 | "RTN","IBC NEHL1",189 ,0) | |
| 3745 | . I XX="" S XX="eIV " | |
| 3746 | "RTN","IBC NEHL1",190 ,0) | |
| 3747 | . S DATA( 2.312,IENS ,1.09)=XX | |
| 3748 | "RTN","IBC NEHL1",191 ,0) | |
| 3749 | ; | |
| 3750 | "RTN","IBC NEHL1",192 ,0) | |
| 3751 | ; Set Sub scriber ad dress Fiel ds if none of the fi elds are c urrently d efined | |
| 3752 | "RTN","IBC NEHL1",193 ,0) | |
| 3753 | ;\Beginni ng IB*2.0* 549 - Modi fied the f ollowing l ines | |
| 3754 | "RTN","IBC NEHL1",194 ,0) | |
| 3755 | S XX=$$GE T1^DIQ(2.3 12,IENS,3. 06,"I") ; Curr ent Ins St reet Line 1 | |
| 3756 | "RTN","IBC NEHL1",195 ,0) | |
| 3757 | I XX="" D | |
| 3758 | "RTN","IBC NEHL1",196 ,0) | |
| 3759 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.07,"I") ; Curr ent Ins St reet Line 2 | |
| 3760 | "RTN","IBC NEHL1",197 ,0) | |
| 3761 | . Q:XX'=" " | |
| 3762 | "RTN","IBC NEHL1",198 ,0) | |
| 3763 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.08,"I") ; Curr ent Ins Ci ty | |
| 3764 | "RTN","IBC NEHL1",199 ,0) | |
| 3765 | . Q:XX'=" " | |
| 3766 | "RTN","IBC NEHL1",200 ,0) | |
| 3767 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.09,"I") ; Curr ent Ins St ate | |
| 3768 | "RTN","IBC NEHL1",201 ,0) | |
| 3769 | . Q:XX'=" " | |
| 3770 | "RTN","IBC NEHL1",202 ,0) | |
| 3771 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.1,"I") ; Curr ent Ins Zi p | |
| 3772 | "RTN","IBC NEHL1",203 ,0) | |
| 3773 | . Q:XX'=" " | |
| 3774 | "RTN","IBC NEHL1",204 ,0) | |
| 3775 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.13,"I") ; Curr ent Ins Co untry | |
| 3776 | "RTN","IBC NEHL1",205 ,0) | |
| 3777 | . Q:XX'=" " | |
| 3778 | "RTN","IBC NEHL1",206 ,0) | |
| 3779 | . S XX=$$ GET1^DIQ(2 .312,IENS, 3.14,"I") ; Curr ent Ins Co untry Subd ivision | |
| 3780 | "RTN","IBC NEHL1",207 ,0) | |
| 3781 | . Q:XX'=" " | |
| 3782 | "RTN","IBC NEHL1",208 ,0) | |
| 3783 | . S DATA( 2.312,IENS ,3.06)=$P( RDATA5,U) ; Stre et line 1 | |
| 3784 | "RTN","IBC NEHL1",209 ,0) | |
| 3785 | . S DATA( 2.312,IENS ,3.07)=$P( RDATA5,U,2 ) ; Stre et line 2 | |
| 3786 | "RTN","IBC NEHL1",210 ,0) | |
| 3787 | . S DATA( 2.312,IENS ,3.08)=$P( RDATA5,U,3 ) ; City | |
| 3788 | "RTN","IBC NEHL1",211 ,0) | |
| 3789 | . S DATA( 2.312,IENS ,3.09)=$P( RDATA5,U,4 ) ; Stat e | |
| 3790 | "RTN","IBC NEHL1",212 ,0) | |
| 3791 | . S DATA( 2.312,IENS ,3.1)=$P(R DATA5,U,5) ; Zip | |
| 3792 | "RTN","IBC NEHL1",213 ,0) | |
| 3793 | . S DATA( 2.312,IENS ,3.13)=$P( RDATA5,U,6 ) ; Coun try | |
| 3794 | "RTN","IBC NEHL1",214 ,0) | |
| 3795 | . S DATA( 2.312,IENS ,3.14)=$P( RDATA5,U,7 ) ; Coun try subdiv ision | |
| 3796 | "RTN","IBC NEHL1",215 ,0) | |
| 3797 | ;\End of IB*2.0*549 changes. | |
| 3798 | "RTN","IBC NEHL1",216 ,0) | |
| 3799 | ; | |
| 3800 | "RTN","IBC NEHL1",217 ,0) | |
| 3801 | L +^DPT(D FN,.312,IE N312):15 I '$T D LCK ERR^IBCNEH L3 D FIL Q | |
| 3802 | "RTN","IBC NEHL1",218 ,0) | |
| 3803 | I $D(DATA ) D FILE^D IE("ET","D ATA","ERRO R") ;IB*2* 595/DM mak e sure DAT A has data | |
| 3804 | "RTN","IBC NEHL1",219 ,0) | |
| 3805 | I $D(ERRO R) D WARN^ IBCNEHL3 K ERROR D F IL G AUTOF ILX | |
| 3806 | "RTN","IBC NEHL1",220 ,0) | |
| 3807 | ; IB*2*59 5/DM set a uto-update fields | |
| 3808 | "RTN","IBC NEHL1",221 ,0) | |
| 3809 | ; the EIV AUTO-UPDA TE flag is now locat ed in the IIV Respon se file | |
| 3810 | "RTN","IBC NEHL1",222 ,0) | |
| 3811 | ;set eIV auto-updat e field se parately b ecause of the trigge r on field 1.05 | |
| 3812 | "RTN","IBC NEHL1",223 ,0) | |
| 3813 | ;S DATA(2 .312,IENS, 4.04)="YES " | |
| 3814 | "RTN","IBC NEHL1",224 ,0) | |
| 3815 | K DATA | |
| 3816 | "RTN","IBC NEHL1",225 ,0) | |
| 3817 | S DATA(2. 312,IENS,1 .03)=TSTAM P ; Dat e last ver ified | |
| 3818 | "RTN","IBC NEHL1",226 ,0) | |
| 3819 | S DATA(2. 312,IENS,1 .04)="AUTO UPDATE,IBE IV" ; Las t verified by ; Edit with 595 was null | |
| 3820 | "RTN","IBC NEHL1",227 ,0) | |
| 3821 | S DATA(2. 312,IENS,1 .05)=TSTAM P ; Dat e last edi ted | |
| 3822 | "RTN","IBC NEHL1",228 ,0) | |
| 3823 | S DATA(2. 312,IENS,1 .06)="AUTO UPDATE,IBE IV" ; Las t edited b y ; Edit w ith 595 wa s null | |
| 3824 | "RTN","IBC NEHL1",229 ,0) | |
| 3825 | D FILE^DI E("ET","DA TA","ERROR ") | |
| 3826 | "RTN","IBC NEHL1",230 ,0) | |
| 3827 | I $D(ERRO R) D WARN^ IBCNEHL3 G AUTOFILX | |
| 3828 | "RTN","IBC NEHL1",231 ,0) | |
| 3829 | ; IB*2*59 5/DM set t he insuran ce record IEN in the IIV Respo nse file | |
| 3830 | "RTN","IBC NEHL1",232 ,0) | |
| 3831 | ; to trac k which po licy was u pdated bas ed on the response | |
| 3832 | "RTN","IBC NEHL1",233 ,0) | |
| 3833 | D UPDIREC ^IBCNEHL3( RIEN,IEN31 2) | |
| 3834 | "RTN","IBC NEHL1",234 ,0) | |
| 3835 | ; IB*2*59 5/DM set t he EIV AUT O-UPDATE i n the resp onse file to signal auto-updat e | |
| 3836 | "RTN","IBC NEHL1",235 ,0) | |
| 3837 | K DATA | |
| 3838 | "RTN","IBC NEHL1",236 ,0) | |
| 3839 | S DATA(36 5,RIEN_"," ,.13)="YES " | |
| 3840 | "RTN","IBC NEHL1",237 ,0) | |
| 3841 | D FILE^DI E("ET","DA TA") | |
| 3842 | "RTN","IBC NEHL1",238 ,0) | |
| 3843 | ; | |
| 3844 | "RTN","IBC NEHL1",239 ,0) | |
| 3845 | S ERFLG=$ $GRPFILE(D FN,IEN312, RIEN,1) | |
| 3846 | "RTN","IBC NEHL1",240 ,0) | |
| 3847 | I $G(ERFL G) G AUTOF ILX ;IB*2 *497 file data at 2 .312, 9, 1 0 and 11 s ubfiles; i f error is produced update buf fer entry and then q uit proces sing | |
| 3848 | "RTN","IBC NEHL1",241 ,0) | |
| 3849 | ; file ne w EB data | |
| 3850 | "RTN","IBC NEHL1",242 ,0) | |
| 3851 | S ERFLG=$ $EBFILE(DF N,IEN312,R IEN,1) | |
| 3852 | "RTN","IBC NEHL1",243 ,0) | |
| 3853 | ; bail ou t if somet hing went wrong duri ng filing of EB data | |
| 3854 | "RTN","IBC NEHL1",244 ,0) | |
| 3855 | I $G(ERFL G) G AUTOF ILX | |
| 3856 | "RTN","IBC NEHL1",245 ,0) | |
| 3857 | ; update insurance record ien in transm ission que ue | |
| 3858 | "RTN","IBC NEHL1",246 ,0) | |
| 3859 | D UPDIREC ^IBCNEHL3( RIEN,IEN31 2) | |
| 3860 | "RTN","IBC NEHL1",247 ,0) | |
| 3861 | ; For an original response, set the Tr ansmission Queue Sta tus to 'Re sponse Rec eived' & | |
| 3862 | "RTN","IBC NEHL1",248 ,0) | |
| 3863 | ; update remaining retries t o comm fai lure (5) | |
| 3864 | "RTN","IBC NEHL1",249 ,0) | |
| 3865 | I $G(RSTY PE)="O" D SST^IBCNEU T2(TQN,3), RSTA^IBCNE UT7(TQN) | |
| 3866 | "RTN","IBC NEHL1",250 ,0) | |
| 3867 | ; update buffer fil e entry so only stub remains a nd status is changed | |
| 3868 | "RTN","IBC NEHL1",251 ,0) | |
| 3869 | S BUFF=+$ P($G(^IBCN (365,RIEN, 0)),U,4) | |
| 3870 | "RTN","IBC NEHL1",252 ,0) | |
| 3871 | I BUFF D | |
| 3872 | "RTN","IBC NEHL1",253 ,0) | |
| 3873 | .D STATUS ^IBCNBEE(B UFF,"A",0, 0,0) ; upd ate buffer entry's s tatus to a ccepted | |
| 3874 | "RTN","IBC NEHL1",254 ,0) | |
| 3875 | .D DELDAT A^IBCNBED( BUFF) ; de lete buffe r's insura nce/patien t data | |
| 3876 | "RTN","IBC NEHL1",255 ,0) | |
| 3877 | .Q | |
| 3878 | "RTN","IBC NEHL1",256 ,0) | |
| 3879 | AUTOFILX ; | |
| 3880 | "RTN","IBC NEHL1",257 ,0) | |
| 3881 | L -^DPT(D FN,.312,IE N312) | |
| 3882 | "RTN","IBC NEHL1",258 ,0) | |
| 3883 | Q | |
| 3884 | "RTN","IBC NEHL1",259 ,0) | |
| 3885 | ; | |
| 3886 | "RTN","IBC NEHL1",260 ,0) | |
| 3887 | GRPFILE(DF N,IEN312,R IEN,AFLG) ; ib*2*49 7 file da ta at node 12 and at subfiles 2.312,9, 1 0 and 11 | |
| 3888 | "RTN","IBC NEHL1",261 ,0) | |
| 3889 | ; DFN - f ile 2 ien | |
| 3890 | "RTN","IBC NEHL1",262 ,0) | |
| 3891 | ; IEN312 - file 2.3 12 ien | |
| 3892 | "RTN","IBC NEHL1",263 ,0) | |
| 3893 | ; RIEN = file 365 i en | |
| 3894 | "RTN","IBC NEHL1",264 ,0) | |
| 3895 | ; AFLG - 1 if calle d from aut oupdate, 0 if called from ins. buffer pr ocess entr y | |
| 3896 | "RTN","IBC NEHL1",265 ,0) | |
| 3897 | ; output - returns 0 or 1 | |
| 3898 | "RTN","IBC NEHL1",266 ,0) | |
| 3899 | ; 0 - entr y update r eceived an error whe n attempti ng to file | |
| 3900 | "RTN","IBC NEHL1",267 ,0) | |
| 3901 | ; 1 - succ essful upd ate | |
| 3902 | "RTN","IBC NEHL1",268 ,0) | |
| 3903 | N DA,DATA 12,DIAG,DI AG3121,ERF LG,ERROR,I ENS,IENS36 5,IENS312, NODE,PROV, PROV332,RE F,REF3129, Z,Z2 | |
| 3904 | "RTN","IBC NEHL1",269 ,0) | |
| 3905 | ; retriev e external values of data loca ted at nod e 12 of 36 5 | |
| 3906 | "RTN","IBC NEHL1",270 ,0) | |
| 3907 | S IENS=IE N312_","_D FN_"," | |
| 3908 | "RTN","IBC NEHL1",271 ,0) | |
| 3909 | D GETS^DI Q(365,RIEN ,"12.01:12 .07",,"MIL ") | |
| 3910 | "RTN","IBC NEHL1",272 ,0) | |
| 3911 | M DATA12( 2.312,IENS )=MIL(365, RIEN_",") | |
| 3912 | "RTN","IBC NEHL1",273 ,0) | |
| 3913 | D FILE^DI E("ET","DA TA12","ERR OR") | |
| 3914 | "RTN","IBC NEHL1",274 ,0) | |
| 3915 | I $D(ERRO R) D:AFLG WARN^IBCNE HL3 K ERRO R | |
| 3916 | "RTN","IBC NEHL1",275 ,0) | |
| 3917 | ; remove existing s ub-file en tries at n odes 9, 10 , and 11 b efore upda te of new data | |
| 3918 | "RTN","IBC NEHL1",276 ,0) | |
| 3919 | F NODE="9 ","10","11 " D | |
| 3920 | "RTN","IBC NEHL1",277 ,0) | |
| 3921 | . S DIK=" ^DPT("_DFN _",.312,"_ IEN312_"," _NODE_",", DA(2)=DFN, DA(1)=IEN3 12 | |
| 3922 | "RTN","IBC NEHL1",278 ,0) | |
| 3923 | . S DA=0 F S DA=$O (^DPT(DFN, .312,IEN31 2,NODE,DA) ) Q:DA=""! (DA?1.A) D ^DIK | |
| 3924 | "RTN","IBC NEHL1",279 ,0) | |
| 3925 | S IENS312 ="+1,"_IEN 312_","_DF N_"," | |
| 3926 | "RTN","IBC NEHL1",280 ,0) | |
| 3927 | ; update node 9 dat a | |
| 3928 | "RTN","IBC NEHL1",281 ,0) | |
| 3929 | S Z="" F S Z=$O(^I BCN(365,RI EN,9,"B",Z )) Q:'Z D | |
| 3930 | "RTN","IBC NEHL1",282 ,0) | |
| 3931 | . S IENS3 65=$O(^IBC N(365,RIEN ,9,"B",Z," "))_","_RI EN_"," | |
| 3932 | "RTN","IBC NEHL1",283 ,0) | |
| 3933 | . D GETS^ DIQ(365.09 ,IENS365," *",,"REF") | |
| 3934 | "RTN","IBC NEHL1",284 ,0) | |
| 3935 | S Z2="" F S Z2=$O( REF(365.09 ,Z2)) Q:Z2 ="" M REF 3129(2.312 9,IENS312) =REF(365.0 9,Z2) D UP DATE^DIE(" E","REF312 9",,"ERROR ") K REF31 29 I $D(ER ROR) D:AFL G WARN^IBC NEHL3 K ER ROR | |
| 3936 | "RTN","IBC NEHL1",285 ,0) | |
| 3937 | ; update node 10 da ta | |
| 3938 | "RTN","IBC NEHL1",286 ,0) | |
| 3939 | S Z="" F S Z=$O(^I BCN(365,RI EN,10,"B", Z)) Q:'Z D | |
| 3940 | "RTN","IBC NEHL1",287 ,0) | |
| 3941 | . S IENS3 65=$O(^IBC N(365,RIEN ,10,"B",Z, ""))_","_R IEN_"," | |
| 3942 | "RTN","IBC NEHL1",288 ,0) | |
| 3943 | . D GETS^ DIQ(365.04 ,IENS365," *",,"PROV" ) | |
| 3944 | "RTN","IBC NEHL1",289 ,0) | |
| 3945 | S Z2="" F S Z2=$O( PROV(365.0 4,Z2)) Q:Z 2="" M PR OV332(2.33 2,IENS312) =PROV(365. 04,Z2) D U PDATE^DIE( "E","PROV3 32",,"ERRO R") K PROV 332 I $D(E RROR) D:AF LG WARN^IB CNEHL3 K E RROR | |
| 3946 | "RTN","IBC NEHL1",290 ,0) | |
| 3947 | ; update node 11 da ta | |
| 3948 | "RTN","IBC NEHL1",291 ,0) | |
| 3949 | S Z="" F S Z=$O(^I BCN(365,RI EN,11,"B", Z)) Q:'Z D | |
| 3950 | "RTN","IBC NEHL1",292 ,0) | |
| 3951 | . S IENS3 65=$O(^IBC N(365,RIEN ,11,"B",Z, ""))_","_R IEN_"," | |
| 3952 | "RTN","IBC NEHL1",293 ,0) | |
| 3953 | . D GETS^ DIQ(365.01 ,IENS365," *",,"DIAG" ) | |
| 3954 | "RTN","IBC NEHL1",294 ,0) | |
| 3955 | S Z2="" F S Z2=$O( DIAG(365.0 1,Z2)) Q:Z 2="" M DI AG3121(2.3 1211,IENS3 12)=DIAG(3 65.01,Z2) D UPDATE^D IE("E","DI AG3121",," ERROR") K DIAG3121 I $D(ERROR) D:AFLG WA RN^IBCNEHL 3 K ERROR | |
| 3956 | "RTN","IBC NEHL1",295 ,0) | |
| 3957 | GRPFILEX ; | |
| 3958 | "RTN","IBC NEHL1",296 ,0) | |
| 3959 | Q $G(ERFL G) | |
| 3960 | "RTN","IBC NEHL1",297 ,0) | |
| 3961 | ; | |
| 3962 | "RTN","IBC NEHL1",298 ,0) | |
| 3963 | FIL ; Fini sh process ing the re sponse mes sage - fil e into ins urance buf fer | |
| 3964 | "RTN","IBC NEHL1",299 ,0) | |
| 3965 | ; IB*2*60 1/DM FIL() routine mo ved to IBC NEHL6 to m eet SAC gu idelines d ue to size | |
| 3966 | "RTN","IBC NEHL1",300 ,0) | |
| 3967 | D FIL^IBC NEHL6 | |
| 3968 | "RTN","IBC NEHL1",301 ,0) | |
| 3969 | Q | |
| 3970 | "RTN","IBC NEHL1",302 ,0) | |
| 3971 | ; | |
| 3972 | "RTN","IBC NEHL1",303 ,0) | |
| 3973 | AUTOUPD(RI EN) ; | |
| 3974 | "RTN","IBC NEHL1",304 ,0) | |
| 3975 | ; Returns "1^file 2 ien^file 2.312 ien^ 2nd file 2 .312 ien^M edicare fl ag^subscri ber flag", if entry | |
| 3976 | "RTN","IBC NEHL1",305 ,0) | |
| 3977 | ; in file 365 is el igible for auto-upda te, return s 0 otherw ise. | |
| 3978 | "RTN","IBC NEHL1",306 ,0) | |
| 3979 | ; | |
| 3980 | "RTN","IBC NEHL1",307 ,0) | |
| 3981 | ; Medicar e flag: 1 for Medica re, 0 othe rwise | |
| 3982 | "RTN","IBC NEHL1",308 ,0) | |
| 3983 | ; Subscri ber flag: 1 if patie nt is the subscriber , 0 otherw ise | |
| 3984 | "RTN","IBC NEHL1",309 ,0) | |
| 3985 | ; | |
| 3986 | "RTN","IBC NEHL1",310 ,0) | |
| 3987 | ; For non -Medicare response: 1st file 2 .312 ien i s set, 2nd file 2.31 2 ien is e mpty, piec es 5-7 are empty | |
| 3988 | "RTN","IBC NEHL1",311 ,0) | |
| 3989 | ; For Med icare resp onse: 1st file 2.312 ien conta ins ien fo r Medicare Part A, 2 nd file 2. 312 ien co ntains ien for Medic are Part B , | |
| 3990 | "RTN","IBC NEHL1",312 ,0) | |
| 3991 | ; eith er one may be empty, but at le ast one of them is s et if entr y is eligi ble. | |
| 3992 | "RTN","IBC NEHL1",313 ,0) | |
| 3993 | ; | |
| 3994 | "RTN","IBC NEHL1",314 ,0) | |
| 3995 | ; RIEN - ien in fil e 365 | |
| 3996 | "RTN","IBC NEHL1",315 ,0) | |
| 3997 | ; | |
| 3998 | "RTN","IBC NEHL1",316 ,0) | |
| 3999 | N APPIEN, GDATA,GIEN ,GNAME,GNU M,GNUM1,GO K,IEN2,IEN 312,IEN36, IDATA0,IDA TA3,ISSUB, MWNRA,MWNR B,MWNRIEN, MWNRTYP | |
| 4000 | "RTN","IBC NEHL1",317 ,0) | |
| 4001 | N ONEPOL, PIEN,RDATA 0,RDATA1,R ES,TQIEN,I DATA7,RDAT A13,RDATA1 4 ; IB*2 .0*497 | |
| 4002 | "RTN","IBC NEHL1",318 ,0) | |
| 4003 | S RES=0 | |
| 4004 | "RTN","IBC NEHL1",319 ,0) | |
| 4005 | I +$G(RIE N)'>0 Q RE S ; Inva lid ien fo r file 365 | |
| 4006 | "RTN","IBC NEHL1",320 ,0) | |
| 4007 | ; IB*2.0* 595/DM if entry is m issing fro m #200, fi le in buff er | |
| 4008 | "RTN","IBC NEHL1",321 ,0) | |
| 4009 | I '$$FIND 1^DIC(200, ,"M","AUTO UPDATE,IBE IV") Q RES | |
| 4010 | "RTN","IBC NEHL1",322 ,0) | |
| 4011 | ; | |
| 4012 | "RTN","IBC NEHL1",323 ,0) | |
| 4013 | ; IB*2.0* 549 - Move d up the n ext 5 line s. Origin ally, thes e lines we re | |
| 4014 | "RTN","IBC NEHL1",324 ,0) | |
| 4015 | ; dire ctly after line 'I $ G(IIVSTAT) '=1 Q RES' | |
| 4016 | "RTN","IBC NEHL1",325 ,0) | |
| 4017 | S RDATA0= $G(^IBCN(3 65,RIEN,0) ),RDATA1=$ G(^IBCN(36 5,RIEN,1)) | |
| 4018 | "RTN","IBC NEHL1",326 ,0) | |
| 4019 | ; | |
| 4020 | "RTN","IBC NEHL1",327 ,0) | |
| 4021 | ; IB*2.0* 497 longe r fields f or GROUP N AME, GROUP NUMBER, N AME OF INS URED, and SUBSCRIBER ID | |
| 4022 | "RTN","IBC NEHL1",328 ,0) | |
| 4023 | S RDATA13 =$G(^IBCN( 365,RIEN,1 3)),RDATA1 4=$G(^IBCN (365,RIEN, 14)) | |
| 4024 | "RTN","IBC NEHL1",329 ,0) | |
| 4025 | S PIEN=$P (RDATA0,U, 3) | |
| 4026 | "RTN","IBC NEHL1",330 ,0) | |
| 4027 | ; | |
| 4028 | "RTN","IBC NEHL1",331 ,0) | |
| 4029 | ; IB*2.0* 549 - Move d up the n ext 2 line s. Origin ally, thes e lines we re | |
| 4030 | "RTN","IBC NEHL1",332 ,0) | |
| 4031 | ; dire ctly after 'S IEN2=$ P(RDATA0,U ,2) I +IEN 2'>0 Q RES ' | |
| 4032 | "RTN","IBC NEHL1",333 ,0) | |
| 4033 | S MWNRIEN =$P($G(^IB E(350.9,1, 51)),U,25) ,MWNRTYP=0 ,(MWNRA,MW NRB)="" | |
| 4034 | "RTN","IBC NEHL1",334 ,0) | |
| 4035 | I PIEN=MW NRIEN S MW NRTYP=$$IS MCR^IBCNEH LU(RIEN) | |
| 4036 | "RTN","IBC NEHL1",335 ,0) | |
| 4037 | ; | |
| 4038 | "RTN","IBC NEHL1",336 ,0) | |
| 4039 | ; IB*2.0* 549 - Adde d ',MWNRTY P' below t o only qui t for non- medicare p olicies | |
| 4040 | "RTN","IBC NEHL1",337 ,0) | |
| 4041 | I $G(IIVS TAT)'=1,'M WNRTYP Q R ES ; Only auto-upda te 'active policy' r esponses | |
| 4042 | "RTN","IBC NEHL1",338 ,0) | |
| 4043 | I +PIEN>0 S APPIEN= $$PYRAPP^I BCNEUT5("I IV",PIEN) | |
| 4044 | "RTN","IBC NEHL1",339 ,0) | |
| 4045 | I +$G(APP IEN)'>0 Q RES ; cou ldn't find eIV appli cation ent ry | |
| 4046 | "RTN","IBC NEHL1",340 ,0) | |
| 4047 | ; | |
| 4048 | "RTN","IBC NEHL1",341 ,0) | |
| 4049 | ;IB*2.0*6 01/HN Don' t allow an y entry wi th HMS SOI to auto-u pdate | |
| 4050 | "RTN","IBC NEHL1",342 ,0) | |
| 4051 | ;IB*2.0*5 95/HN Don' t allow an y entry wi th Contrac t Services SOI to au to-update | |
| 4052 | "RTN","IBC NEHL1",343 ,0) | |
| 4053 | I "^HMS^C ONTRACT SE RVICES^"[( "^"_$$GET1 ^DIQ(355.3 3,+$$GET1^ DIQ(365,RI EN_",","BU FFER ENTRY ","I")_"," ,"SOURCE O F INFORMAT ION")_"^") Q RES | |
| 4054 | "RTN","IBC NEHL1",344 ,0) | |
| 4055 | ; | |
| 4056 | "RTN","IBC NEHL1",345 ,0) | |
| 4057 | ; Check d ictionary 365.1 MANU AL REQUEST DATE/TIME Flag, Qui t if Set. | |
| 4058 | "RTN","IBC NEHL1",346 ,0) | |
| 4059 | I $P(RDAT A0,U,5)'=" ",$P($G(^I BCN(365.1, $P(RDATA0, U,5),3)),U ,1)'="" Q RES | |
| 4060 | "RTN","IBC NEHL1",347 ,0) | |
| 4061 | I $P(^IBE (365.12,PI EN,1,APPIE N,0),U,7)= 0 Q RES ; auto-acce pt is OFF | |
| 4062 | "RTN","IBC NEHL1",348 ,0) | |
| 4063 | S IEN2=$P (RDATA0,U, 2) I +IEN2 '>0 Q RES ; couldn' t find pat ient | |
| 4064 | "RTN","IBC NEHL1",349 ,0) | |
| 4065 | S ONEPOL= $$ONEPOL^I BCNEHLU(PI EN,IEN2) | |
| 4066 | "RTN","IBC NEHL1",350 ,0) | |
| 4067 | ; try to find a mat ching pat. insurance | |
| 4068 | "RTN","IBC NEHL1",351 ,0) | |
| 4069 | S IEN36=" " F S IEN 36=$O(^DIC (36,"AC",P IEN,IEN36) ) Q:IEN36= ""!(RES>0) D | |
| 4070 | "RTN","IBC NEHL1",352 ,0) | |
| 4071 | .S IEN312 ="" F S I EN312=$O(^ DPT(IEN2,. 312,"B",IE N36,IEN312 )) Q:IEN31 2=""!(RES> 0&('+MWNRT YP)) D | |
| 4072 | "RTN","IBC NEHL1",353 ,0) | |
| 4073 | ..S IDATA 0=$G(^DPT( IEN2,.312, IEN312,0)) ,IDATA3=$G (^DPT(IEN2 ,.312,IEN3 12,3)) | |
| 4074 | "RTN","IBC NEHL1",354 ,0) | |
| 4075 | ..S IDATA 7=$G(^DPT( IEN2,.312, IEN312,7)) ; IB*2. 0*497 (vd) | |
| 4076 | "RTN","IBC NEHL1",355 ,0) | |
| 4077 | ..I $$EXP IRED^IBCNE DE2($P(IDA TA0,U,4)) Q ; Insur ance polic y has expi red | |
| 4078 | "RTN","IBC NEHL1",356 ,0) | |
| 4079 | ..S ISSUB =$$PATISSU B^IBCNEHLU (IDATA0) | |
| 4080 | "RTN","IBC NEHL1",357 ,0) | |
| 4081 | ..; Patie nt is the subscriber | |
| 4082 | "RTN","IBC NEHL1",358 ,0) | |
| 4083 | ..I ISSUB ,'$$CHK1^I BCNEHL3 Q | |
| 4084 | "RTN","IBC NEHL1",359 ,0) | |
| 4085 | ..; Patie nt is the dependent | |
| 4086 | "RTN","IBC NEHL1",360 ,0) | |
| 4087 | ..I 'ISSU B,'$$CHK2^ IBCNEHL3(M WNRTYP) Q | |
| 4088 | "RTN","IBC NEHL1",361 ,0) | |
| 4089 | ..; check group num ber | |
| 4090 | "RTN","IBC NEHL1",362 ,0) | |
| 4091 | ..S GNUM= $P(RDATA14 ,U,2),GIEN =+$P(IDATA 0,U,18),GO K=1 ;IB*2 *497 grou p number n eeds to be retrieved from new field | |
| 4092 | "RTN","IBC NEHL1",363 ,0) | |
| 4093 | ..; check non-Medic are group number | |
| 4094 | "RTN","IBC NEHL1",364 ,0) | |
| 4095 | ..I '+MWN RTYP D Q: 'GOK ; Gr oup number doesn't m atch | |
| 4096 | "RTN","IBC NEHL1",365 ,0) | |
| 4097 | ...I 'ONE POL D | |
| 4098 | "RTN","IBC NEHL1",366 ,0) | |
| 4099 | ....I GIE N'>0 S GOK =0 Q | |
| 4100 | "RTN","IBC NEHL1",367 ,0) | |
| 4101 | ....S GNU M1=$P($G(^ IBA(355.3, GIEN,2)),U ,2) ; I B*2.0*497 (vd) | |
| 4102 | "RTN","IBC NEHL1",368 ,0) | |
| 4103 | ....I GNU M=""!(GNUM 1="")!(GNU M'=GNUM1) S GOK=0 | |
| 4104 | "RTN","IBC NEHL1",369 ,0) | |
| 4105 | ....Q | |
| 4106 | "RTN","IBC NEHL1",370 ,0) | |
| 4107 | ...I ONEP OL D | |
| 4108 | "RTN","IBC NEHL1",371 ,0) | |
| 4109 | ....I GNU M'="",GIEN '="" S GNU M1=$P($G(^ IBA(355.3, GIEN,2)),U ,2) I GNUM 1'="",GNUM '=GNUM1 S GOK=0 ; I B*2.0*497 (vd) | |
| 4110 | "RTN","IBC NEHL1",372 ,0) | |
| 4111 | ....Q | |
| 4112 | "RTN","IBC NEHL1",373 ,0) | |
| 4113 | ...Q | |
| 4114 | "RTN","IBC NEHL1",374 ,0) | |
| 4115 | ..; check for Medic are part A /B | |
| 4116 | "RTN","IBC NEHL1",375 ,0) | |
| 4117 | ..I +MWNR TYP D Q:' GOK ; Gro up number doesn't ma tch | |
| 4118 | "RTN","IBC NEHL1",376 ,0) | |
| 4119 | ...I GIEN '>0 S GOK= 0 Q | |
| 4120 | "RTN","IBC NEHL1",377 ,0) | |
| 4121 | ...S GDAT A=$G(^IBA( 355.3,GIEN ,0)) | |
| 4122 | "RTN","IBC NEHL1",378 ,0) | |
| 4123 | ...I $P(G DATA,U,14) ="A" D | |
| 4124 | "RTN","IBC NEHL1",379 ,0) | |
| 4125 | ....;IB*2 .0*549 Cha nge $P(MWN RTYP,U,2)= "MA"!($P(M WNRTYP,U,2 )="B") | |
| 4126 | "RTN","IBC NEHL1",380 ,0) | |
| 4127 | ....; To $P(MWN RTYP,U,5)= "MA"!($P(M WNRTYP,U,5 )="B") | |
| 4128 | "RTN","IBC NEHL1",381 ,0) | |
| 4129 | ....I $P( MWNRTYP,U, 5)="MA"!($ P(MWNRTYP, U,5)="B") S MWNRA=IE N312 Q | |
| 4130 | "RTN","IBC NEHL1",382 ,0) | |
| 4131 | ....S GOK =0 | |
| 4132 | "RTN","IBC NEHL1",383 ,0) | |
| 4133 | ....Q | |
| 4134 | "RTN","IBC NEHL1",384 ,0) | |
| 4135 | ...I $P(G DATA,U,14) ="B" D | |
| 4136 | "RTN","IBC NEHL1",385 ,0) | |
| 4137 | ....;IB*2 .0*549 Cha nge $P(MWN RTYP,U,2)= "MB"!($P(M WNRTYP,U,2 )="B") | |
| 4138 | "RTN","IBC NEHL1",386 ,0) | |
| 4139 | ....; To $P(MWN RTYP,U,5)= "MB"!($P(M WNRTYP,U,5 )="B") | |
| 4140 | "RTN","IBC NEHL1",387 ,0) | |
| 4141 | ....I $P( MWNRTYP,U, 5)="MB"!($ P(MWNRTYP, U,5)="B") S MWNRB=IE N312 Q | |
| 4142 | "RTN","IBC NEHL1",388 ,0) | |
| 4143 | ....S GOK =0 | |
| 4144 | "RTN","IBC NEHL1",389 ,0) | |
| 4145 | ....Q | |
| 4146 | "RTN","IBC NEHL1",390 ,0) | |
| 4147 | ...Q | |
| 4148 | "RTN","IBC NEHL1",391 ,0) | |
| 4149 | ..S RES=1 _U_IEN2_U_ $S(+MWNRTY P:MWNRA_U_ MWNRB_U_1, 1:IEN312_U _U_0) | |
| 4150 | "RTN","IBC NEHL1",392 ,0) | |
| 4151 | ..S $P(RE S,U,6)=ISS UB | |
| 4152 | "RTN","IBC NEHL1",393 ,0) | |
| 4153 | ..Q | |
| 4154 | "RTN","IBC NEHL1",394 ,0) | |
| 4155 | .Q | |
| 4156 | "RTN","IBC NEHL1",395 ,0) | |
| 4157 | Q RES | |
| 4158 | "RTN","IBC NEHL1",396 ,0) | |
| 4159 | ; | |
| 4160 | "RTN","IBC NEHL1",397 ,0) | |
| 4161 | EBFILE(DFN ,IEN312,RI EN,AFLG) ; File elig ibility/be nefit data from file 365 into file 2.312 | |
| 4162 | "RTN","IBC NEHL1",398 ,0) | |
| 4163 | ; Input: DFN - Internal Patient I EN | |
| 4164 | "RTN","IBC NEHL1",399 ,0) | |
| 4165 | ; IEN312 - Insuranc e multiple # | |
| 4166 | "RTN","IBC NEHL1",400 ,0) | |
| 4167 | ; RIEN - file 365 ien | |
| 4168 | "RTN","IBC NEHL1",401 ,0) | |
| 4169 | ; AFLG - 1 if cal led from a utoupdate | |
| 4170 | "RTN","IBC NEHL1",402 ,0) | |
| 4171 | ; 0 if cal led from i ns. buffer process e ntry | |
| 4172 | "RTN","IBC NEHL1",403 ,0) | |
| 4173 | ; Returns : "" on su ccess, ERF LG on fail ure. Also called fro m ACCEPT^I BCNBAR | |
| 4174 | "RTN","IBC NEHL1",404 ,0) | |
| 4175 | ; for manu al process ing of ins . buffer e ntry. | |
| 4176 | "RTN","IBC NEHL1",405 ,0) | |
| 4177 | ; | |
| 4178 | "RTN","IBC NEHL1",406 ,0) | |
| 4179 | ; | |
| 4180 | "RTN","IBC NEHL1",407 ,0) | |
| 4181 | Q $$EBFIL E^IBCNEHL5 (DFN,IEN31 2,RIEN,AFL G) ;IB*2. 0*549 move d because of routine size | |
| 4182 | "RTN","IBC NEHL1",408 ,0) | |
| 4183 | ; | |
| 4184 | "RTN","IBC NEHL2") | |
| 4185 | 0^16^B7561 3048^B7023 6887 | |
| 4186 | "RTN","IBC NEHL2",1,0 ) | |
| 4187 | IBCNEHL2 ; DAOU/ALA - HL7 Proce ss Incomin g RPI Msgs (cont.) ; 26-JUN-200 2 ; Compi led Decemb er 16, 200 4 15:29:37 | |
| 4188 | "RTN","IBC NEHL2",2,0 ) | |
| 4189 | ;;2.0;INT EGRATED BI LLING;**30 0,345,416, 438,497,62 1**;21-MAR -94;Build 8 | |
| 4190 | "RTN","IBC NEHL2",3,0 ) | |
| 4191 | ;;Per VHA Directive 6402, thi s routine should not be modifi ed. | |
| 4192 | "RTN","IBC NEHL2",4,0 ) | |
| 4193 | ; | |
| 4194 | "RTN","IBC NEHL2",5,0 ) | |
| 4195 | ;**Progra m Descript ion** | |
| 4196 | "RTN","IBC NEHL2",6,0 ) | |
| 4197 | ; This p gm will pr ocess the indiv segm ents of th e | |
| 4198 | "RTN","IBC NEHL2",7,0 ) | |
| 4199 | ; incomi ng eIV res ponse msgs . | |
| 4200 | "RTN","IBC NEHL2",8,0 ) | |
| 4201 | ; | |
| 4202 | "RTN","IBC NEHL2",9,0 ) | |
| 4203 | ; * Each of these t ags are ca lled by IB CNEHL1. | |
| 4204 | "RTN","IBC NEHL2",10, 0) | |
| 4205 | ; | |
| 4206 | "RTN","IBC NEHL2",11, 0) | |
| 4207 | ; This r outine is based on I BCNEHLP wh ich was in troduced w ith patch 184, and s ubsequentl y | |
| 4208 | "RTN","IBC NEHL2",12, 0) | |
| 4209 | ; patche d with pat ches 252 a nd 271. I BCNEHLP is obsolete and delete d with pat ch 300. | |
| 4210 | "RTN","IBC NEHL2",13, 0) | |
| 4211 | ; | |
| 4212 | "RTN","IBC NEHL2",14, 0) | |
| 4213 | ; Variab les | |
| 4214 | "RTN","IBC NEHL2",15, 0) | |
| 4215 | ; SEG = HL7 Seg Name | |
| 4216 | "RTN","IBC NEHL2",16, 0) | |
| 4217 | ; MSGI D = Origin al Msg Con trol ID | |
| 4218 | "RTN","IBC NEHL2",17, 0) | |
| 4219 | ; ACK = Acknowl edgment (A A=Accepted , AE=Error ) | |
| 4220 | "RTN","IBC NEHL2",18, 0) | |
| 4221 | ; ERTX T = Error Msg Text | |
| 4222 | "RTN","IBC NEHL2",19, 0) | |
| 4223 | ; ERFL G = Error quit flag | |
| 4224 | "RTN","IBC NEHL2",20, 0) | |
| 4225 | ; ERAC T = Error Action | |
| 4226 | "RTN","IBC NEHL2",21, 0) | |
| 4227 | ; ERCO N = Error Condition | |
| 4228 | "RTN","IBC NEHL2",22, 0) | |
| 4229 | ; RIEN = Respons e Record I EN | |
| 4230 | "RTN","IBC NEHL2",23, 0) | |
| 4231 | ; IBSE G = Array of the seg ment | |
| 4232 | "RTN","IBC NEHL2",24, 0) | |
| 4233 | ; | |
| 4234 | "RTN","IBC NEHL2",25, 0) | |
| 4235 | Q ; No d irect call s | |
| 4236 | "RTN","IBC NEHL2",26, 0) | |
| 4237 | ; | |
| 4238 | "RTN","IBC NEHL2",27, 0) | |
| 4239 | MSA(ERACT, ERCON,ERRO R,ERTXT,IB SEG,MGRP,R IEN,TRACE, EVENTYP) ; Process the MSA se g | |
| 4240 | "RTN","IBC NEHL2",28, 0) | |
| 4241 | ; | |
| 4242 | "RTN","IBC NEHL2",29, 0) | |
| 4243 | ; Input: | |
| 4244 | "RTN","IBC NEHL2",30, 0) | |
| 4245 | ; IBSEG, MGRP | |
| 4246 | "RTN","IBC NEHL2",31, 0) | |
| 4247 | ; | |
| 4248 | "RTN","IBC NEHL2",32, 0) | |
| 4249 | ; Output : | |
| 4250 | "RTN","IBC NEHL2",33, 0) | |
| 4251 | ; ERACT, ERCON,ERRO R,ERTXT,RI EN,TRACE,A CK | |
| 4252 | "RTN","IBC NEHL2",34, 0) | |
| 4253 | ; | |
| 4254 | "RTN","IBC NEHL2",35, 0) | |
| 4255 | D MSA^IBC NEHL4 | |
| 4256 | "RTN","IBC NEHL2",36, 0) | |
| 4257 | Q | |
| 4258 | "RTN","IBC NEHL2",37, 0) | |
| 4259 | ; | |
| 4260 | "RTN","IBC NEHL2",38, 0) | |
| 4261 | CTD(ERROR, IBSEG,RIEN ) ; Proces s the CTD seg | |
| 4262 | "RTN","IBC NEHL2",39, 0) | |
| 4263 | ; | |
| 4264 | "RTN","IBC NEHL2",40, 0) | |
| 4265 | ; Input: | |
| 4266 | "RTN","IBC NEHL2",41, 0) | |
| 4267 | ; IBSEG,R IEN | |
| 4268 | "RTN","IBC NEHL2",42, 0) | |
| 4269 | ; | |
| 4270 | "RTN","IBC NEHL2",43, 0) | |
| 4271 | ; Output: | |
| 4272 | "RTN","IBC NEHL2",44, 0) | |
| 4273 | ; ERROR | |
| 4274 | "RTN","IBC NEHL2",45, 0) | |
| 4275 | ; | |
| 4276 | "RTN","IBC NEHL2",46, 0) | |
| 4277 | N CTNAME, CTQUAL,CTN UM,CTQIEN, D1,DA,DATA ,DIC,DILN, DISYS,DLAY GO,FFL,FLD ,IENS,II,R SUPDT,X,Y | |
| 4278 | "RTN","IBC NEHL2",47, 0) | |
| 4279 | ; | |
| 4280 | "RTN","IBC NEHL2",48, 0) | |
| 4281 | ; Parse out data f rom seg | |
| 4282 | "RTN","IBC NEHL2",49, 0) | |
| 4283 | S CTNAME= $G(IBSEG(3 )),CTQUAL= $P($G(IBSE G(6)),$E(H LECH),9),C TNUM=$P($G (IBSEG(6)) ,$E(HLECH) ) | |
| 4284 | "RTN","IBC NEHL2",50, 0) | |
| 4285 | I $TR(CTN AME," ")=" " S CTNAME ="NOT SPEC IFIED" | |
| 4286 | "RTN","IBC NEHL2",51, 0) | |
| 4287 | S CTQIEN= $$FIND1^DI C(365.021, "","X",CTQ UAL) | |
| 4288 | "RTN","IBC NEHL2",52, 0) | |
| 4289 | I CTNAME[ $E(HLECH) S CTNAME=$ $DECHL7($$ FMNAME^HLF NC(CTNAME, HLECH)) | |
| 4290 | "RTN","IBC NEHL2",53, 0) | |
| 4291 | S CTNAME= $E(CTNAME, 1,32) | |
| 4292 | "RTN","IBC NEHL2",54, 0) | |
| 4293 | ; | |
| 4294 | "RTN","IBC NEHL2",55, 0) | |
| 4295 | ; Look u p contact person | |
| 4296 | "RTN","IBC NEHL2",56, 0) | |
| 4297 | S DA(1)=R IEN,DIC="^ IBCN(365," _DA(1)_",3 ,",DIC(0)= "LZ",DLAYG O=365.03 | |
| 4298 | "RTN","IBC NEHL2",57, 0) | |
| 4299 | I '$D(^IB CN(365,DA( 1),3,0)) S ^IBCN(365 ,DA(1),3,0 )="^365.03 ^^" | |
| 4300 | "RTN","IBC NEHL2",58, 0) | |
| 4301 | S X=CTNAM E D ^DIC | |
| 4302 | "RTN","IBC NEHL2",59, 0) | |
| 4303 | S DA=+Y,D ATA=^IBCN( 365,DA(1), 3,DA,0),FL D=2,FFL=0 | |
| 4304 | "RTN","IBC NEHL2",60, 0) | |
| 4305 | ; | |
| 4306 | "RTN","IBC NEHL2",61, 0) | |
| 4307 | ; Check if contact already h as this co mmunicatio n qualifie r on file | |
| 4308 | "RTN","IBC NEHL2",62, 0) | |
| 4309 | F II=2,4, 6 I $P(DAT A,U,II)=CT QIEN S FLD =II,FFL=1 Q | |
| 4310 | "RTN","IBC NEHL2",63, 0) | |
| 4311 | I 'FFL F II=2,4,6 I $P(DATA,U ,II)="" S FLD=II Q | |
| 4312 | "RTN","IBC NEHL2",64, 0) | |
| 4313 | ; | |
| 4314 | "RTN","IBC NEHL2",65, 0) | |
| 4315 | S IENS=$$ IENS^DILF( .DA) | |
| 4316 | "RTN","IBC NEHL2",66, 0) | |
| 4317 | S RSUPDT( 365.03,IEN S,(FLD/2)) =CTNUM ; stuffs the communica tion # in the correc t field ;I B*2.0*497 | |
| 4318 | "RTN","IBC NEHL2",67, 0) | |
| 4319 | S RSUPDT( 365.03,IEN S,".0"_FLD )=CTQIEN | |
| 4320 | "RTN","IBC NEHL2",68, 0) | |
| 4321 | D FILE^DI E("I","RSU PDT","ERRO R") | |
| 4322 | "RTN","IBC NEHL2",69, 0) | |
| 4323 | CTDX ; | |
| 4324 | "RTN","IBC NEHL2",70, 0) | |
| 4325 | Q | |
| 4326 | "RTN","IBC NEHL2",71, 0) | |
| 4327 | ; | |
| 4328 | "RTN","IBC NEHL2",72, 0) | |
| 4329 | PID(ERFLG, ERROR,IBSE G,RIEN) ; Process t he PID seg | |
| 4330 | "RTN","IBC NEHL2",73, 0) | |
| 4331 | ; | |
| 4332 | "RTN","IBC NEHL2",74, 0) | |
| 4333 | ; Input: | |
| 4334 | "RTN","IBC NEHL2",75, 0) | |
| 4335 | ; IBSEG,R IEN | |
| 4336 | "RTN","IBC NEHL2",76, 0) | |
| 4337 | ; | |
| 4338 | "RTN","IBC NEHL2",77, 0) | |
| 4339 | ; Output: | |
| 4340 | "RTN","IBC NEHL2",78, 0) | |
| 4341 | ; ERFLG,E RROR | |
| 4342 | "RTN","IBC NEHL2",79, 0) | |
| 4343 | ; | |
| 4344 | "RTN","IBC NEHL2",80, 0) | |
| 4345 | D PID^IBC NEHL4 | |
| 4346 | "RTN","IBC NEHL2",81, 0) | |
| 4347 | Q | |
| 4348 | "RTN","IBC NEHL2",82, 0) | |
| 4349 | ; | |
| 4350 | "RTN","IBC NEHL2",83, 0) | |
| 4351 | GT1(ERROR, IBSEG,RIEN ,SUBID,EVE NTYP) ; P rocess the GT1 Guara ntor seg | |
| 4352 | "RTN","IBC NEHL2",84, 0) | |
| 4353 | ; | |
| 4354 | "RTN","IBC NEHL2",85, 0) | |
| 4355 | ; Input: | |
| 4356 | "RTN","IBC NEHL2",86, 0) | |
| 4357 | ; IBSEG,R IEN | |
| 4358 | "RTN","IBC NEHL2",87, 0) | |
| 4359 | ; | |
| 4360 | "RTN","IBC NEHL2",88, 0) | |
| 4361 | ; Output: | |
| 4362 | "RTN","IBC NEHL2",89, 0) | |
| 4363 | ; ERROR,S UBID | |
| 4364 | "RTN","IBC NEHL2",90, 0) | |
| 4365 | ; | |
| 4366 | "RTN","IBC NEHL2",91, 0) | |
| 4367 | D GT1^IBC NEHL4 | |
| 4368 | "RTN","IBC NEHL2",92, 0) | |
| 4369 | Q | |
| 4370 | "RTN","IBC NEHL2",93, 0) | |
| 4371 | ; | |
| 4372 | "RTN","IBC NEHL2",94, 0) | |
| 4373 | IN1(ERROR, IBSEG,RIEN ,SUBID,EVE NTYP) ; P rocess the IN1 Insur ance seg | |
| 4374 | "RTN","IBC NEHL2",95, 0) | |
| 4375 | ; | |
| 4376 | "RTN","IBC NEHL2",96, 0) | |
| 4377 | ; Input: | |
| 4378 | "RTN","IBC NEHL2",97, 0) | |
| 4379 | ; IBSEG,R IEN,SUBID, ACK | |
| 4380 | "RTN","IBC NEHL2",98, 0) | |
| 4381 | ; | |
| 4382 | "RTN","IBC NEHL2",99, 0) | |
| 4383 | ; Output: | |
| 4384 | "RTN","IBC NEHL2",100 ,0) | |
| 4385 | ; ERROR | |
| 4386 | "RTN","IBC NEHL2",101 ,0) | |
| 4387 | ; | |
| 4388 | "RTN","IBC NEHL2",102 ,0) | |
| 4389 | N COB,EFF DT,EXPDT,G NAME,GNUMB ,MBRID,PAY RID,PYRNM, RSUPDT,SRV DT | |
| 4390 | "RTN","IBC NEHL2",103 ,0) | |
| 4391 | N PYLEDT, CERDT,RELT N | |
| 4392 | "RTN","IBC NEHL2",104 ,0) | |
| 4393 | ; | |
| 4394 | "RTN","IBC NEHL2",105 ,0) | |
| 4395 | ; Austin sending re sponses wi th an erro r indicato r will pop ulate IBSE G(3) w/ | |
| 4396 | "RTN","IBC NEHL2",106 ,0) | |
| 4397 | ;9 zeros in order t o send the HL7 requi red field when the p ayer does not | |
| 4398 | "RTN","IBC NEHL2",107 ,0) | |
| 4399 | ;send a v alue for t his field | |
| 4400 | "RTN","IBC NEHL2",108 ,0) | |
| 4401 | S MBRID=$ $DECHL7($G (IBSEG(3)) ) I ACK="A E",($TR(MB RID,0)="") S MBRID=" " | |
| 4402 | "RTN","IBC NEHL2",109 ,0) | |
| 4403 | S PAYRID= $G(IBSEG(4 )),PYRNM=$ G(IBSEG(5) ) | |
| 4404 | "RTN","IBC NEHL2",110 ,0) | |
| 4405 | S GNAME=$ $DECHL7($G (IBSEG(10) )),GNUMB=$ $DECHL7($G (IBSEG(9)) ) | |
| 4406 | "RTN","IBC NEHL2",111 ,0) | |
| 4407 | ; make su re group n umber is n ot longer than 17 ch ars, send mailman no tification | |
| 4408 | "RTN","IBC NEHL2",112 ,0) | |
| 4409 | ; if trun cation is necessary | |
| 4410 | "RTN","IBC NEHL2",113 ,0) | |
| 4411 | I $L(GNUM B)>17 D TR NCWARN^IBC NEHLU(GNUM B,$G(TRACE )) S GNUMB =$E(GNUMB, 1,17) | |
| 4412 | "RTN","IBC NEHL2",114 ,0) | |
| 4413 | ;IB*2.0*6 21/TAZ - P rocess EIC D Discover y Response and Quit | |
| 4414 | "RTN","IBC NEHL2",115 ,0) | |
| 4415 | I EVENTYP =1 D G IN 1X | |
| 4416 | "RTN","IBC NEHL2",116 ,0) | |
| 4417 | . N SETID | |
| 4418 | "RTN","IBC NEHL2",117 ,0) | |
| 4419 | . S SETID =$G(IBSEG( 2)) | |
| 4420 | "RTN","IBC NEHL2",118 ,0) | |
| 4421 | . S IBTRA CK(SETID,. 01)=PAYRID ;PAYER VA ID | |
| 4422 | "RTN","IBC NEHL2",119 ,0) | |
| 4423 | . S IBTRA CK(SETID,. 02)=PYRNM ;PAYER NAME | |
| 4424 | "RTN","IBC NEHL2",120 ,0) | |
| 4425 | . S IBTRA CK(SETID,. 03)=GNUMB ;GROUP NUMBER | |
| 4426 | "RTN","IBC NEHL2",121 ,0) | |
| 4427 | . I $G(IB TRACK(SETI D,.04))="" S IBTRACK (SETID,.04 )=MBRID ; SUBSCRIBER ID | |
| 4428 | "RTN","IBC NEHL2",122 ,0) | |
| 4429 | . S IBTRA CK(SETID,. 05)=MBRID ;MEMBER ID | |
| 4430 | "RTN","IBC NEHL2",123 ,0) | |
| 4431 | S EFFDT=$ G(IBSEG(13 )),EXPDT=$ G(IBSEG(14 )) | |
| 4432 | "RTN","IBC NEHL2",124 ,0) | |
| 4433 | S COB=$G( IBSEG(23)) ,SRVDT=$G( IBSEG(27)) | |
| 4434 | "RTN","IBC NEHL2",125 ,0) | |
| 4435 | S PYLEDT= $G(IBSEG(3 0)),RELTN= $G(IBSEG(1 8)) | |
| 4436 | "RTN","IBC NEHL2",126 ,0) | |
| 4437 | ; | |
| 4438 | "RTN","IBC NEHL2",127 ,0) | |
| 4439 | ; Relatio nship code s sent thr ough the H L7 msg are X12 codes | |
| 4440 | "RTN","IBC NEHL2",128 ,0) | |
| 4441 | ; X12 cod es from th e interfac e that are special c ases: "21" =unknown, "40"=cadav er donor | |
| 4442 | "RTN","IBC NEHL2",129 ,0) | |
| 4443 | S RELTN=$ S(RELTN="2 1":"",RELT N="40":"G8 ",1:RELTN) | |
| 4444 | "RTN","IBC NEHL2",130 ,0) | |
| 4445 | S EFFDT=$ $FMDATE^HL FNC(EFFDT) ,EXPDT=$$F MDATE^HLFN C(EXPDT) | |
| 4446 | "RTN","IBC NEHL2",131 ,0) | |
| 4447 | S SRVDT=$ $FMDATE^HL FNC(SRVDT) ,PYLEDT=$$ FMDATE^HLF NC(PYLEDT) | |
| 4448 | "RTN","IBC NEHL2",132 ,0) | |
| 4449 | ; | |
| 4450 | "RTN","IBC NEHL2",133 ,0) | |
| 4451 | S RSUPDT( 365,RIEN_" ,",1.11)=E FFDT | |
| 4452 | "RTN","IBC NEHL2",134 ,0) | |
| 4453 | S RSUPDT( 365,RIEN_" ,",1.12)=E XPDT,RSUPD T(365,RIEN _",",1.1)= SRVDT | |
| 4454 | "RTN","IBC NEHL2",135 ,0) | |
| 4455 | S RSUPDT( 365,RIEN_" ,",1.19)=P YLEDT | |
| 4456 | "RTN","IBC NEHL2",136 ,0) | |
| 4457 | S RSUPDT( 365,RIEN_" ,",1.13)=C OB,RSUPDT( 365,RIEN_" ,",1.18)=M BRID | |
| 4458 | "RTN","IBC NEHL2",137 ,0) | |
| 4459 | D FILE^DI E("","RSUP DT","ERROR ") Q:$D(ER ROR) ; da ta needs t o filed as internal values | |
| 4460 | "RTN","IBC NEHL2",138 ,0) | |
| 4461 | ; IB*2*49 7 - add th e followin g lines | |
| 4462 | "RTN","IBC NEHL2",139 ,0) | |
| 4463 | ; data at 365, 8.01 ,13.02,14. 01, 14.02 needs to b e validate d before i t can be f iled; pass the 'E' f lag to DBS filer | |
| 4464 | "RTN","IBC NEHL2",140 ,0) | |
| 4465 | K RSUPDT | |
| 4466 | "RTN","IBC NEHL2",141 ,0) | |
| 4467 | S RSUPDT( 365,RIEN_" ,",8.01)=R ELTN D COD ECHK^IBCNE HLU(.RSUPD T) ; IB*2 *497 chec k for new coded valu es | |
| 4468 | "RTN","IBC NEHL2",142 ,0) | |
| 4469 | S RSUPDT( 365,RIEN_" ,",13.02)= $S($G(SUBI D)'="":SUB ID,1:MBRID ) | |
| 4470 | "RTN","IBC NEHL2",143 ,0) | |
| 4471 | S RSUPDT( 365,RIEN_" ,",14.01)= GNAME | |
| 4472 | "RTN","IBC NEHL2",144 ,0) | |
| 4473 | S RSUPDT( 365,RIEN_" ,",14.02)= GNUMB | |
| 4474 | "RTN","IBC NEHL2",145 ,0) | |
| 4475 | D FILE^DI E("E","RSU PDT","ERRO R") | |
| 4476 | "RTN","IBC NEHL2",146 ,0) | |
| 4477 | IN1X ; | |
| 4478 | "RTN","IBC NEHL2",147 ,0) | |
| 4479 | Q | |
| 4480 | "RTN","IBC NEHL2",148 ,0) | |
| 4481 | ; | |
| 4482 | "RTN","IBC NEHL2",149 ,0) | |
| 4483 | IN3(ERROR, IBSEG,RIEN ) ; Proce ss IN3 Add t'l Insura nce - Cert Seg | |
| 4484 | "RTN","IBC NEHL2",150 ,0) | |
| 4485 | ; | |
| 4486 | "RTN","IBC NEHL2",151 ,0) | |
| 4487 | ; Input: | |
| 4488 | "RTN","IBC NEHL2",152 ,0) | |
| 4489 | ; IBSEG,R IEN | |
| 4490 | "RTN","IBC NEHL2",153 ,0) | |
| 4491 | ; | |
| 4492 | "RTN","IBC NEHL2",154 ,0) | |
| 4493 | ; Output: | |
| 4494 | "RTN","IBC NEHL2",155 ,0) | |
| 4495 | ; ERROR | |
| 4496 | "RTN","IBC NEHL2",156 ,0) | |
| 4497 | ; | |
| 4498 | "RTN","IBC NEHL2",157 ,0) | |
| 4499 | N CRDT,RS UPDT | |
| 4500 | "RTN","IBC NEHL2",158 ,0) | |
| 4501 | ; | |
| 4502 | "RTN","IBC NEHL2",159 ,0) | |
| 4503 | S CRDT=$G (IBSEG(7)) | |
| 4504 | "RTN","IBC NEHL2",160 ,0) | |
| 4505 | S CRDT=$$ FMDATE^HLF NC(CRDT) | |
| 4506 | "RTN","IBC NEHL2",161 ,0) | |
| 4507 | S RSUPDT( 365,RIEN_" ,",1.17)=C RDT | |
| 4508 | "RTN","IBC NEHL2",162 ,0) | |
| 4509 | D FILE^DI E("I","RSU PDT","ERRO R") | |
| 4510 | "RTN","IBC NEHL2",163 ,0) | |
| 4511 | IN3X ; | |
| 4512 | "RTN","IBC NEHL2",164 ,0) | |
| 4513 | Q | |
| 4514 | "RTN","IBC NEHL2",165 ,0) | |
| 4515 | ; | |
| 4516 | "RTN","IBC NEHL2",166 ,0) | |
| 4517 | ZEB(EBDA,E RROR,IBSEG ,RIEN) ; Process th e ZEB Elig /Benefit s eg | |
| 4518 | "RTN","IBC NEHL2",167 ,0) | |
| 4519 | ; | |
| 4520 | "RTN","IBC NEHL2",168 ,0) | |
| 4521 | ; Input: | |
| 4522 | "RTN","IBC NEHL2",169 ,0) | |
| 4523 | ; IBSEG,I IVSTAT,RIE N | |
| 4524 | "RTN","IBC NEHL2",170 ,0) | |
| 4525 | ; | |
| 4526 | "RTN","IBC NEHL2",171 ,0) | |
| 4527 | ; Output: | |
| 4528 | "RTN","IBC NEHL2",172 ,0) | |
| 4529 | ; EBDA,ER ROR | |
| 4530 | "RTN","IBC NEHL2",173 ,0) | |
| 4531 | ; | |
| 4532 | "RTN","IBC NEHL2",174 ,0) | |
| 4533 | N D1,DA,D IC,DILN,DI SYS,DLAYGO ,EBN,IENS, II,MSG,PRM ODS,RSUPDT ,STC,STCST R,SUBJECT, X,XMY,Y,MA ,CODES | |
| 4534 | "RTN","IBC NEHL2",175 ,0) | |
| 4535 | ; | |
| 4536 | "RTN","IBC NEHL2",176 ,0) | |
| 4537 | ; Set a d efault eIV Status va lue of # ( "V") | |
| 4538 | "RTN","IBC NEHL2",177 ,0) | |
| 4539 | I IIVSTAT ="" D | |
| 4540 | "RTN","IBC NEHL2",178 ,0) | |
| 4541 | . I IBS EG(7)'="eI V Eligibil ity Determ ination" S IIVSTAT=" V" Q | |
| 4542 | "RTN","IBC NEHL2",179 ,0) | |
| 4543 | . I $F( "_1_6_V_", "_"_IBSEG( 3)_"_") S IIVSTAT=IB SEG(3) Q | |
| 4544 | "RTN","IBC NEHL2",180 ,0) | |
| 4545 | . ; Unk nown code received f rom the EC | |
| 4546 | "RTN","IBC NEHL2",181 ,0) | |
| 4547 | . S SUB JECT="eIV: Invalid E ligibility Status fl ag" | |
| 4548 | "RTN","IBC NEHL2",182 ,0) | |
| 4549 | . S MSG (1)="An in valid Elig ibility St atus flag '"_$G(IBSE G(3))_"' w as receive d for site "_$P($$SI TE^VASITE, "^",3)_"," | |
| 4550 | "RTN","IBC NEHL2",183 ,0) | |
| 4551 | . S MSG (2)="trace number "_ $G(TRACE," unknown")_ " and mess age contro l id "_$G( MSGID,"unk nown")_"." | |
| 4552 | "RTN","IBC NEHL2",184 ,0) | |
| 4553 | . S MSG (3)="It ha s been int erpreted a s an ambig uous respo nse in Vis tA." | |
| 4554 | "RTN","IBC NEHL2",185 ,0) | |
| 4555 | . S XMY(" P I I ")="" | |
| 4556 | "RTN","IBC NEHL2",186 ,0) | |
| 4557 | . D MSG ^IBCNEUT5( "",SUBJECT ,"MSG(",,. XMY) | |
| 4558 | "RTN","IBC NEHL2",187 ,0) | |
| 4559 | . S IIV STAT="V" | |
| 4560 | "RTN","IBC NEHL2",188 ,0) | |
| 4561 | ; | |
| 4562 | "RTN","IBC NEHL2",189 ,0) | |
| 4563 | ; Process the ZEB | |
| 4564 | "RTN","IBC NEHL2",190 ,0) | |
| 4565 | S EBN=$G( IBSEG(2)) | |
| 4566 | "RTN","IBC NEHL2",191 ,0) | |
| 4567 | S DA(1)=R IEN,DIC="^ IBCN(365," _DA(1)_",2 ,",DIC(0)= "L",DLAYGO =365.02 | |
| 4568 | "RTN","IBC NEHL2",192 ,0) | |
| 4569 | I '$D(^IB CN(365,DA( 1),2,0)) S ^IBCN(365 ,DA(1),2,0 )="^365.02 ^^" | |
| 4570 | "RTN","IBC NEHL2",193 ,0) | |
| 4571 | S X=EBN D ^DIC | |
| 4572 | "RTN","IBC NEHL2",194 ,0) | |
| 4573 | S DA=+Y,E BDA=DA | |
| 4574 | "RTN","IBC NEHL2",195 ,0) | |
| 4575 | ; | |
| 4576 | "RTN","IBC NEHL2",196 ,0) | |
| 4577 | S IENS=$$ IENS^DILF( .DA) | |
| 4578 | "RTN","IBC NEHL2",197 ,0) | |
| 4579 | ; | |
| 4580 | "RTN","IBC NEHL2",198 ,0) | |
| 4581 | ; decode plan descr iption ZEB segment | |
| 4582 | "RTN","IBC NEHL2",199 ,0) | |
| 4583 | S IBSEG(7 )=$$DECHL7 ($G(IBSEG( 7))) | |
| 4584 | "RTN","IBC NEHL2",200 ,0) | |
| 4585 | S RSUPDT( 365.02,IEN S,".02")=$ P($G(IBSEG (3)),HLCMP ) ; elig/b enefit inf o | |
| 4586 | "RTN","IBC NEHL2",201 ,0) | |
| 4587 | S RSUPDT( 365.02,IEN S,".03")=$ P($G(IBSEG (4)),HLCMP ) ; covera ge level | |
| 4588 | "RTN","IBC NEHL2",202 ,0) | |
| 4589 | S RSUPDT( 365.02,IEN S,".05")=$ P($G(IBSEG (6)),HLCMP ) ; insura nce type | |
| 4590 | "RTN","IBC NEHL2",203 ,0) | |
| 4591 | S RSUPDT( 365.02,IEN S,".06")=$ G(IBSEG(7) ) ; plan c overage | |
| 4592 | "RTN","IBC NEHL2",204 ,0) | |
| 4593 | S RSUPDT( 365.02,IEN S,".07")=$ P($G(IBSEG (8)),HLCMP ) ; time p eriod qual ifier | |
| 4594 | "RTN","IBC NEHL2",205 ,0) | |
| 4595 | S MA=$G(I BSEG(9)) I $TR(MA," ","")'="" S MA=$J(MA ,0,2) | |
| 4596 | "RTN","IBC NEHL2",206 ,0) | |
| 4597 | S RSUPDT( 365.02,IEN S,".08")=$ $NUMCHK(MA ) ; Monet ary amt | |
| 4598 | "RTN","IBC NEHL2",207 ,0) | |
| 4599 | S RSUPDT( 365.02,IEN S,".09")=$ $NUMCHK($G (IBSEG(10) )) ; Perce nt | |
| 4600 | "RTN","IBC NEHL2",208 ,0) | |
| 4601 | S RSUPDT( 365.02,IEN S,".1")=$G (IBSEG(11) ) ; Quant ity Qual. | |
| 4602 | "RTN","IBC NEHL2",209 ,0) | |
| 4603 | F II=11:1 :13 S RSUP DT(365.02, IENS,"."_I I)=$G(IBSE G(II+1)) | |
| 4604 | "RTN","IBC NEHL2",210 ,0) | |
| 4605 | S RSUPDT( 365.02,IEN S,"1.01")= $P($G(IBSE G(15)),HLC MP) ; Proc edure codi ng method | |
| 4606 | "RTN","IBC NEHL2",211 ,0) | |
| 4607 | S RSUPDT( 365.02,IEN S,"1.02")= $G(IBSEG(1 6)) ; Proc edure code | |
| 4608 | "RTN","IBC NEHL2",212 ,0) | |
| 4609 | ; Procedu re modifie rs | |
| 4610 | "RTN","IBC NEHL2",213 ,0) | |
| 4611 | S PRMODS= $G(IBSEG(1 7)) F II=1 :1:4 S RSU PDT(365.02 ,IENS,"1.0 "_(II+2))= $TR($P(PRM ODS,HLREP, II),HL("EC H")) | |
| 4612 | "RTN","IBC NEHL2",214 ,0) | |
| 4613 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 4614 | "RTN","IBC NEHL2",215 ,0) | |
| 4615 | D FILE^DI E("ET","RS UPDT","ERR OR") I $D( ERROR) Q | |
| 4616 | "RTN","IBC NEHL2",216 ,0) | |
| 4617 | ; service type code s | |
| 4618 | "RTN","IBC NEHL2",217 ,0) | |
| 4619 | K RSUPDT S STCSTR=$ P($G(IBSEG (5)),HLCMP ) | |
| 4620 | "RTN","IBC NEHL2",218 ,0) | |
| 4621 | F II=1:1 S STC=$P(S TCSTR,HLRE P,II) Q:ST C="" S RS UPDT(365.2 92,"+"_II_ ","_IENS," .01")=STC, CODES(365. 292,II,.01 )=STC ; I B*2*497 se t up CODES array | |
| 4622 | "RTN","IBC NEHL2",219 ,0) | |
| 4623 | D CODECHK ^IBCNEHLU( .CODES) ; IB*2*497 | |
| 4624 | "RTN","IBC NEHL2",220 ,0) | |
| 4625 | I $D(RSUP DT) D UPDA TE^DIE("E" ,"RSUPDT", ,"ERROR") | |
| 4626 | "RTN","IBC NEHL2",221 ,0) | |
| 4627 | ZEBX ; | |
| 4628 | "RTN","IBC NEHL2",222 ,0) | |
| 4629 | Q | |
| 4630 | "RTN","IBC NEHL2",223 ,0) | |
| 4631 | ; | |
| 4632 | "RTN","IBC NEHL2",224 ,0) | |
| 4633 | EBNTE(EBDA ,IBSEG,RIE N) ; Proce ss NTE Ben efit relat ed entity Notes segm ent (in El igibility/ Benefit gr oup) | |
| 4634 | "RTN","IBC NEHL2",225 ,0) | |
| 4635 | ; | |
| 4636 | "RTN","IBC NEHL2",226 ,0) | |
| 4637 | ; Input: | |
| 4638 | "RTN","IBC NEHL2",227 ,0) | |
| 4639 | ; EBDA,IB SEG,RIEN | |
| 4640 | "RTN","IBC NEHL2",228 ,0) | |
| 4641 | ; | |
| 4642 | "RTN","IBC NEHL2",229 ,0) | |
| 4643 | ; Output: | |
| 4644 | "RTN","IBC NEHL2",230 ,0) | |
| 4645 | ; ERROR | |
| 4646 | "RTN","IBC NEHL2",231 ,0) | |
| 4647 | ; | |
| 4648 | "RTN","IBC NEHL2",232 ,0) | |
| 4649 | N DA,IENS ,NOTES | |
| 4650 | "RTN","IBC NEHL2",233 ,0) | |
| 4651 | I $G(EBDA )="" G EBN TEX | |
| 4652 | "RTN","IBC NEHL2",234 ,0) | |
| 4653 | S NOTES(1 )=$$DECHL7 ($G(IBSEG( 4))) | |
| 4654 | "RTN","IBC NEHL2",235 ,0) | |
| 4655 | S DA(1)=R IEN,DA=EBD A | |
| 4656 | "RTN","IBC NEHL2",236 ,0) | |
| 4657 | S IENS=$$ IENS^DILF( .DA) | |
| 4658 | "RTN","IBC NEHL2",237 ,0) | |
| 4659 | D WP^DIE( 365.02,IEN S,2,"A","N OTES","ERR OR") | |
| 4660 | "RTN","IBC NEHL2",238 ,0) | |
| 4661 | EBNTEX ; | |
| 4662 | "RTN","IBC NEHL2",239 ,0) | |
| 4663 | Q | |
| 4664 | "RTN","IBC NEHL2",240 ,0) | |
| 4665 | ; | |
| 4666 | "RTN","IBC NEHL2",241 ,0) | |
| 4667 | DECHL7(STR ,HLSEP,ECH ARS) ; Dec ode HL7 es cape seqs in data fi elds | |
| 4668 | "RTN","IBC NEHL2",242 ,0) | |
| 4669 | ; | |
| 4670 | "RTN","IBC NEHL2",243 ,0) | |
| 4671 | ; Input: | |
| 4672 | "RTN","IBC NEHL2",244 ,0) | |
| 4673 | ; STR = F ield data possible c ontaining HL7 escape seqs for encoding c hars | |
| 4674 | "RTN","IBC NEHL2",245 ,0) | |
| 4675 | ; HLSEP ( opt) = HL7 Field sep . char - a ssumes HLF S if not p assed | |
| 4676 | "RTN","IBC NEHL2",246 ,0) | |
| 4677 | ; ECHARS (opt) = HL 7 encoding chars bei ng used, a ssumes HL( "ECH") if not passed | |
| 4678 | "RTN","IBC NEHL2",247 ,0) | |
| 4679 | ; | |
| 4680 | "RTN","IBC NEHL2",248 ,0) | |
| 4681 | ; Output Values | |
| 4682 | "RTN","IBC NEHL2",249 ,0) | |
| 4683 | ; Fn retu rns string w/convert ed escape seqs | |
| 4684 | "RTN","IBC NEHL2",250 ,0) | |
| 4685 | ; | |
| 4686 | "RTN","IBC NEHL2",251 ,0) | |
| 4687 | N ESC,PAT ,REPL,ECOD E,PCE | |
| 4688 | "RTN","IBC NEHL2",252 ,0) | |
| 4689 | ; Initial ize opt. p arams. | |
| 4690 | "RTN","IBC NEHL2",253 ,0) | |
| 4691 | I $G(HLSE P)="" S HL SEP=HLFS | |
| 4692 | "RTN","IBC NEHL2",254 ,0) | |
| 4693 | I $G(ECHA RS)="" S E CHARS=HL(" ECH") | |
| 4694 | "RTN","IBC NEHL2",255 ,0) | |
| 4695 | ; | |
| 4696 | "RTN","IBC NEHL2",256 ,0) | |
| 4697 | S ESC=$E( ECHARS,3) ; Escape c har. | |
| 4698 | "RTN","IBC NEHL2",257 ,0) | |
| 4699 | ; Check f or escape seqs, quit if not | |
| 4700 | "RTN","IBC NEHL2",258 ,0) | |
| 4701 | I STR'[ES C G DECHL7 X | |
| 4702 | "RTN","IBC NEHL2",259 ,0) | |
| 4703 | ; Replace ^ w/{sp} (if any) t o prevent filing pro blems | |
| 4704 | "RTN","IBC NEHL2",260 ,0) | |
| 4705 | S ECHARS= $TR(ECHARS ,"^"," ") | |
| 4706 | "RTN","IBC NEHL2",261 ,0) | |
| 4707 | ; | |
| 4708 | "RTN","IBC NEHL2",262 ,0) | |
| 4709 | ; Array o f rep. cha rs | |
| 4710 | "RTN","IBC NEHL2",263 ,0) | |
| 4711 | S REPL("F ")=$TR(HLS EP,"^"," " ) ;Field S ep | |
| 4712 | "RTN","IBC NEHL2",264 ,0) | |
| 4713 | S REPL("S ")=$E(ECHA RS) ;C omp Sep | |
| 4714 | "RTN","IBC NEHL2",265 ,0) | |
| 4715 | S REPL("R ")=$E(ECHA RS,2) ;R ep. sep | |
| 4716 | "RTN","IBC NEHL2",266 ,0) | |
| 4717 | ; Temp. r eplace w/A SC 26, unt il after o ther ESC a re strippe d | |
| 4718 | "RTN","IBC NEHL2",267 ,0) | |
| 4719 | S REPL("E ")=$C(26) ;Esc. sep | |
| 4720 | "RTN","IBC NEHL2",268 ,0) | |
| 4721 | S REPL("T ")=$E(ECHA RS,4) ;S ubcomp. se p | |
| 4722 | "RTN","IBC NEHL2",269 ,0) | |
| 4723 | ; | |
| 4724 | "RTN","IBC NEHL2",270 ,0) | |
| 4725 | ; Transla te out esc ape seqs l eft->right | |
| 4726 | "RTN","IBC NEHL2",271 ,0) | |
| 4727 | F PCE=1:1 :($L(STR,E SC)-1)\2 D | |
| 4728 | "RTN","IBC NEHL2",272 ,0) | |
| 4729 | . ; Ignor e empty es c. or unre c. esc. se q. | |
| 4730 | "RTN","IBC NEHL2",273 ,0) | |
| 4731 | . S ECODE =$P(STR,ES C,2) I ECO DE="" S EC ODE="XXXX" | |
| 4732 | "RTN","IBC NEHL2",274 ,0) | |
| 4733 | . I $D(RE PL(ECODE)) '>0 S STR= $P(STR,ESC )_$C(26)_$ P(STR,ESC, 2)_$C(26)_ $P(STR,ESC ,3,99999) Q | |
| 4734 | "RTN","IBC NEHL2",275 ,0) | |
| 4735 | . ; Else, replace e sc. seq. w / char. | |
| 4736 | "RTN","IBC NEHL2",276 ,0) | |
| 4737 | . S STR=$ P(STR,ESC) _$G(REPL(E CODE))_$P( STR,ESC,3, 99999) | |
| 4738 | "RTN","IBC NEHL2",277 ,0) | |
| 4739 | ; | |
| 4740 | "RTN","IBC NEHL2",278 ,0) | |
| 4741 | ;Replace the decode d ESC char s that wer e actually sent | |
| 4742 | "RTN","IBC NEHL2",279 ,0) | |
| 4743 | S STR=$TR (STR,$C(26 ),ESC) | |
| 4744 | "RTN","IBC NEHL2",280 ,0) | |
| 4745 | ; | |
| 4746 | "RTN","IBC NEHL2",281 ,0) | |
| 4747 | DECHL7X ; Exit w/ret urn values | |
| 4748 | "RTN","IBC NEHL2",282 ,0) | |
| 4749 | Q STR | |
| 4750 | "RTN","IBC NEHL2",283 ,0) | |
| 4751 | ; | |
| 4752 | "RTN","IBC NEHL2",284 ,0) | |
| 4753 | NUMCHK(N) ; make sur e that num eric value N is not greater th an 99999 | |
| 4754 | "RTN","IBC NEHL2",285 ,0) | |
| 4755 | Q $S(+N>9 9999:99999 ,1:N) | |
| 4756 | "RTN","IBC NEHL3") | |
| 4757 | 0^20^B1721 54152^B171 754905 | |
| 4758 | "RTN","IBC NEHL3",1,0 ) | |
| 4759 | IBCNEHL3 ; DAOU/ALA - HL7 Proce ss Incomin g RPI Cont inued ;03- JUL-2002 ; Compiled June 2, 2 005 14:20: 19 | |
| 4760 | "RTN","IBC NEHL3",2,0 ) | |
| 4761 | ;;2.0;INT EGRATED BI LLING;**30 0,416,497, 506,595,62 1**;21-MAR -94;Build 8 | |
| 4762 | "RTN","IBC NEHL3",3,0 ) | |
| 4763 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 4764 | "RTN","IBC NEHL3",4,0 ) | |
| 4765 | ; | |
| 4766 | "RTN","IBC NEHL3",5,0 ) | |
| 4767 | ;**Progra m Descript ion** | |
| 4768 | "RTN","IBC NEHL3",6,0 ) | |
| 4769 | ; This i s a contin uation of IBCNEHL1 w hich proce sses an in coming | |
| 4770 | "RTN","IBC NEHL3",7,0 ) | |
| 4771 | ; RPI II V message. | |
| 4772 | "RTN","IBC NEHL3",8,0 ) | |
| 4773 | ; | |
| 4774 | "RTN","IBC NEHL3",9,0 ) | |
| 4775 | ; This r outine is based on I BCNEHLS wh ich was in troduced w ith patch 184, and s ubsequentl y | |
| 4776 | "RTN","IBC NEHL3",10, 0) | |
| 4777 | ; patche d with pat ch 271. I BCNEHLS is obsolete and delete d with pat ch 300. | |
| 4778 | "RTN","IBC NEHL3",11, 0) | |
| 4779 | ; | |
| 4780 | "RTN","IBC NEHL3",12, 0) | |
| 4781 | Q ; no direct cal ls allow | |
| 4782 | "RTN","IBC NEHL3",13, 0) | |
| 4783 | ; | |
| 4784 | "RTN","IBC NEHL3",14, 0) | |
| 4785 | ERROR(TQN, ERACT,ERCO N,TRCN) ; Entry poin t | |
| 4786 | "RTN","IBC NEHL3",15, 0) | |
| 4787 | ; Input: TQN - IEN for eIV T ransmissio n Queue (# 365.1), re quired | |
| 4788 | "RTN","IBC NEHL3",16, 0) | |
| 4789 | ; ERACT - E rror Actio n Code (#3 65.14), re quired | |
| 4790 | "RTN","IBC NEHL3",17, 0) | |
| 4791 | ; ERCON - E rror Condi tion Code (#365.17), required | |
| 4792 | "RTN","IBC NEHL3",18, 0) | |
| 4793 | ; TRCN - Tr ace # from eIV Respo nse (#365) | |
| 4794 | "RTN","IBC NEHL3",19, 0) | |
| 4795 | ; | |
| 4796 | "RTN","IBC NEHL3",20, 0) | |
| 4797 | ; IIVSTAT - IIV statu s transmit ted by EC | |
| 4798 | "RTN","IBC NEHL3",21, 0) | |
| 4799 | ; Note: MAP (IIVSTAT) = IIV STAT US IEN | |
| 4800 | "RTN","IBC NEHL3",22, 0) | |
| 4801 | N MSG,ERD ESC,ERIEN, XMY,DA,DIE ,DR | |
| 4802 | "RTN","IBC NEHL3",23, 0) | |
| 4803 | ; | |
| 4804 | "RTN","IBC NEHL3",24, 0) | |
| 4805 | I $G(TQN) ="" G ERRO RX | |
| 4806 | "RTN","IBC NEHL3",25, 0) | |
| 4807 | ; | |
| 4808 | "RTN","IBC NEHL3",26, 0) | |
| 4809 | ;/Removed the follo wing lines of code a s part of IB*2.0*506 but wante d to | |
| 4810 | "RTN","IBC NEHL3",27, 0) | |
| 4811 | ;/leave t his code a vailable i f it shoul d be neede d in the f uture. | |
| 4812 | "RTN","IBC NEHL3",28, 0) | |
| 4813 | ; Scenari os: | |
| 4814 | "RTN","IBC NEHL3",29, 0) | |
| 4815 | ; #1 - If error mes sage = "Re submission Allowed" OR "Please Resubmit | |
| 4816 | "RTN","IBC NEHL3",30, 0) | |
| 4817 | ; Origina l Transact ion" - set TQ | |
| 4818 | "RTN","IBC NEHL3",31, 0) | |
| 4819 | ; Fut Tra ns Dt to T + Comm Fa ilure Days and Statu s to "Hold " | |
| 4820 | "RTN","IBC NEHL3",32, 0) | |
| 4821 | ;I ERACT= "R"!(ERACT ="P") D G ERRORX | |
| 4822 | "RTN","IBC NEHL3",33, 0) | |
| 4823 | ;. I $P($ G(^IBCN(36 5.1,TQN,0) ),U,9)="" D Q ; firs t time pay er asked u s to resub mit | |
| 4824 | "RTN","IBC NEHL3",34, 0) | |
| 4825 | ;. . ; Up date IIV T Q fields: "Hold" (4) , IIV Site Param Com m Failure Days | |
| 4826 | "RTN","IBC NEHL3",35, 0) | |
| 4827 | ;. . D UP DATE(TQN,4 ,+$P($G(^I BE(350.9,1 ,51)),U,5) ,ERACT) | |
| 4828 | "RTN","IBC NEHL3",36, 0) | |
| 4829 | ;. . ; | |
| 4830 | "RTN","IBC NEHL3",37, 0) | |
| 4831 | ;. ; paye r asked us to resubm it for the 2nd time for this i nquiry | |
| 4832 | "RTN","IBC NEHL3",38, 0) | |
| 4833 | ;. ; Upda te IIV TQ fields: "R esponse Re ceived" (3 ), n/a ("" ) | |
| 4834 | "RTN","IBC NEHL3",39, 0) | |
| 4835 | ;. D UPDA TE(TQN,3," ",ERACT,ER CON) | |
| 4836 | "RTN","IBC NEHL3",40, 0) | |
| 4837 | ;. ; clea r future t ransmissio n date so it won't d isplay in the buffer | |
| 4838 | "RTN","IBC NEHL3",41, 0) | |
| 4839 | ;. S DA=T QN,DIE="^I BCN(365.1, ",DR=".09/ //@" D ^DI E | |
| 4840 | "RTN","IBC NEHL3",42, 0) | |
| 4841 | ; | |
| 4842 | "RTN","IBC NEHL3",43, 0) | |
| 4843 | ; #2 - If error mes sage = "Pl ease Wait 30 Days an d Resubmit " - set TQ | |
| 4844 | "RTN","IBC NEHL3",44, 0) | |
| 4845 | ; Fut Tra ns Dt to T + 30 and Status to "Hold" | |
| 4846 | "RTN","IBC NEHL3",45, 0) | |
| 4847 | ;I ERACT= "W" D G ER RORX | |
| 4848 | "RTN","IBC NEHL3",46, 0) | |
| 4849 | ;. ; Upda te IIV TQ fields: "H old" (4), 30 | |
| 4850 | "RTN","IBC NEHL3",47, 0) | |
| 4851 | ;. D UPDA TE(TQN,4,3 0,ERACT) | |
| 4852 | "RTN","IBC NEHL3",48, 0) | |
| 4853 | ; | |
| 4854 | "RTN","IBC NEHL3",49, 0) | |
| 4855 | ; #3 - If error mes sage = "Pl ease Wait 10 Days an d Resubmit " - set TQ | |
| 4856 | "RTN","IBC NEHL3",50, 0) | |
| 4857 | ; Fut Tra ns Dt to T + 10 and Status to "Hold" | |
| 4858 | "RTN","IBC NEHL3",51, 0) | |
| 4859 | ;I ERACT= "X" D G ER RORX | |
| 4860 | "RTN","IBC NEHL3",52, 0) | |
| 4861 | ;. ; Upda te IIV TQ fields: "H old" (4), 10 | |
| 4862 | "RTN","IBC NEHL3",53, 0) | |
| 4863 | ;. D UPDA TE(TQN,4,1 0,ERACT) | |
| 4864 | "RTN","IBC NEHL3",54, 0) | |
| 4865 | ; | |
| 4866 | "RTN","IBC NEHL3",55, 0) | |
| 4867 | ; #4 - If error mes sage = "Re submission Not Allow ed" or | |
| 4868 | "RTN","IBC NEHL3",56, 0) | |
| 4869 | ; "Do not resubmit ...." OR " Please cor rect and r esubmit" | |
| 4870 | "RTN","IBC NEHL3",57, 0) | |
| 4871 | ; - set T Q Status t o "Respons e Received " | |
| 4872 | "RTN","IBC NEHL3",58, 0) | |
| 4873 | ; If we r eceive err or txt, tr eat as an "N" | |
| 4874 | "RTN","IBC NEHL3",59, 0) | |
| 4875 | ;I ERACT= "" S ERACT ="N" | |
| 4876 | "RTN","IBC NEHL3",60, 0) | |
| 4877 | ;I ERACT= "N"!(ERACT ="Y")!(ERA CT="S")!(E RACT="C") D G ERRORX | |
| 4878 | "RTN","IBC NEHL3",61, 0) | |
| 4879 | ;. ; Upda te IIV TQ fields: "R esponse Re ceived" (3 ), n/a ("" ) | |
| 4880 | "RTN","IBC NEHL3",62, 0) | |
| 4881 | ;. D UPDA TE(TQN,3," ",ERACT,ER CON) | |
| 4882 | "RTN","IBC NEHL3",63, 0) | |
| 4883 | ; | |
| 4884 | "RTN","IBC NEHL3",64, 0) | |
| 4885 | ; #5 - Er ror messag e is unfam iliar - ne w Error Ac tion Code | |
| 4886 | "RTN","IBC NEHL3",65, 0) | |
| 4887 | ; *** Cur rently pro cessed in IBCNEHL1 * ** | |
| 4888 | "RTN","IBC NEHL3",66, 0) | |
| 4889 | ;/End of removed co de for IB* 2.0*506 | |
| 4890 | "RTN","IBC NEHL3",67, 0) | |
| 4891 | ; | |
| 4892 | "RTN","IBC NEHL3",68, 0) | |
| 4893 | ; /IB*2.0 *506 Begin ning | |
| 4894 | "RTN","IBC NEHL3",69, 0) | |
| 4895 | ; For all Scenarios 1 thru 5, set TQ St atus to "R esponse Re ceived" | |
| 4896 | "RTN","IBC NEHL3",70, 0) | |
| 4897 | I ERACT=" " S ERACT= "N" | |
| 4898 | "RTN","IBC NEHL3",71, 0) | |
| 4899 | I ",R,P,W ,X,N,Y,S,C ,"[(","_ER ACT_",") D G ERRORX | |
| 4900 | "RTN","IBC NEHL3",72, 0) | |
| 4901 | . ; Updat e IIV TQ f ields: "Re sponse Rec eived" (3) , n/a ("") | |
| 4902 | "RTN","IBC NEHL3",73, 0) | |
| 4903 | . D UPDAT E(TQN,3,"" ,ERACT,ERC ON) | |
| 4904 | "RTN","IBC NEHL3",74, 0) | |
| 4905 | ; /IB*2.0 *506 End | |
| 4906 | "RTN","IBC NEHL3",75, 0) | |
| 4907 | ; | |
| 4908 | "RTN","IBC NEHL3",76, 0) | |
| 4909 | ERRORX ; E RROR exit pt | |
| 4910 | "RTN","IBC NEHL3",77, 0) | |
| 4911 | Q | |
| 4912 | "RTN","IBC NEHL3",78, 0) | |
| 4913 | ; | |
| 4914 | "RTN","IBC NEHL3",79, 0) | |
| 4915 | UPDATE(TQN ,TSTS,TDAY S,ERACT,ER CON) ; Up date Trans mission Qu eue (#365. 1) | |
| 4916 | "RTN","IBC NEHL3",80, 0) | |
| 4917 | ; Update/ Create Buf fer inform ation as n ecessary | |
| 4918 | "RTN","IBC NEHL3",81, 0) | |
| 4919 | ; * If un solicited error or n egative Ve rification response do not | |
| 4920 | "RTN","IBC NEHL3",82, 0) | |
| 4921 | ; update TQ entry. However, create a n ew Buffer entry. | |
| 4922 | "RTN","IBC NEHL3",83, 0) | |
| 4923 | ; Input V ariables | |
| 4924 | "RTN","IBC NEHL3",84, 0) | |
| 4925 | ; ERACT,E RCON,IIVST AT,TDAYS,T QN,TSTS | |
| 4926 | "RTN","IBC NEHL3",85, 0) | |
| 4927 | ; | |
| 4928 | "RTN","IBC NEHL3",86, 0) | |
| 4929 | ; Output Variables | |
| 4930 | "RTN","IBC NEHL3",87, 0) | |
| 4931 | ; IIVSTAT (updated) | |
| 4932 | "RTN","IBC NEHL3",88, 0) | |
| 4933 | ; | |
| 4934 | "RTN","IBC NEHL3",89, 0) | |
| 4935 | ; Init op tional par am | |
| 4936 | "RTN","IBC NEHL3",90, 0) | |
| 4937 | S ERCON=$ G(ERCON) | |
| 4938 | "RTN","IBC NEHL3",91, 0) | |
| 4939 | ; | |
| 4940 | "RTN","IBC NEHL3",92, 0) | |
| 4941 | ; Init va rs | |
| 4942 | "RTN","IBC NEHL3",93, 0) | |
| 4943 | N D,D0,DA ,DFN,DI,DI C,DIE,DQ,D R,FTDT,IBD ATA,IBIEN, IBQFL,IBST S,IBSYM | |
| 4944 | "RTN","IBC NEHL3",94, 0) | |
| 4945 | N INSIEN, RSTYPE,SYM BOL,TQDATA ,X | |
| 4946 | "RTN","IBC NEHL3",95, 0) | |
| 4947 | ; | |
| 4948 | "RTN","IBC NEHL3",96, 0) | |
| 4949 | ; If no Z EB segment received, set IIVST AT to "V" | |
| 4950 | "RTN","IBC NEHL3",97, 0) | |
| 4951 | I $TR(IIV STAT," ")= "" S IIVST AT="V" | |
| 4952 | "RTN","IBC NEHL3",98, 0) | |
| 4953 | ; | |
| 4954 | "RTN","IBC NEHL3",99, 0) | |
| 4955 | S TQDATA= $G(^IBCN(3 65.1,TQN,0 )) | |
| 4956 | "RTN","IBC NEHL3",100 ,0) | |
| 4957 | I TQDATA= "" G UPDAT X | |
| 4958 | "RTN","IBC NEHL3",101 ,0) | |
| 4959 | ; | |
| 4960 | "RTN","IBC NEHL3",102 ,0) | |
| 4961 | ; Ins Buf fer IEN | |
| 4962 | "RTN","IBC NEHL3",103 ,0) | |
| 4963 | S IBIEN=$ P(TQDATA,U ,5) | |
| 4964 | "RTN","IBC NEHL3",104 ,0) | |
| 4965 | S IBQFL=$ P(TQDATA,U ,11) | |
| 4966 | "RTN","IBC NEHL3",105 ,0) | |
| 4967 | S RSTYPE= $P($G(^IBC N(365,RIEN ,0)),U,10) | |
| 4968 | "RTN","IBC NEHL3",106 ,0) | |
| 4969 | ; | |
| 4970 | "RTN","IBC NEHL3",107 ,0) | |
| 4971 | ; If unso licited er ror or neg ative Iden tification response DON'T | |
| 4972 | "RTN","IBC NEHL3",108 ,0) | |
| 4973 | ; update TQ entry o r Buffer ( includes n ot creatin g a new bu ffer) | |
| 4974 | "RTN","IBC NEHL3",109 ,0) | |
| 4975 | I RSTYPE= "U",(IBQFL ="I") G UP DATX | |
| 4976 | "RTN","IBC NEHL3",110 ,0) | |
| 4977 | ; | |
| 4978 | "RTN","IBC NEHL3",111 ,0) | |
| 4979 | I RSTYPE= "U" S IBIE N="" ; ma kes sure a new buffe r is creat ed | |
| 4980 | "RTN","IBC NEHL3",112 ,0) | |
| 4981 | ; | |
| 4982 | "RTN","IBC NEHL3",113 ,0) | |
| 4983 | ; Ins Buf fer proces sing | |
| 4984 | "RTN","IBC NEHL3",114 ,0) | |
| 4985 | I IBIEN'= "" D | |
| 4986 | "RTN","IBC NEHL3",115 ,0) | |
| 4987 | . ; Ins B uf data | |
| 4988 | "RTN","IBC NEHL3",116 ,0) | |
| 4989 | . S IBDAT A=$G(^IBA( 355.33,+IB IEN,0)) | |
| 4990 | "RTN","IBC NEHL3",117 ,0) | |
| 4991 | . S IBSTS =$P(IBDATA ,U,4) ; Status | |
| 4992 | "RTN","IBC NEHL3",118 ,0) | |
| 4993 | . S IBSYM =$P(IBDATA ,U,12) ; Symbol | |
| 4994 | "RTN","IBC NEHL3",119 ,0) | |
| 4995 | . ; If IB status is (A)ccepte d or (R)ej ected or I B symbol i s "*" | |
| 4996 | "RTN","IBC NEHL3",120 ,0) | |
| 4997 | . ; (ver ified) or IB symbol is "-" (de nied), upd ate TQ sta tus to | |
| 4998 | "RTN","IBC NEHL3",121 ,0) | |
| 4999 | . ; Resp Rec'd (3) and DON'T update th e Ins Buff er symbol | |
| 5000 | "RTN","IBC NEHL3",122 ,0) | |
| 5001 | . I IBSTS ="A"!(IBST S="R")!(IB SYM=8)!(IB SYM=9) S T STS=3 Q | |
| 5002 | "RTN","IBC NEHL3",123 ,0) | |
| 5003 | . ; If TQ status is "Hold", u pdate buff er symbol to "?" (10 ) | |
| 5004 | "RTN","IBC NEHL3",124 ,0) | |
| 5005 | . I TSTS= 4 D BUFF^I BCNEUT2(IB IEN,10) Q ; Set buf fer symbol to "?" | |
| 5006 | "RTN","IBC NEHL3",125 ,0) | |
| 5007 | . ; If TQ status is "Response Received" , update b uffer symb ol to "-" (9) for Er ror | |
| 5008 | "RTN","IBC NEHL3",126 ,0) | |
| 5009 | . ; Actio n Codes (' N','Y','S' ) & Action Codes ('P ','R', if 2nd time p ayer sent that code) | |
| 5010 | "RTN","IBC NEHL3",127 ,0) | |
| 5011 | . I TSTS= 3,(ERACT=" N"!(ERACT= "Y")!(ERAC T="S")!(ER ACT="C")!( ERACT="P") !(ERACT="R ")) D Q | |
| 5012 | "RTN","IBC NEHL3",128 ,0) | |
| 5013 | .. S SYMB OL=MAP(IIV STAT) | |
| 5014 | "RTN","IBC NEHL3",129 ,0) | |
| 5015 | .. D BUFF ^IBCNEUT2( IBIEN,SYMB OL) ; Set buffer sym bol to EC value | |
| 5016 | "RTN","IBC NEHL3",130 ,0) | |
| 5017 | .. D IIVP ROC(IBIEN) ; Set I IV process date & II V status | |
| 5018 | "RTN","IBC NEHL3",131 ,0) | |
| 5019 | . ; If TQ status is "Response Received" , update b uffer symb ol to "!" (12 = B9) for new Er ror Action Code | |
| 5020 | "RTN","IBC NEHL3",132 ,0) | |
| 5021 | . I TSTS= 3,",W,X,R, P,C,N,Y,S, "'[(","_ER ACT_",") D BUFF^IBCN EUT2(IBIEN ,22) Q | |
| 5022 | "RTN","IBC NEHL3",133 ,0) | |
| 5023 | ; | |
| 5024 | "RTN","IBC NEHL3",134 ,0) | |
| 5025 | ; Non-Ins Buffer pr ocessing, create ent ry only fo r Verifica tion queri es | |
| 5026 | "RTN","IBC NEHL3",135 ,0) | |
| 5027 | I IBIEN=" ",IBQFL="V " D | |
| 5028 | "RTN","IBC NEHL3",136 ,0) | |
| 5029 | . ; Deter mine Patie nt DFN | |
| 5030 | "RTN","IBC NEHL3",137 ,0) | |
| 5031 | . S DFN=$ P(TQDATA,U ,2) | |
| 5032 | "RTN","IBC NEHL3",138 ,0) | |
| 5033 | . ; Deter mine Patie nt Ins rec ord IEN | |
| 5034 | "RTN","IBC NEHL3",139 ,0) | |
| 5035 | . S INSIE N=$P(TQDAT A,U,13) ; If INSIEN ="" avoids TQ update | |
| 5036 | "RTN","IBC NEHL3",140 ,0) | |
| 5037 | . ; If ER ACT="C" sy mbol is pa ssed by EC | |
| 5038 | "RTN","IBC NEHL3",141 ,0) | |
| 5039 | . I ERACT ="C" S SYM BOL=MAP(II VSTAT) D B UF Q | |
| 5040 | "RTN","IBC NEHL3",142 ,0) | |
| 5041 | . ; Resu bmission N ot Allowed or Do Not Resubmit ... | |
| 5042 | "RTN","IBC NEHL3",143 ,0) | |
| 5043 | . I ERACT ="N"!(ERAC T="Y")!(ER ACT="S") S SYMBOL=MA P(IIVSTAT) D BUF Q | |
| 5044 | "RTN","IBC NEHL3",144 ,0) | |
| 5045 | . ; An un known erro r action - generate a '#' | |
| 5046 | "RTN","IBC NEHL3",145 ,0) | |
| 5047 | . I ",W,X ,R,P,C,N,Y ,S,"'[("," _ERACT_"," ) S SYMBOL =22 D BUF Q | |
| 5048 | "RTN","IBC NEHL3",146 ,0) | |
| 5049 | ; | |
| 5050 | "RTN","IBC NEHL3",147 ,0) | |
| 5051 | I RSTYPE= "U" G UPDA TX ; fini shed creat ing new bu ffer | |
| 5052 | "RTN","IBC NEHL3",148 ,0) | |
| 5053 | ; | |
| 5054 | "RTN","IBC NEHL3",149 ,0) | |
| 5055 | ; Update TQ record - Status | |
| 5056 | "RTN","IBC NEHL3",150 ,0) | |
| 5057 | D SST^IBC NEUT2(TQN, TSTS) | |
| 5058 | "RTN","IBC NEHL3",151 ,0) | |
| 5059 | ; | |
| 5060 | "RTN","IBC NEHL3",152 ,0) | |
| 5061 | ; If TQ S tatus = "H old", upda te TQ reco rd - Futur e Transmis sion Date | |
| 5062 | "RTN","IBC NEHL3",153 ,0) | |
| 5063 | I TSTS=4, +$G(TDAYS) D | |
| 5064 | "RTN","IBC NEHL3",154 ,0) | |
| 5065 | . S FTDT= $$FMADD^XL FDT($$DT^X LFDT,TDAYS ) | |
| 5066 | "RTN","IBC NEHL3",155 ,0) | |
| 5067 | . S DIE=" ^IBCN(365. 1,",DA=TQN ,DR=".09// /^S X=FTDT " | |
| 5068 | "RTN","IBC NEHL3",156 ,0) | |
| 5069 | . D ^DIE | |
| 5070 | "RTN","IBC NEHL3",157 ,0) | |
| 5071 | I TSTS=4, $P(TQDATA, U,8) D | |
| 5072 | "RTN","IBC NEHL3",158 ,0) | |
| 5073 | . S DIE=" ^IBCN(365. 1,",DA=TQN ,DR=".08// /0" | |
| 5074 | "RTN","IBC NEHL3",159 ,0) | |
| 5075 | . D ^DIE | |
| 5076 | "RTN","IBC NEHL3",160 ,0) | |
| 5077 | ; | |
| 5078 | "RTN","IBC NEHL3",161 ,0) | |
| 5079 | UPDATX ; U PDATE exit point | |
| 5080 | "RTN","IBC NEHL3",162 ,0) | |
| 5081 | Q | |
| 5082 | "RTN","IBC NEHL3",163 ,0) | |
| 5083 | ; | |
| 5084 | "RTN","IBC NEHL3",164 ,0) | |
| 5085 | PCK ; Paye r Check | |
| 5086 | "RTN","IBC NEHL3",165 ,0) | |
| 5087 | ; Find t he associa ted Respon se IEN | |
| 5088 | "RTN","IBC NEHL3",166 ,0) | |
| 5089 | ; | |
| 5090 | "RTN","IBC NEHL3",167 ,0) | |
| 5091 | ; Input V ariables | |
| 5092 | "RTN","IBC NEHL3",168 ,0) | |
| 5093 | ; MSGID | |
| 5094 | "RTN","IBC NEHL3",169 ,0) | |
| 5095 | ; | |
| 5096 | "RTN","IBC NEHL3",170 ,0) | |
| 5097 | ; Output Variables | |
| 5098 | "RTN","IBC NEHL3",171 ,0) | |
| 5099 | ; RIEN,ER FLG | |
| 5100 | "RTN","IBC NEHL3",172 ,0) | |
| 5101 | ; | |
| 5102 | "RTN","IBC NEHL3",173 ,0) | |
| 5103 | N BUFF,DA ,DFN,DIE,D R,IEN,IERN ,IN1DATA,M DTM,QFL,PA YR,PIEN,PP | |
| 5104 | "RTN","IBC NEHL3",174 ,0) | |
| 5105 | N PRDATA, PRIEN,RSIE N,X | |
| 5106 | "RTN","IBC NEHL3",175 ,0) | |
| 5107 | N NOPAYER ,TQIEN | |
| 5108 | "RTN","IBC NEHL3",176 ,0) | |
| 5109 | ; | |
| 5110 | "RTN","IBC NEHL3",177 ,0) | |
| 5111 | K ^TMP("I BCNEMID",$ J) | |
| 5112 | "RTN","IBC NEHL3",178 ,0) | |
| 5113 | D FIND^DI C(365,""," ","P",MSGI D,"","B"," ","","^TMP (""IBCNEMI D"",$J)") | |
| 5114 | "RTN","IBC NEHL3",179 ,0) | |
| 5115 | ; | |
| 5116 | "RTN","IBC NEHL3",180 ,0) | |
| 5117 | S PP=0,QF L=0,(RIEN, PIEN)="" | |
| 5118 | "RTN","IBC NEHL3",181 ,0) | |
| 5119 | S NOPAYER =$$FIND1^D IC(365.12, ,"X","~NO PAYER"),TQ IEN=$O(^IB CN(365.1," C",MSGID," ")) | |
| 5120 | "RTN","IBC NEHL3",182 ,0) | |
| 5121 | F S PP=$ O(^TMP("IB CNEMID",$J ,"DILIST", PP)) Q:'PP D Q:QFL | |
| 5122 | "RTN","IBC NEHL3",183 ,0) | |
| 5123 | . S PRIEN =$P(^TMP(" IBCNEMID", $J,"DILIST ",PP,0),U, 1) | |
| 5124 | "RTN","IBC NEHL3",184 ,0) | |
| 5125 | . ; | |
| 5126 | "RTN","IBC NEHL3",185 ,0) | |
| 5127 | . ; If t his is a r esponse w/ o an IN1 s egment | |
| 5128 | "RTN","IBC NEHL3",186 ,0) | |
| 5129 | . ; Get payer IEN from TQ as original response s hell will change for | |
| 5130 | "RTN","IBC NEHL3",187 ,0) | |
| 5131 | . ; ~NO PAYER if a payer res ponse is r eceived | |
| 5132 | "RTN","IBC NEHL3",188 ,0) | |
| 5133 | . S IN1DA TA=$S(EVEN TYP=1:"",1 :$$GIN1()) ; IB*2.0* 621 | |
| 5134 | "RTN","IBC NEHL3",189 ,0) | |
| 5135 | . I IN1DA TA="",PRIE N'="",TQIE N'="" D | |
| 5136 | "RTN","IBC NEHL3",190 ,0) | |
| 5137 | .. S QFL =1,PIEN=$P (^IBCN(365 .1,TQIEN,0 ),U,3) | |
| 5138 | "RTN","IBC NEHL3",191 ,0) | |
| 5139 | . ; | |
| 5140 | "RTN","IBC NEHL3",192 ,0) | |
| 5141 | . I 'PIEN D PFN(IN1 DATA) I 'P IEN S QFL= 1 Q | |
| 5142 | "RTN","IBC NEHL3",193 ,0) | |
| 5143 | . ; | |
| 5144 | "RTN","IBC NEHL3",194 ,0) | |
| 5145 | . ; If me ssage id/p ayer found & Respons e (#365) s tatus is N OT | |
| 5146 | "RTN","IBC NEHL3",195 ,0) | |
| 5147 | . ; 'Resp onse Recei ved' updat e the exis ting respo nse entry (set RIEN) | |
| 5148 | "RTN","IBC NEHL3",196 ,0) | |
| 5149 | . I $P(^I BCN(365,PR IEN,0),U,3 )=PIEN,($P (^IBCN(365 ,PRIEN,0), U,6)'=3) D Q | |
| 5150 | "RTN","IBC NEHL3",197 ,0) | |
| 5151 | .. S RIEN =PRIEN,QFL =1 | |
| 5152 | "RTN","IBC NEHL3",198 ,0) | |
| 5153 | ..; | |
| 5154 | "RTN","IBC NEHL3",199 ,0) | |
| 5155 | ..; If me ssage id/p ayer found & Respons e (#365) s tatus equa ls | |
| 5156 | "RTN","IBC NEHL3",200 ,0) | |
| 5157 | . ; 'Resp onse Recei ved', RIEN is still null so th at this ta g knows | |
| 5158 | "RTN","IBC NEHL3",201 ,0) | |
| 5159 | . ; to cr eate a new unsolicit ed respons e entry | |
| 5160 | "RTN","IBC NEHL3",202 ,0) | |
| 5161 | . ; | |
| 5162 | "RTN","IBC NEHL3",203 ,0) | |
| 5163 | . ; If pa yer respon se receive d to ~NO P AYER, upda te eIV Res ponse file | |
| 5164 | "RTN","IBC NEHL3",204 ,0) | |
| 5165 | . ; w/ re sponding p ayer | |
| 5166 | "RTN","IBC NEHL3",205 ,0) | |
| 5167 | . I RIEN= "" S PRDAT A=$G(^IBCN (365,PRIEN ,0)) I $P( PRDATA,U,3 )=NOPAYER, $P(PRDATA, U,6)'=3,$P (PRDATA,U, 10)="O" D Q | |
| 5168 | "RTN","IBC NEHL3",206 ,0) | |
| 5169 | .. S RIEN =PRIEN,QFL =1 | |
| 5170 | "RTN","IBC NEHL3",207 ,0) | |
| 5171 | .. S DIE= "^IBCN(365 ,",DA=RIEN ,DR=".03// /^S X=PIEN " D ^DIE | |
| 5172 | "RTN","IBC NEHL3",208 ,0) | |
| 5173 | ; | |
| 5174 | "RTN","IBC NEHL3",209 ,0) | |
| 5175 | ; If mes sage id/pa yer not fo und or uns olicited r esponse, c reate new response e ntry | |
| 5176 | "RTN","IBC NEHL3",210 ,0) | |
| 5177 | I RIEN="" D Q:ERFL G | |
| 5178 | "RTN","IBC NEHL3",211 ,0) | |
| 5179 | . I $G(PR IEN)'="" D | |
| 5180 | "RTN","IBC NEHL3",212 ,0) | |
| 5181 | .. S PRDA TA=$G(^IBC N(365,PRIE N,0)) | |
| 5182 | "RTN","IBC NEHL3",213 ,0) | |
| 5183 | .. S DFN= $P(PRDATA, U,2),IEN=$ P(PRDATA,U ,5),MDTM=$ P(PRDATA,U ,8) | |
| 5184 | "RTN","IBC NEHL3",214 ,0) | |
| 5185 | . ; | |
| 5186 | "RTN","IBC NEHL3",215 ,0) | |
| 5187 | . I PIEN= "" D Q:ER FLG | |
| 5188 | "RTN","IBC NEHL3",216 ,0) | |
| 5189 | .. S IN1 DATA=$$GIN 1() | |
| 5190 | "RTN","IBC NEHL3",217 ,0) | |
| 5191 | .. I IN1 DATA]"" D PFN(IN1DAT A) I 'PIEN S PIEN="" ,QFL=1 | |
| 5192 | "RTN","IBC NEHL3",218 ,0) | |
| 5193 | . S PAYR= PIEN,(RSTY PE,BUFF)=" " | |
| 5194 | "RTN","IBC NEHL3",219 ,0) | |
| 5195 | . D RESP^ IBCNEDEQ | |
| 5196 | "RTN","IBC NEHL3",220 ,0) | |
| 5197 | . S RIEN= RSIEN | |
| 5198 | "RTN","IBC NEHL3",221 ,0) | |
| 5199 | ; | |
| 5200 | "RTN","IBC NEHL3",222 ,0) | |
| 5201 | ; If no p ayer in re sponse fil e, set it | |
| 5202 | "RTN","IBC NEHL3",223 ,0) | |
| 5203 | ; IB*2*59 5/DM corre ctly ident ify a paye r when the payer nam e begins w ith number s | |
| 5204 | "RTN","IBC NEHL3",224 ,0) | |
| 5205 | I $G(PIEN )'="",$G(R IEN)'="",$ P($G(^IBCN (365,RIEN, 0)),U,3)=" " D | |
| 5206 | "RTN","IBC NEHL3",225 ,0) | |
| 5207 | . S DIE=" ^IBCN(365, ",DA=RIEN, DR=".03/// /^S X=PIEN " D ^DIE ; stuff inte rnal value for payer | |
| 5208 | "RTN","IBC NEHL3",226 ,0) | |
| 5209 | Q | |
| 5210 | "RTN","IBC NEHL3",227 ,0) | |
| 5211 | ; | |
| 5212 | "RTN","IBC NEHL3",228 ,0) | |
| 5213 | BUF ; Crea te Buffer Record if Doesn't Ex ist | |
| 5214 | "RTN","IBC NEHL3",229 ,0) | |
| 5215 | ; | |
| 5216 | "RTN","IBC NEHL3",230 ,0) | |
| 5217 | ; Input V ariables | |
| 5218 | "RTN","IBC NEHL3",231 ,0) | |
| 5219 | ; RIEN,RS TYPE,TQN | |
| 5220 | "RTN","IBC NEHL3",232 ,0) | |
| 5221 | ; | |
| 5222 | "RTN","IBC NEHL3",233 ,0) | |
| 5223 | ; Output Variables | |
| 5224 | "RTN","IBC NEHL3",234 ,0) | |
| 5225 | ; ERROR,S YMBOL is k illed,TQIE N and IRIE N may be r eset | |
| 5226 | "RTN","IBC NEHL3",235 ,0) | |
| 5227 | ; | |
| 5228 | "RTN","IBC NEHL3",236 ,0) | |
| 5229 | N BUFF,IB FDA,UP | |
| 5230 | "RTN","IBC NEHL3",237 ,0) | |
| 5231 | I $G(RSTY PE)="U" S (TQIEN,IRI EN)="" | |
| 5232 | "RTN","IBC NEHL3",238 ,0) | |
| 5233 | D RP^IBCN EBF(RIEN,1 ) | |
| 5234 | "RTN","IBC NEHL3",239 ,0) | |
| 5235 | S BUFF=+I BFDA | |
| 5236 | "RTN","IBC NEHL3",240 ,0) | |
| 5237 | S UP(365, RIEN_",",. 04)=+IBFDA | |
| 5238 | "RTN","IBC NEHL3",241 ,0) | |
| 5239 | I RSTYPE= "O" S UP(3 65.1,TQN_" ,",.05)=+I BFDA | |
| 5240 | "RTN","IBC NEHL3",242 ,0) | |
| 5241 | D FILE^DI E("I","UP" ,"ERROR") | |
| 5242 | "RTN","IBC NEHL3",243 ,0) | |
| 5243 | K SYMBOL | |
| 5244 | "RTN","IBC NEHL3",244 ,0) | |
| 5245 | Q | |
| 5246 | "RTN","IBC NEHL3",245 ,0) | |
| 5247 | ; | |
| 5248 | "RTN","IBC NEHL3",246 ,0) | |
| 5249 | IIVPROC(BU FF) ; Set IIV Proces sed Date t o current dt/tm & II V stat (ak a SYMBOL) | |
| 5250 | "RTN","IBC NEHL3",247 ,0) | |
| 5251 | ; Input V ariables | |
| 5252 | "RTN","IBC NEHL3",248 ,0) | |
| 5253 | ; BUFF | |
| 5254 | "RTN","IBC NEHL3",249 ,0) | |
| 5255 | ; | |
| 5256 | "RTN","IBC NEHL3",250 ,0) | |
| 5257 | ; Output Variables | |
| 5258 | "RTN","IBC NEHL3",251 ,0) | |
| 5259 | ; SYMBOL | |
| 5260 | "RTN","IBC NEHL3",252 ,0) | |
| 5261 | ; | |
| 5262 | "RTN","IBC NEHL3",253 ,0) | |
| 5263 | N IDUZ,UP | |
| 5264 | "RTN","IBC NEHL3",254 ,0) | |
| 5265 | S UP(355. 33,BUFF_", ",.15)=$$N OW^XLFDT() | |
| 5266 | "RTN","IBC NEHL3",255 ,0) | |
| 5267 | ; Set ID UZ to the specific, non-human user. | |
| 5268 | "RTN","IBC NEHL3",256 ,0) | |
| 5269 | S IDUZ=$$ FIND1^DIC( 200,"","X" ,"INTERFAC E,IB EIV") | |
| 5270 | "RTN","IBC NEHL3",257 ,0) | |
| 5271 | D FILE^DI E("I","UP" ,"ERROR") | |
| 5272 | "RTN","IBC NEHL3",258 ,0) | |
| 5273 | ; set the symbol of the buffe r entry | |
| 5274 | "RTN","IBC NEHL3",259 ,0) | |
| 5275 | D BUFF^IB CNEUT2(BUF F,SYMBOL) ; reset s ymbol to a ppropriate value | |
| 5276 | "RTN","IBC NEHL3",260 ,0) | |
| 5277 | Q | |
| 5278 | "RTN","IBC NEHL3",261 ,0) | |
| 5279 | ; | |
| 5280 | "RTN","IBC NEHL3",262 ,0) | |
| 5281 | PFN(IN1DAT A) ; Find Payer fro m HL7 msg | |
| 5282 | "RTN","IBC NEHL3",263 ,0) | |
| 5283 | ; | |
| 5284 | "RTN","IBC NEHL3",264 ,0) | |
| 5285 | ; Input V ariables | |
| 5286 | "RTN","IBC NEHL3",265 ,0) | |
| 5287 | ; IN1DATA , TRACE | |
| 5288 | "RTN","IBC NEHL3",266 ,0) | |
| 5289 | ; | |
| 5290 | "RTN","IBC NEHL3",267 ,0) | |
| 5291 | ; Output Variables | |
| 5292 | "RTN","IBC NEHL3",268 ,0) | |
| 5293 | ; ERFLG,E RROR,PIEN | |
| 5294 | "RTN","IBC NEHL3",269 ,0) | |
| 5295 | ; | |
| 5296 | "RTN","IBC NEHL3",270 ,0) | |
| 5297 | N IERN,PA YRID | |
| 5298 | "RTN","IBC NEHL3",271 ,0) | |
| 5299 | S PAYRID= $$CLNSTR^I BCNEHLU($P ($P(IN1DAT A,HLFS,4), $E(HL("ECH "))),HL("E CH"),$E(HL ("ECH"))) | |
| 5300 | "RTN","IBC NEHL3",272 ,0) | |
| 5301 | S PIEN=+$ $FIND1^DIC (365.12,"" ,"MX",PAYR ID) | |
| 5302 | "RTN","IBC NEHL3",273 ,0) | |
| 5303 | I PIEN=0 D Q | |
| 5304 | "RTN","IBC NEHL3",274 ,0) | |
| 5305 | . S ERFLG =1,IERN=$$ ERRN^IBCNE UT7("ERROR (""DIERR"" )") | |
| 5306 | "RTN","IBC NEHL3",275 ,0) | |
| 5307 | . S ERROR ("DIERR",I ERN,"TEXT" ,1)="Natio nal Id: "_ PAYRID_" n ot found i n Payer Ta ble" | |
| 5308 | "RTN","IBC NEHL3",276 ,0) | |
| 5309 | . S ERROR ("DIERR",I ERN,"TEXT" ,2)="for T race Numbe r: "_TRACE | |
| 5310 | "RTN","IBC NEHL3",277 ,0) | |
| 5311 | Q | |
| 5312 | "RTN","IBC NEHL3",278 ,0) | |
| 5313 | ; | |
| 5314 | "RTN","IBC NEHL3",279 ,0) | |
| 5315 | GIN1() ;Ge t IN1 segm ent | |
| 5316 | "RTN","IBC NEHL3",280 ,0) | |
| 5317 | ; | |
| 5318 | "RTN","IBC NEHL3",281 ,0) | |
| 5319 | ; Input V ariables | |
| 5320 | "RTN","IBC NEHL3",282 ,0) | |
| 5321 | ; HCT | |
| 5322 | "RTN","IBC NEHL3",283 ,0) | |
| 5323 | ; | |
| 5324 | "RTN","IBC NEHL3",284 ,0) | |
| 5325 | ; Returns value of SEGMT | |
| 5326 | "RTN","IBC NEHL3",285 ,0) | |
| 5327 | ; | |
| 5328 | "RTN","IBC NEHL3",286 ,0) | |
| 5329 | N IPCT,SE GMT | |
| 5330 | "RTN","IBC NEHL3",287 ,0) | |
| 5331 | S IPCT=HC T,SEGMT="" | |
| 5332 | "RTN","IBC NEHL3",288 ,0) | |
| 5333 | F S IPCT =$O(^TMP($ J,"IBCNEHL I",IPCT)) Q:IPCT="" D | |
| 5334 | "RTN","IBC NEHL3",289 ,0) | |
| 5335 | . I $E(^T MP($J,"IBC NEHLI",IPC T,0),1,3)= "IN1" S SE GMT=^TMP($ J,"IBCNEHL I",IPCT,0) | |
| 5336 | "RTN","IBC NEHL3",290 ,0) | |
| 5337 | Q SEGMT | |
| 5338 | "RTN","IBC NEHL3",291 ,0) | |
| 5339 | ; | |
| 5340 | "RTN","IBC NEHL3",292 ,0) | |
| 5341 | ; ======= ========== ========== ========== ========== ========== ======== | |
| 5342 | "RTN","IBC NEHL3",293 ,0) | |
| 5343 | WARN ; Cr eate and s end a resp onse proce ssing erro r warning message | |
| 5344 | "RTN","IBC NEHL3",294 ,0) | |
| 5345 | ; | |
| 5346 | "RTN","IBC NEHL3",295 ,0) | |
| 5347 | ; Input V ariables | |
| 5348 | "RTN","IBC NEHL3",296 ,0) | |
| 5349 | ; ERROR, TRACE | |
| 5350 | "RTN","IBC NEHL3",297 ,0) | |
| 5351 | ; | |
| 5352 | "RTN","IBC NEHL3",298 ,0) | |
| 5353 | ; Output Variables | |
| 5354 | "RTN","IBC NEHL3",299 ,0) | |
| 5355 | ; ERFLG=1 | |
| 5356 | "RTN","IBC NEHL3",300 ,0) | |
| 5357 | ; | |
| 5358 | "RTN","IBC NEHL3",301 ,0) | |
| 5359 | N MCT,MSG ,SUBCNT,VE N,XMY | |
| 5360 | "RTN","IBC NEHL3",302 ,0) | |
| 5361 | S VEN=0,M CT=9,ERFLG =1,SUBCNT= "" | |
| 5362 | "RTN","IBC NEHL3",303 ,0) | |
| 5363 | S MSG(1)= "IMPORTANT : Error Wh ile Proces sing Respo nse Messag e from the EC" | |
| 5364 | "RTN","IBC NEHL3",304 ,0) | |
| 5365 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- ---------- --" | |
| 5366 | "RTN","IBC NEHL3",305 ,0) | |
| 5367 | S MSG(3)= "*** IRM * ** Please contact He lp Desk be cause the" | |
| 5368 | "RTN","IBC NEHL3",306 ,0) | |
| 5369 | S MSG(4)= "response message re ceived fro m the Elig ibility Co mmunicator " | |
| 5370 | "RTN","IBC NEHL3",307 ,0) | |
| 5371 | S MSG(5)= "could not be proces sed. Prog ramming ch anges may be necessa ry" | |
| 5372 | "RTN","IBC NEHL3",308 ,0) | |
| 5373 | S MSG(6)= "to proper ly handle the respon se." | |
| 5374 | "RTN","IBC NEHL3",309 ,0) | |
| 5375 | S MSG(7)= "The assoc iated Trac e # is "_$ S($G(TRACE )="":"Unkn own",1:TRA CE)_". If applicable ," | |
| 5376 | "RTN","IBC NEHL3",310 ,0) | |
| 5377 | S MSG(8)= "please re view the r esponse wi th the eIV Response Report by Trace#." | |
| 5378 | "RTN","IBC NEHL3",311 ,0) | |
| 5379 | S MSG(9)= " " | |
| 5380 | "RTN","IBC NEHL3",312 ,0) | |
| 5381 | F S VEN= $O(ERROR(" DIERR",VEN )) Q:'VEN D | |
| 5382 | "RTN","IBC NEHL3",313 ,0) | |
| 5383 | .S MCT=MC T+1,MSG(MC T)="Error: " | |
| 5384 | "RTN","IBC NEHL3",314 ,0) | |
| 5385 | .F S SUB CNT=$O(ERR OR("DIERR" ,VEN,"TEXT ",SUBCNT)) Q:'SUBCNT S MCT=MC T+1,MSG(MC T)=ERROR(" DIERR",VEN ,"TEXT",SU BCNT) | |
| 5386 | "RTN","IBC NEHL3",315 ,0) | |
| 5387 | .S MCT=MC T+1,MSG(MC T)=" " | |
| 5388 | "RTN","IBC NEHL3",316 ,0) | |
| 5389 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","FILE") )'="" S MC T=MCT+1,MS G(MCT)="Fi le: "_ERRO R("DIERR", VEN,"PARAM ","FILE") | |
| 5390 | "RTN","IBC NEHL3",317 ,0) | |
| 5391 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","IENS") )'="" S MC T=MCT+1,MS G(MCT)="IE NS: "_ERRO R("DIERR", VEN,"PARAM ","IENS") | |
| 5392 | "RTN","IBC NEHL3",318 ,0) | |
| 5393 | .I $G(ERR OR("DIERR" ,VEN,"PARA M","FIELD" ))'="" S M CT=MCT+1,M SG(MCT)="F ield: "_ER ROR("DIERR ",VEN,"PAR AM","FIELD ") | |
| 5394 | "RTN","IBC NEHL3",319 ,0) | |
| 5395 | .S MCT=MC T+1,MSG(MC T)=" " | |
| 5396 | "RTN","IBC NEHL3",320 ,0) | |
| 5397 | .Q | |
| 5398 | "RTN","IBC NEHL3",321 ,0) | |
| 5399 | D MSG^IBC NEUT5(MGRP ,MSG(1),"M SG(",,.XMY ) | |
| 5400 | "RTN","IBC NEHL3",322 ,0) | |
| 5401 | Q | |
| 5402 | "RTN","IBC NEHL3",323 ,0) | |
| 5403 | ; | |
| 5404 | "RTN","IBC NEHL3",324 ,0) | |
| 5405 | ; ======= ========== ========== ========== ========== ========== ======== | |
| 5406 | "RTN","IBC NEHL3",325 ,0) | |
| 5407 | UEACT ; Se nd warning msg if Un known Erro r Action C ode was re ceived or | |
| 5408 | "RTN","IBC NEHL3",326 ,0) | |
| 5409 | ; encount ered probl em filing date | |
| 5410 | "RTN","IBC NEHL3",327 ,0) | |
| 5411 | ; | |
| 5412 | "RTN","IBC NEHL3",328 ,0) | |
| 5413 | ; Input V ariables | |
| 5414 | "RTN","IBC NEHL3",329 ,0) | |
| 5415 | ; ERROR, IBIEN, IBQ FL, RIEN, RSTYPE, TQ DATA, TRAC E | |
| 5416 | "RTN","IBC NEHL3",330 ,0) | |
| 5417 | ; | |
| 5418 | "RTN","IBC NEHL3",331 ,0) | |
| 5419 | ; Output Variables | |
| 5420 | "RTN","IBC NEHL3",332 ,0) | |
| 5421 | ; ERFLG=1 (SET IN W ARN TAG) | |
| 5422 | "RTN","IBC NEHL3",333 ,0) | |
| 5423 | ; | |
| 5424 | "RTN","IBC NEHL3",334 ,0) | |
| 5425 | N DFN,SYM BOL | |
| 5426 | "RTN","IBC NEHL3",335 ,0) | |
| 5427 | D WARN ; send warn ing msg | |
| 5428 | "RTN","IBC NEHL3",336 ,0) | |
| 5429 | ; | |
| 5430 | "RTN","IBC NEHL3",337 ,0) | |
| 5431 | ; If the response c ould not b e created or there i s no assoc iated TQ e ntry, stop processin g | |
| 5432 | "RTN","IBC NEHL3",338 ,0) | |
| 5433 | I '$G(RIE N)!(TQDATA ="") Q | |
| 5434 | "RTN","IBC NEHL3",339 ,0) | |
| 5435 | ; | |
| 5436 | "RTN","IBC NEHL3",340 ,0) | |
| 5437 | ; For an original response, set the Tr ansmission Queue Sta tus to 'Re sponse Rec eived' & | |
| 5438 | "RTN","IBC NEHL3",341 ,0) | |
| 5439 | ; update remaining retries t o comm fai lure (5) | |
| 5440 | "RTN","IBC NEHL3",342 ,0) | |
| 5441 | I $G(RSTY PE)="O" D SST^IBCNEU T2(TQN,3), RSTA^IBCNE UT7(TQN) | |
| 5442 | "RTN","IBC NEHL3",343 ,0) | |
| 5443 | ; | |
| 5444 | "RTN","IBC NEHL3",344 ,0) | |
| 5445 | ; If it i s an ident ification and policy is not ac tive don't | |
| 5446 | "RTN","IBC NEHL3",345 ,0) | |
| 5447 | ; create buffer ent ry | |
| 5448 | "RTN","IBC NEHL3",346 ,0) | |
| 5449 | I IBQFL=" I",IIVSTAT '=1 Q | |
| 5450 | "RTN","IBC NEHL3",347 ,0) | |
| 5451 | ; | |
| 5452 | "RTN","IBC NEHL3",348 ,0) | |
| 5453 | ; If unso licited me ssage or n o buffer i n TQ, crea te new buf fer entry | |
| 5454 | "RTN","IBC NEHL3",349 ,0) | |
| 5455 | I RSTYPE= "U" S IBIE N="" | |
| 5456 | "RTN","IBC NEHL3",350 ,0) | |
| 5457 | I IBIEN=" " D Q | |
| 5458 | "RTN","IBC NEHL3",351 ,0) | |
| 5459 | . S DFN= $P(TQDATA, U,2) ; Determ ine Patien t DFN | |
| 5460 | "RTN","IBC NEHL3",352 ,0) | |
| 5461 | . S SYMB OL=22 D BU F^IBCNEHL3 ; Create a new buf fer entry | |
| 5462 | "RTN","IBC NEHL3",353 ,0) | |
| 5463 | ; | |
| 5464 | "RTN","IBC NEHL3",354 ,0) | |
| 5465 | ;Update b uffer symb ol | |
| 5466 | "RTN","IBC NEHL3",355 ,0) | |
| 5467 | D BUFF^IB CNEUT2(IBI EN,22) | |
| 5468 | "RTN","IBC NEHL3",356 ,0) | |
| 5469 | ; | |
| 5470 | "RTN","IBC NEHL3",357 ,0) | |
| 5471 | Q | |
| 5472 | "RTN","IBC NEHL3",358 ,0) | |
| 5473 | ; | |
| 5474 | "RTN","IBC NEHL3",359 ,0) | |
| 5475 | CHK1() ; c heck auto- update cri teria for patient wh o is the s ubscriber | |
| 5476 | "RTN","IBC NEHL3",360 ,0) | |
| 5477 | ; called from tag A UTOUPD, us es variabl es defined there | |
| 5478 | "RTN","IBC NEHL3",361 ,0) | |
| 5479 | ; | |
| 5480 | "RTN","IBC NEHL3",362 ,0) | |
| 5481 | ; returns 1 if give n policy s atisfies a uto-update criteria, returns 0 otherwise | |
| 5482 | "RTN","IBC NEHL3",363 ,0) | |
| 5483 | N RES | |
| 5484 | "RTN","IBC NEHL3",364 ,0) | |
| 5485 | S RES=0 | |
| 5486 | "RTN","IBC NEHL3",365 ,0) | |
| 5487 | I $P(RDAT A13,U,2)'= $P(IDATA7, U,2) G CHK 1X ; Subs criber ID doesn't ma tch ; IB *2.0*497 c ompare sub scriber ID data at t heir new l ocations | |
| 5488 | "RTN","IBC NEHL3",366 ,0) | |
| 5489 | I $P(RDAT A1,U,2)'=$ P(IDATA3,U ) G CHK1X ; DOB doe sn't match | |
| 5490 | "RTN","IBC NEHL3",367 ,0) | |
| 5491 | I '$$NAME CMP^IBCNEH LU($P(RDAT A13,U),$P( IDATA7,U)) G CHK1X ; Insured' s name doe sn't match ; IB*2.0 *497 compa re name of insured d ata at the ir new loc ations | |
| 5492 | "RTN","IBC NEHL3",368 ,0) | |
| 5493 | S RES=1 | |
| 5494 | "RTN","IBC NEHL3",369 ,0) | |
| 5495 | CHK1X ; | |
| 5496 | "RTN","IBC NEHL3",370 ,0) | |
| 5497 | Q RES | |
| 5498 | "RTN","IBC NEHL3",371 ,0) | |
| 5499 | ; | |
| 5500 | "RTN","IBC NEHL3",372 ,0) | |
| 5501 | CHK2(MWNRT YP) ; chec k auto-upd ate criter ia for pat ient who i s not the subscriber | |
| 5502 | "RTN","IBC NEHL3",373 ,0) | |
| 5503 | ; called from tag A UTOUPD, us es variabl es defined there | |
| 5504 | "RTN","IBC NEHL3",374 ,0) | |
| 5505 | ; | |
| 5506 | "RTN","IBC NEHL3",375 ,0) | |
| 5507 | ; returns 1 if poli cy satisfi es auto-up date crite ria, retur ns 0 other wise | |
| 5508 | "RTN","IBC NEHL3",376 ,0) | |
| 5509 | N DOB,ID, IDATA5,IEN S,NAME,PDO B,PNAME,RE S | |
| 5510 | "RTN","IBC NEHL3",377 ,0) | |
| 5511 | S RES=0 | |
| 5512 | "RTN","IBC NEHL3",378 ,0) | |
| 5513 | S IDATA5= $G(^DPT(IE N2,.312,IE N312,5)) | |
| 5514 | "RTN","IBC NEHL3",379 ,0) | |
| 5515 | S IENS=IE N2_"," | |
| 5516 | "RTN","IBC NEHL3",380 ,0) | |
| 5517 | S ID=$P(R DATA13,U,2 ) ; IB* 2.0*497 Su bscriber I D needs to be retrie ved from i ts new loc ation | |
| 5518 | "RTN","IBC NEHL3",381 ,0) | |
| 5519 | I ID'=$P( IDATA7,U,2 ),ID'=$P(I DATA5,U) G CHK2X ; both Subsc riber ID a nd Patient ID don't match ; IB *2.0*497 c ompare sub scriber ID at new lo cations | |
| 5520 | "RTN","IBC NEHL3",382 ,0) | |
| 5521 | S DOB=$P( RDATA1,U,2 ),PDOB=$$G ET1^DIQ(2, IENS,.03," I") | |
| 5522 | "RTN","IBC NEHL3",383 ,0) | |
| 5523 | I DOB'=$P (IDATA3,U) ,DOB'=PDOB G CHK2X ; both Sub scriber an d Patient DOB don't match | |
| 5524 | "RTN","IBC NEHL3",384 ,0) | |
| 5525 | S NAME=$P (RDATA13,U ),PNAME=$$ GET1^DIQ(2 ,IENS,.01) ; IB*2. 0*497 get name of in sured at i ts new loc ation | |
| 5526 | "RTN","IBC NEHL3",385 ,0) | |
| 5527 | I '+MWNRT YP,'$$NAME CMP^IBCNEH LU(NAME,$P (IDATA7,U) ),'$$NAMEC MP^IBCNEHL U(NAME,PNA ME) G CHK2 X ; non-M edicare, b oth Subscr iber and P atient nam e don't ma tch ; IB*2 *497 | |
| 5528 | "RTN","IBC NEHL3",386 ,0) | |
| 5529 | I +MWNRTY P,'$$NAMEC MP^IBCNEHL U(NAME,PNA ME) G CHK2 X ; Medic are, Patie nt name do esn't matc h | |
| 5530 | "RTN","IBC NEHL3",387 ,0) | |
| 5531 | S RES=1 | |
| 5532 | "RTN","IBC NEHL3",388 ,0) | |
| 5533 | CHK2X ; | |
| 5534 | "RTN","IBC NEHL3",389 ,0) | |
| 5535 | Q RES | |
| 5536 | "RTN","IBC NEHL3",390 ,0) | |
| 5537 | ; | |
| 5538 | "RTN","IBC NEHL3",391 ,0) | |
| 5539 | UPDIREC(RI EN,IEN312) ; IB*2*59 5/DM updat e INSUR RE CORD IEN i n the resp onse file (#365,.12) | |
| 5540 | "RTN","IBC NEHL3",392 ,0) | |
| 5541 | ; RIEN - ien in eIV Response file (365) | |
| 5542 | "RTN","IBC NEHL3",393 ,0) | |
| 5543 | ; IEN312 - ien in p at. insura nce multip le (2.312) | |
| 5544 | "RTN","IBC NEHL3",394 ,0) | |
| 5545 | ; | |
| 5546 | "RTN","IBC NEHL3",395 ,0) | |
| 5547 | N DATA,ER ROR,IENS | |
| 5548 | "RTN","IBC NEHL3",396 ,0) | |
| 5549 | I RIEN'>0 !(IEN312'> 0) Q | |
| 5550 | "RTN","IBC NEHL3",397 ,0) | |
| 5551 | ; IB*2*59 5/DM do no t update T Q file. | |
| 5552 | "RTN","IBC NEHL3",398 ,0) | |
| 5553 | ; The pro per INSUR RECORD IEN field is now locate d in the r esponse fi le | |
| 5554 | "RTN","IBC NEHL3",399 ,0) | |
| 5555 | ;S IENS=$ P($G(^IBCN (365,RIEN, 0)),U,5)_" ," I IENS= "," Q | |
| 5556 | "RTN","IBC NEHL3",400 ,0) | |
| 5557 | ;S DATA(3 65.1,IENS, .13)=IEN31 2 | |
| 5558 | "RTN","IBC NEHL3",401 ,0) | |
| 5559 | S DATA(36 5,RIEN_"," ,.12)=IEN3 12 | |
| 5560 | "RTN","IBC NEHL3",402 ,0) | |
| 5561 | D FILE^DI E("ET","DA TA","ERROR ") | |
| 5562 | "RTN","IBC NEHL3",403 ,0) | |
| 5563 | Q | |
| 5564 | "RTN","IBC NEHL3",404 ,0) | |
| 5565 | ; | |
| 5566 | "RTN","IBC NEHL3",405 ,0) | |
| 5567 | LCKERR ; s end lockin g error me ssage | |
| 5568 | "RTN","IBC NEHL3",406 ,0) | |
| 5569 | N MSG,XMY | |
| 5570 | "RTN","IBC NEHL3",407 ,0) | |
| 5571 | S MSG(1)= "WARNING: Unable to Auto-file Response M essage fro m the EC" | |
| 5572 | "RTN","IBC NEHL3",408 ,0) | |
| 5573 | S MSG(2)= "--------- ---------- ---------- ---------- ---------- --------" | |
| 5574 | "RTN","IBC NEHL3",409 ,0) | |
| 5575 | S MSG(3)= "Failed to lock pati ent insura nce entry: " | |
| 5576 | "RTN","IBC NEHL3",410 ,0) | |
| 5577 | S MSG(4)= " Patient name - "_ $$GET1^DIQ (2,DFN_"," ,.01) | |
| 5578 | "RTN","IBC NEHL3",411 ,0) | |
| 5579 | S MSG(5)= " Insuran ce - "_$$G ET1^DIQ(2. 312,IENS,. 01) | |
| 5580 | "RTN","IBC NEHL3",412 ,0) | |
| 5581 | S MSG(6)= " IENS - "_$S($G(IE NS)="":"Un known",1:I ENS) | |
| 5582 | "RTN","IBC NEHL3",413 ,0) | |
| 5583 | S MSG(7)= " " | |
| 5584 | "RTN","IBC NEHL3",414 ,0) | |
| 5585 | S MSG(8)= "The respo nse will b e filed in to Insuran ce Buffer instead." | |
| 5586 | "RTN","IBC NEHL3",415 ,0) | |
| 5587 | S MSG(9)= " " | |
| 5588 | "RTN","IBC NEHL3",416 ,0) | |
| 5589 | D MSG^IBC NEUT5(MGRP ,MSG(1),"M SG(",,.XMY ) | |
| 5590 | "RTN","IBC NEHL3",417 ,0) | |
| 5591 | Q | |
| 5592 | "RTN","IBC NEHL3",418 ,0) | |
| 5593 | ; | |
| 5594 | "RTN","IBC NEHL4") | |
| 5595 | 0^17^B2096 69693^B176 214857 | |
| 5596 | "RTN","IBC NEHL4",1,0 ) | |
| 5597 | IBCNEHL4 ; DAOU/ALA - HL7 Proce ss Incomin g RPI Msgs (cont.) ; 26-JUN-200 2 ; Compi led Decemb er 16, 200 4 15:35:46 | |
| 5598 | "RTN","IBC NEHL4",2,0 ) | |
| 5599 | ;;2.0;INT EGRATED BI LLING;**30 0,416,438, 497,506,51 9,621**;21 -MAR-94;Bu ild 8 | |
| 5600 | "RTN","IBC NEHL4",3,0 ) | |
| 5601 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 5602 | "RTN","IBC NEHL4",4,0 ) | |
| 5603 | ; | |
| 5604 | "RTN","IBC NEHL4",5,0 ) | |
| 5605 | ;**Progra m Descript ion** | |
| 5606 | "RTN","IBC NEHL4",6,0 ) | |
| 5607 | ; This p gm will pr ocess the non-repeat ing segmen ts of the | |
| 5608 | "RTN","IBC NEHL4",7,0 ) | |
| 5609 | ; incomi ng eIV res ponse msgs . | |
| 5610 | "RTN","IBC NEHL4",8,0 ) | |
| 5611 | ; It was separated out from IBCNEHL2 t o conserve space. | |
| 5612 | "RTN","IBC NEHL4",9,0 ) | |
| 5613 | ; | |
| 5614 | "RTN","IBC NEHL4",10, 0) | |
| 5615 | ; This r outine is based on I BCNEHLP wh ich was in troduced w ith patch 184, and s ubsequentl y | |
| 5616 | "RTN","IBC NEHL4",11, 0) | |
| 5617 | ; patche d with pat ches 252 a nd 271. I BCNEHLP is obsolete and delete d with pat ch 300. | |
| 5618 | "RTN","IBC NEHL4",12, 0) | |
| 5619 | ; | |
| 5620 | "RTN","IBC NEHL4",13, 0) | |
| 5621 | ; * Each of these t ags are ca lled by IB CNEHL2. | |
| 5622 | "RTN","IBC NEHL4",14, 0) | |
| 5623 | ; | |
| 5624 | "RTN","IBC NEHL4",15, 0) | |
| 5625 | ; Variab les | |
| 5626 | "RTN","IBC NEHL4",16, 0) | |
| 5627 | ; SEG = HL7 Seg Name | |
| 5628 | "RTN","IBC NEHL4",17, 0) | |
| 5629 | ; MSGI D = Origin al Msg Con trol ID | |
| 5630 | "RTN","IBC NEHL4",18, 0) | |
| 5631 | ; ACK = Acknowl edgment (A A=Accepted , AE=Error ) | |
| 5632 | "RTN","IBC NEHL4",19, 0) | |
| 5633 | ; ERTX T = Error Msg Text | |
| 5634 | "RTN","IBC NEHL4",20, 0) | |
| 5635 | ; ERFL G = Error quit flag | |
| 5636 | "RTN","IBC NEHL4",21, 0) | |
| 5637 | ; ERAC T = Error Action | |
| 5638 | "RTN","IBC NEHL4",22, 0) | |
| 5639 | ; ERCO N = Error Condition | |
| 5640 | "RTN","IBC NEHL4",23, 0) | |
| 5641 | ; RIEN = Respons e Record I EN | |
| 5642 | "RTN","IBC NEHL4",24, 0) | |
| 5643 | ; IBSE G = Array of the seg ment | |
| 5644 | "RTN","IBC NEHL4",25, 0) | |
| 5645 | ; | |
| 5646 | "RTN","IBC NEHL4",26, 0) | |
| 5647 | Q ; No d irect call s | |
| 5648 | "RTN","IBC NEHL4",27, 0) | |
| 5649 | ; | |
| 5650 | "RTN","IBC NEHL4",28, 0) | |
| 5651 | ; IB*2*51 9 Only fi xed line 2 of the ro utine. Cha nged "..49 7*506" to "..497,506 " | |
| 5652 | "RTN","IBC NEHL4",29, 0) | |
| 5653 | ; | |
| 5654 | "RTN","IBC NEHL4",30, 0) | |
| 5655 | MSA ; Pro cess the M SA seg | |
| 5656 | "RTN","IBC NEHL4",31, 0) | |
| 5657 | ; | |
| 5658 | "RTN","IBC NEHL4",32, 0) | |
| 5659 | ; Input: | |
| 5660 | "RTN","IBC NEHL4",33, 0) | |
| 5661 | ; IBSEG, MGRP | |
| 5662 | "RTN","IBC NEHL4",34, 0) | |
| 5663 | ; | |
| 5664 | "RTN","IBC NEHL4",35, 0) | |
| 5665 | ; Output : | |
| 5666 | "RTN","IBC NEHL4",36, 0) | |
| 5667 | ; ERACT, ERCON,ERRO R,ERTXT,RI EN,TRACE,A CK | |
| 5668 | "RTN","IBC NEHL4",37, 0) | |
| 5669 | ; | |
| 5670 | "RTN","IBC NEHL4",38, 0) | |
| 5671 | N MSGID,R SUPDT,VRFD T | |
| 5672 | "RTN","IBC NEHL4",39, 0) | |
| 5673 | S ACK=$G( IBSEG(2)), MSGID=$G(I BSEG(3)),T RACE=$G(IB SEG(4)) | |
| 5674 | "RTN","IBC NEHL4",40, 0) | |
| 5675 | S ERTXT=$ $DECHL7^IB CNEHL2($P( $G(IBSEG(7 )),$E(HLEC H),2)),ERA CT=$G(IBSE G(6)),ERCO N=$P($G(IB SEG(7)),$E (HLECH),1) | |
| 5676 | "RTN","IBC NEHL4",41, 0) | |
| 5677 | ; | |
| 5678 | "RTN","IBC NEHL4",42, 0) | |
| 5679 | ; If no C ontrol Id, send Mail man error msg | |
| 5680 | "RTN","IBC NEHL4",43, 0) | |
| 5681 | I MSGID=" " D ERRMSA (TRACE,MGR P) S ERFLG =1 G MSAX | |
| 5682 | "RTN","IBC NEHL4",44, 0) | |
| 5683 | ; | |
| 5684 | "RTN","IBC NEHL4",45, 0) | |
| 5685 | ; Check f or msg id/ payer comb ination an d get resp onse IEN | |
| 5686 | "RTN","IBC NEHL4",46, 0) | |
| 5687 | D PCK^IBC NEHL3 | |
| 5688 | "RTN","IBC NEHL4",47, 0) | |
| 5689 | ; | |
| 5690 | "RTN","IBC NEHL4",48, 0) | |
| 5691 | ; If no r ecord IEN, quit | |
| 5692 | "RTN","IBC NEHL4",49, 0) | |
| 5693 | I $G(RIEN )="" G MSA X | |
| 5694 | "RTN","IBC NEHL4",50, 0) | |
| 5695 | ; | |
| 5696 | "RTN","IBC NEHL4",51, 0) | |
| 5697 | ;IB*2.0*6 21/TAZ - P rocess EIC D Error me ssages | |
| 5698 | "RTN","IBC NEHL4",52, 0) | |
| 5699 | I EVENTYP =1 D | |
| 5700 | "RTN","IBC NEHL4",53, 0) | |
| 5701 | . N DFN | |
| 5702 | "RTN","IBC NEHL4",54, 0) | |
| 5703 | . S DFN=$ $GET1^DIQ( 365,RIEN_" ,",.02,"I" ) | |
| 5704 | "RTN","IBC NEHL4",55, 0) | |
| 5705 | . S IBTRA CK(0,.04)= TRACE | |
| 5706 | "RTN","IBC NEHL4",56, 0) | |
| 5707 | . S IBTRA CK(0,.06)= RIEN | |
| 5708 | "RTN","IBC NEHL4",57, 0) | |
| 5709 | . I ERTXT ="" S IBTR ACK(0,.07) =1 Q | |
| 5710 | "RTN","IBC NEHL4",58, 0) | |
| 5711 | . I $$UP^ XLFSTR(ERT XT)["NO AC TIVE POLIC IES" S IBT RACK(0,.07 )=2 Q | |
| 5712 | "RTN","IBC NEHL4",59, 0) | |
| 5713 | . I $$UP^ XLFSTR(ERT XT)["TIMEO UT" D Q | |
| 5714 | "RTN","IBC NEHL4",60, 0) | |
| 5715 | .. S IBTR ACK(0,.07) =3 | |
| 5716 | "RTN","IBC NEHL4",61, 0) | |
| 5717 | .. ;Need to remove (EICD Last Date Run) from Pati ent File # 2 - IB*2.0 *621 | |
| 5718 | "RTN","IBC NEHL4",62, 0) | |
| 5719 | .. S DA=D FN,DIE="^D PT(",DR="2 001///@" | |
| 5720 | "RTN","IBC NEHL4",63, 0) | |
| 5721 | .. D ^DIE | |
| 5722 | "RTN","IBC NEHL4",64, 0) | |
| 5723 | .. K DA,D IE,DR | |
| 5724 | "RTN","IBC NEHL4",65, 0) | |
| 5725 | . S IBTRA CK(0,.07)= 0 | |
| 5726 | "RTN","IBC NEHL4",66, 0) | |
| 5727 | ; Update record w/i nfo | |
| 5728 | "RTN","IBC NEHL4",67, 0) | |
| 5729 | S RSUPDT( 365,RIEN_" ,",.09)=TR ACE,RSUPDT (365,RIEN_ ",",.06)=3 | |
| 5730 | "RTN","IBC NEHL4",68, 0) | |
| 5731 | S RSUPDT( 365,RIEN_" ,",4.01)=E RTXT | |
| 5732 | "RTN","IBC NEHL4",69, 0) | |
| 5733 | S VRFDT=$ $NOW^XLFDT (),RSUPDT( 365,RIEN_" ,",.07)=VR FDT | |
| 5734 | "RTN","IBC NEHL4",70, 0) | |
| 5735 | ; | |
| 5736 | "RTN","IBC NEHL4",71, 0) | |
| 5737 | ; Update w/internal values | |
| 5738 | "RTN","IBC NEHL4",72, 0) | |
| 5739 | D FILE^DI E("I","RSU PDT","ERRO R") | |
| 5740 | "RTN","IBC NEHL4",73, 0) | |
| 5741 | ; | |
| 5742 | "RTN","IBC NEHL4",74, 0) | |
| 5743 | S RSUPDT( 365,RIEN_" ,",1.14)=E RCON,RSUPD T(365,RIEN _",",1.15) =ERACT | |
| 5744 | "RTN","IBC NEHL4",75, 0) | |
| 5745 | ; | |
| 5746 | "RTN","IBC NEHL4",76, 0) | |
| 5747 | ; Update w/external values | |
| 5748 | "RTN","IBC NEHL4",77, 0) | |
| 5749 | D FILE^DI E("ET","RS UPDT","ERR OR") | |
| 5750 | "RTN","IBC NEHL4",78, 0) | |
| 5751 | MSAX ; | |
| 5752 | "RTN","IBC NEHL4",79, 0) | |
| 5753 | Q | |
| 5754 | "RTN","IBC NEHL4",80, 0) | |
| 5755 | ; | |
| 5756 | "RTN","IBC NEHL4",81, 0) | |
| 5757 | ERRMSA(TRA CE,MGRP) ; Msg Contr ol Id is b lank - Se nd Mailman error msg | |
| 5758 | "RTN","IBC NEHL4",82, 0) | |
| 5759 | ; | |
| 5760 | "RTN","IBC NEHL4",83, 0) | |
| 5761 | N HCT,ICN ,MSG,MSGCT ,NAME,XMSU B | |
| 5762 | "RTN","IBC NEHL4",84, 0) | |
| 5763 | ; | |
| 5764 | "RTN","IBC NEHL4",85, 0) | |
| 5765 | ;1st find the PID s eg to extr act ICN an d patient name | |
| 5766 | "RTN","IBC NEHL4",86, 0) | |
| 5767 | D GTICNM^ IBCNEHLU(. ICN,.NAME) | |
| 5768 | "RTN","IBC NEHL4",87, 0) | |
| 5769 | ; | |
| 5770 | "RTN","IBC NEHL4",88, 0) | |
| 5771 | ;Send the Mailman e rror msg | |
| 5772 | "RTN","IBC NEHL4",89, 0) | |
| 5773 | S XMSUB=" Message Co ntrol Id F ield is Bl ank",MSGCT =$S(TRACE= "":4,1:3) | |
| 5774 | "RTN","IBC NEHL4",90, 0) | |
| 5775 | S MSG(1)= "A respons e was rece ived w/a b lank Messa ge Control Id" | |
| 5776 | "RTN","IBC NEHL4",91, 0) | |
| 5777 | I TRACE=" " S MSG(1) =MSG(1)_" and Trace #" | |
| 5778 | "RTN","IBC NEHL4",92, 0) | |
| 5779 | S MSG(2)= "for "_$S( TRACE'="": "Trace #: "_TRACE_", ",1:"")_" ICN #: "_I CN_", Pati ent: "_NAM E_"." | |
| 5780 | "RTN","IBC NEHL4",93, 0) | |
| 5781 | I TRACE=" " D | |
| 5782 | "RTN","IBC NEHL4",94, 0) | |
| 5783 | . S MSG(3 )="It is l ikely that there are communica tion issue s with the EC." | |
| 5784 | "RTN","IBC NEHL4",95, 0) | |
| 5785 | S MSG(MSG CT)="This response c annot be p rocessed. Please co ntact the Help Desk. " | |
| 5786 | "RTN","IBC NEHL4",96, 0) | |
| 5787 | D MSG^IBC NEUT5(MGRP ,XMSUB,"MS G(") | |
| 5788 | "RTN","IBC NEHL4",97, 0) | |
| 5789 | Q | |
| 5790 | "RTN","IBC NEHL4",98, 0) | |
| 5791 | ; | |
| 5792 | "RTN","IBC NEHL4",99, 0) | |
| 5793 | PID ; Pro cess the P ID seg | |
| 5794 | "RTN","IBC NEHL4",100 ,0) | |
| 5795 | N DFN,DOB ,DOD,FLD,I CN,IENSTR, LFAC,LUPDT ,NAME,RSUP DT,SEX,SSN ,STATE,XDF N,IDLIST | |
| 5796 | "RTN","IBC NEHL4",101 ,0) | |
| 5797 | N SUBCNT, SUBC,SUBCI D,SUBCDATA ,IERN | |
| 5798 | "RTN","IBC NEHL4",102 ,0) | |
| 5799 | ; | |
| 5800 | "RTN","IBC NEHL4",103 ,0) | |
| 5801 | S ERFLG=0 | |
| 5802 | "RTN","IBC NEHL4",104 ,0) | |
| 5803 | S DOB=$G( IBSEG(8)), SEX=$G(IBS EG(9)) | |
| 5804 | "RTN","IBC NEHL4",105 ,0) | |
| 5805 | S NAME=$G (IBSEG(6)) | |
| 5806 | "RTN","IBC NEHL4",106 ,0) | |
| 5807 | S DOD=$G( IBSEG(30)) ,LUPDT=$G( IBSEG(34)) ,LFAC=$G(I BSEG(35)) | |
| 5808 | "RTN","IBC NEHL4",107 ,0) | |
| 5809 | ; | |
| 5810 | "RTN","IBC NEHL4",108 ,0) | |
| 5811 | ; Parse R epeating I D field to fill in o ther ident ifiers | |
| 5812 | "RTN","IBC NEHL4",109 ,0) | |
| 5813 | S (ICN,SS N,DFN)="" | |
| 5814 | "RTN","IBC NEHL4",110 ,0) | |
| 5815 | S IDLIST= $G(IBSEG(4 )) | |
| 5816 | "RTN","IBC NEHL4",111 ,0) | |
| 5817 | F SUBCNT= 1:1:$L(IDL IST,$E(HLE CH,2,2)) D | |
| 5818 | "RTN","IBC NEHL4",112 ,0) | |
| 5819 | . S SUBC= $P(IDLIST, $E(HLECH,2 ,2),SUBCNT ) | |
| 5820 | "RTN","IBC NEHL4",113 ,0) | |
| 5821 | . S SUBCI D=$P(SUBC, $E(HLECH), 5) ; Id entifier T ype Code | |
| 5822 | "RTN","IBC NEHL4",114 ,0) | |
| 5823 | . S SUBCD ATA=$P(SUB C,$E(HLECH ),1) ; Dat a Value | |
| 5824 | "RTN","IBC NEHL4",115 ,0) | |
| 5825 | . I SUBCI D="PI" S D FN=SUBCDAT A | |
| 5826 | "RTN","IBC NEHL4",116 ,0) | |
| 5827 | . I SUBCI D="SS" S S SN=SUBCDAT A | |
| 5828 | "RTN","IBC NEHL4",117 ,0) | |
| 5829 | . I SUBCI D="NI" S I CN=SUBCDAT A | |
| 5830 | "RTN","IBC NEHL4",118 ,0) | |
| 5831 | ; | |
| 5832 | "RTN","IBC NEHL4",119 ,0) | |
| 5833 | ; Conver t data fro m HL7 form at to Vist A format | |
| 5834 | "RTN","IBC NEHL4",120 ,0) | |
| 5835 | S NAME=$$ DECHL7^IBC NEHL2($$FM NAME^HLFNC (NAME,HLEC H)) | |
| 5836 | "RTN","IBC NEHL4",121 ,0) | |
| 5837 | S DOD=$$F MDATE^HLFN C(DOD),DOB =$$FMDATE^ HLFNC(DOB) ,LUPDT=$$F MDATE^HLFN C(LUPDT) | |
| 5838 | "RTN","IBC NEHL4",122 ,0) | |
| 5839 | ; | |
| 5840 | "RTN","IBC NEHL4",123 ,0) | |
| 5841 | ; Use ICN to find t he patient s DFN at t his site | |
| 5842 | "RTN","IBC NEHL4",124 ,0) | |
| 5843 | I ICN'="" D | |
| 5844 | "RTN","IBC NEHL4",125 ,0) | |
| 5845 | .S XDFN=$ $GETDFN^MP IF001(ICN) | |
| 5846 | "RTN","IBC NEHL4",126 ,0) | |
| 5847 | .; if uns uccessful, wait 5 se c and try one more t ime | |
| 5848 | "RTN","IBC NEHL4",127 ,0) | |
| 5849 | .I +$G(XD FN)'>0 H 5 S XDFN=$$ GETDFN^MPI F001(ICN) | |
| 5850 | "RTN","IBC NEHL4",128 ,0) | |
| 5851 | .Q | |
| 5852 | "RTN","IBC NEHL4",129 ,0) | |
| 5853 | I +$G(XDF N)'>0,+$G( ICN)>0 D Q | |
| 5854 | "RTN","IBC NEHL4",130 ,0) | |
| 5855 | . S ERFLG =1,IERN=$$ ERRN^IBCNE UT7("ERROR (""DIERR"" )") | |
| 5856 | "RTN","IBC NEHL4",131 ,0) | |
| 5857 | . S ERROR ("DIERR",I ERN,"TEXT" ,1)="Unabl e to deter mine the p atient's D FN value f or this si te." | |
| 5858 | "RTN","IBC NEHL4",132 ,0) | |
| 5859 | . S ERROR ("DIERR",I ERN,"TEXT" ,2)=" The ICN for th e patient in this re sponse is ICN: "_ICN | |
| 5860 | "RTN","IBC NEHL4",133 ,0) | |
| 5861 | . S ERROR ("DIERR",I ERN,"TEXT" ,3)=" eIV was unable to file t he respons e informat ion." | |
| 5862 | "RTN","IBC NEHL4",134 ,0) | |
| 5863 | ; | |
| 5864 | "RTN","IBC NEHL4",135 ,0) | |
| 5865 | I +ICN>0 S DFN=XDFN | |
| 5866 | "RTN","IBC NEHL4",136 ,0) | |
| 5867 | ; | |
| 5868 | "RTN","IBC NEHL4",137 ,0) | |
| 5869 | ; Perfor m date of death chec k | |
| 5870 | "RTN","IBC NEHL4",138 ,0) | |
| 5871 | I DOD'="" D DODCK^I BCNEHLU(DF N,DOD,MGRP ,NAME,RIEN ,SSN) | |
| 5872 | "RTN","IBC NEHL4",139 ,0) | |
| 5873 | ; | |
| 5874 | "RTN","IBC NEHL4",140 ,0) | |
| 5875 | S IENSTR= RIEN_"," | |
| 5876 | "RTN","IBC NEHL4",141 ,0) | |
| 5877 | I $P(^IBC N(365,RIEN ,0),U,2)=" " S RSUPDT (365,IENST R,.02)=DFN | |
| 5878 | "RTN","IBC NEHL4",142 ,0) | |
| 5879 | ;IB*2.0*6 21/TAZ - O nly file D OB, SEX, S SN, PT REL ATIONSHIP and ADDRES S on regul ar 271s | |
| 5880 | "RTN","IBC NEHL4",143 ,0) | |
| 5881 | I EVENTYP '=1 D | |
| 5882 | "RTN","IBC NEHL4",144 ,0) | |
| 5883 | . S RSUPD T(365,IENS TR,1.02)=D OB,RSUPDT( 365,IENSTR ,1.04)=SEX | |
| 5884 | "RTN","IBC NEHL4",145 ,0) | |
| 5885 | . S RSUPD T(365,IENS TR,1.09)=" 01" | |
| 5886 | "RTN","IBC NEHL4",146 ,0) | |
| 5887 | . S RSUPD T(365,IENS TR,1.03)=S SN | |
| 5888 | "RTN","IBC NEHL4",147 ,0) | |
| 5889 | . ; Subsc riber addr ess | |
| 5890 | "RTN","IBC NEHL4",148 ,0) | |
| 5891 | . S FLD=$ G(IBSEG(12 )) | |
| 5892 | "RTN","IBC NEHL4",149 ,0) | |
| 5893 | . S RSUPD T(365,IENS TR,5.01)=$ P($P(FLD,H LCMP),HLSC MP) ; line 1 | |
| 5894 | "RTN","IBC NEHL4",150 ,0) | |
| 5895 | . S RSUPD T(365,IENS TR,5.02)=$ P(FLD,HLCM P,2) ; lin e 2 | |
| 5896 | "RTN","IBC NEHL4",151 ,0) | |
| 5897 | . S RSUPD T(365,IENS TR,5.03)=$ P(FLD,HLCM P,3) ; cit y | |
| 5898 | "RTN","IBC NEHL4",152 ,0) | |
| 5899 | . S STATE =+$$FIND1^ DIC(5,,"X" ,$P(FLD,HL CMP,4),"C" ) I STATE> 0 S RSUPDT (365,IENST R,5.04)=ST ATE ; stat e | |
| 5900 | "RTN","IBC NEHL4",153 ,0) | |
| 5901 | . S RSUPD T(365,IENS TR,5.05)=$ P(FLD,HLCM P,5) ; zip | |
| 5902 | "RTN","IBC NEHL4",154 ,0) | |
| 5903 | . S RSUPD T(365,IENS TR,5.06)=$ P(FLD,HLCM P,6) ; cou ntry | |
| 5904 | "RTN","IBC NEHL4",155 ,0) | |
| 5905 | . S RSUPD T(365,IENS TR,5.07)=$ P(FLD,HLCM P,8) ; cou ntry subdi vision | |
| 5906 | "RTN","IBC NEHL4",156 ,0) | |
| 5907 | S RSUPDT( 365,IENSTR ,1.16)=DOD | |
| 5908 | "RTN","IBC NEHL4",157 ,0) | |
| 5909 | S RSUPDT( 365,IENSTR ,1.08)="v" | |
| 5910 | "RTN","IBC NEHL4",158 ,0) | |
| 5911 | D FILE^DI E("I","RSU PDT","ERRO R") Q:$D(E RROR) | |
| 5912 | "RTN","IBC NEHL4",159 ,0) | |
| 5913 | ; IB*2*49 7 - add th e followin g lines | |
| 5914 | "RTN","IBC NEHL4",160 ,0) | |
| 5915 | ; the val ue at NAME OF INSURE D (365,13. 01) must b e validate d before i t can be f iled; pass the 'E' f lag to DBS filer | |
| 5916 | "RTN","IBC NEHL4",161 ,0) | |
| 5917 | ; IB*2.0* 621/TAZ On ly file NA ME OF INSU RED on reg ular 271's | |
| 5918 | "RTN","IBC NEHL4",162 ,0) | |
| 5919 | I EVENTYP '=1 D | |
| 5920 | "RTN","IBC NEHL4",163 ,0) | |
| 5921 | . K RSUPD T | |
| 5922 | "RTN","IBC NEHL4",164 ,0) | |
| 5923 | . S RSUPD T(365,IENS TR,13.01)= NAME | |
| 5924 | "RTN","IBC NEHL4",165 ,0) | |
| 5925 | . D FILE^ DIE("E","R SUPDT","ER ROR") | |
| 5926 | "RTN","IBC NEHL4",166 ,0) | |
| 5927 | PIDX ; | |
| 5928 | "RTN","IBC NEHL4",167 ,0) | |
| 5929 | Q | |
| 5930 | "RTN","IBC NEHL4",168 ,0) | |
| 5931 | ; | |
| 5932 | "RTN","IBC NEHL4",169 ,0) | |
| 5933 | GT1 ; Pro cess the G T1 Guarant or seg | |
| 5934 | "RTN","IBC NEHL4",170 ,0) | |
| 5935 | ; | |
| 5936 | "RTN","IBC NEHL4",171 ,0) | |
| 5937 | ; Input: | |
| 5938 | "RTN","IBC NEHL4",172 ,0) | |
| 5939 | ; IBSEG,R IEN | |
| 5940 | "RTN","IBC NEHL4",173 ,0) | |
| 5941 | ; | |
| 5942 | "RTN","IBC NEHL4",174 ,0) | |
| 5943 | ; Output: | |
| 5944 | "RTN","IBC NEHL4",175 ,0) | |
| 5945 | ; ERROR,S UBID | |
| 5946 | "RTN","IBC NEHL4",176 ,0) | |
| 5947 | ; | |
| 5948 | "RTN","IBC NEHL4",177 ,0) | |
| 5949 | N DOB,IEN STR,NAME,R SUPDT,SEX, SSN,SUBIDC | |
| 5950 | "RTN","IBC NEHL4",178 ,0) | |
| 5951 | S NAME=$G (IBSEG(4)) ,DOB=$G(IB SEG(9)),SE X=$G(IBSEG (10)) | |
| 5952 | "RTN","IBC NEHL4",179 ,0) | |
| 5953 | S SSN=$G( IBSEG(13)) ; fsc NO LONGER SEN DS SSN for regular 2 71's | |
| 5954 | "RTN","IBC NEHL4",180 ,0) | |
| 5955 | ; | |
| 5956 | "RTN","IBC NEHL4",181 ,0) | |
| 5957 | S SUBIDC= $G(IBSEG(3 )) ; Raw field with sub-comp. | |
| 5958 | "RTN","IBC NEHL4",182 ,0) | |
| 5959 | S SUBID=$ P(SUBIDC,$ E(HLECH),1 ) | |
| 5960 | "RTN","IBC NEHL4",183 ,0) | |
| 5961 | S SUBID=$ $DECHL7^IB CNEHL2(SUB ID) | |
| 5962 | "RTN","IBC NEHL4",184 ,0) | |
| 5963 | ; | |
| 5964 | "RTN","IBC NEHL4",185 ,0) | |
| 5965 | S DOB=$$F MDATE^HLFN C(DOB),NAM E=$$DECHL7 ^IBCNEHL2( $$FMNAME^H LFNC(NAME, HLECH)) | |
| 5966 | "RTN","IBC NEHL4",186 ,0) | |
| 5967 | ; | |
| 5968 | "RTN","IBC NEHL4",187 ,0) | |
| 5969 | ;IB*2.0*6 21/TAZ - P rocess EIC D Identifi cation Res ponse and Quit | |
| 5970 | "RTN","IBC NEHL4",188 ,0) | |
| 5971 | I EVENTYP =1 D G GT 1X | |
| 5972 | "RTN","IBC NEHL4",189 ,0) | |
| 5973 | . N FLG,S ETID,STATE | |
| 5974 | "RTN","IBC NEHL4",190 ,0) | |
| 5975 | . S SETID =$G(IBSEG( 2)) | |
| 5976 | "RTN","IBC NEHL4",191 ,0) | |
| 5977 | . S IBTRA CK(SETID,. 04)=SUBID | |
| 5978 | "RTN","IBC NEHL4",192 ,0) | |
| 5979 | . S IBTRA CK(SETID,. 06)=SSN | |
| 5980 | "RTN","IBC NEHL4",193 ,0) | |
| 5981 | . S:DOB'= "" IBTRACK (SETID,.07 )=DOB | |
| 5982 | "RTN","IBC NEHL4",194 ,0) | |
| 5983 | . S IBTRA CK(SETID,. 08)=SEX | |
| 5984 | "RTN","IBC NEHL4",195 ,0) | |
| 5985 | . S IBTRA CK(SETID,. 09)=NAME | |
| 5986 | "RTN","IBC NEHL4",196 ,0) | |
| 5987 | . S FLD=$ G(IBSEG(6) ) | |
| 5988 | "RTN","IBC NEHL4",197 ,0) | |
| 5989 | . S IBTRA CK(SETID,. 1)=$P($P(F LD,HLCMP), HLSCMP) ; Subscriber Address 1 | |
| 5990 | "RTN","IBC NEHL4",198 ,0) | |
| 5991 | . S IBTRA CK(SETID,. 11)=$P(FLD ,HLCMP,2) ;Subscribe r Address 2 | |
| 5992 | "RTN","IBC NEHL4",199 ,0) | |
| 5993 | . S IBTRA CK(SETID,. 12)=$P(FLD ,HLCMP,3) ;Subscribe r City | |
| 5994 | "RTN","IBC NEHL4",200 ,0) | |
| 5995 | . S STATE =+$$FIND1^ DIC(5,,"X" ,$P(FLD,HL CMP,4),"C" ) I STATE> 0 S IBTRAC K(SETID,.1 3)=STATE ; Subscriber State | |
| 5996 | "RTN","IBC NEHL4",201 ,0) | |
| 5997 | . S IBTRA CK(SETID,. 14)=$P(FLD ,HLCMP,5) ;Subscribe r Zip | |
| 5998 | "RTN","IBC NEHL4",202 ,0) | |
| 5999 | . S IBTRA CK(SETID,. 15)=1 | |
| 6000 | "RTN","IBC NEHL4",203 ,0) | |
| 6001 | S IENSTR= RIEN_"," | |
| 6002 | "RTN","IBC NEHL4",204 ,0) | |
| 6003 | S RSUPDT( 365,RIEN_" ,",1.08)=" " | |
| 6004 | "RTN","IBC NEHL4",205 ,0) | |
| 6005 | S:DOB'="" RSUPDT(36 5,IENSTR,1 .02)=DOB | |
| 6006 | "RTN","IBC NEHL4",206 ,0) | |
| 6007 | S RSUPDT( 365,RIEN_" ,",1.04)=S EX | |
| 6008 | "RTN","IBC NEHL4",207 ,0) | |
| 6009 | S RSUPDT( 365,IENSTR ,1.03)=SSN | |
| 6010 | "RTN","IBC NEHL4",208 ,0) | |
| 6011 | S RSUPDT( 365,IENSTR ,1.18)=SUB ID | |
| 6012 | "RTN","IBC NEHL4",209 ,0) | |
| 6013 | ; Subscri ber addres s | |
| 6014 | "RTN","IBC NEHL4",210 ,0) | |
| 6015 | S FLD=$G( IBSEG(6)) | |
| 6016 | "RTN","IBC NEHL4",211 ,0) | |
| 6017 | S RSUPDT( 365,IENSTR ,5.01)=$P( $P(FLD,HLC MP),HLSCMP ) ; line 1 | |
| 6018 | "RTN","IBC NEHL4",212 ,0) | |
| 6019 | S RSUPDT( 365,IENSTR ,5.02)=$P( FLD,HLCMP, 2) ; line 2 | |
| 6020 | "RTN","IBC NEHL4",213 ,0) | |
| 6021 | S RSUPDT( 365,IENSTR ,5.03)=$P( FLD,HLCMP, 3) ; city | |
| 6022 | "RTN","IBC NEHL4",214 ,0) | |
| 6023 | S STATE=+ $$FIND1^DI C(5,,"X",$ P(FLD,HLCM P,4),"C") I STATE>0 S RSUPDT(3 65,IENSTR, 5.04)=STAT E ; state | |
| 6024 | "RTN","IBC NEHL4",215 ,0) | |
| 6025 | S RSUPDT( 365,IENSTR ,5.05)=$P( FLD,HLCMP, 5) ; zip | |
| 6026 | "RTN","IBC NEHL4",216 ,0) | |
| 6027 | S RSUPDT( 365,IENSTR ,5.06)=$P( FLD,HLCMP, 6) ; count ry | |
| 6028 | "RTN","IBC NEHL4",217 ,0) | |
| 6029 | S RSUPDT( 365,IENSTR ,5.07)=$P( FLD,HLCMP, 8) ; count ry subdivi sion | |
| 6030 | "RTN","IBC NEHL4",218 ,0) | |
| 6031 | D FILE^DI E("I","RSU PDT","ERRO R") Q:$D(E RROR) | |
| 6032 | "RTN","IBC NEHL4",219 ,0) | |
| 6033 | ; IB*2*49 7 - add th e followin g lines | |
| 6034 | "RTN","IBC NEHL4",220 ,0) | |
| 6035 | ; the val ue at NAME OF INSURE D (365,13. 01) must b e validate d before i t can be f iled; pass the 'E' f lag to DBS filer | |
| 6036 | "RTN","IBC NEHL4",221 ,0) | |
| 6037 | K RSUPDT | |
| 6038 | "RTN","IBC NEHL4",222 ,0) | |
| 6039 | S RSUPDT( 365,IENSTR ,13.01)=NA ME | |
| 6040 | "RTN","IBC NEHL4",223 ,0) | |
| 6041 | D FILE^DI E("E","RSU PDT","ERRO R") | |
| 6042 | "RTN","IBC NEHL4",224 ,0) | |
| 6043 | GT1X ; | |
| 6044 | "RTN","IBC NEHL4",225 ,0) | |
| 6045 | Q | |
| 6046 | "RTN","IBC NEHL4",226 ,0) | |
| 6047 | ; | |
| 6048 | "RTN","IBC NEHL4",227 ,0) | |
| 6049 | ZHS(EBDA,E RROR,IBSEG ,RIEN) ; P rocess ZHS Healthcar e services delivery segment | |
| 6050 | "RTN","IBC NEHL4",228 ,0) | |
| 6051 | N IENSTR, RSUPDT,QUA L,VALUE | |
| 6052 | "RTN","IBC NEHL4",229 ,0) | |
| 6053 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6054 | "RTN","IBC NEHL4",230 ,0) | |
| 6055 | S IENSTR= "+1,"_EBDA _","_RIEN_ "," | |
| 6056 | "RTN","IBC NEHL4",231 ,0) | |
| 6057 | S RSUPDT( 365.27,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,2, EBDA,7,"B" ,""),-1)+1 ; ZHS seq uence | |
| 6058 | "RTN","IBC NEHL4",232 ,0) | |
| 6059 | ; Benefit quantity & qualifie r | |
| 6060 | "RTN","IBC NEHL4",233 ,0) | |
| 6061 | S QUAL=$P ($G(IBSEG( 3)),HLCMP) ,VALUE=$G( IBSEG(4)) | |
| 6062 | "RTN","IBC NEHL4",234 ,0) | |
| 6063 | I VALUE'= "",QUAL'=" " S RSUPDT (365.27,IE NSTR,.02)= $$NUMCHK^I BCNEHL2(VA LUE),RSUPD T(365.27,I ENSTR,.03) =QUAL | |
| 6064 | "RTN","IBC NEHL4",235 ,0) | |
| 6065 | ; Samplin g frequenc y & qualif ier | |
| 6066 | "RTN","IBC NEHL4",236 ,0) | |
| 6067 | S QUAL=$P ($G(IBSEG( 5)),HLCMP) ,VALUE=$G( IBSEG(6)) | |
| 6068 | "RTN","IBC NEHL4",237 ,0) | |
| 6069 | I VALUE'= "",QUAL'=" " S RSUPDT (365.27,IE NSTR,.04)= VALUE,RSUP DT(365.27, IENSTR,.05 )=QUAL | |
| 6070 | "RTN","IBC NEHL4",238 ,0) | |
| 6071 | ; Time pe riod & qua lifier | |
| 6072 | "RTN","IBC NEHL4",239 ,0) | |
| 6073 | S QUAL=$P ($G(IBSEG( 7)),HLCMP) ,VALUE=$G( IBSEG(8)) | |
| 6074 | "RTN","IBC NEHL4",240 ,0) | |
| 6075 | I VALUE'= "",QUAL'=" " S RSUPDT (365.27,IE NSTR,.06)= $$NUMCHK^I BCNEHL2(VA LUE),RSUPD T(365.27,I ENSTR,.07) =QUAL | |
| 6076 | "RTN","IBC NEHL4",241 ,0) | |
| 6077 | S RSUPDT( 365.27,IEN STR,.08)=$ P($G(IBSEG (9)),HLCMP ) ; Delive ry frequen cy | |
| 6078 | "RTN","IBC NEHL4",242 ,0) | |
| 6079 | S RSUPDT( 365.27,IEN STR,.09)=$ P($G(IBSEG (10)),HLCM P) ; Deliv ery patter n | |
| 6080 | "RTN","IBC NEHL4",243 ,0) | |
| 6081 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6082 | "RTN","IBC NEHL4",244 ,0) | |
| 6083 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6084 | "RTN","IBC NEHL4",245 ,0) | |
| 6085 | Q | |
| 6086 | "RTN","IBC NEHL4",246 ,0) | |
| 6087 | ; | |
| 6088 | "RTN","IBC NEHL4",247 ,0) | |
| 6089 | ZRF(EBDA,E RROR,IBSEG ,RIEN) ; P rocess ZRF Reference identific ation segm ent | |
| 6090 | "RTN","IBC NEHL4",248 ,0) | |
| 6091 | N IENSTR, RSUPDT,QUA L,VALUE | |
| 6092 | "RTN","IBC NEHL4",249 ,0) | |
| 6093 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6094 | "RTN","IBC NEHL4",250 ,0) | |
| 6095 | S IENSTR= "+1,"_EBDA _","_RIEN_ "," | |
| 6096 | "RTN","IBC NEHL4",251 ,0) | |
| 6097 | S RSUPDT( 365.291,IE NSTR,.01)= +$O(^IBCN( 365,RIEN,2 ,EBDA,10," B",""),-1) +1 ; ZRF s equence | |
| 6098 | "RTN","IBC NEHL4",252 ,0) | |
| 6099 | ; Referen ce id & qu alifier | |
| 6100 | "RTN","IBC NEHL4",253 ,0) | |
| 6101 | S QUAL=$P ($G(IBSEG( 3)),HLCMP) ,VALUE=$G( IBSEG(4)) | |
| 6102 | "RTN","IBC NEHL4",254 ,0) | |
| 6103 | I VALUE'= "",QUAL'=" " S RSUPDT (365.291,I ENSTR,.02) =VALUE,RSU PDT(365.29 1,IENSTR,. 03)=QUAL | |
| 6104 | "RTN","IBC NEHL4",255 ,0) | |
| 6105 | S RSUPDT( 365.291,IE NSTR,.04)= $G(IBSEG(5 )) ; Descr iption | |
| 6106 | "RTN","IBC NEHL4",256 ,0) | |
| 6107 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6108 | "RTN","IBC NEHL4",257 ,0) | |
| 6109 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6110 | "RTN","IBC NEHL4",258 ,0) | |
| 6111 | Q | |
| 6112 | "RTN","IBC NEHL4",259 ,0) | |
| 6113 | ; | |
| 6114 | "RTN","IBC NEHL4",260 ,0) | |
| 6115 | ZSD(EBDA,E RROR,IBSEG ,RIEN) ; P rocess ZSD Subscribe r date seg ment | |
| 6116 | "RTN","IBC NEHL4",261 ,0) | |
| 6117 | N IENSTR, RSUPDT,QUA L,VALUE | |
| 6118 | "RTN","IBC NEHL4",262 ,0) | |
| 6119 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6120 | "RTN","IBC NEHL4",263 ,0) | |
| 6121 | S IENSTR= "+1,"_EBDA _","_RIEN_ "," | |
| 6122 | "RTN","IBC NEHL4",264 ,0) | |
| 6123 | S RSUPDT( 365.28,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,2, EBDA,8,"B" ,""),-1)+1 ; ZSD seq uence | |
| 6124 | "RTN","IBC NEHL4",265 ,0) | |
| 6125 | ; Date & qualifier | |
| 6126 | "RTN","IBC NEHL4",266 ,0) | |
| 6127 | S QUAL=$P ($G(IBSEG( 3)),HLCMP) ,VALUE=$P( $G(IBSEG(5 )),HLCMP) | |
| 6128 | "RTN","IBC NEHL4",267 ,0) | |
| 6129 | I VALUE'= "",QUAL'=" " S RSUPDT (365.28,IE NSTR,.02)= VALUE,RSUP DT(365.28, IENSTR,.03 )=QUAL | |
| 6130 | "RTN","IBC NEHL4",268 ,0) | |
| 6131 | S RSUPDT( 365.28,IEN STR,.04)=$ P($G(IBSEG (4)),HLCMP ) ; Date f ormat | |
| 6132 | "RTN","IBC NEHL4",269 ,0) | |
| 6133 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6134 | "RTN","IBC NEHL4",270 ,0) | |
| 6135 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6136 | "RTN","IBC NEHL4",271 ,0) | |
| 6137 | Q | |
| 6138 | "RTN","IBC NEHL4",272 ,0) | |
| 6139 | ; | |
| 6140 | "RTN","IBC NEHL4",273 ,0) | |
| 6141 | ZII(EBDA,E RROR,IBSEG ,RIEN) ; P rocess ZII Subscribe r addition al info se gment | |
| 6142 | "RTN","IBC NEHL4",274 ,0) | |
| 6143 | N IENSTR, RSUPDT,QUA L,VALUE | |
| 6144 | "RTN","IBC NEHL4",275 ,0) | |
| 6145 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6146 | "RTN","IBC NEHL4",276 ,0) | |
| 6147 | S IENSTR= "+1,"_EBDA _","_RIEN_ "," | |
| 6148 | "RTN","IBC NEHL4",277 ,0) | |
| 6149 | S RSUPDT( 365.29,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,2, EBDA,9,"B" ,""),-1)+1 ; ZII seq uence | |
| 6150 | "RTN","IBC NEHL4",278 ,0) | |
| 6151 | ; place o f service or diagnos is (if qua lifier is "BF" or "B K") & qual ifier | |
| 6152 | "RTN","IBC NEHL4",279 ,0) | |
| 6153 | S QUAL=$P ($G(IBSEG( 3)),HLCMP) | |
| 6154 | "RTN","IBC NEHL4",280 ,0) | |
| 6155 | ; IB*2*49 7 set up f or Nature of Injury type quali fiers "GR" , "NI", or null valu e | |
| 6156 | "RTN","IBC NEHL4",281 ,0) | |
| 6157 | I (QUAL=" ")!(".GR.N I."[("."_Q UAL_".")) D | |
| 6158 | "RTN","IBC NEHL4",282 ,0) | |
| 6159 | . S RSUPD T(365.29,I ENSTR,.05) =$P($G(IBS EG(5)),U,2 ) ;nature of injury code | |
| 6160 | "RTN","IBC NEHL4",283 ,0) | |
| 6161 | . S RSUPD T(365.29,I ENSTR,.06) =$P($G(IBS EG(6)),U,2 ) ; nature of injury code cate gory | |
| 6162 | "RTN","IBC NEHL4",284 ,0) | |
| 6163 | . S RSUPD T(365.29,I ENSTR,.07) =$G(IBSEG( 7)) ; nat ure of inj ury code f ree text d escription | |
| 6164 | "RTN","IBC NEHL4",285 ,0) | |
| 6165 | E S RSUP DT(365.29, IENSTR,$S( ".BF.BK."[ ("."_QUAL_ "."):.03,1 :.02))=$P( $G(IBSEG(4 )),HLCMP) | |
| 6166 | "RTN","IBC NEHL4",286 ,0) | |
| 6167 | S RSUPDT( 365.29,IEN STR,.04)=Q UAL | |
| 6168 | "RTN","IBC NEHL4",287 ,0) | |
| 6169 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check for new coded values | |
| 6170 | "RTN","IBC NEHL4",288 ,0) | |
| 6171 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6172 | "RTN","IBC NEHL4",289 ,0) | |
| 6173 | Q | |
| 6174 | "RTN","IBC NEHL4",290 ,0) | |
| 6175 | ; | |
| 6176 | "RTN","IBC NEHL4",291 ,0) | |
| 6177 | ZTY(EBDA,E RROR,IBSEG ,RIEN) ; P rocess ZTY Benefit r elated ent ity segmen t | |
| 6178 | "RTN","IBC NEHL4",292 ,0) | |
| 6179 | N FLD,IEN STR,RSUPDT ,QUAL,VALU E | |
| 6180 | "RTN","IBC NEHL4",293 ,0) | |
| 6181 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6182 | "RTN","IBC NEHL4",294 ,0) | |
| 6183 | S IENSTR= EBDA_","_R IEN_"," | |
| 6184 | "RTN","IBC NEHL4",295 ,0) | |
| 6185 | ; Entity id code & qualifier | |
| 6186 | "RTN","IBC NEHL4",296 ,0) | |
| 6187 | S QUAL=$P ($G(IBSEG( 4)),HLCMP) ,VALUE=$P( $G(IBSEG(3 )),HLCMP) | |
| 6188 | "RTN","IBC NEHL4",297 ,0) | |
| 6189 | I VALUE'= "",QUAL'=" " S RSUPDT (365.02,IE NSTR,3.01) =VALUE,RSU PDT(365.02 ,IENSTR,3. 02)=QUAL | |
| 6190 | "RTN","IBC NEHL4",298 ,0) | |
| 6191 | ; Entity name | |
| 6192 | "RTN","IBC NEHL4",299 ,0) | |
| 6193 | S FLD=$G( IBSEG(5)) | |
| 6194 | "RTN","IBC NEHL4",300 ,0) | |
| 6195 | ;S RSUPDT (365.02,IE NSTR,3.03) =$P($P(FLD ,HLCMP),HL SCMP)_","_ $P(FLD,HLC MP,2)_" "_ $P(FLD,HLC MP,3)_" "_ $P(FLD,HLC MP,4) | |
| 6196 | "RTN","IBC NEHL4",301 ,0) | |
| 6197 | S RSUPDT( 365.02,IEN STR,3.03)= $P($P(FLD, HLCMP),HLS CMP)_" "_$ P(FLD,HLCM P,2)_" "_$ P(FLD,HLCM P,3)_" "_$ P(FLD,HLCM P,4) ;ib* 2*497 pre vent orpha n commas | |
| 6198 | "RTN","IBC NEHL4",302 ,0) | |
| 6199 | ; make su re that na me is not empty | |
| 6200 | "RTN","IBC NEHL4",303 ,0) | |
| 6201 | ;I $TR(RS UPDT(365.0 2,IENSTR,3 .03),", ") ="" K RSUP DT(365.02, IENSTR,3.0 3) | |
| 6202 | "RTN","IBC NEHL4",304 ,0) | |
| 6203 | I $TR(RSU PDT(365.02 ,IENSTR,3. 03)," ")=" " K RSUPDT (365.02,IE NSTR,3.03) ;ib*2*49 7 remove comma from $TR state ment | |
| 6204 | "RTN","IBC NEHL4",305 ,0) | |
| 6205 | ; Entity id & quali fier | |
| 6206 | "RTN","IBC NEHL4",306 ,0) | |
| 6207 | S QUAL=$P ($G(IBSEG( 6)),HLCMP) ,VALUE=$G( IBSEG(7)) | |
| 6208 | "RTN","IBC NEHL4",307 ,0) | |
| 6209 | I VALUE'= "",QUAL'=" " S RSUPDT (365.02,IE NSTR,3.04) =VALUE,RSU PDT(365.02 ,IENSTR,3. 05)=QUAL | |
| 6210 | "RTN","IBC NEHL4",308 ,0) | |
| 6211 | ; IB*2*49 7 - entity relations hip code | |
| 6212 | "RTN","IBC NEHL4",309 ,0) | |
| 6213 | S RSUPDT( 365.02,IEN STR,3.06)= $G(IBSEG(1 4)) | |
| 6214 | "RTN","IBC NEHL4",310 ,0) | |
| 6215 | ; Entity address | |
| 6216 | "RTN","IBC NEHL4",311 ,0) | |
| 6217 | S FLD=$G( IBSEG(8)) | |
| 6218 | "RTN","IBC NEHL4",312 ,0) | |
| 6219 | S RSUPDT( 365.02,IEN STR,4.01)= $P($P(FLD, HLCMP),HLS CMP) ; lin e 1 | |
| 6220 | "RTN","IBC NEHL4",313 ,0) | |
| 6221 | S RSUPDT( 365.02,IEN STR,4.02)= $P(FLD,HLC MP,2) ; li ne 2 | |
| 6222 | "RTN","IBC NEHL4",314 ,0) | |
| 6223 | S RSUPDT( 365.02,IEN STR,4.03)= $P(FLD,HLC MP,3) ; ci ty | |
| 6224 | "RTN","IBC NEHL4",315 ,0) | |
| 6225 | S VALUE=+ $$FIND1^DI C(5,,"X",$ P(FLD,HLCM P,4),"C") I VALUE>0 S RSUPDT(3 65.02,IENS TR,4.04)=V ALUE ; sta te | |
| 6226 | "RTN","IBC NEHL4",316 ,0) | |
| 6227 | S RSUPDT( 365.02,IEN STR,4.05)= $P(FLD,HLC MP,5) ; zi p / postal code | |
| 6228 | "RTN","IBC NEHL4",317 ,0) | |
| 6229 | S RSUPDT( 365.02,IEN STR,4.06)= $P(FLD,HLC MP,6) ; co untry code | |
| 6230 | "RTN","IBC NEHL4",318 ,0) | |
| 6231 | S RSUPDT( 365.02,IEN STR,4.09)= $P(FLD,HLC MP,8) ; co untry subd ivision co de | |
| 6232 | "RTN","IBC NEHL4",319 ,0) | |
| 6233 | ; Entity location & qualifier | |
| 6234 | "RTN","IBC NEHL4",320 ,0) | |
| 6235 | S QUAL=$G (IBSEG(9)) ,VALUE=$G( IBSEG(10)) | |
| 6236 | "RTN","IBC NEHL4",321 ,0) | |
| 6237 | I VALUE'= "",QUAL'=" " S RSUPDT (365.02,IE NSTR,4.07) =VALUE,RSU PDT(365.02 ,IENSTR,4. 08)=QUAL | |
| 6238 | "RTN","IBC NEHL4",322 ,0) | |
| 6239 | ; Provide r code | |
| 6240 | "RTN","IBC NEHL4",323 ,0) | |
| 6241 | S RSUPDT( 365.02,IEN STR,5.01)= $P($G(IBSE G(11)),HLC MP) | |
| 6242 | "RTN","IBC NEHL4",324 ,0) | |
| 6243 | ; Referen ce id & qu alifier | |
| 6244 | "RTN","IBC NEHL4",325 ,0) | |
| 6245 | S QUAL=$P ($G(IBSEG( 12)),HLCMP ),VALUE=$G (IBSEG(13) ) | |
| 6246 | "RTN","IBC NEHL4",326 ,0) | |
| 6247 | I VALUE'= "",QUAL'=" " S RSUPDT (365.02,IE NSTR,5.02) =VALUE,RSU PDT(365.02 ,IENSTR,5. 03)=QUAL | |
| 6248 | "RTN","IBC NEHL4",327 ,0) | |
| 6249 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6250 | "RTN","IBC NEHL4",328 ,0) | |
| 6251 | D FILE^DI E("ET","RS UPDT","ERR OR") | |
| 6252 | "RTN","IBC NEHL4",329 ,0) | |
| 6253 | Q | |
| 6254 | "RTN","IBC NEHL4",330 ,0) | |
| 6255 | ; | |
| 6256 | "RTN","IBC NEHL4",331 ,0) | |
| 6257 | G2OCTD(EBD A,ERROR,IB SEG,RIEN) ; Process G2O.CTD Be nefit rela ted entity contact d ata segmen t | |
| 6258 | "RTN","IBC NEHL4",332 ,0) | |
| 6259 | N FLD,IEN STR,RSUPDT ,QUAL,VALU E | |
| 6260 | "RTN","IBC NEHL4",333 ,0) | |
| 6261 | Q:$G(EBDA )="" ; Qu it if EB m ultiple ie n is missi ng | |
| 6262 | "RTN","IBC NEHL4",334 ,0) | |
| 6263 | S IENSTR= "+1,"_EBDA _","_RIEN_ "," | |
| 6264 | "RTN","IBC NEHL4",335 ,0) | |
| 6265 | S RSUPDT( 365.26,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,2, EBDA,6,"B" ,""),-1)+1 ; G2O.CTD sequence | |
| 6266 | "RTN","IBC NEHL4",336 ,0) | |
| 6267 | ; Contact name | |
| 6268 | "RTN","IBC NEHL4",337 ,0) | |
| 6269 | S FLD=$G( IBSEG(3)) | |
| 6270 | "RTN","IBC NEHL4",338 ,0) | |
| 6271 | S RSUPDT( 365.26,IEN STR,.02)=$ P(FLD,HLCM P,5)_" "_$ P($P(FLD,H LCMP),HLSC MP)_","_$P (FLD,HLCMP ,2)_" "_$P (FLD,HLCMP ,3)_" "_$P (FLD,HLCMP ,4)_" "_$P (FLD,HLCMP ,6) | |
| 6272 | "RTN","IBC NEHL4",339 ,0) | |
| 6273 | ; make su re that na me is not empty | |
| 6274 | "RTN","IBC NEHL4",340 ,0) | |
| 6275 | I $TR(RSU PDT(365.26 ,IENSTR,.0 2),", ")=" " K RSUPDT (365.26,IE NSTR,.02) | |
| 6276 | "RTN","IBC NEHL4",341 ,0) | |
| 6277 | ; Contact number & qualifier | |
| 6278 | "RTN","IBC NEHL4",342 ,0) | |
| 6279 | S FLD=$G( IBSEG(6)), QUAL=$P(FL D,HLCMP,9) ,VALUE=$P( FLD,HLCMP) | |
| 6280 | "RTN","IBC NEHL4",343 ,0) | |
| 6281 | I VALUE'= "",QUAL'=" " S RSUPDT (365.26,IE NSTR,1)=VA LUE,RSUPDT (365.26,IE NSTR,.04)= QUAL ;ib*2 *497 stuf f COMMUNIC ATION NUMB ER data in to its new location (365.26,1) | |
| 6282 | "RTN","IBC NEHL4",344 ,0) | |
| 6283 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6284 | "RTN","IBC NEHL4",345 ,0) | |
| 6285 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6286 | "RTN","IBC NEHL4",346 ,0) | |
| 6287 | Q | |
| 6288 | "RTN","IBC NEHL4",347 ,0) | |
| 6289 | ; | |
| 6290 | "RTN","IBC NEHL4",348 ,0) | |
| 6291 | ERR(ERDA,E RROR,IBSEG ,RIEN) ; P rocess ERR Reject re asons segm ent | |
| 6292 | "RTN","IBC NEHL4",349 ,0) | |
| 6293 | N I,IENAR R,IENSTR,F LD,LOC,RSU PDT,VAL | |
| 6294 | "RTN","IBC NEHL4",350 ,0) | |
| 6295 | S IENSTR= "+1,"_RIEN _"," | |
| 6296 | "RTN","IBC NEHL4",351 ,0) | |
| 6297 | S RSUPDT( 365.06,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,6, "B",""),-1 )+1 ; ERR sequence | |
| 6298 | "RTN","IBC NEHL4",352 ,0) | |
| 6299 | S FLD=$G( IBSEG(3)), LOC=$P(FLD ,HLCMP) | |
| 6300 | "RTN","IBC NEHL4",353 ,0) | |
| 6301 | F I=2:1:6 S VAL=$P( FLD,HLCMP, 2) I VAL'= "" S LOC=L OC_$S(I=2! (I=4):"("_ VAL_")",1: "."_VAL_". ") | |
| 6302 | "RTN","IBC NEHL4",354 ,0) | |
| 6303 | S RSUPDT( 365.06,IEN STR,.02)=L OC ; Error location (HL7) | |
| 6304 | "RTN","IBC NEHL4",355 ,0) | |
| 6305 | S RSUPDT( 365.06,IEN STR,.03)=$ P($G(IBSEG (6)),HLCMP ) ; Reject reason | |
| 6306 | "RTN","IBC NEHL4",356 ,0) | |
| 6307 | S RSUPDT( 365.06,IEN STR,.04)=$ G(IBSEG(9) ) ; Action code | |
| 6308 | "RTN","IBC NEHL4",357 ,0) | |
| 6309 | S RSUPDT( 365.06,IEN STR,.05)=$ G(IBSEG(8) ) ; Loop i d | |
| 6310 | "RTN","IBC NEHL4",358 ,0) | |
| 6311 | S RSUPDT( 365.06,IEN STR,.06)=$ P($G(IBSEG (6)),HLCMP ,3) ; Sour ce | |
| 6312 | "RTN","IBC NEHL4",359 ,0) | |
| 6313 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6314 | "RTN","IBC NEHL4",360 ,0) | |
| 6315 | D UPDATE^ DIE("E","R SUPDT","IE NARR","ERR OR") | |
| 6316 | "RTN","IBC NEHL4",361 ,0) | |
| 6317 | S ERDA=IE NARR(1) | |
| 6318 | "RTN","IBC NEHL4",362 ,0) | |
| 6319 | Q | |
| 6320 | "RTN","IBC NEHL4",363 ,0) | |
| 6321 | ; | |
| 6322 | "RTN","IBC NEHL4",364 ,0) | |
| 6323 | NTE(ERDA,E RROR,IBSEG ,RIEN) ; P rocess NTE segment | |
| 6324 | "RTN","IBC NEHL4",365 ,0) | |
| 6325 | N DA,IENS ,MSG,MSGST R,RSUPDT,Z | |
| 6326 | "RTN","IBC NEHL4",366 ,0) | |
| 6327 | S DA(1)=R IEN,DA=ERD A | |
| 6328 | "RTN","IBC NEHL4",367 ,0) | |
| 6329 | S IENS=$$ IENS^DILF( .DA) | |
| 6330 | "RTN","IBC NEHL4",368 ,0) | |
| 6331 | S MSGSTR= $G(IBSEG(4 )) | |
| 6332 | "RTN","IBC NEHL4",369 ,0) | |
| 6333 | F Z=1:1 S MSG=$P(MS GSTR,HLREP ,Z) Q:MSG= "" S RSUP DT(365.061 ,"+"_Z_"," _IENS,".01 ")=MSG ;I B*506 Q:' MSG | |
| 6334 | "RTN","IBC NEHL4",370 ,0) | |
| 6335 | I $D(RSUP DT) D UPDA TE^DIE("E" ,"RSUPDT", ,"ERROR") | |
| 6336 | "RTN","IBC NEHL4",371 ,0) | |
| 6337 | Q | |
| 6338 | "RTN","IBC NEHL4",372 ,0) | |
| 6339 | ; | |
| 6340 | "RTN","IBC NEHL4",373 ,0) | |
| 6341 | ZTP(ERROR, IBSEG,RIEN ) ; Proces s ZTP Subs criber dat e (subscri ber level) segment | |
| 6342 | "RTN","IBC NEHL4",374 ,0) | |
| 6343 | N IENSTR, QUAL,RSUPD T,VALUE,Z | |
| 6344 | "RTN","IBC NEHL4",375 ,0) | |
| 6345 | S IENSTR= "+1,"_RIEN _"," | |
| 6346 | "RTN","IBC NEHL4",376 ,0) | |
| 6347 | S RSUPDT( 365.07,IEN STR,.01)=+ $O(^IBCN(3 65,RIEN,7, "B",""),-1 )+1 ; ZTP sequence | |
| 6348 | "RTN","IBC NEHL4",377 ,0) | |
| 6349 | ; Date & qualifier | |
| 6350 | "RTN","IBC NEHL4",378 ,0) | |
| 6351 | S QUAL=$P ($G(IBSEG( 3)),HLCMP) ,VALUE=$P( $P($G(IBSE G(4)),HLCM P),HLSCMP) | |
| 6352 | "RTN","IBC NEHL4",379 ,0) | |
| 6353 | S Z=$P($P ($G(IBSEG( 4)),HLCMP, 2),HLSCMP) I Z'="" S VALUE=VAL UE_" - "_Z | |
| 6354 | "RTN","IBC NEHL4",380 ,0) | |
| 6355 | I VALUE'= "",QUAL'=" " S RSUPDT (365.07,IE NSTR,.02)= VALUE,RSUP DT(365.07, IENSTR,.03 )=QUAL | |
| 6356 | "RTN","IBC NEHL4",381 ,0) | |
| 6357 | S RSUPDT( 365.07,IEN STR,.04)=$ G(IBSEG(5) ) ; Loop i d | |
| 6358 | "RTN","IBC NEHL4",382 ,0) | |
| 6359 | D CODECHK ^IBCNEHLU( .RSUPDT) ; IB*2*497 check fo r new code d values | |
| 6360 | "RTN","IBC NEHL4",383 ,0) | |
| 6361 | D UPDATE^ DIE("E","R SUPDT",,"E RROR") | |
| 6362 | "RTN","IBC NEHL4",384 ,0) | |
| 6363 | Q | |
| 6364 | "RTN","IBC NEHL6") | |
| 6365 | 0^21^B7440 508^B67673 66 | |
| 6366 | "RTN","IBC NEHL6",1,0 ) | |
| 6367 | IBCNEHL6 ; EDE/DM - H L7 Process Incoming RPI Contin ued ; 19-O CT-2017 | |
| 6368 | "RTN","IBC NEHL6",2,0 ) | |
| 6369 | ;;2.0;INT EGRATED BI LLING;**60 1,621**;21 -MAR-94;Bu ild 8 | |
| 6370 | "RTN","IBC NEHL6",3,0 ) | |
| 6371 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 6372 | "RTN","IBC NEHL6",4,0 ) | |
| 6373 | ; | |
| 6374 | "RTN","IBC NEHL6",5,0 ) | |
| 6375 | Q | |
| 6376 | "RTN","IBC NEHL6",6,0 ) | |
| 6377 | FIL ; Fini sh process ing the re sponse mes sage - fil e into ins urance buf fer | |
| 6378 | "RTN","IBC NEHL6",7,0 ) | |
| 6379 | ; | |
| 6380 | "RTN","IBC NEHL6",8,0 ) | |
| 6381 | ; Input V ariables | |
| 6382 | "RTN","IBC NEHL6",9,0 ) | |
| 6383 | ; ERACT, ERFLG, ERR OR, IIVSTA T, MAP, RI EN, TRACE, TRKIEN | |
| 6384 | "RTN","IBC NEHL6",10, 0) | |
| 6385 | ; | |
| 6386 | "RTN","IBC NEHL6",11, 0) | |
| 6387 | ; If no r ecord IEN, quit | |
| 6388 | "RTN","IBC NEHL6",12, 0) | |
| 6389 | I $G(RIEN )="" Q | |
| 6390 | "RTN","IBC NEHL6",13, 0) | |
| 6391 | ; | |
| 6392 | "RTN","IBC NEHL6",14, 0) | |
| 6393 | N BUFF,CA LLEDBY,DFN ,FILEIT,IB FDA,IBIEN, IBQFL,RDAT 0,RSRVDT,R STYPE,SYMB OL,TQDATA, TQN,TQSRVD T,IBISMBI | |
| 6394 | "RTN","IBC NEHL6",15, 0) | |
| 6395 | ; Initial ize variab les from t he Respons e File | |
| 6396 | "RTN","IBC NEHL6",16, 0) | |
| 6397 | S RDAT0=$ G(^IBCN(36 5,RIEN,0)) ,TQN=$P(RD AT0,U,5) | |
| 6398 | "RTN","IBC NEHL6",17, 0) | |
| 6399 | S TQDATA= $G(^IBCN(3 65.1,TQN,0 )) | |
| 6400 | "RTN","IBC NEHL6",18, 0) | |
| 6401 | S IBQFL=$ P(TQDATA,U ,11) | |
| 6402 | "RTN","IBC NEHL6",19, 0) | |
| 6403 | S DFN=$P( RDAT0,U,2) ,BUFF=$P(R DAT0,U,4) | |
| 6404 | "RTN","IBC NEHL6",20, 0) | |
| 6405 | S IBISMBI =+$$MBICHK ^IBCNEUT7( BUFF) ; IB *2*601/DM | |
| 6406 | "RTN","IBC NEHL6",21, 0) | |
| 6407 | S IBIEN=$ P(TQDATA,U ,5),RSTYPE =$P(RDAT0, U,10) | |
| 6408 | "RTN","IBC NEHL6",22, 0) | |
| 6409 | S RSRVDT= $P($G(^IBC N(365,RIEN ,1)),U,10) | |
| 6410 | "RTN","IBC NEHL6",23, 0) | |
| 6411 | ; | |
| 6412 | "RTN","IBC NEHL6",24, 0) | |
| 6413 | ; If an u nknown err or action or an erro r filing t he respons e message, | |
| 6414 | "RTN","IBC NEHL6",25, 0) | |
| 6415 | ; send a warning em ail messag e | |
| 6416 | "RTN","IBC NEHL6",26, 0) | |
| 6417 | ; Note - A call to UEACT will always se t ERFLAG=1 | |
| 6418 | "RTN","IBC NEHL6",27, 0) | |
| 6419 | ; | |
| 6420 | "RTN","IBC NEHL6",28, 0) | |
| 6421 | ; IB*2.0* 506 Remove d the foll owing line of code t o Treat al l AAA Acti on Codes | |
| 6422 | "RTN","IBC NEHL6",29, 0) | |
| 6423 | ; as thou gh the Pay er/FSC Res ponded. | |
| 6424 | "RTN","IBC NEHL6",30, 0) | |
| 6425 | ;I ",W,X, R,P,C,N,Y, S,"'[(","_ $G(ERACT)_ ",")&($G(E RACT)'="") !$D(ERROR) D UEACT^I BCNEHL3 | |
| 6426 | "RTN","IBC NEHL6",31, 0) | |
| 6427 | ; | |
| 6428 | "RTN","IBC NEHL6",32, 0) | |
| 6429 | ; If an e rror occur red, proce ssing comp lete | |
| 6430 | "RTN","IBC NEHL6",33, 0) | |
| 6431 | I $G(ERFL G)=1 Q | |
| 6432 | "RTN","IBC NEHL6",34, 0) | |
| 6433 | ; | |
| 6434 | "RTN","IBC NEHL6",35, 0) | |
| 6435 | ; For an original response, set the Tr ansmission Queue Sta tus to 'Re sponse Rec eived' & | |
| 6436 | "RTN","IBC NEHL6",36, 0) | |
| 6437 | ; update remaining retries t o comm fai lure (5) | |
| 6438 | "RTN","IBC NEHL6",37, 0) | |
| 6439 | I $G(RSTY PE)="O" D SST^IBCNEU T2(TQN,3), RSTA^IBCNE UT7(TQN) | |
| 6440 | "RTN","IBC NEHL6",38, 0) | |
| 6441 | ; | |
| 6442 | "RTN","IBC NEHL6",39, 0) | |
| 6443 | ; Update the TQ ser vice date to the dat e in the r esponse fi le | |
| 6444 | "RTN","IBC NEHL6",40, 0) | |
| 6445 | ; if they are diffe rent AND t he Error A ction <> | |
| 6446 | "RTN","IBC NEHL6",41, 0) | |
| 6447 | ; 'P' for 'Please s ubmit orig inal trans action' | |
| 6448 | "RTN","IBC NEHL6",42, 0) | |
| 6449 | ; | |
| 6450 | "RTN","IBC NEHL6",43, 0) | |
| 6451 | ; *** Tem porary cha nge to sup press upda te of serv ice & fres hness date s. | |
| 6452 | "RTN","IBC NEHL6",44, 0) | |
| 6453 | ; *** To reinstate, remove co mment (;) from next line. | |
| 6454 | "RTN","IBC NEHL6",45, 0) | |
| 6455 | ;I TQN'=" ",$G(RSTYP E)="O" D | |
| 6456 | "RTN","IBC NEHL6",46, 0) | |
| 6457 | ;. S TQSR VDT=$P($G( ^IBCN(365. 1,TQN,0)), U,12) | |
| 6458 | "RTN","IBC NEHL6",47, 0) | |
| 6459 | ;. I RSRV DT'="",TQS RVDT'=RSRV DT,$G(ERAC T)'="P" D SAVETQ^IBC NEUT2(TQN, RSRVDT) | |
| 6460 | "RTN","IBC NEHL6",48, 0) | |
| 6461 | ;. ; upda te freshne ss date by same delt a | |
| 6462 | "RTN","IBC NEHL6",49, 0) | |
| 6463 | ;. D SAVF RSH^IBCNEU T5(TQN,+$$ FMDIFF^XLF DT(RSRVDT, TQSRVDT,1) ) | |
| 6464 | "RTN","IBC NEHL6",50, 0) | |
| 6465 | ; | |
| 6466 | "RTN","IBC NEHL6",51, 0) | |
| 6467 | ; Check for error action | |
| 6468 | "RTN","IBC NEHL6",52, 0) | |
| 6469 | I $G(ERAC T)'=""!($G (ERTXT)'=" ") D G:'I BISMBI FIL X ; IB*2 *601/DM I f MBI resp onse keep processing | |
| 6470 | "RTN","IBC NEHL6",53, 0) | |
| 6471 | . S ERACT =$$ERRACT^ IBCNEHLU(R IEN),ERCON =$P(ERACT, U,2),ERACT =$P(ERACT, U) | |
| 6472 | "RTN","IBC NEHL6",54, 0) | |
| 6473 | . D ERROR ^IBCNEHL3( TQN,ERACT, ERCON,TRAC E) | |
| 6474 | "RTN","IBC NEHL6",55, 0) | |
| 6475 | ; | |
| 6476 | "RTN","IBC NEHL6",56, 0) | |
| 6477 | I EVENTYP =1 D PROCT RK^IBCNEHL 7(TRKIEN) Q ;IB*621 Process EICD Track ing file # 365.18 | |
| 6478 | "RTN","IBC NEHL6",57, 0) | |
| 6479 | ; | |
| 6480 | "RTN","IBC NEHL6",58, 0) | |
| 6481 | ; Stop pr ocessing i f identifi cation res ponse and not an act ive policy | |
| 6482 | "RTN","IBC NEHL6",59, 0) | |
| 6483 | S FILEIT= 1 | |
| 6484 | "RTN","IBC NEHL6",60, 0) | |
| 6485 | I $G(IIVS TAT)=6,TQN ]"" D | |
| 6486 | "RTN","IBC NEHL6",61, 0) | |
| 6487 | . I TQDAT A="" Q | |
| 6488 | "RTN","IBC NEHL6",62, 0) | |
| 6489 | . I IBQFL '="I" Q | |
| 6490 | "RTN","IBC NEHL6",63, 0) | |
| 6491 | . S FILEI T=0 | |
| 6492 | "RTN","IBC NEHL6",64, 0) | |
| 6493 | I 'FILEIT G FILX | |
| 6494 | "RTN","IBC NEHL6",65, 0) | |
| 6495 | ; | |
| 6496 | "RTN","IBC NEHL6",66, 0) | |
| 6497 | ; - | |
| 6498 | "RTN","IBC NEHL6",67, 0) | |
| 6499 | ; ** Very important : Variabl e 'CALLEDB Y' must be set for t his routin e so | |
| 6500 | "RTN","IBC NEHL6",68, 0) | |
| 6501 | ; that when a pa yer respon se is save d to the b uffer eith er as an | |
| 6502 | "RTN","IBC NEHL6",69, 0) | |
| 6503 | ; upda te to an e xisting bu ffer entry or as a n ew buffer entry a ne w | |
| 6504 | "RTN","IBC NEHL6",70, 0) | |
| 6505 | ; eIV inquiry is not autom atically t riggered a nd resent to the pay er again. | |
| 6506 | "RTN","IBC NEHL6",71, 0) | |
| 6507 | ; When certain f ields are changed in file #355 .33 a trig ger calls routine | |
| 6508 | "RTN","IBC NEHL6",72, 0) | |
| 6509 | ; ^IBC NERTQ whic h can crea te and sen d a new in quiry in r eal time t o the paye r. | |
| 6510 | "RTN","IBC NEHL6",73, 0) | |
| 6511 | ; We w ant this t o occur in all cases _EXCEPT_ when it is a payer r esponse. | |
| 6512 | "RTN","IBC NEHL6",74, 0) | |
| 6513 | ; Whic h means _E XCEPT_ whe n it is tr iggered as a result of this ro utine. | |
| 6514 | "RTN","IBC NEHL6",75, 0) | |
| 6515 | ; | |
| 6516 | "RTN","IBC NEHL6",76, 0) | |
| 6517 | S CALLEDB Y="IBCNEHL 1" | |
| 6518 | "RTN","IBC NEHL6",77, 0) | |
| 6519 | ; | |
| 6520 | "RTN","IBC NEHL6",78, 0) | |
| 6521 | ; If the re is an a ssociated buffer ent ry & one o r both of the follow ing | |
| 6522 | "RTN","IBC NEHL6",79, 0) | |
| 6523 | ; is tru e, stop fi ling (don' t update b uffer entr y) | |
| 6524 | "RTN","IBC NEHL6",80, 0) | |
| 6525 | ; 1) buf fer status is not 'E ntered' | |
| 6526 | "RTN","IBC NEHL6",81, 0) | |
| 6527 | ; 2) the buffer en try is ver ified (* s ymbol) | |
| 6528 | "RTN","IBC NEHL6",82, 0) | |
| 6529 | I BUFF'=" ",($P($G(^ IBA(355.33 ,BUFF,0)), U,4)'="E") !($$SYMBOL ^IBCNBLL(B UFF)="*") G FILX | |
| 6530 | "RTN","IBC NEHL6",83, 0) | |
| 6531 | ; | |
| 6532 | "RTN","IBC NEHL6",84, 0) | |
| 6533 | ; Set buf fer symbol based on value retu rned from EC | |
| 6534 | "RTN","IBC NEHL6",85, 0) | |
| 6535 | ; IB*2*60 1/DM | |
| 6536 | "RTN","IBC NEHL6",86, 0) | |
| 6537 | ;S SYMBOL =MAP(IIVST AT) | |
| 6538 | "RTN","IBC NEHL6",87, 0) | |
| 6539 | I 'IBISMB I S SYMBOL =MAP(IIVST AT) | |
| 6540 | "RTN","IBC NEHL6",88, 0) | |
| 6541 | ; if subs criber ID is populat ed set SYM BOL to '%' otherwise a '#' | |
| 6542 | "RTN","IBC NEHL6",89, 0) | |
| 6543 | I IBISMBI S SYMBOL= $S($$GET1^ DIQ(365,RI EN_",","SU BSCRIBER I D")'="":MA P("MBI%"), 1:MAP("MBI #")) | |
| 6544 | "RTN","IBC NEHL6",90, 0) | |
| 6545 | ; | |
| 6546 | "RTN","IBC NEHL6",91, 0) | |
| 6547 | ; If the re is an a ssociated buffer ent ry, update the buffe r entry w/ | |
| 6548 | "RTN","IBC NEHL6",92, 0) | |
| 6549 | ; respon se data | |
| 6550 | "RTN","IBC NEHL6",93, 0) | |
| 6551 | I BUFF'=" " D RP^IBC NEBF(RIEN, "",BUFF) | |
| 6552 | "RTN","IBC NEHL6",94, 0) | |
| 6553 | ; | |
| 6554 | "RTN","IBC NEHL6",95, 0) | |
| 6555 | ; If no associated buffer en try, creat e one & po pulate w/ response | |
| 6556 | "RTN","IBC NEHL6",96, 0) | |
| 6557 | ; data ( routine ca ll sets IB FDA) | |
| 6558 | "RTN","IBC NEHL6",97, 0) | |
| 6559 | I BUFF="" D RP^IBCN EBF(RIEN,1 ) S BUFF=+ IBFDA,UP(3 65,RIEN_", ",.04)=BUF F | |
| 6560 | "RTN","IBC NEHL6",98, 0) | |
| 6561 | ; | |
| 6562 | "RTN","IBC NEHL6",99, 0) | |
| 6563 | ; IB*2*60 1/DM for a n MBI quer y, set the patient r elationshi p to insur ed to "Pat ient" | |
| 6564 | "RTN","IBC NEHL6",100 ,0) | |
| 6565 | I IBISMBI S UP(355. 33,BUFF_", ",60.06)=" 01" | |
| 6566 | "RTN","IBC NEHL6",101 ,0) | |
| 6567 | ; | |
| 6568 | "RTN","IBC NEHL6",102 ,0) | |
| 6569 | ; Set eI V Processe d Date to now | |
| 6570 | "RTN","IBC NEHL6",103 ,0) | |
| 6571 | S UP(355. 33,BUFF_", ",.15)=$$N OW^XLFDT() | |
| 6572 | "RTN","IBC NEHL6",104 ,0) | |
| 6573 | D FILE^DI E("I","UP" ,"ERROR") | |
| 6574 | "RTN","IBC NEHL6",105 ,0) | |
| 6575 | FILX ; | |
| 6576 | "RTN","IBC NEHL6",106 ,0) | |
| 6577 | Q | |
| 6578 | "RTN","IBC NEHL6",107 ,0) | |
| 6579 | ; | |
| 6580 | "RTN","IBC NEHL7") | |
| 6581 | 0^18^B3394 7813^n/a | |
| 6582 | "RTN","IBC NEHL7",1,0 ) | |
| 6583 | IBCNEHL7 ; AITC/DM - HL7 Proces s Incoming 271 Messa ges Contin ued;05-MAY -2018 | |
| 6584 | "RTN","IBC NEHL7",2,0 ) | |
| 6585 | ;;2.0;INT EGRATED BI LLING;**62 1**;21-MAR -94;Build 8 | |
| 6586 | "RTN","IBC NEHL7",3,0 ) | |
| 6587 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 6588 | "RTN","IBC NEHL7",4,0 ) | |
| 6589 | ; | |
| 6590 | "RTN","IBC NEHL7",5,0 ) | |
| 6591 | ;This rou tine is us ed to proc ess EICD a ssociated entries. | |
| 6592 | "RTN","IBC NEHL7",6,0 ) | |
| 6593 | Q | |
| 6594 | "RTN","IBC NEHL7",7,0 ) | |
| 6595 | ; | |
| 6596 | "RTN","IBC NEHL7",8,0 ) | |
| 6597 | SVEICD() ; Save EICD Identific ation Data into the EIV EICD T RACKING (# 365.18) fi le. | |
| 6598 | "RTN","IBC NEHL7",9,0 ) | |
| 6599 | ; INPUT: IBTRACK a rray index ed by SETI D | |
| 6600 | "RTN","IBC NEHL7",10, 0) | |
| 6601 | ; RIEN Inte rnal Entry Number of the IIV R ESPONSE (# 365) File. | |
| 6602 | "RTN","IBC NEHL7",11, 0) | |
| 6603 | ; | |
| 6604 | "RTN","IBC NEHL7",12, 0) | |
| 6605 | N CNT,IEN S,RSUPDT,T QIEN,TRKIE N | |
| 6606 | "RTN","IBC NEHL7",13, 0) | |
| 6607 | S TQIEN=$ $GET1^DIQ( 365,RIEN_" ,",.05,"I" ) ;Transm ission Que ue IEN | |
| 6608 | "RTN","IBC NEHL7",14, 0) | |
| 6609 | S TRKIEN= $O(^IBCN(3 65.18,"B", TQIEN,"")) ,IENS=TRKI EN_"," | |
| 6610 | "RTN","IBC NEHL7",15, 0) | |
| 6611 | S RSUPDT( 365.18,IEN S,.04)=IBT RACK(0,.04 ) | |
| 6612 | "RTN","IBC NEHL7",16, 0) | |
| 6613 | S RSUPDT( 365.18,IEN S,.06)=IBT RACK(0,.06 ) | |
| 6614 | "RTN","IBC NEHL7",17, 0) | |
| 6615 | S RSUPDT( 365.18,IEN S,.07)=IBT RACK(0,.07 ) | |
| 6616 | "RTN","IBC NEHL7",18, 0) | |
| 6617 | D FILE^DI E("","RSUP DT","ERROR ") | |
| 6618 | "RTN","IBC NEHL7",19, 0) | |
| 6619 | S CNT=0 F S CNT=$O (IBTRACK(C NT)) Q:'CN T D | |
| 6620 | "RTN","IBC NEHL7",20, 0) | |
| 6621 | . N IENS, RSUPDT,RSU PDT9IEN | |
| 6622 | "RTN","IBC NEHL7",21, 0) | |
| 6623 | . S IENS= "+"_CNT_", "_TRKIEN_" ," | |
| 6624 | "RTN","IBC NEHL7",22, 0) | |
| 6625 | . S RSUPD T(365.185, IENS,.01)= $G(IBTRACK (CNT,.01)) | |
| 6626 | "RTN","IBC NEHL7",23, 0) | |
| 6627 | . S RSUPD T(365.185, IENS,.02)= $G(IBTRACK (CNT,.02)) | |
| 6628 | "RTN","IBC NEHL7",24, 0) | |
| 6629 | . S RSUPD T(365.185, IENS,.03)= $G(IBTRACK (CNT,.03)) | |
| 6630 | "RTN","IBC NEHL7",25, 0) | |
| 6631 | . S RSUPD T(365.185, IENS,.04)= $G(IBTRACK (CNT,.04)) | |
| 6632 | "RTN","IBC NEHL7",26, 0) | |
| 6633 | . S RSUPD T(365.185, IENS,.05)= $G(IBTRACK (CNT,.05)) | |
| 6634 | "RTN","IBC NEHL7",27, 0) | |
| 6635 | . S RSUPD T(365.185, IENS,.06)= $G(IBTRACK (CNT,.06)) | |
| 6636 | "RTN","IBC NEHL7",28, 0) | |
| 6637 | . S RSUPD T(365.185, IENS,.07)= $G(IBTRACK (CNT,.07)) | |
| 6638 | "RTN","IBC NEHL7",29, 0) | |
| 6639 | . S RSUPD T(365.185, IENS,.08)= $G(IBTRACK (CNT,.08)) | |
| 6640 | "RTN","IBC NEHL7",30, 0) | |
| 6641 | . S RSUPD T(365.185, IENS,.09)= $G(IBTRACK (CNT,.09)) | |
| 6642 | "RTN","IBC NEHL7",31, 0) | |
| 6643 | . S RSUPD T(365.185, IENS,.1)=$ G(IBTRACK( CNT,.1)) | |
| 6644 | "RTN","IBC NEHL7",32, 0) | |
| 6645 | . S RSUPD T(365.185, IENS,.11)= $G(IBTRACK (CNT,.11)) | |
| 6646 | "RTN","IBC NEHL7",33, 0) | |
| 6647 | . S RSUPD T(365.185, IENS,.12)= $G(IBTRACK (CNT,.12)) | |
| 6648 | "RTN","IBC NEHL7",34, 0) | |
| 6649 | . S RSUPD T(365.185, IENS,.13)= $G(IBTRACK (CNT,.13)) | |
| 6650 | "RTN","IBC NEHL7",35, 0) | |
| 6651 | . S RSUPD T(365.185, IENS,.14)= $G(IBTRACK (CNT,.14)) | |
| 6652 | "RTN","IBC NEHL7",36, 0) | |
| 6653 | . S RSUPD T(365.185, IENS,.15)= +$G(IBTRAC K(CNT,.15) ) | |
| 6654 | "RTN","IBC NEHL7",37, 0) | |
| 6655 | . D UPDAT E^DIE(""," RSUPDT","R SUPIEN","E RROR") | |
| 6656 | "RTN","IBC NEHL7",38, 0) | |
| 6657 | SVEICDQ ; | |
| 6658 | "RTN","IBC NEHL7",39, 0) | |
| 6659 | Q TRKIEN | |
| 6660 | "RTN","IBC NEHL7",40, 0) | |
| 6661 | ; | |
| 6662 | "RTN","IBC NEHL7",41, 0) | |
| 6663 | PROCTRK(TR KIEN) ; Pr ocess the EICD Track ing File e ntries. | |
| 6664 | "RTN","IBC NEHL7",42, 0) | |
| 6665 | ; TRKIEN = EIV EICD TRACKING Identifica tion IEN | |
| 6666 | "RTN","IBC NEHL7",43, 0) | |
| 6667 | ; | |
| 6668 | "RTN","IBC NEHL7",44, 0) | |
| 6669 | N DATA1,D ATA2,DATA5 ,IBBUF,IBB UFIEN,IBCS IEN,IBDFN, IBERR,IBFD A,IBFMIEN | |
| 6670 | "RTN","IBC NEHL7",45, 0) | |
| 6671 | N IBFRESH ,IBIDIEN,I BINSDTA,IB MSG,IBPYRI EN,IBPYROK ,IBSUBID,I BTQIEN,IBT QSTAT | |
| 6672 | "RTN","IBC NEHL7",46, 0) | |
| 6673 | ; | |
| 6674 | "RTN","IBC NEHL7",47, 0) | |
| 6675 | S IBFRESH =$$FMADD^X LFDT(DT,-( $$GET1^DIQ (350.9,"1, ",51.01,"I "))) ; DT - "FRESHNE SS DAYS" | |
| 6676 | "RTN","IBC NEHL7",48, 0) | |
| 6677 | S IBTQSTA T=$$FIND1^ DIC(365.14 ,,,"Ready to Transmi t","B") | |
| 6678 | "RTN","IBC NEHL7",49, 0) | |
| 6679 | S IBCSIEN =$$FIND1^D IC(355.12, ,"X","CONT RACT SERVI CES","C") | |
| 6680 | "RTN","IBC NEHL7",50, 0) | |
| 6681 | S IBDFN=$ $GET1^DIQ( 365.18,TRK IEN_",",.0 5,"I") ; " EICD PATIE NT" | |
| 6682 | "RTN","IBC NEHL7",51, 0) | |
| 6683 | ; loop th rough any discovered insurance creating TQ/Buffer/ Tracking e ntries | |
| 6684 | "RTN","IBC NEHL7",52, 0) | |
| 6685 | S IBIDIEN =0 F S IB IDIEN=$O(^ IBCN(365.1 8,TRKIEN," INS-FND",I BIDIEN)) Q :'IBIDIEN D | |
| 6686 | "RTN","IBC NEHL7",53, 0) | |
| 6687 | . S IBFMI EN=IBIDIEN _","_TRKIE N_"," | |
| 6688 | "RTN","IBC NEHL7",54, 0) | |
| 6689 | . K IBINS DTA D GETS ^DIQ(365.1 85,IBFMIEN ,"*",,"IBI NSDTA") ; grab selec ted fields (external ) | |
| 6690 | "RTN","IBC NEHL7",55, 0) | |
| 6691 | . Q:'$D(I BINSDTA) ; no data | |
| 6692 | "RTN","IBC NEHL7",56, 0) | |
| 6693 | . ; see i f PAYER VA ID is on file and a ctive | |
| 6694 | "RTN","IBC NEHL7",57, 0) | |
| 6695 | . S IBPYR IEN=0,IBPY ROK=1 | |
| 6696 | "RTN","IBC NEHL7",58, 0) | |
| 6697 | . S:IBINS DTA(365.18 5,IBFMIEN, .01)="UNKN OWN" IBPYR OK=0 | |
| 6698 | "RTN","IBC NEHL7",59, 0) | |
| 6699 | . S:IBPYR OK IBPYRIE N=$$FIND1^ DIC(365.12 ,,"X",IBIN SDTA(365.1 85,IBFMIEN ,.01),"C") | |
| 6700 | "RTN","IBC NEHL7",60, 0) | |
| 6701 | . S:'IBPY RIEN IBPYR OK=0 | |
| 6702 | "RTN","IBC NEHL7",61, 0) | |
| 6703 | . I IBPYR OK,'($$GET 1^DIQ(365. 121,"1,"_I BPYRIEN_", ",.02,"I") ) S IBPYRO K=0 ; "NA TIONAL ACT IVE" | |
| 6704 | "RTN","IBC NEHL7",62, 0) | |
| 6705 | . I IBPYR OK,'($$GET 1^DIQ(365. 121,"1,"_I BPYRIEN_", ",.03,"I") ) S IBPYRO K=0 ; "LO CAL ACTIVE " | |
| 6706 | "RTN","IBC NEHL7",63, 0) | |
| 6707 | . I IBPYR OK D Q | |
| 6708 | "RTN","IBC NEHL7",64, 0) | |
| 6709 | .. S IBSU BID=IBINSD TA(365.185 ,IBFMIEN,. 04) ; SUB SCRIBER ID | |
| 6710 | "RTN","IBC NEHL7",65, 0) | |
| 6711 | .. S:IBSU BID="" IBS UBID=IBINS DTA(365.18 5,IBFMIEN, .05) ; MEM BER ID | |
| 6712 | "RTN","IBC NEHL7",66, 0) | |
| 6713 | .. ; SET prepare an d file the TQ | |
| 6714 | "RTN","IBC NEHL7",67, 0) | |
| 6715 | .. ; IBDF N:Patient IEN | |
| 6716 | "RTN","IBC NEHL7",68, 0) | |
| 6717 | .. ; IBPY RIEN:Payer IEN | |
| 6718 | "RTN","IBC NEHL7",69, 0) | |
| 6719 | .. ; IBTQ STAT:TQ ST ATUS IEN - Ready to Transmit | |
| 6720 | "RTN","IBC NEHL7",70, 0) | |
| 6721 | .. ; IBSU BID:SUBSCR IBER ID (m ay be MEMB ERID) | |
| 6722 | "RTN","IBC NEHL7",71, 0) | |
| 6723 | .. ; IBFR ESH:Freshn ess date | |
| 6724 | "RTN","IBC NEHL7",72, 0) | |
| 6725 | .. ; IBIN SDTA(365.1 85,IBFMIEN ,.05):MEMB ER ID | |
| 6726 | "RTN","IBC NEHL7",73, 0) | |
| 6727 | .. ; 4:EI CD data ex tract (#4) | |
| 6728 | "RTN","IBC NEHL7",74, 0) | |
| 6729 | .. ; V:Ve rification | |
| 6730 | "RTN","IBC NEHL7",75, 0) | |
| 6731 | .. ; DT:T odays date | |
| 6732 | "RTN","IBC NEHL7",76, 0) | |
| 6733 | .. ; IBCS IEN:Source of Inform ation IEN - Contract Services | |
| 6734 | "RTN","IBC NEHL7",77, 0) | |
| 6735 | .. ; IBID IEN:IEN of the INS-F ND multipl e (discove red insura nce) in #3 65.185 | |
| 6736 | "RTN","IBC NEHL7",78, 0) | |
| 6737 | .. S DATA 1=IBDFN_U_ IBPYRIEN_U _IBTQSTAT_ U_""_U_IBS UBID_U_IBF RESH_U_""_ U_IBINSDTA (365.185,I BFMIEN,.05 ) | |
| 6738 | "RTN","IBC NEHL7",79, 0) | |
| 6739 | .. S DATA 2=4_U_"V"_ U_DT | |
| 6740 | "RTN","IBC NEHL7",80, 0) | |
| 6741 | .. S DATA 5=IBCSIEN_ U_IBIDIEN | |
| 6742 | "RTN","IBC NEHL7",81, 0) | |
| 6743 | .. S IBTQ IEN=$$SETT Q^IBCNEDE7 (DATA1,DAT A2,,,DATA5 ) ; Sets i n TQ | |
| 6744 | "RTN","IBC NEHL7",82, 0) | |
| 6745 | .. I IBTQ IEN="" Q ; didn't f ile | |
| 6746 | "RTN","IBC NEHL7",83, 0) | |
| 6747 | .. ; upda te the EIV EICD TRAC KING (#365 .185) | |
| 6748 | "RTN","IBC NEHL7",84, 0) | |
| 6749 | .. K IBFD A,IBERR | |
| 6750 | "RTN","IBC NEHL7",85, 0) | |
| 6751 | .. S IBFD A(365.185, IBFMIEN,1. 01)=IBTQIE N ; EICD V ER INQ TRA NSMISSION | |
| 6752 | "RTN","IBC NEHL7",86, 0) | |
| 6753 | .. S IBFD A(365.185, IBFMIEN,1. 02)=DT ; EICD V ER INQ DAT E CREATED | |
| 6754 | "RTN","IBC NEHL7",87, 0) | |
| 6755 | .. D FILE ^DIE(,"IBF DA","IBERR ") | |
| 6756 | "RTN","IBC NEHL7",88, 0) | |
| 6757 | .. I $G(I BERR("DIER R",1,"TEXT ",1))'="" D Q | |
| 6758 | "RTN","IBC NEHL7",89, 0) | |
| 6759 | ... S IBM SG="" | |
| 6760 | "RTN","IBC NEHL7",90, 0) | |
| 6761 | ... D MSG 002^IBCNEM S1(.IBMSG, .IBERR,IBT QIEN) | |
| 6762 | "RTN","IBC NEHL7",91, 0) | |
| 6763 | ... D MSG ^IBCNEUT5( $$MGRP^IBC NEUT5(),"e IV Problem : Error up dating EIV EICD TRAC KING (#365 .185)","IB MSG(") | |
| 6764 | "RTN","IBC NEHL7",92, 0) | |
| 6765 | .. ;Load and Send t he HL7 Mes sage | |
| 6766 | "RTN","IBC NEHL7",93, 0) | |
| 6767 | .. S DATA 1=$$PROCSE ND^IBCNERT Q(IBTQIEN) | |
| 6768 | "RTN","IBC NEHL7",94, 0) | |
| 6769 | .. K ^TMP ("DIERR",$ J) ; safet y, cleanup | |
| 6770 | "RTN","IBC NEHL7",95, 0) | |
| 6771 | .. Q ; n ext insura nce discov ery | |
| 6772 | "RTN","IBC NEHL7",96, 0) | |
| 6773 | . ; Payer had issue s, place a n entry in the buffe r for manu al process ing | |
| 6774 | "RTN","IBC NEHL7",97, 0) | |
| 6775 | . D | |
| 6776 | "RTN","IBC NEHL7",98, 0) | |
| 6777 | .. ; we'r e forcing a new bloc k so we ca n redefine DUZ safel y | |
| 6778 | "RTN","IBC NEHL7",99, 0) | |
| 6779 | .. N DUZ | |
| 6780 | "RTN","IBC NEHL7",100 ,0) | |
| 6781 | .. S DUZ= $$FIND1^DI C(200,,,"I NTERFACE,I B EIV","B" ) | |
| 6782 | "RTN","IBC NEHL7",101 ,0) | |
| 6783 | .. K IBBU F | |
| 6784 | "RTN","IBC NEHL7",102 ,0) | |
| 6785 | .. ; Pati ent fields , name, do b and ssn will be po pulated au tomaticall y | |
| 6786 | "RTN","IBC NEHL7",103 ,0) | |
| 6787 | .. S IBBU F(.02)=DUZ ; entere d By | |
| 6788 | "RTN","IBC NEHL7",104 ,0) | |
| 6789 | .. S IBBU F(.12)="" ; settin g to Null for the Bu ffer Symbo l | |
| 6790 | "RTN","IBC NEHL7",105 ,0) | |
| 6791 | .. S IBBU F(.18)=$$F MTE^XLFDT( DT) ; Serv ice Date | |
| 6792 | "RTN","IBC NEHL7",106 ,0) | |
| 6793 | .. S IBBU F(20.01)=I BINSDTA(36 5.185,IBFM IEN,.02) ; PAYER NAM E, used to populate INSURANCE COMPANY NA ME | |
| 6794 | "RTN","IBC NEHL7",107 ,0) | |
| 6795 | .. S IBBU F(60.01)=I BDFN ; Pat ient IEN | |
| 6796 | "RTN","IBC NEHL7",108 ,0) | |
| 6797 | .. S IBBU F(60.06)=$ S(IBINSDTA (365.185,I BFMIEN,.15 )="Y":"",1 :"PATIENT" ) ; Patien t relation ship to In sured | |
| 6798 | "RTN","IBC NEHL7",109 ,0) | |
| 6799 | .. S IBBU F(60.08)=I BINSDTA(36 5.185,IBFM IEN,.07) ; INSURED D OB | |
| 6800 | "RTN","IBC NEHL7",110 ,0) | |
| 6801 | .. S IBBU F(60.13)=I BINSDTA(36 5.185,IBFM IEN,.08) ; INSURED S EX | |
| 6802 | "RTN","IBC NEHL7",111 ,0) | |
| 6803 | .. S IBBU F(62.01)=I BINSDTA(36 5.185,IBFM IEN,.05) ; MEMBER/PA TIENT ID | |
| 6804 | "RTN","IBC NEHL7",112 ,0) | |
| 6805 | .. S IBBU F(80.01)=$ $GET1^DIQ( 350.9,"1," ,60.01,"E" ) ; DEFAU LT SERVICE TYPE CODE 1 | |
| 6806 | "RTN","IBC NEHL7",113 ,0) | |
| 6807 | .. S IBBU F(90.02)=I BINSDTA(36 5.185,IBFM IEN,.03) ; GROUP NUM BER | |
| 6808 | "RTN","IBC NEHL7",114 ,0) | |
| 6809 | .. S IBBU F(90.03)=I BINSDTA(36 5.185,IBFM IEN,.04) ; SUBSCRIBE R ID | |
| 6810 | "RTN","IBC NEHL7",115 ,0) | |
| 6811 | .. ; the following call in-tu rn, calls EDITSTF^IB CNBES whic h will mak e sure to file subsc riber ID l ast, autom atically | |
| 6812 | "RTN","IBC NEHL7",116 ,0) | |
| 6813 | .. S IBBU FIEN=$$ADD STF^IBCNBE S(IBCSIEN, IBDFN,.IBB UF) | |
| 6814 | "RTN","IBC NEHL7",117 ,0) | |
| 6815 | . Q ; ne xt insuran ce discove ry | |
| 6816 | "RTN","IBC NEHL7",118 ,0) | |
| 6817 | ; | |
| 6818 | "RTN","IBC NEHL7",119 ,0) | |
| 6819 | Q | |
| 6820 | "RTN","IBC NEHL7",120 ,0) | |
| 6821 | ; | |
| 6822 | "RTN","IBC NEHLI") | |
| 6823 | 0^19^B1118 3366^B8125 280 | |
| 6824 | "RTN","IBC NEHLI",1,0 ) | |
| 6825 | IBCNEHLI ; DAOU/ALA - Incoming HL7 messag es ;16-JUN -2002 | |
| 6826 | "RTN","IBC NEHLI",2,0 ) | |
| 6827 | ;;2.0;INT EGRATED BI LLING;**18 4,252,251, 271,300,41 6,550,601, 621**;21-M AR-94;Buil d 8 | |
| 6828 | "RTN","IBC NEHLI",3,0 ) | |
| 6829 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 6830 | "RTN","IBC NEHLI",4,0 ) | |
| 6831 | ; | |
| 6832 | "RTN","IBC NEHLI",5,0 ) | |
| 6833 | ;**Progra m Descript ion** | |
| 6834 | "RTN","IBC NEHLI",6,0 ) | |
| 6835 | ; This p rogram par ses each i ncoming HL 7 message. | |
| 6836 | "RTN","IBC NEHLI",7,0 ) | |
| 6837 | ; | |
| 6838 | "RTN","IBC NEHLI",8,0 ) | |
| 6839 | EN ; Star ting point - put mes sage into a TMP glob al | |
| 6840 | "RTN","IBC NEHLI",9,0 ) | |
| 6841 | ; | |
| 6842 | "RTN","IBC NEHLI",10, 0) | |
| 6843 | N ACK,BUF F,DFN,ERAC T,ERCON,ER FLG,ERTXT, EVENT,HCT, HLECH,HLEI D | |
| 6844 | "RTN","IBC NEHLI",11, 0) | |
| 6845 | N HLEIDS, HLFS,HLQ,I BPRTCL,IDU Z,MGRP,MSG ID,RDAT0,R IEN,SBDEP, SEG | |
| 6846 | "RTN","IBC NEHLI",12, 0) | |
| 6847 | N SEGMT,S EGMT2,TAG, TQN,TRACE, VRFDT,DISY S,IPCT,PAY RID,PIEN,C NT | |
| 6848 | "RTN","IBC NEHLI",13, 0) | |
| 6849 | N ERROR,I RIEN,RSTYP E,SUBID,TQ IEN | |
| 6850 | "RTN","IBC NEHLI",14, 0) | |
| 6851 | N DA,EBDA ,IBFDA,II, MSGP,SYMBO L,IBSEG,PP ,PRIEN,QFL ,IBIEN,TQD ATA,IBQFL | |
| 6852 | "RTN","IBC NEHLI",15, 0) | |
| 6853 | N DATAMFK ,EPHARM | |
| 6854 | "RTN","IBC NEHLI",16, 0) | |
| 6855 | ; | |
| 6856 | "RTN","IBC NEHLI",17, 0) | |
| 6857 | K ^TMP($J ,"IBCNEHLI ") | |
| 6858 | "RTN","IBC NEHLI",18, 0) | |
| 6859 | F SEGCNT= 1:1 X HLNE XT Q:HLQUI T'>0 D | |
| 6860 | "RTN","IBC NEHLI",19, 0) | |
| 6861 | . S CNT=0 | |
| 6862 | "RTN","IBC NEHLI",20, 0) | |
| 6863 | . S ^TMP( $J,"IBCNEH LI",SEGCNT ,CNT)=HLNO DE | |
| 6864 | "RTN","IBC NEHLI",21, 0) | |
| 6865 | . F S CN T=$O(HLNOD E(CNT)) Q: 'CNT D | |
| 6866 | "RTN","IBC NEHLI",22, 0) | |
| 6867 | .. S ^TMP ($J,"IBCNE HLI",SEGCN T,CNT)=HLN ODE(CNT) | |
| 6868 | "RTN","IBC NEHLI",23, 0) | |
| 6869 | ; | |
| 6870 | "RTN","IBC NEHLI",24, 0) | |
| 6871 | ; Get th e eIV user | |
| 6872 | "RTN","IBC NEHLI",25, 0) | |
| 6873 | S IDUZ=$$ FIND1^DIC( 200,"","X" ,"INTERFAC E,IB EIV") | |
| 6874 | "RTN","IBC NEHLI",26, 0) | |
| 6875 | ; Deter mine which protocol to use | |
| 6876 | "RTN","IBC NEHLI",27, 0) | |
| 6877 | S SEGMT=$ G(^TMP($J, "IBCNEHLI" ,1,0)) | |
| 6878 | "RTN","IBC NEHLI",28, 0) | |
| 6879 | I $E(SEGM T,1,3)'="M SH" D D E RR Q | |
| 6880 | "RTN","IBC NEHLI",29, 0) | |
| 6881 | . S MSG(1 )="MSH Seg ment is no t the firs t segment found" | |
| 6882 | "RTN","IBC NEHLI",30, 0) | |
| 6883 | . S MSG(2 )="Please call the H elp Desk a nd report this probl em." | |
| 6884 | "RTN","IBC NEHLI",31, 0) | |
| 6885 | S HLFS=$E (SEGMT,4) | |
| 6886 | "RTN","IBC NEHLI",32, 0) | |
| 6887 | S EVENT=$ P(SEGMT,HL FS,9),IBPR TCL="" | |
| 6888 | "RTN","IBC NEHLI",33, 0) | |
| 6889 | ; | |
| 6890 | "RTN","IBC NEHLI",34, 0) | |
| 6891 | ; The ev ent type d etermines protocol | |
| 6892 | "RTN","IBC NEHLI",35, 0) | |
| 6893 | ; IB*2.0* 601 - Adde d logic fo r MFN^M01 event | |
| 6894 | "RTN","IBC NEHLI",36, 0) | |
| 6895 | I EVENT=" MFN^M01" S TAG="TBL" ,IBPRTCL=" IBCNE IIV MFN IN" | |
| 6896 | "RTN","IBC NEHLI",37, 0) | |
| 6897 | I EVENT=" RPI^I01" S TAG="RSP" ,IBPRTCL=" IBCNE IIV IN" I '$$H L7VAL G XI T | |
| 6898 | "RTN","IBC NEHLI",38, 0) | |
| 6899 | I EVENT=" MFK^M01" S TAG="ACK" ,IBPRTCL=" IBCNE IIV REGISTER" | |
| 6900 | "RTN","IBC NEHLI",39, 0) | |
| 6901 | ;IB*2.0*6 21/TAZ - A dded new e vent | |
| 6902 | "RTN","IBC NEHLI",40, 0) | |
| 6903 | I EVENT=" RPI^I04" S TAG="EICD ",IBPRTCL= "IBCNE EIV RPI IN" | |
| 6904 | "RTN","IBC NEHLI",41, 0) | |
| 6905 | I IBPRTCL ="" S MSG( 1)="Unable to find a protocol for Event = "_EVENT D ERR G XI T | |
| 6906 | "RTN","IBC NEHLI",42, 0) | |
| 6907 | ; | |
| 6908 | "RTN","IBC NEHLI",43, 0) | |
| 6909 | ; Initia lize the H L7 variabl es | |
| 6910 | "RTN","IBC NEHLI",44, 0) | |
| 6911 | D INIT^HL FNC2(IBPRT CL,.HL) | |
| 6912 | "RTN","IBC NEHLI",45, 0) | |
| 6913 | ; | |
| 6914 | "RTN","IBC NEHLI",46, 0) | |
| 6915 | ; Call t he event t ag | |
| 6916 | "RTN","IBC NEHLI",47, 0) | |
| 6917 | D @TAG | |
| 6918 | "RTN","IBC NEHLI",48, 0) | |
| 6919 | ; | |
| 6920 | "RTN","IBC NEHLI",49, 0) | |
| 6921 | XIT K ^TMP ($J,"IBCNE HLI"),HL,H LNEXT,HLNO DE,HLQUIT, SEGCNT,EVE NTYP | |
| 6922 | "RTN","IBC NEHLI",50, 0) | |
| 6923 | Q | |
| 6924 | "RTN","IBC NEHLI",51, 0) | |
| 6925 | ; | |
| 6926 | "RTN","IBC NEHLI",52, 0) | |
| 6927 | TBL ; Tab le Update Processing | |
| 6928 | "RTN","IBC NEHLI",53, 0) | |
| 6929 | N IBACK | |
| 6930 | "RTN","IBC NEHLI",54, 0) | |
| 6931 | S IBACK=" AE" | |
| 6932 | "RTN","IBC NEHLI",55, 0) | |
| 6933 | D ^IBCNEH LT | |
| 6934 | "RTN","IBC NEHLI",56, 0) | |
| 6935 | ; | |
| 6936 | "RTN","IBC NEHLI",57, 0) | |
| 6937 | I ERFLG D ERR | |
| 6938 | "RTN","IBC NEHLI",58, 0) | |
| 6939 | K ERFLG | |
| 6940 | "RTN","IBC NEHLI",59, 0) | |
| 6941 | ; | |
| 6942 | "RTN","IBC NEHLI",60, 0) | |
| 6943 | D ACK^IBC NEHLK | |
| 6944 | "RTN","IBC NEHLI",61, 0) | |
| 6945 | Q | |
| 6946 | "RTN","IBC NEHLI",62, 0) | |
| 6947 | ; | |
| 6948 | "RTN","IBC NEHLI",63, 0) | |
| 6949 | RSP ; Res ponse Proc essing | |
| 6950 | "RTN","IBC NEHLI",64, 0) | |
| 6951 | D EN^IBCN EHL1(2) ;I B*2.0*621 Added Para meter | |
| 6952 | "RTN","IBC NEHLI",65, 0) | |
| 6953 | ; | |
| 6954 | "RTN","IBC NEHLI",66, 0) | |
| 6955 | K ACK,BUF F,DFN,ERAC T,ERCON,ER FLG,ERTXT, EVENT,HCT, HL,HLECH,H LEID | |
| 6956 | "RTN","IBC NEHLI",67, 0) | |
| 6957 | K HLEIDS, HLFS,HLQ,I BPRTCL,IDU Z,MGRP,MSG ID,RDAT0,R IEN,SBDEP, SEG | |
| 6958 | "RTN","IBC NEHLI",68, 0) | |
| 6959 | K SEGMT,S EGMT2,TAG, TQN,TRACE, VRFDT,DISY S,IPCT,PAY RID,PIEN | |
| 6960 | "RTN","IBC NEHLI",69, 0) | |
| 6961 | K ERROR,I RIEN,RSTYP E,SUBID,TQ IEN | |
| 6962 | "RTN","IBC NEHLI",70, 0) | |
| 6963 | K DA,EBDA ,IBFDA,II, MSGP,SYMBO L,IBSEG,PP ,PRIEN,QFL | |
| 6964 | "RTN","IBC NEHLI",71, 0) | |
| 6965 | Q | |
| 6966 | "RTN","IBC NEHLI",72, 0) | |
| 6967 | ; | |
| 6968 | "RTN","IBC NEHLI",73, 0) | |
| 6969 | ;IB*2.0*6 21/TAZ - A dded secti on to proc ess the EI CD Inquiry Response. | |
| 6970 | "RTN","IBC NEHLI",74, 0) | |
| 6971 | EICD ; Ins urance Dis covery Inq uiry Respo nse. | |
| 6972 | "RTN","IBC NEHLI",75, 0) | |
| 6973 | D EN^IBCN EHL1(1) | |
| 6974 | "RTN","IBC NEHLI",76, 0) | |
| 6975 | ; | |
| 6976 | "RTN","IBC NEHLI",77, 0) | |
| 6977 | K ACK,BUF F,DFN,ERAC T,ERCON,ER FLG,ERTXT, EVENT,HCT, HL,HLECH,H LEID | |
| 6978 | "RTN","IBC NEHLI",78, 0) | |
| 6979 | K HLEIDS, HLFS,HLQ,I BPRTCL,IDU Z,MGRP,MSG ID,RDAT0,R IEN,SBDEP, SEG | |
| 6980 | "RTN","IBC NEHLI",79, 0) | |
| 6981 | K SEGMT,S EGMT2,TAG, TQN,TRACE, VRFDT,DISY S,IPCT,PAY RID,PIEN | |
| 6982 | "RTN","IBC NEHLI",80, 0) | |
| 6983 | K ERROR,I RIEN,RSTYP E,SUBID,TQ IEN | |
| 6984 | "RTN","IBC NEHLI",81, 0) | |
| 6985 | K DA,EBDA ,IBFDA,II, MSGP,SYMBO L,IBSEG,PP ,PRIEN,QFL ,IBTRACK,T RKIEN | |
| 6986 | "RTN","IBC NEHLI",82, 0) | |
| 6987 | Q | |
| 6988 | "RTN","IBC NEHLI",83, 0) | |
| 6989 | ; | |
| 6990 | "RTN","IBC NEHLI",84, 0) | |
| 6991 | ACK ; Ack nowledgeme nt Process ing | |
| 6992 | "RTN","IBC NEHLI",85, 0) | |
| 6993 | D ^IBCNEH LK | |
| 6994 | "RTN","IBC NEHLI",86, 0) | |
| 6995 | ; | |
| 6996 | "RTN","IBC NEHLI",87, 0) | |
| 6997 | Q | |
| 6998 | "RTN","IBC NEHLI",88, 0) | |
| 6999 | ; | |
| 7000 | "RTN","IBC NEHLI",89, 0) | |
| 7001 | ERR ; Proc ess an err or | |
| 7002 | "RTN","IBC NEHLI",90, 0) | |
| 7003 | S MGRP=$$ MGRP^IBCNE UT5() | |
| 7004 | "RTN","IBC NEHLI",91, 0) | |
| 7005 | D MSG^IBC NEUT5(MGRP ,"INCOMING eIV HL7 P ROBLEM","M SG(") | |
| 7006 | "RTN","IBC NEHLI",92, 0) | |
| 7007 | K MSG,MGR P | |
| 7008 | "RTN","IBC NEHLI",93, 0) | |
| 7009 | Q | |
| 7010 | "RTN","IBC NEHLI",94, 0) | |
| 7011 | ; | |
| 7012 | "RTN","IBC NEHLI",95, 0) | |
| 7013 | HL7VAL() ; Check for valid pos t 300 resp onse | |
| 7014 | "RTN","IBC NEHLI",96, 0) | |
| 7015 | N X,HCT | |
| 7016 | "RTN","IBC NEHLI",97, 0) | |
| 7017 | S X=0,HCT =0 | |
| 7018 | "RTN","IBC NEHLI",98, 0) | |
| 7019 | F S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT="" D SPAR^IBCNE HLU I $G(I BSEG(1))=" PRD" S X=1 Q | |
| 7020 | "RTN","IBC NEHLI",99, 0) | |
| 7021 | Q X | |
| 7022 | "RTN","IBC NEHLM") | |
| 7023 | 0^7^B24096 430^B23949 973 | |
| 7024 | "RTN","IBC NEHLM",1,0 ) | |
| 7025 | IBCNEHLM ; DAOU/ALA - HL7 Regis tration MF N Message ;02-JUN-20 15 | |
| 7026 | "RTN","IBC NEHLM",2,0 ) | |
| 7027 | ;;2.0;INT EGRATED BI LLING;**18 4,251,300, 416,438,49 7,506,549, 601,621**; 21-MAR-94; Build 8 | |
| 7028 | "RTN","IBC NEHLM",3,0 ) | |
| 7029 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 7030 | "RTN","IBC NEHLM",4,0 ) | |
| 7031 | ; | |
| 7032 | "RTN","IBC NEHLM",5,0 ) | |
| 7033 | ;**Progra m Descript ion** | |
| 7034 | "RTN","IBC NEHLM",6,0 ) | |
| 7035 | ; This p rogram wil l process the outgoi ng registr ation MFN message | |
| 7036 | "RTN","IBC NEHLM",7,0 ) | |
| 7037 | ; | |
| 7038 | "RTN","IBC NEHLM",8,0 ) | |
| 7039 | ; Variab les | |
| 7040 | "RTN","IBC NEHLM",9,0 ) | |
| 7041 | ; MCT = Lines of MailMan m essage cou nter | |
| 7042 | "RTN","IBC NEHLM",10, 0) | |
| 7043 | ; QFL = Quit fla g | |
| 7044 | "RTN","IBC NEHLM",11, 0) | |
| 7045 | ; HL* = HL7 pack age specif ic variabl es | |
| 7046 | "RTN","IBC NEHLM",12, 0) | |
| 7047 | ; TAXI D = Tax ID | |
| 7048 | "RTN","IBC NEHLM",13, 0) | |
| 7049 | ; CNTC PH = Conta ct Phone | |
| 7050 | "RTN","IBC NEHLM",14, 0) | |
| 7051 | ; CNTC EM = Conta ct Email | |
| 7052 | "RTN","IBC NEHLM",15, 0) | |
| 7053 | ; FRSH = Freshne ss Days | |
| 7054 | "RTN","IBC NEHLM",16, 0) | |
| 7055 | ; MGRP = Mailgro up to emai l messages to | |
| 7056 | "RTN","IBC NEHLM",17, 0) | |
| 7057 | ; INAC T = Inacti ve Insuran ce Flag | |
| 7058 | "RTN","IBC NEHLM",18, 0) | |
| 7059 | ; APP = Applicat ion | |
| 7060 | "RTN","IBC NEHLM",19, 0) | |
| 7061 | ; EVEN T = HL7 Ev ent | |
| 7062 | "RTN","IBC NEHLM",20, 0) | |
| 7063 | ; CODE = Values sent in th e MFN mess age | |
| 7064 | "RTN","IBC NEHLM",21, 0) | |
| 7065 | ; IPP = IP Port | |
| 7066 | "RTN","IBC NEHLM",22, 0) | |
| 7067 | ; IPA = IP Addre ss | |
| 7068 | "RTN","IBC NEHLM",23, 0) | |
| 7069 | ; RESP = Respons e Code | |
| 7070 | "RTN","IBC NEHLM",24, 0) | |
| 7071 | ; IHLP = Interfa ce HL7 Pro cessing Ty pe | |
| 7072 | "RTN","IBC NEHLM",25, 0) | |
| 7073 | ; IHLT = Interfa ce HL7 Bat ch Start T ime | |
| 7074 | "RTN","IBC NEHLM",26, 0) | |
| 7075 | ; IHLS = Interfa ce HL7 Bat ch Stop Ti me | |
| 7076 | "RTN","IBC NEHLM",27, 0) | |
| 7077 | ; IVER = Interfa ce Version | |
| 7078 | "RTN","IBC NEHLM",28, 0) | |
| 7079 | ; TIMO UT = Timeo ut Days Si te Paramet er | |
| 7080 | "RTN","IBC NEHLM",29, 0) | |
| 7081 | ; RETR Y = Retry Flag Site Parameter | |
| 7082 | "RTN","IBC NEHLM",30, 0) | |
| 7083 | ; | |
| 7084 | "RTN","IBC NEHLM",31, 0) | |
| 7085 | N IBPERSI ST | |
| 7086 | "RTN","IBC NEHLM",32, 0) | |
| 7087 | S IBPERSI ST="N" ; p ersistence flag - If "N", FSC will not u se the sta tistics on the NTE s egment | |
| 7088 | "RTN","IBC NEHLM",33, 0) | |
| 7089 | D REG | |
| 7090 | "RTN","IBC NEHLM",34, 0) | |
| 7091 | Q | |
| 7092 | "RTN","IBC NEHLM",35, 0) | |
| 7093 | ; | |
| 7094 | "RTN","IBC NEHLM",36, 0) | |
| 7095 | EN1 ; Task Man entry point | |
| 7096 | "RTN","IBC NEHLM",37, 0) | |
| 7097 | N IBPERSI ST | |
| 7098 | "RTN","IBC NEHLM",38, 0) | |
| 7099 | S IBPERSI ST="Y" ; p ersistence flag - If "Y", FSC will use N TE segment to update their cop y of the s ite's stat s | |
| 7100 | "RTN","IBC NEHLM",39, 0) | |
| 7101 | D REG | |
| 7102 | "RTN","IBC NEHLM",40, 0) | |
| 7103 | ; Purge t he task re cord | |
| 7104 | "RTN","IBC NEHLM",41, 0) | |
| 7105 | S ZTREQ=" @" | |
| 7106 | "RTN","IBC NEHLM",42, 0) | |
| 7107 | Q | |
| 7108 | "RTN","IBC NEHLM",43, 0) | |
| 7109 | ; | |
| 7110 | "RTN","IBC NEHLM",44, 0) | |
| 7111 | REG ; Reg istration message fo r when a s ite instal ls | |
| 7112 | "RTN","IBC NEHLM",45, 0) | |
| 7113 | N APP,CNT CEM,CNTCNM ,CNTCPH,CO DE,EDT,EVE NT,FRSH,HL ,HLCDOM,HL CINS,HLCS | |
| 7114 | "RTN","IBC NEHLM",46, 0) | |
| 7115 | N HLCSTCP ,HLECH,HLE ID,HLFS,HL HDR,HLINST ,HLIP,HLN, HLNHLQ,HLP ROD,HLQ,HL REP | |
| 7116 | "RTN","IBC NEHLM",47, 0) | |
| 7117 | N HLRESLT ,HLSAN,HLT YPE,HLX,IB CNE,IBCNED AT,IHLP,IH LS,IHLT,ID ,INACT,IPA ,IPP | |
| 7118 | "RTN","IBC NEHLM",48, 0) | |
| 7119 | N MCT,MFE ,MFN,MGRP, QFL,RESP,T AXID,ZMID, %I | |
| 7120 | "RTN","IBC NEHLM",49, 0) | |
| 7121 | N IVER,RE TRY,TIMOUT ,VMFE ; IB*2 .0*506 | |
| 7122 | "RTN","IBC NEHLM",50, 0) | |
| 7123 | K ^TMP("H LS",$J) S MCT=0,QFL= 0 | |
| 7124 | "RTN","IBC NEHLM",51, 0) | |
| 7125 | ; | |
| 7126 | "RTN","IBC NEHLM",52, 0) | |
| 7127 | ; Get da ta from IB Parameter s File | |
| 7128 | "RTN","IBC NEHLM",53, 0) | |
| 7129 | S TAXID=$ TR($P($G(^ IBE(350.9, 1,1)),U,5) ,"-",""),C NTCPH="",C NTCEM="",C NTCNM="" | |
| 7130 | "RTN","IBC NEHLM",54, 0) | |
| 7131 | S IBCNE=$ G(^IBE(350 .9,1,51)) | |
| 7132 | "RTN","IBC NEHLM",55, 0) | |
| 7133 | S FRSH=$P (IBCNE,U,1 ),TIMOUT=$ P(IBCNE,U, 5),RETRY=$ P(IBCNE,U, 26) ; IB*2 .0*506 | |
| 7134 | "RTN","IBC NEHLM",56, 0) | |
| 7135 | S MGRP=$$ MGRP^IBCNE UT5() | |
| 7136 | "RTN","IBC NEHLM",57, 0) | |
| 7137 | S INACT=$ E($$GET1^D IQ(350.9," 1,",51.08, "E")) | |
| 7138 | "RTN","IBC NEHLM",58, 0) | |
| 7139 | S IHLP=$P (IBCNE,U,1 3),IHLT=$P (IBCNE,U,1 4) | |
| 7140 | "RTN","IBC NEHLM",59, 0) | |
| 7141 | S IHLS=$P (IBCNE,U,1 9) | |
| 7142 | "RTN","IBC NEHLM",60, 0) | |
| 7143 | ; | |
| 7144 | "RTN","IBC NEHLM",61, 0) | |
| 7145 | ; IB*2.0* 549 Update d version to 7, Remo ved retrie val of Con tact Name, Phone, em ail | |
| 7146 | "RTN","IBC NEHLM",62, 0) | |
| 7147 | ; IB*2.0* 601 Update d version to 8 | |
| 7148 | "RTN","IBC NEHLM",63, 0) | |
| 7149 | ; IB*2.0* 621 Update d version to 9, EICD | |
| 7150 | "RTN","IBC NEHLM",64, 0) | |
| 7151 | S IVER="9 " | |
| 7152 | "RTN","IBC NEHLM",65, 0) | |
| 7153 | I IHLP="I " S (IHLT, IHLS)="" | |
| 7154 | "RTN","IBC NEHLM",66, 0) | |
| 7155 | ; | |
| 7156 | "RTN","IBC NEHLM",67, 0) | |
| 7157 | I IHLP="B ",IHLT=""! (IHLS="") D S QFL=1 | |
| 7158 | "RTN","IBC NEHLM",68, 0) | |
| 7159 | . S MCT=M CT+1,MSG(M CT)="The " "HL7 Respo nse Proces sing Metho d"" select ed is Batc h but the HL7 Batch " | |
| 7160 | "RTN","IBC NEHLM",69, 0) | |
| 7161 | . I IHLT= "",IHLS="" S MSG(MCT )=MSG(MCT) _"Start an d End Time s are blan k. " Q | |
| 7162 | "RTN","IBC NEHLM",70, 0) | |
| 7163 | . S MSG(M CT)=MSG(MC T)_$S(IHLT ="":"Start ",1:"End") _" Time is blank. " | |
| 7164 | "RTN","IBC NEHLM",71, 0) | |
| 7165 | ; | |
| 7166 | "RTN","IBC NEHLM",72, 0) | |
| 7167 | I FRSH="" !(INACT="" )!(IHLP="" ) D | |
| 7168 | "RTN","IBC NEHLM",73, 0) | |
| 7169 | . S MCT=M CT+1,MSG(M CT)="The f ollowing e IV Site Pa rameters a re not def ined: " | |
| 7170 | "RTN","IBC NEHLM",74, 0) | |
| 7171 | . I FRSH= "" S MCT=M CT+1,MSG(M CT)="""Day s between electronic re-verifi cation che cks"" is b lank. " | |
| 7172 | "RTN","IBC NEHLM",75, 0) | |
| 7173 | . I INACT ="" S MCT= MCT+1,MSG( MCT)="""Lo ok at a pa tient's in active ins urance?"" is blank. " | |
| 7174 | "RTN","IBC NEHLM",76, 0) | |
| 7175 | . I IHLP= "" S MCT=M CT+1,MSG(M CT)="""HL7 Response Processing Method"" is blank. " | |
| 7176 | "RTN","IBC NEHLM",77, 0) | |
| 7177 | . Q | |
| 7178 | "RTN","IBC NEHLM",78, 0) | |
| 7179 | ; | |
| 7180 | "RTN","IBC NEHLM",79, 0) | |
| 7181 | I $O(MSG( ""))'="" D MLMN | |
| 7182 | "RTN","IBC NEHLM",80, 0) | |
| 7183 | I QFL=1 Q | |
| 7184 | "RTN","IBC NEHLM",81, 0) | |
| 7185 | ; | |
| 7186 | "RTN","IBC NEHLM",82, 0) | |
| 7187 | HL ; When a site in stalls, th e enrollme nt should be an | |
| 7188 | "RTN","IBC NEHLM",83, 0) | |
| 7189 | ; "MUP" (update) r ecord. | |
| 7190 | "RTN","IBC NEHLM",84, 0) | |
| 7191 | N DSTAT,D STAT2,VNTE ,VZRR ; IB*2 .0*549 add ed DSTAT2 | |
| 7192 | "RTN","IBC NEHLM",85, 0) | |
| 7193 | S MFE(1)= "MUP" | |
| 7194 | "RTN","IBC NEHLM",86, 0) | |
| 7195 | ; | |
| 7196 | "RTN","IBC NEHLM",87, 0) | |
| 7197 | ; Initia lize the H L7 | |
| 7198 | "RTN","IBC NEHLM",88, 0) | |
| 7199 | D INIT^HL FNC2("IBCN E IIV REGI STER",.HL) | |
| 7200 | "RTN","IBC NEHLM",89, 0) | |
| 7201 | S HLFS=HL ("FS"),HLE CH=HL("ECH "),HL("SAF ")=$P($$SI TE^VASITE, U,2,3),HLR EP=$E(HL(" ECH"),2) | |
| 7202 | "RTN","IBC NEHLM",90, 0) | |
| 7203 | ; S HLEID =$$HLP^IBC NEHLU("IBC NE IIV REG ISTER") | |
| 7204 | "RTN","IBC NEHLM",91, 0) | |
| 7205 | ; | |
| 7206 | "RTN","IBC NEHLM",92, 0) | |
| 7207 | ; Set t he MFI seg ment | |
| 7208 | "RTN","IBC NEHLM",93, 0) | |
| 7209 | S ID="Fac ility Tabl e",APP="", EVENT="UPD ",RESP="NE " | |
| 7210 | "RTN","IBC NEHLM",94, 0) | |
| 7211 | S ^TMP("H LS",$J,1)= $$MFI^VAFH LMFI(ID,AP P,EVENT,,, RESP) | |
| 7212 | "RTN","IBC NEHLM",95, 0) | |
| 7213 | ; | |
| 7214 | "RTN","IBC NEHLM",96, 0) | |
| 7215 | ; Set th e MFE segm ent | |
| 7216 | "RTN","IBC NEHLM",97, 0) | |
| 7217 | S EVENT=M FE(1),MFN= "",EDT=$$D T^XLFDT() | |
| 7218 | "RTN","IBC NEHLM",98, 0) | |
| 7219 | S CODE=$P ($$SITE^VA SITE,U,3)_ $E(HLECH) | |
| 7220 | "RTN","IBC NEHLM",99, 0) | |
| 7221 | S VMFE=$$ MFE^VAFHLM FE(EVENT,M FN,EDT,COD E) | |
| 7222 | "RTN","IBC NEHLM",100 ,0) | |
| 7223 | S ^TMP("H LS",$J,2)= VMFE_HLFS_ "CE" | |
| 7224 | "RTN","IBC NEHLM",101 ,0) | |
| 7225 | ; | |
| 7226 | "RTN","IBC NEHLM",102 ,0) | |
| 7227 | ; Set the ZRR segme nt | |
| 7228 | "RTN","IBC NEHLM",103 ,0) | |
| 7229 | ;IB*549 A dded line to send nu ll values for remove d fields s o msg layo ut remains unchanged | |
| 7230 | "RTN","IBC NEHLM",104 ,0) | |
| 7231 | S (CNTCPH ,CNTCEM,CN TCNM)="" | |
| 7232 | "RTN","IBC NEHLM",105 ,0) | |
| 7233 | S VZRR="Z RR"_HLFS_" 1"_HLFS_TA XID_HLFS_H LFS_$$HLNA ME^HLFNC(C NTCNM,$E(H LECH))_"^C "_HLFS | |
| 7234 | "RTN","IBC NEHLM",106 ,0) | |
| 7235 | S VZRR=VZ RR_CNTCPH_ $E(HLECH)_ $E(HLECH)_ $E(HLECH)_ CNTCEM_HLF S_FRSH_HLF S_IHLP_HLF S_IHLT_$E( HLECH)_IHL S_HLFS_INA CT_HLFS_IV ER | |
| 7236 | "RTN","IBC NEHLM",107 ,0) | |
| 7237 | S ^TMP("H LS",$J,3)= VZRR | |
| 7238 | "RTN","IBC NEHLM",108 ,0) | |
| 7239 | ; | |
| 7240 | "RTN","IBC NEHLM",109 ,0) | |
| 7241 | ; Set the NTE segme nt | |
| 7242 | "RTN","IBC NEHLM",110 ,0) | |
| 7243 | S DSTAT=$ $GETSTAT^I BCNEDST() | |
| 7244 | "RTN","IBC NEHLM",111 ,0) | |
| 7245 | S DSTAT2= $$GETSTAT2 ^IBCNEDST( ) ; IB*2.0*549 Added lin e | |
| 7246 | "RTN","IBC NEHLM",112 ,0) | |
| 7247 | S VNTE="N TE"_HLFS_" 1"_HLFS_HL FS_IBPERSI ST_HLREP_$ TR(DSTAT,U ,HLREP) | |
| 7248 | "RTN","IBC NEHLM",113 ,0) | |
| 7249 | S VNTE=VN TE_HLREP_R ETRY_HLREP _TIMOUT ; IB*2.0*506 | |
| 7250 | "RTN","IBC NEHLM",114 ,0) | |
| 7251 | S VNTE=VN TE_HLREP_$ TR(DSTAT2, U,HLREP) ; IB*2.0*549 Added lin e | |
| 7252 | "RTN","IBC NEHLM",115 ,0) | |
| 7253 | S ^TMP("H LS",$J,4)= VNTE | |
| 7254 | "RTN","IBC NEHLM",116 ,0) | |
| 7255 | ; | |
| 7256 | "RTN","IBC NEHLM",117 ,0) | |
| 7257 | D GENERAT E^HLMA("IB CNE IIV RE GISTER","G M",1,.HLRE SLT,"") | |
| 7258 | "RTN","IBC NEHLM",118 ,0) | |
| 7259 | I $P(HLRE SLT,U,2)]" " S HLRESL T="Error - "_$P(HLRE SLT,U,2,99 ) D Q | |
| 7260 | "RTN","IBC NEHLM",119 ,0) | |
| 7261 | . S MSG(1 )="HL7 eIV Registrat ion Messag e not crea ted." | |
| 7262 | "RTN","IBC NEHLM",120 ,0) | |
| 7263 | . S MSG(2 )=HLRESLT | |
| 7264 | "RTN","IBC NEHLM",121 ,0) | |
| 7265 | . D MLMN | |
| 7266 | "RTN","IBC NEHLM",122 ,0) | |
| 7267 | K ^TMP("H LS",$J) | |
| 7268 | "RTN","IBC NEHLM",123 ,0) | |
| 7269 | Q | |
| 7270 | "RTN","IBC NEHLM",124 ,0) | |
| 7271 | ; | |
| 7272 | "RTN","IBC NEHLM",125 ,0) | |
| 7273 | MLMN ; Ma ilMan Mess age | |
| 7274 | "RTN","IBC NEHLM",126 ,0) | |
| 7275 | D TXT^IBC NEUT7("MSG ") | |
| 7276 | "RTN","IBC NEHLM",127 ,0) | |
| 7277 | S XMSUB=" eIV Regist ration Fai lure" | |
| 7278 | "RTN","IBC NEHLM",128 ,0) | |
| 7279 | D MSG^IBC NEUT5(MGRP ,XMSUB,"MS G(") | |
| 7280 | "RTN","IBC NEHLM",129 ,0) | |
| 7281 | K XMSUB,X MY,MSG,XMZ ,XMDUZ | |
| 7282 | "RTN","IBC NEHLM",130 ,0) | |
| 7283 | Q | |
| 7284 | "RTN","IBC NEHLQ") | |
| 7285 | 0^8^B10014 0677^B6095 4828 | |
| 7286 | "RTN","IBC NEHLQ",1,0 ) | |
| 7287 | IBCNEHLQ ; DAOU/ALA - HL7 RQI M essage ;17 -JUN-2002 | |
| 7288 | "RTN","IBC NEHLQ",2,0 ) | |
| 7289 | ;;2.0;INT EGRATED BI LLING;**18 4,271,300, 361,416,43 8,467,497, 533,516,60 1,621**;21 -MAR-94;Bu ild 8 | |
| 7290 | "RTN","IBC NEHLQ",3,0 ) | |
| 7291 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 7292 | "RTN","IBC NEHLQ",4,0 ) | |
| 7293 | ; | |
| 7294 | "RTN","IBC NEHLQ",5,0 ) | |
| 7295 | ;**Progra m Descript ion** | |
| 7296 | "RTN","IBC NEHLQ",6,0 ) | |
| 7297 | ; This r outine bui lds an eIV Verificat ion (RQI^I 01) or | |
| 7298 | "RTN","IBC NEHLQ",7,0 ) | |
| 7299 | ; Identi fication ( RQI^I03) r equest | |
| 7300 | "RTN","IBC NEHLQ",8,0 ) | |
| 7301 | ; | |
| 7302 | "RTN","IBC NEHLQ",9,0 ) | |
| 7303 | ;**Modifi ed by Dat e R eason | |
| 7304 | "RTN","IBC NEHLQ",10, 0) | |
| 7305 | ; DAOU/B HS 10/ 04/2002 I mplementin g Transmit SSN logic | |
| 7306 | "RTN","IBC NEHLQ",11, 0) | |
| 7307 | ; DAOU/D B 03/ 19/2004 S tripped da shes from SSN (PID, GT1) | |
| 7308 | "RTN","IBC NEHLQ",12, 0) | |
| 7309 | ; | |
| 7310 | "RTN","IBC NEHLQ",13, 0) | |
| 7311 | EN ; Entr y Point | |
| 7312 | "RTN","IBC NEHLQ",14, 0) | |
| 7313 | ; Variab les | |
| 7314 | "RTN","IBC NEHLQ",15, 0) | |
| 7315 | ; HLFS = Field S eparator | |
| 7316 | "RTN","IBC NEHLQ",16, 0) | |
| 7317 | ; DFN = Patient IEN | |
| 7318 | "RTN","IBC NEHLQ",17, 0) | |
| 7319 | ; PAYR = Payer I EN | |
| 7320 | "RTN","IBC NEHLQ",18, 0) | |
| 7321 | ; BUFF = Buffer IEN | |
| 7322 | "RTN","IBC NEHLQ",19, 0) | |
| 7323 | ; FRDT = Freshne ss Date | |
| 7324 | "RTN","IBC NEHLQ",20, 0) | |
| 7325 | ; | |
| 7326 | "RTN","IBC NEHLQ",21, 0) | |
| 7327 | PID ; Pati ent Identi fication S egment | |
| 7328 | "RTN","IBC NEHLQ",22, 0) | |
| 7329 | N VAFSTR, ICN,NM,I,P ID11,EDQ,I BWHO,IBDOB ,PID19 | |
| 7330 | "RTN","IBC NEHLQ",23, 0) | |
| 7331 | ; IB*2.0* 601 | |
| 7332 | "RTN","IBC NEHLQ",24, 0) | |
| 7333 | S VAFSTR= ",1,7,8,11 ,",DFN=+$G (DFN) I $$ MBICHK^IBC NEUT7(BUFF )!(EXT=4) S VAFSTR=V AFSTR_"19, " ; IB*2.0 *621 HAN | |
| 7334 | "RTN","IBC NEHLQ",25, 0) | |
| 7335 | S PID=$$E N^VAFHLPID (DFN,VAFST R,1) | |
| 7336 | "RTN","IBC NEHLQ",26, 0) | |
| 7337 | S PID11=$ P(PID,HLFS ,12) | |
| 7338 | "RTN","IBC NEHLQ",27, 0) | |
| 7339 | I PID11'= "" D | |
| 7340 | "RTN","IBC NEHLQ",28, 0) | |
| 7341 | . I $P(PI D11,HLECH, 1)="""""" S $P(PID11 ,HLECH,1)= "" | |
| 7342 | "RTN","IBC NEHLQ",29, 0) | |
| 7343 | . I $P(PI D11,HLECH, 2)="""""" S $P(PID11 ,HLECH,2)= "" | |
| 7344 | "RTN","IBC NEHLQ",30, 0) | |
| 7345 | . I $P(PI D11,HLECH, 3)="""""" S $P(PID11 ,HLECH,3)= "UNKNOWN" | |
| 7346 | "RTN","IBC NEHLQ",31, 0) | |
| 7347 | . S $P(PI D,HLFS,12) =PID11 | |
| 7348 | "RTN","IBC NEHLQ",32, 0) | |
| 7349 | S PID19=$ P(PID,HLFS ,20) | |
| 7350 | "RTN","IBC NEHLQ",33, 0) | |
| 7351 | ; Encode special ch aracters i nto Name a nd address pieces | |
| 7352 | "RTN","IBC NEHLQ",34, 0) | |
| 7353 | ; **NOTE: If $$EN^V AFHLPID sh ould, in t he future, return mo re than 11 pieces th an the lin es below m ay | |
| 7354 | "RTN","IBC NEHLQ",35, 0) | |
| 7355 | ; need to b e modified as they c urrently e xpect 11 p ieces to b e returned . | |
| 7356 | "RTN","IBC NEHLQ",36, 0) | |
| 7357 | I DFN D | |
| 7358 | "RTN","IBC NEHLQ",37, 0) | |
| 7359 | .; try to get name of insured from NAME OF INSURE D | |
| 7360 | "RTN","IBC NEHLQ",38, 0) | |
| 7361 | .I EXT'=1 ,$G(IRIEN) '="" D | |
| 7362 | "RTN","IBC NEHLQ",39, 0) | |
| 7363 | .. S IBWH O=$P($G(^D PT(DFN,.31 2,IRIEN,0) ),U,6) | |
| 7364 | "RTN","IBC NEHLQ",40, 0) | |
| 7365 | .. I IBWH O'="",IBWH O'="v" Q | |
| 7366 | "RTN","IBC NEHLQ",41, 0) | |
| 7367 | ..;IB*2.0 *601/DM fo r "self" a ppt extrac t, use pat ient's ins urance ins ured DOB | |
| 7368 | "RTN","IBC NEHLQ",42, 0) | |
| 7369 | .. S IBDO B=$$GET1^D IQ(2.312,I RIEN_","_D FN_",","IN SURED'S DO B","I") | |
| 7370 | "RTN","IBC NEHLQ",43, 0) | |
| 7371 | .. I IBDO B S $P(PID ,HLFS,8)=$ $HLDATE^HL FNC(IBDOB) | |
| 7372 | "RTN","IBC NEHLQ",44, 0) | |
| 7373 | .. S NM=$ P($G(^DPT( DFN,.312,I RIEN,7)),U ,1) | |
| 7374 | "RTN","IBC NEHLQ",45, 0) | |
| 7375 | .I EXT=1, BUFF,$G(NM )="" D | |
| 7376 | "RTN","IBC NEHLQ",46, 0) | |
| 7377 | .. S IBWH O=$P($G(^I BA(355.33, BUFF,60)), U,5) | |
| 7378 | "RTN","IBC NEHLQ",47, 0) | |
| 7379 | .. I IBWH O'="",IBWH O'="v" Q | |
| 7380 | "RTN","IBC NEHLQ",48, 0) | |
| 7381 | ..;IB*2.0 *601/DM fo r "self" b uffer extr act, use b uff's insu red DOB | |
| 7382 | "RTN","IBC NEHLQ",49, 0) | |
| 7383 | ..;otherw ise, use p atient's i nsurance i nsured DOB , otherwis e use pati ent's DOB | |
| 7384 | "RTN","IBC NEHLQ",50, 0) | |
| 7385 | .. S IBDO B=$$GET1^D IQ(355.33, BUFF_","," INSURED'S DOB","I") | |
| 7386 | "RTN","IBC NEHLQ",51, 0) | |
| 7387 | .. I 'IBD OB,$G(IRIE N)'="" S I BDOB=$$GET 1^DIQ(2.31 2,IRIEN_", "_DFN_",", "INSURED'S DOB","I") | |
| 7388 | "RTN","IBC NEHLQ",52, 0) | |
| 7389 | .. I IBDO B S $P(PID ,HLFS,8)=$ $HLDATE^HL FNC(IBDOB) | |
| 7390 | "RTN","IBC NEHLQ",53, 0) | |
| 7391 | .. S NM=$ P($G(^IBA( 355.33,BUF F,91)),U) | |
| 7392 | "RTN","IBC NEHLQ",54, 0) | |
| 7393 | .I $G(NM) '="" S NM= $$HLNAME^H LFNC(NM,HL ECH) | |
| 7394 | "RTN","IBC NEHLQ",55, 0) | |
| 7395 | .; if uns uccessful, get patie nt name fr om 2/.01 | |
| 7396 | "RTN","IBC NEHLQ",56, 0) | |
| 7397 | .I $G(NM) ="" D | |
| 7398 | "RTN","IBC NEHLQ",57, 0) | |
| 7399 | ..S NM("F ILE")=2,NM ("IENS")=D FN,NM("FIE LD")=.01 | |
| 7400 | "RTN","IBC NEHLQ",58, 0) | |
| 7401 | ..S NM=$$ HLNAME^XLF NAME(.NM," ",$E(HLECH )),NM=$S(N M]"":NM,1: HLQ) | |
| 7402 | "RTN","IBC NEHLQ",59, 0) | |
| 7403 | ..Q | |
| 7404 | "RTN","IBC NEHLQ",60, 0) | |
| 7405 | .S I=$L(N M,HLFS),NM =$$ENCHL7( NM),$P(PID ,HLFS,6,5+ I)=NM | |
| 7406 | "RTN","IBC NEHLQ",61, 0) | |
| 7407 | .; IB*2.0 *601 | |
| 7408 | "RTN","IBC NEHLQ",62, 0) | |
| 7409 | .S $P(PID ,HLFS,20,9 9)=$$ENCHL 7($P(PID,H LFS,20,99) ) | |
| 7410 | "RTN","IBC NEHLQ",63, 0) | |
| 7411 | .S ICN=$P ($G(^DPT(D FN,"MPI")) ,U,1) | |
| 7412 | "RTN","IBC NEHLQ",64, 0) | |
| 7413 | .S $P(PID ,HLFS,4)=I CN_HLECH_H LECH_HLECH _"USVHA"_H LECH_"NI"_ HLECH_"~"_ DFN_HLECH_ HLECH_HLEC H_"USVHA"_ HLECH_"PI" _HLECH_$P( $$SITE^VAS ITE,U,3)_H LECH | |
| 7414 | "RTN","IBC NEHLQ",65, 0) | |
| 7415 | .Q | |
| 7416 | "RTN","IBC NEHLQ",66, 0) | |
| 7417 | S FRDT=$$ HLDATE^HLF NC($G(FRDT )) | |
| 7418 | "RTN","IBC NEHLQ",67, 0) | |
| 7419 | I PID19'= "" S $P(PI D,HLFS,13) ="",$P(PID ,HLFS,20)= PID19 | |
| 7420 | "RTN","IBC NEHLQ",68, 0) | |
| 7421 | I EXT'=4 S $P(PID,H LFS,34)=FR DT ; IB*2. 0*621 Not for A1 tra nsaction | |
| 7422 | "RTN","IBC NEHLQ",69, 0) | |
| 7423 | Q | |
| 7424 | "RTN","IBC NEHLQ",70, 0) | |
| 7425 | ; | |
| 7426 | "RTN","IBC NEHLQ",71, 0) | |
| 7427 | GT1 ; Gua rantor Seg ment | |
| 7428 | "RTN","IBC NEHLQ",72, 0) | |
| 7429 | N WHO,NM, IDOB,ISEX, SEX,RLIEN, PER,PLIEN, RDATA,IBSD ATA,IBADDR | |
| 7430 | "RTN","IBC NEHLQ",73, 0) | |
| 7431 | N EICDIIE N,IBFMIEN, IBTRKDTA ; IB*2.0*62 1/DM varia bles | |
| 7432 | "RTN","IBC NEHLQ",74, 0) | |
| 7433 | ; | |
| 7434 | "RTN","IBC NEHLQ",75, 0) | |
| 7435 | S GT1="" | |
| 7436 | "RTN","IBC NEHLQ",76, 0) | |
| 7437 | I $G(QUER Y)="I" Q | |
| 7438 | "RTN","IBC NEHLQ",77, 0) | |
| 7439 | ; | |
| 7440 | "RTN","IBC NEHLQ",78, 0) | |
| 7441 | ; If the data was extracted from Buffe r get spec ifics from Buffer fi le | |
| 7442 | "RTN","IBC NEHLQ",79, 0) | |
| 7443 | I EXT=1 D | |
| 7444 | "RTN","IBC NEHLQ",80, 0) | |
| 7445 | . S WHO=$ P($G(^IBA( 355.33,BUF F,60)),U,5 ) | |
| 7446 | "RTN","IBC NEHLQ",81, 0) | |
| 7447 | . I WHO=" v"!(WHO="" ) Q | |
| 7448 | "RTN","IBC NEHLQ",82, 0) | |
| 7449 | . ;S NM=$ P($G(^IBA( 355.33,BUF F,60)),U,7 ),NM=$$NAM E^IBCNEHLU (NM) | |
| 7450 | "RTN","IBC NEHLQ",83, 0) | |
| 7451 | . S NM=$$ GET1^DIQ(3 55.33,BUFF ,91.01),NM =$$NAME^IB CNEHLU(NM) ;Get HIPA A data fro m new fiel ds - IB*2* 516 | |
| 7452 | "RTN","IBC NEHLQ",84, 0) | |
| 7453 | . S NM=$$ HLNAME^HLF NC(NM,HLEC H) | |
| 7454 | "RTN","IBC NEHLQ",85, 0) | |
| 7455 | . S NM=$$ ENCHL7(NM) | |
| 7456 | "RTN","IBC NEHLQ",86, 0) | |
| 7457 | . S $P(GT 1,HLFS,3)= NM_HLECH_H LECH_HLECH | |
| 7458 | "RTN","IBC NEHLQ",87, 0) | |
| 7459 | . S IDOB= $P($G(^IBA (355.33,BU FF,60)),U, 8),IDOB=$$ HLDATE^HLF NC(IDOB) | |
| 7460 | "RTN","IBC NEHLQ",88, 0) | |
| 7461 | . S $P(GT 1,HLFS,8)= IDOB | |
| 7462 | "RTN","IBC NEHLQ",89, 0) | |
| 7463 | . S $P(GT 1,HLFS,2)= $$SCRUB($G (SUBID))_H LECH_HLECH _HLECH_HLE CH_"HC" | |
| 7464 | "RTN","IBC NEHLQ",90, 0) | |
| 7465 | . Q | |
| 7466 | "RTN","IBC NEHLQ",91, 0) | |
| 7467 | ; | |
| 7468 | "RTN","IBC NEHLQ",92, 0) | |
| 7469 | ; If the data was from the a ppointment extract, check Pati ent file, IB*2.0*621 /DM | |
| 7470 | "RTN","IBC NEHLQ",93, 0) | |
| 7471 | I EXT=2 D | |
| 7472 | "RTN","IBC NEHLQ",94, 0) | |
| 7473 | . I IRIEN ="" Q | |
| 7474 | "RTN","IBC NEHLQ",95, 0) | |
| 7475 | . S WHO=$ P($G(^DPT( DFN,.312,I RIEN,0)),U ,6) | |
| 7476 | "RTN","IBC NEHLQ",96, 0) | |
| 7477 | . I WHO=" v"!(WHO="" ) Q | |
| 7478 | "RTN","IBC NEHLQ",97, 0) | |
| 7479 | . ;S NM=$ P($G(^DPT( DFN,.312,I RIEN,0)),U ,17) ; WC J;IB*2.0*4 97 | |
| 7480 | "RTN","IBC NEHLQ",98, 0) | |
| 7481 | . S NM=$P ($G(^DPT(D FN,.312,IR IEN,7)),U, 1) ; WCJ; IB*2.0*497 | |
| 7482 | "RTN","IBC NEHLQ",99, 0) | |
| 7483 | . S NM=$$ HLNAME^HLF NC(NM,HLEC H) | |
| 7484 | "RTN","IBC NEHLQ",100 ,0) | |
| 7485 | . S NM=$$ ENCHL7(NM) | |
| 7486 | "RTN","IBC NEHLQ",101 ,0) | |
| 7487 | . S $P(GT 1,HLFS,3)= NM_HLECH_H LECH_HLECH | |
| 7488 | "RTN","IBC NEHLQ",102 ,0) | |
| 7489 | . S IDOB= $P($G(^DPT (DFN,.312, IRIEN,3)), U,1),IDOB= $$HLDATE^H LFNC(IDOB) | |
| 7490 | "RTN","IBC NEHLQ",103 ,0) | |
| 7491 | . S $P(GT 1,HLFS,8)= IDOB | |
| 7492 | "RTN","IBC NEHLQ",104 ,0) | |
| 7493 | . S $P(GT 1,HLFS,2)= $$SCRUB($G (SUBID))_H LECH_HLECH _HLECH_HLE CH_"HC" | |
| 7494 | "RTN","IBC NEHLQ",105 ,0) | |
| 7495 | . ; | |
| 7496 | "RTN","IBC NEHLQ",106 ,0) | |
| 7497 | . S IBSDA TA=$G(^DPT (DFN,.312, IRIEN,3)) | |
| 7498 | "RTN","IBC NEHLQ",107 ,0) | |
| 7499 | . S IBADD R=$$HLADDR ^HLFNC($P( IBSDATA,U, 6,7),$P(IB SDATA,U,8, 10)) | |
| 7500 | "RTN","IBC NEHLQ",108 ,0) | |
| 7501 | . S $P(GT 1,HLFS,5)= $$ENCHL7(I BADDR) | |
| 7502 | "RTN","IBC NEHLQ",109 ,0) | |
| 7503 | . ; | |
| 7504 | "RTN","IBC NEHLQ",110 ,0) | |
| 7505 | . D CHK | |
| 7506 | "RTN","IBC NEHLQ",111 ,0) | |
| 7507 | . I $P(GT 1,HLFS,8)= ""&(IDOB'= "") S $P(G T1,HLFS,8) =$$HLDATE^ HLFNC(IDOB ) | |
| 7508 | "RTN","IBC NEHLQ",112 ,0) | |
| 7509 | . I $P(GT 1,HLFS,9)= ""&(ISEX'= "") S $P(G T1,HLFS,9) =ISEX | |
| 7510 | "RTN","IBC NEHLQ",113 ,0) | |
| 7511 | . I $P(GT 1,HLFS,9)= "",WHO="s" D | |
| 7512 | "RTN","IBC NEHLQ",114 ,0) | |
| 7513 | .. S SEX= $P($G(^DPT (DFN,.312, IRIEN,3)), U,12) ; ge t policy h older sex | |
| 7514 | "RTN","IBC NEHLQ",115 ,0) | |
| 7515 | .. I SEX= "" S SEX=$ P(^DPT(DFN ,0),U,2),S EX=$S(SEX= "M":"F",1: "M") ; if null, use alternativ e method | |
| 7516 | "RTN","IBC NEHLQ",116 ,0) | |
| 7517 | .. S $P(G T1,HLFS,9) =SEX | |
| 7518 | "RTN","IBC NEHLQ",117 ,0) | |
| 7519 | ; | |
| 7520 | "RTN","IBC NEHLQ",118 ,0) | |
| 7521 | ; IB*2.0* 621/DM add EICD Veri fication, use data f rom EIV EI CD TRACKIN G (#365.18 ) | |
| 7522 | "RTN","IBC NEHLQ",119 ,0) | |
| 7523 | I EXT=4,$ G(QUERY)=" V" D | |
| 7524 | "RTN","IBC NEHLQ",120 ,0) | |
| 7525 | . S EICDI IEN=+$O(^I BCN(365.18 ,"C",IEN,0 )) ; IEN i s the TQ f rom IBCNED EP | |
| 7526 | "RTN","IBC NEHLQ",121 ,0) | |
| 7527 | . I ('EIC DIIEN)!(EI CDVIEN="") Q | |
| 7528 | "RTN","IBC NEHLQ",122 ,0) | |
| 7529 | . S IBFMI EN=EICDVIE N_","_EICD IIEN_"," | |
| 7530 | "RTN","IBC NEHLQ",123 ,0) | |
| 7531 | . K IBTRK DTA D GETS ^DIQ(365.1 85,IBFMIEN ,".04;.07; .08;.09"," I","IBTRKD TA") ; gra b selected fields (i nternal) | |
| 7532 | "RTN","IBC NEHLQ",124 ,0) | |
| 7533 | . ; | |
| 7534 | "RTN","IBC NEHLQ",125 ,0) | |
| 7535 | . S NM=IB TRKDTA(365 .185,IBFMI EN,.09,"I" ) | |
| 7536 | "RTN","IBC NEHLQ",126 ,0) | |
| 7537 | . Q:NM="" ; no nam e means su bscriber - - GT1 is n ot needed | |
| 7538 | "RTN","IBC NEHLQ",127 ,0) | |
| 7539 | . S NM=$$ HLNAME^HLF NC(NM,HLEC H) | |
| 7540 | "RTN","IBC NEHLQ",128 ,0) | |
| 7541 | . S NM=$$ ENCHL7(NM) | |
| 7542 | "RTN","IBC NEHLQ",129 ,0) | |
| 7543 | . S $P(GT 1,HLFS,3)= NM_HLECH_H LECH_HLECH | |
| 7544 | "RTN","IBC NEHLQ",130 ,0) | |
| 7545 | . S IDOB= IBTRKDTA(3 65.185,IBF MIEN,.07," I"),IDOB=$ $HLDATE^HL FNC(IDOB) | |
| 7546 | "RTN","IBC NEHLQ",131 ,0) | |
| 7547 | . S $P(GT 1,HLFS,8)= IDOB | |
| 7548 | "RTN","IBC NEHLQ",132 ,0) | |
| 7549 | . ; Subsc riber ID - - Guaranto r Number | |
| 7550 | "RTN","IBC NEHLQ",133 ,0) | |
| 7551 | . S $P(GT 1,HLFS,2)= $$SCRUB(IB TRKDTA(365 .185,IBFMI EN,.04,"I" ))_HLECH_H LECH_HLECH _HLECH_"HC " | |
| 7552 | "RTN","IBC NEHLQ",134 ,0) | |
| 7553 | . ; skip address da ta | |
| 7554 | "RTN","IBC NEHLQ",135 ,0) | |
| 7555 | . S ISEX= IBTRKDTA(3 65.185,IBF MIEN,.08," I") | |
| 7556 | "RTN","IBC NEHLQ",136 ,0) | |
| 7557 | . I $P(GT 1,HLFS,8)= ""&(IDOB'= "") S $P(G T1,HLFS,8) =$$HLDATE^ HLFNC(IDOB ) | |
| 7558 | "RTN","IBC NEHLQ",137 ,0) | |
| 7559 | . I $P(GT 1,HLFS,9)= ""&(ISEX'= "") S $P(G T1,HLFS,9) =ISEX | |
| 7560 | "RTN","IBC NEHLQ",138 ,0) | |
| 7561 | ; | |
| 7562 | "RTN","IBC NEHLQ",139 ,0) | |
| 7563 | I GT1="" Q | |
| 7564 | "RTN","IBC NEHLQ",140 ,0) | |
| 7565 | S $P(GT1, HLFS,1)=1 | |
| 7566 | "RTN","IBC NEHLQ",141 ,0) | |
| 7567 | S GT1="GT 1"_HLFS_GT 1 | |
| 7568 | "RTN","IBC NEHLQ",142 ,0) | |
| 7569 | Q | |
| 7570 | "RTN","IBC NEHLQ",143 ,0) | |
| 7571 | ; | |
| 7572 | "RTN","IBC NEHLQ",144 ,0) | |
| 7573 | IN1 ; Ins urance Seg ment | |
| 7574 | "RTN","IBC NEHLQ",145 ,0) | |
| 7575 | N EFFDT,E LIGDT,EXPD T,PREL,ADM N,ADMDT,IE NS | |
| 7576 | "RTN","IBC NEHLQ",146 ,0) | |
| 7577 | N EICDIIE N,IBFMIEN, IBPYIEN,IB TRKDTA ; I B*2.0*621/ DM variabl es | |
| 7578 | "RTN","IBC NEHLQ",147 ,0) | |
| 7579 | S IN1="" | |
| 7580 | "RTN","IBC NEHLQ",148 ,0) | |
| 7581 | ; | |
| 7582 | "RTN","IBC NEHLQ",149 ,0) | |
| 7583 | ; If the data was extracted from Buffe r get spec ifics from Buffer fi le | |
| 7584 | "RTN","IBC NEHLQ",150 ,0) | |
| 7585 | I EXT=1 D | |
| 7586 | "RTN","IBC NEHLQ",151 ,0) | |
| 7587 | .S PREL=$ P($G(^IBA( 355.33,BUF F,60)),U,1 4) | |
| 7588 | "RTN","IBC NEHLQ",152 ,0) | |
| 7589 | .S ELIGDT =$P($G(TRA NSR),U,12) I ELIGDT= DT S ELIGD T="" | |
| 7590 | "RTN","IBC NEHLQ",153 ,0) | |
| 7591 | .S $P(IN1 ,HLFS,2)=$ S(PREL=18: $$SCRUB($G (SUBID)),P REL="":$$S CRUB($G(SU BID)),1:$$ SCRUB($G(P ATID))) | |
| 7592 | "RTN","IBC NEHLQ",154 ,0) | |
| 7593 | .I PAYR'= $$FIND1^DI C(365.12," ","X","~NO PAYER") D | |
| 7594 | "RTN","IBC NEHLQ",155 ,0) | |
| 7595 | ..S $P(IN 1,HLFS,3)= $$ENCHL7($ P(^IBE(365 .12,PAYR,0 ),U,2))_HL ECH_HLECH_ HLECH_"USV HA"_HLECH_ "VP"_HLECH | |
| 7596 | "RTN","IBC NEHLQ",156 ,0) | |
| 7597 | ..S $P(IN 1,HLFS,4)= $$ENCHL7($ P(^IBE(365 .12,PAYR,0 ),U,1)) | |
| 7598 | "RTN","IBC NEHLQ",157 ,0) | |
| 7599 | . ;IB*2.0 *516/TAZ - Use HIPAA compliant fields | |
| 7600 | "RTN","IBC NEHLQ",158 ,0) | |
| 7601 | .;S $P(IN 1,HLFS,8)= $$ENCHL7($ P($G(^IBA( 355.33,BUF F,40)),U,3 )) | |
| 7602 | "RTN","IBC NEHLQ",159 ,0) | |
| 7603 | .;S $P(IN 1,HLFS,9)= $$ENCHL7($ P($G(^IBA( 355.33,BUF F,40)),U,2 )) | |
| 7604 | "RTN","IBC NEHLQ",160 ,0) | |
| 7605 | .S $P(IN1 ,HLFS,8)=$ $ENCHL7($$ GET1^DIQ(3 55.33,BUFF _",",90.02 )) | |
| 7606 | "RTN","IBC NEHLQ",161 ,0) | |
| 7607 | .S $P(IN1 ,HLFS,9)=$ $ENCHL7($$ GET1^DIQ(3 55.33,BUFF _",",90.01 )) | |
| 7608 | "RTN","IBC NEHLQ",162 ,0) | |
| 7609 | .S EFFDT= $P($G(^IBA (355.33,BU FF,60)),U, 2),EFFDT=$ $HLDATE^HL FNC(EFFDT) | |
| 7610 | "RTN","IBC NEHLQ",163 ,0) | |
| 7611 | .S EXPDT= $P($G(^IBA (355.33,BU FF,60)),U, 3),EXPDT=$ $HLDATE^HL FNC(EXPDT) | |
| 7612 | "RTN","IBC NEHLQ",164 ,0) | |
| 7613 | .S $P(IN1 ,HLFS,12)= EFFDT | |
| 7614 | "RTN","IBC NEHLQ",165 ,0) | |
| 7615 | .S $P(IN1 ,HLFS,13)= EXPDT | |
| 7616 | "RTN","IBC NEHLQ",166 ,0) | |
| 7617 | .S $P(IN1 ,HLFS,17)= $$PATREL(P REL) | |
| 7618 | "RTN","IBC NEHLQ",167 ,0) | |
| 7619 | .S $P(IN1 ,HLFS,26)= $$HLDATE^H LFNC(ELIGD T) | |
| 7620 | "RTN","IBC NEHLQ",168 ,0) | |
| 7621 | .I $P(IN1 ,HLFS,17)= "" S $P(IN 1,HLFS,17) =18 | |
| 7622 | "RTN","IBC NEHLQ",169 ,0) | |
| 7623 | ; | |
| 7624 | "RTN","IBC NEHLQ",170 ,0) | |
| 7625 | ; If the data was f rom the ap pointment extract, c heck Patie nt file, I B*2.0*621/ DM | |
| 7626 | "RTN","IBC NEHLQ",171 ,0) | |
| 7627 | I EXT=2 D | |
| 7628 | "RTN","IBC NEHLQ",172 ,0) | |
| 7629 | . I IRIEN ="" Q | |
| 7630 | "RTN","IBC NEHLQ",173 ,0) | |
| 7631 | . I $$SCR UB($G(SUBI D))'=$$SCR UB($P($G(^ DPT(DFN,.3 12,IRIEN,0 )),U,2)) Q | |
| 7632 | "RTN","IBC NEHLQ",174 ,0) | |
| 7633 | . S EFFDT =$P($G(^DP T(DFN,.312 ,IRIEN,0)) ,U,8),EFFD T=$$HLDATE ^HLFNC(EFF DT) | |
| 7634 | "RTN","IBC NEHLQ",175 ,0) | |
| 7635 | . S EXPDT =$P($G(^DP T(DFN,.312 ,IRIEN,0)) ,U,4),EXPD T=$$HLDATE ^HLFNC(EXP DT) | |
| 7636 | "RTN","IBC NEHLQ",176 ,0) | |
| 7637 | . S $P(IN 1,HLFS,12) =EFFDT | |
| 7638 | "RTN","IBC NEHLQ",177 ,0) | |
| 7639 | . S $P(IN 1,HLFS,13) =EXPDT | |
| 7640 | "RTN","IBC NEHLQ",178 ,0) | |
| 7641 | . S PREL= $P($G(^DPT (DFN,.312, IRIEN,4)), U,3) | |
| 7642 | "RTN","IBC NEHLQ",179 ,0) | |
| 7643 | . S $P(IN 1,HLFS,2)= $S(PREL=18 :$$SCRUB($ G(SUBID)), PREL="":$$ SCRUB($G(S UBID)),1:$ $SCRUB($G( PATID))) | |
| 7644 | "RTN","IBC NEHLQ",180 ,0) | |
| 7645 | . I PAYR' =$$FIND1^D IC(365.12, "","X","~N O PAYER") D | |
| 7646 | "RTN","IBC NEHLQ",181 ,0) | |
| 7647 | .. S $P(I N1,HLFS,3) =$$ENCHL7( $P(^IBE(36 5.12,PAYR, 0),U,2))_H LECH_HLECH _HLECH_"US VHA"_HLECH _"VP"_HLEC H | |
| 7648 | "RTN","IBC NEHLQ",182 ,0) | |
| 7649 | .. S $P(I N1,HLFS,4) =$$ENCHL7( $P(^IBE(36 5.12,PAYR, 0),U,1)) | |
| 7650 | "RTN","IBC NEHLQ",183 ,0) | |
| 7651 | . S $P(IN 1,HLFS,17) =$$PATREL( PREL) | |
| 7652 | "RTN","IBC NEHLQ",184 ,0) | |
| 7653 | . S IENS= IRIEN_","_ DFN_"," | |
| 7654 | "RTN","IBC NEHLQ",185 ,0) | |
| 7655 | . S $P(IN 1,HLFS,8)= $$ENCHL7($ $GET1^DIQ( 2.312,IENS ,21,"E")) | |
| 7656 | "RTN","IBC NEHLQ",186 ,0) | |
| 7657 | . S $P(IN 1,HLFS,9)= $$ENCHL7($ $GET1^DIQ( 2.312,IENS ,20,"E")) | |
| 7658 | "RTN","IBC NEHLQ",187 ,0) | |
| 7659 | . I $P(IN 1,HLFS,17) ="" S $P(I N1,HLFS,17 )=18 | |
| 7660 | "RTN","IBC NEHLQ",188 ,0) | |
| 7661 | ; | |
| 7662 | "RTN","IBC NEHLQ",189 ,0) | |
| 7663 | ; IB*2.0* 621/DM add EICD Veri fication, use data f rom EIV EI CD TRACKIN G (#365.18 ) | |
| 7664 | "RTN","IBC NEHLQ",190 ,0) | |
| 7665 | I EXT=4,$ G(QUERY)=" V" D | |
| 7666 | "RTN","IBC NEHLQ",191 ,0) | |
| 7667 | . S EICDI IEN=+$O(^I BCN(365.18 ,"C",IEN,0 )) ; IEN i s the TQ f rom IBCNED EP | |
| 7668 | "RTN","IBC NEHLQ",192 ,0) | |
| 7669 | . I ('EIC DIIEN)!(EI CDVIEN="") Q | |
| 7670 | "RTN","IBC NEHLQ",193 ,0) | |
| 7671 | . S IBFMI EN=EICDVIE N_","_EICD IIEN_"," | |
| 7672 | "RTN","IBC NEHLQ",194 ,0) | |
| 7673 | . K IBTRK DTA D GETS ^DIQ(365.1 85,IBFMIEN ,".01;.03; .05;.09"," I","IBTRKD TA") ; gra b selected fields (i nternal) | |
| 7674 | "RTN","IBC NEHLQ",195 ,0) | |
| 7675 | . ; | |
| 7676 | "RTN","IBC NEHLQ",196 ,0) | |
| 7677 | . S PREL= "18" ; me ans self/v eteran | |
| 7678 | "RTN","IBC NEHLQ",197 ,0) | |
| 7679 | . S:IBTRK DTA(365.18 5,IBFMIEN, .09,"I")'= "" PREL="" ; not sub scriber | |
| 7680 | "RTN","IBC NEHLQ",198 ,0) | |
| 7681 | . S $P(IN 1,HLFS,2)= IBTRKDTA(3 65.185,IBF MIEN,.05," I") | |
| 7682 | "RTN","IBC NEHLQ",199 ,0) | |
| 7683 | . S $P(IN 1,HLFS,3)= $$ENCHL7(I BTRKDTA(36 5.185,IBFM IEN,.01,"I "))_HLECH_ HLECH_HLEC H_"USVHA"_ HLECH_"VP" _HLECH ; P AYER VA ID | |
| 7684 | "RTN","IBC NEHLQ",200 ,0) | |
| 7685 | . S IBPYI EN=+$$FIND 1^DIC(365. 12,,"QX",I BTRKDTA(36 5.185,IBFM IEN,.01,"I "),"C") ; PAYER IEN | |
| 7686 | "RTN","IBC NEHLQ",201 ,0) | |
| 7687 | . S $P(IN 1,HLFS,4)= $$ENCHL7($ $GET1^DIQ( 365.12,IBP YIEN_",",. 01)) ; PAY ER NAME | |
| 7688 | "RTN","IBC NEHLQ",202 ,0) | |
| 7689 | . S $P(IN 1,HLFS,17) =$$PATREL( PREL) | |
| 7690 | "RTN","IBC NEHLQ",203 ,0) | |
| 7691 | . S $P(IN 1,HLFS,8)= IBTRKDTA(3 65.185,IBF MIEN,.03," I") ; GROU P NUMBER | |
| 7692 | "RTN","IBC NEHLQ",204 ,0) | |
| 7693 | I IN1="" Q | |
| 7694 | "RTN","IBC NEHLQ",205 ,0) | |
| 7695 | ; | |
| 7696 | "RTN","IBC NEHLQ",206 ,0) | |
| 7697 | S $P(IN1, HLFS,1)=1 | |
| 7698 | "RTN","IBC NEHLQ",207 ,0) | |
| 7699 | S IN1="IN 1"_HLFS_IN 1 | |
| 7700 | "RTN","IBC NEHLQ",208 ,0) | |
| 7701 | Q | |
| 7702 | "RTN","IBC NEHLQ",209 ,0) | |
| 7703 | ; | |
| 7704 | "RTN","IBC NEHLQ",210 ,0) | |
| 7705 | NTE(CTR) ; NTE Segm ent | |
| 7706 | "RTN","IBC NEHLQ",211 ,0) | |
| 7707 | N EICDIIE N | |
| 7708 | "RTN","IBC NEHLQ",212 ,0) | |
| 7709 | ; TRANSR is 0 node of TQ, set in PROC^I BCNEDEP | |
| 7710 | "RTN","IBC NEHLQ",213 ,0) | |
| 7711 | I CTR=1 S NTE=$$EXT ERNAL^DILF D(365.1,.2 ,,$P($G(TR ANSR),U,20 )) ; servi ce code fr om 365.1/. 2 | |
| 7712 | "RTN","IBC NEHLQ",214 ,0) | |
| 7713 | ; IB*2.0* 601 - Adde d NTE2 and NTE3 | |
| 7714 | "RTN","IBC NEHLQ",215 ,0) | |
| 7715 | I CTR=2 D | |
| 7716 | "RTN","IBC NEHLQ",216 ,0) | |
| 7717 | . S NTE=$ $GET1^DIQ( 365.1,IEN_ ",","SOURC E OF INFOR MATION","I ") ; IEN = ien of T Q | |
| 7718 | "RTN","IBC NEHLQ",217 ,0) | |
| 7719 | . S NTE=$ $GET1^DIQ( 355.12,NTE _",","IB B UFFER ACRO NYM") | |
| 7720 | "RTN","IBC NEHLQ",218 ,0) | |
| 7721 | I CTR=3 S NTE=$S((( EXT=4)&(QU ERY="I")): "OHI",$$MB ICHK^IBCNE UT7(BUFF): "MBI",1:"E LI") ; IB* 2.0*621 | |
| 7722 | "RTN","IBC NEHLQ",219 ,0) | |
| 7723 | ; IB*2.0* 621 | |
| 7724 | "RTN","IBC NEHLQ",220 ,0) | |
| 7725 | I CTR=4 S NTE="" ; Reporting of known i nsurance i nfomation will happe n at a lat er release | |
| 7726 | "RTN","IBC NEHLQ",221 ,0) | |
| 7727 | I CTR=5 S NTE="" | |
| 7728 | "RTN","IBC NEHLQ",222 ,0) | |
| 7729 | I CTR=5,E XT=4,QUERY ="V" D | |
| 7730 | "RTN","IBC NEHLQ",223 ,0) | |
| 7731 | . ; on EI CD Verific ations, pa ss the TRA CE # from the associ ted EICD I nquiry | |
| 7732 | "RTN","IBC NEHLQ",224 ,0) | |
| 7733 | . S EICDI IEN=+$O(^I BCN(365.18 ,"C",IEN,0 )) ; IEN i s the TQ f rom IBCNED EP | |
| 7734 | "RTN","IBC NEHLQ",225 ,0) | |
| 7735 | . S NTE=$ $GET1^DIQ( 365.18,EIC DIIEN_",", .04,"I") ; EICD TRAC E NUMBER | |
| 7736 | "RTN","IBC NEHLQ",226 ,0) | |
| 7737 | S NTE="NT E"_HLFS_CT R_HLFS_HLF S_NTE | |
| 7738 | "RTN","IBC NEHLQ",227 ,0) | |
| 7739 | K CTR | |
| 7740 | "RTN","IBC NEHLQ",228 ,0) | |
| 7741 | Q | |
| 7742 | "RTN","IBC NEHLQ",229 ,0) | |
| 7743 | ; | |
| 7744 | "RTN","IBC NEHLQ",230 ,0) | |
| 7745 | CHK ; Che ck for spo use or oth er informa tion in th e Patient Relation F ile | |
| 7746 | "RTN","IBC NEHLQ",231 ,0) | |
| 7747 | ; DGREL = Relation ship (1=Se lf, 2=Spou se, 3-34,9 9=Other) | |
| 7748 | "RTN","IBC NEHLQ",232 ,0) | |
| 7749 | NEW IEN,Q FL | |
| 7750 | "RTN","IBC NEHLQ",233 ,0) | |
| 7751 | S IEN="", RLIEN="",I SEX="",QFL =0 | |
| 7752 | "RTN","IBC NEHLQ",234 ,0) | |
| 7753 | F S IEN= $O(^DGPR(4 08.12,"B", DFN,IEN)) Q:IEN="" D Q:QFL | |
| 7754 | "RTN","IBC NEHLQ",235 ,0) | |
| 7755 | . S DGREL =$P($G(^DG PR(408.12, IEN,0)),U, 2) | |
| 7756 | "RTN","IBC NEHLQ",236 ,0) | |
| 7757 | . ; | |
| 7758 | "RTN","IBC NEHLQ",237 ,0) | |
| 7759 | . ; If p erson is v eteran, qu it | |
| 7760 | "RTN","IBC NEHLQ",238 ,0) | |
| 7761 | . I DGREL =1 Q | |
| 7762 | "RTN","IBC NEHLQ",239 ,0) | |
| 7763 | . ; | |
| 7764 | "RTN","IBC NEHLQ",240 ,0) | |
| 7765 | . ; If p erson is s pouse, pic k that rec ord and qu it | |
| 7766 | "RTN","IBC NEHLQ",241 ,0) | |
| 7767 | . I WHO=" s",DGREL=2 S RLIEN=I EN,QFL=1 Q | |
| 7768 | "RTN","IBC NEHLQ",242 ,0) | |
| 7769 | . ; | |
| 7770 | "RTN","IBC NEHLQ",243 ,0) | |
| 7771 | . ; Othe rwise it s hould be a n 'other' dependent | |
| 7772 | "RTN","IBC NEHLQ",244 ,0) | |
| 7773 | . S RLIEN =IEN | |
| 7774 | "RTN","IBC NEHLQ",245 ,0) | |
| 7775 | ; | |
| 7776 | "RTN","IBC NEHLQ",246 ,0) | |
| 7777 | I RLIEN=" " Q | |
| 7778 | "RTN","IBC NEHLQ",247 ,0) | |
| 7779 | ; | |
| 7780 | "RTN","IBC NEHLQ",248 ,0) | |
| 7781 | ; Check for Sex, S SN, DOB in INCOME PE RSON File | |
| 7782 | "RTN","IBC NEHLQ",249 ,0) | |
| 7783 | S PER=$P( ^DGPR(408. 12,RLIEN,0 ),U,3) | |
| 7784 | "RTN","IBC NEHLQ",250 ,0) | |
| 7785 | I PER'["D GPR(408.13 " Q | |
| 7786 | "RTN","IBC NEHLQ",251 ,0) | |
| 7787 | S PLIEN=$ P(PER,";", 1) | |
| 7788 | "RTN","IBC NEHLQ",252 ,0) | |
| 7789 | I PLIEN=" " Q | |
| 7790 | "RTN","IBC NEHLQ",253 ,0) | |
| 7791 | S RDATA=$ G(^DGPR(40 8.13,PLIEN ,0)),ISEX= $P(RDATA,U ,2),IDOB=$ P(RDATA,U, 3) | |
| 7792 | "RTN","IBC NEHLQ",254 ,0) | |
| 7793 | I $P(RDAT A,U,4)'="" N DFN S D FN=$P(RDAT A,U,4),ISE X=$P(^DPT( DFN,0),U,2 ),IDOB=$P( ^DPT(DFN,0 ),U,3) | |
| 7794 | "RTN","IBC NEHLQ",255 ,0) | |
| 7795 | Q | |
| 7796 | "RTN","IBC NEHLQ",256 ,0) | |
| 7797 | ; | |
| 7798 | "RTN","IBC NEHLQ",257 ,0) | |
| 7799 | ENCHL7(STR ) ; Encode HL7 escap e seqs in data field s | |
| 7800 | "RTN","IBC NEHLQ",258 ,0) | |
| 7801 | ; | |
| 7802 | "RTN","IBC NEHLQ",259 ,0) | |
| 7803 | ; Input: | |
| 7804 | "RTN","IBC NEHLQ",260 ,0) | |
| 7805 | ; STR = F ield data possible c ontaining HL7 encodi ng chars | |
| 7806 | "RTN","IBC NEHLQ",261 ,0) | |
| 7807 | ; | |
| 7808 | "RTN","IBC NEHLQ",262 ,0) | |
| 7809 | ; Output Values | |
| 7810 | "RTN","IBC NEHLQ",263 ,0) | |
| 7811 | ; Fn retu rns string w/convert ed escape seqs | |
| 7812 | "RTN","IBC NEHLQ",264 ,0) | |
| 7813 | ; | |
| 7814 | "RTN","IBC NEHLQ",265 ,0) | |
| 7815 | N CHR,NEW ,RPLC,CNT, LOOP | |
| 7816 | "RTN","IBC NEHLQ",266 ,0) | |
| 7817 | ; | |
| 7818 | "RTN","IBC NEHLQ",267 ,0) | |
| 7819 | ; Replace "\" "&" " ~" "|" wit h \F\ \R\ \E\ \T\ re spectively | |
| 7820 | "RTN","IBC NEHLQ",268 ,0) | |
| 7821 | F CHR="\" ,"&","~"," |" S CNT=$ L(STR,CHR) I CNT>1 D | |
| 7822 | "RTN","IBC NEHLQ",269 ,0) | |
| 7823 | . S NEW=$ P(STR,CHR) | |
| 7824 | "RTN","IBC NEHLQ",270 ,0) | |
| 7825 | . S RPLC= "\"_$TR(CH R,"|~\&"," FRET")_"\" | |
| 7826 | "RTN","IBC NEHLQ",271 ,0) | |
| 7827 | . F LOOP= 2:1:CNT S NEW=NEW_RP LC_$P(STR, CHR,LOOP) | |
| 7828 | "RTN","IBC NEHLQ",272 ,0) | |
| 7829 | . S STR=N EW | |
| 7830 | "RTN","IBC NEHLQ",273 ,0) | |
| 7831 | ; | |
| 7832 | "RTN","IBC NEHLQ",274 ,0) | |
| 7833 | Q STR | |
| 7834 | "RTN","IBC NEHLQ",275 ,0) | |
| 7835 | ; | |
| 7836 | "RTN","IBC NEHLQ",276 ,0) | |
| 7837 | SCRUB(Z) ; remove al l punctuat ion from t he string and conver t lowercas e to upper case | |
| 7838 | "RTN","IBC NEHLQ",277 ,0) | |
| 7839 | ; IB*2*41 6 - used f or subscri ber and pa tient ID f ields | |
| 7840 | "RTN","IBC NEHLQ",278 ,0) | |
| 7841 | S Z=$$NOP UNCT^IBCEF (Z,1) | |
| 7842 | "RTN","IBC NEHLQ",279 ,0) | |
| 7843 | S Z=$$UP^ XLFSTR(Z) | |
| 7844 | "RTN","IBC NEHLQ",280 ,0) | |
| 7845 | SCRUBX ; | |
| 7846 | "RTN","IBC NEHLQ",281 ,0) | |
| 7847 | Q Z | |
| 7848 | "RTN","IBC NEHLQ",282 ,0) | |
| 7849 | ; | |
| 7850 | "RTN","IBC NEHLQ",283 ,0) | |
| 7851 | PATREL(REL ) ; conver t pat.rela tionship t o insured from VistA to X12 an d return X 12 value | |
| 7852 | "RTN","IBC NEHLQ",284 ,0) | |
| 7853 | ; REL - V istA value | |
| 7854 | "RTN","IBC NEHLQ",285 ,0) | |
| 7855 | ; | |
| 7856 | "RTN","IBC NEHLQ",286 ,0) | |
| 7857 | ; VistA v alues of S elf (18), Spouse (01 ), and Chi ld (19) re main uncha nged, | |
| 7858 | "RTN","IBC NEHLQ",287 ,0) | |
| 7859 | ; anythin g else is converted to X12 val ue of Othe r Adult (3 4) | |
| 7860 | "RTN","IBC NEHLQ",288 ,0) | |
| 7861 | ; | |
| 7862 | "RTN","IBC NEHLQ",289 ,0) | |
| 7863 | Q $S($G(R EL)="":"", ".01.18.19 ."[("."_RE L_"."):REL ,1:34) | |
| 7864 | "RTN","IBC NEHLT") | |
| 7865 | 0^9^B95865 249^B94982 650 | |
| 7866 | "RTN","IBC NEHLT",1,0 ) | |
| 7867 | IBCNEHLT ; DAOU/ALA - HL7 Proce ss Incomin g MFN Mess ages ; 15 Mar 2016 3:00 PM | |
| 7868 | "RTN","IBC NEHLT",2,0 ) | |
| 7869 | ;;2.0;INT EGRATED BI LLING;**18 4,251,271, 300,416,43 8,506,549, 582,601,62 1**;21-MAR -94;Build 8 | |
| 7870 | "RTN","IBC NEHLT",3,0 ) | |
| 7871 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 7872 | "RTN","IBC NEHLT",4,0 ) | |
| 7873 | ; | |
| 7874 | "RTN","IBC NEHLT",5,0 ) | |
| 7875 | ;**Progra m Descript ion** | |
| 7876 | "RTN","IBC NEHLT",6,0 ) | |
| 7877 | ; This p rogram wil l process incoming M FN message s and | |
| 7878 | "RTN","IBC NEHLT",7,0 ) | |
| 7879 | ; update the appro priate tab les | |
| 7880 | "RTN","IBC NEHLT",8,0 ) | |
| 7881 | ; | |
| 7882 | "RTN","IBC NEHLT",9,0 ) | |
| 7883 | EN ; Entr y Point | |
| 7884 | "RTN","IBC NEHLT",10, 0) | |
| 7885 | NEW AIEN, APIEN,APP, D0,D,DESC, DQ,DR,FILE ,FLN,HEDI, ID,IEN | |
| 7886 | "RTN","IBC NEHLT",11, 0) | |
| 7887 | NEW PEDI, SEG,STAT,H CT,NEWID,T SSN,REQSUB ,NAFLG,NPF LG,TRUSTED | |
| 7888 | "RTN","IBC NEHLT",12, 0) | |
| 7889 | NEW IBCNA CT,IBCNADT ,FSVDY,PSV DY | |
| 7890 | "RTN","IBC NEHLT",13, 0) | |
| 7891 | NEW BPSIE N,CMIEN,DA TA,DATAAP, DATABPS,DA TACM,DATE, ERROR,FIEL DNO,FILENO | |
| 7892 | "RTN","IBC NEHLT",14, 0) | |
| 7893 | NEW IBSEG ,MSG,BUFF | |
| 7894 | "RTN","IBC NEHLT",15, 0) | |
| 7895 | NEW X12TA BLE,BADFMT | |
| 7896 | "RTN","IBC NEHLT",16, 0) | |
| 7897 | ; | |
| 7898 | "RTN","IBC NEHLT",17, 0) | |
| 7899 | ; BADFMT is true if a site wi th patch 3 00 receive s an eIV m essage in the previo us HL7 int erface str ucture (pr e-300) | |
| 7900 | "RTN","IBC NEHLT",18, 0) | |
| 7901 | ; | |
| 7902 | "RTN","IBC NEHLT",19, 0) | |
| 7903 | ; ** With national release of IB*2*550 ePharmacy will no lo nger use t his routin e to proce ss table | |
| 7904 | "RTN","IBC NEHLT",20, 0) | |
| 7905 | ; upda tes. | |
| 7906 | "RTN","IBC NEHLT",21, 0) | |
| 7907 | ; ** Ther efore, sev eral lines of code w ill become obsolete as comment ed in this routine. | |
| 7908 | "RTN","IBC NEHLT",22, 0) | |
| 7909 | ; | |
| 7910 | "RTN","IBC NEHLT",23, 0) | |
| 7911 | ; ** Upon national release of IB*2*550 reword sta tement bel ow to drop ePHARM re ference | |
| 7912 | "RTN","IBC NEHLT",24, 0) | |
| 7913 | ; | |
| 7914 | "RTN","IBC NEHLT",25, 0) | |
| 7915 | ; Build l ocal table of file n umbers to determine if respons e is eIV o r ePHARM | |
| 7916 | "RTN","IBC NEHLT",26, 0) | |
| 7917 | ; * Warni ng: Before adding a new table to be upda ted by FSC , one must get FSC | |
| 7918 | "RTN","IBC NEHLT",27, 0) | |
| 7919 | ; to agr ee and the eIV ICD d ocumentati on has to be updated and | |
| 7920 | "RTN","IBC NEHLT",28, 0) | |
| 7921 | ; approv ed by the VA HL7 tea m. Just ad ding a tab le number here does | |
| 7922 | "RTN","IBC NEHLT",29, 0) | |
| 7923 | ; absolu tely nothi ng without involving the other teams. | |
| 7924 | "RTN","IBC NEHLT",30, 0) | |
| 7925 | ; | |
| 7926 | "RTN","IBC NEHLT",31, 0) | |
| 7927 | F D=11:1: 18 S X12TA BLE("365.0 "_D)="" | |
| 7928 | "RTN","IBC NEHLT",32, 0) | |
| 7929 | ;F D=21:1 :28 S X12T ABLE("365. 0"_D)="" | |
| 7930 | "RTN","IBC NEHLT",33, 0) | |
| 7931 | S X12TABL E(350.021) ="" | |
| 7932 | "RTN","IBC NEHLT",34, 0) | |
| 7933 | S X12TABL E(350.9)=" " ; IB *2.0*506 | |
| 7934 | "RTN","IBC NEHLT",35, 0) | |
| 7935 | S X12TABL E(350.9002 )="" ; IB *2.0*549 | |
| 7936 | "RTN","IBC NEHLT",36, 0) | |
| 7937 | ; | |
| 7938 | "RTN","IBC NEHLT",37, 0) | |
| 7939 | ; Decide if message belongs t o "E-Pharm " or "eIV" | |
| 7940 | "RTN","IBC NEHLT",38, 0) | |
| 7941 | S APP="" | |
| 7942 | "RTN","IBC NEHLT",39, 0) | |
| 7943 | S HCT=0,E RFLG=0 | |
| 7944 | "RTN","IBC NEHLT",40, 0) | |
| 7945 | F S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT="" D SPAR^IBCNE HLU I $G(I BSEG(1))=" MFI" S FIL E=$G(IBSEG (2)),FLN=$ P(FILE,$E( HLECH,1),1 ) Q | |
| 7946 | "RTN","IBC NEHLT",41, 0) | |
| 7947 | I ",366.0 1,366.02,3 66.03,365. 12,355.3," [(","_FLN_ ",") S APP ="E-PHARM" ; ** Ob solete lin e upon rel ease of IB *2*550 | |
| 7948 | "RTN","IBC NEHLT",42, 0) | |
| 7949 | I FLN=365 .12 D | |
| 7950 | "RTN","IBC NEHLT",43, 0) | |
| 7951 | . S HCT=0 ,BADFMT=0 | |
| 7952 | "RTN","IBC NEHLT",44, 0) | |
| 7953 | . F S HC T=$O(^TMP( $J,"IBCNEH LI",HCT)) Q:HCT="" D Q:(APP= "IIV")!BAD FMT | |
| 7954 | "RTN","IBC NEHLT",45, 0) | |
| 7955 | .. D SPAR ^IBCNEHLU | |
| 7956 | "RTN","IBC NEHLT",46, 0) | |
| 7957 | .. I $G(I BSEG(1))=" MFE",$P($G (IBSEG(5)) ,$E(HLECH, 1),3)'="" D Q | |
| 7958 | "RTN","IBC NEHLT",47, 0) | |
| 7959 | ... S BAD FMT=1,APP= "" | |
| 7960 | "RTN","IBC NEHLT",48, 0) | |
| 7961 | ... S MSG (1)="Log a Remedy Ti cket for t his issue. " | |
| 7962 | "RTN","IBC NEHLT",49, 0) | |
| 7963 | ... S MSG (2)="Pleas e include in the Rem edy Ticket that the Vista eIV payer tabl es may be out" | |
| 7964 | "RTN","IBC NEHLT",50, 0) | |
| 7965 | ... S MSG (3)="of sy nc with th e master l ist and wi ll need a new copy o f the paye r table" | |
| 7966 | "RTN","IBC NEHLT",51, 0) | |
| 7967 | ... S MSG (4)="updat e message from Austi n." | |
| 7968 | "RTN","IBC NEHLT",52, 0) | |
| 7969 | ... D MSG ^IBCNEUT5( $$MGRP^IBC NEUT5(),"e IV payer t ables may be out of synch with master li st","MSG(" ) | |
| 7970 | "RTN","IBC NEHLT",53, 0) | |
| 7971 | .. I $G(I BSEG(1))=" ZPA" S APP ="IIV" | |
| 7972 | "RTN","IBC NEHLT",54, 0) | |
| 7973 | I $D(X12T ABLE(FLN)) S APP="II V" | |
| 7974 | "RTN","IBC NEHLT",55, 0) | |
| 7975 | ; | |
| 7976 | "RTN","IBC NEHLT",56, 0) | |
| 7977 | ; ** Upon release o f IB*2*550 , drop the ePharm re ference in the comme nt below | |
| 7978 | "RTN","IBC NEHLT",57, 0) | |
| 7979 | ; If neit her eIV or ePHARM th en quit | |
| 7980 | "RTN","IBC NEHLT",58, 0) | |
| 7981 | I APP="" Q | |
| 7982 | "RTN","IBC NEHLT",59, 0) | |
| 7983 | ; | |
| 7984 | "RTN","IBC NEHLT",60, 0) | |
| 7985 | S HCT=1,N AFLG=0,NPF LG=0,D="" | |
| 7986 | "RTN","IBC NEHLT",61, 0) | |
| 7987 | F S HCT= $O(^TMP($J ,"IBCNEHLI ",HCT)) Q: HCT="" D Q:ERFLG | |
| 7988 | "RTN","IBC NEHLT",62, 0) | |
| 7989 | . D SPAR^ IBCNEHLU | |
| 7990 | "RTN","IBC NEHLT",63, 0) | |
| 7991 | . S SEG=$ G(IBSEG(1) ) | |
| 7992 | "RTN","IBC NEHLT",64, 0) | |
| 7993 | . ; | |
| 7994 | "RTN","IBC NEHLT",65, 0) | |
| 7995 | . I APP=" E-PHARM" D ; ** T his Do-loo p is obsol ete upon r elease of IB*2*550 | |
| 7996 | "RTN","IBC NEHLT",66, 0) | |
| 7997 | .. I SEG= "MFI" D | |
| 7998 | "RTN","IBC NEHLT",67, 0) | |
| 7999 | ... S FIL E=$G(IBSEG (2)) | |
| 8000 | "RTN","IBC NEHLT",68, 0) | |
| 8001 | ... S FLN =$P(FILE,$ E(HLECH,1) ,1) | |
| 8002 | "RTN","IBC NEHLT",69, 0) | |
| 8003 | ... ; | |
| 8004 | "RTN","IBC NEHLT",70, 0) | |
| 8005 | ... ; Ini tialize MF K Message (Applicati on Acknowl edgement) variables | |
| 8006 | "RTN","IBC NEHLT",71, 0) | |
| 8007 | ... ; Mas ter File I dentifier | |
| 8008 | "RTN","IBC NEHLT",72, 0) | |
| 8009 | ... S DAT AMFK("MFI- 1")=$G(IBS EG(2)) | |
| 8010 | "RTN","IBC NEHLT",73, 0) | |
| 8011 | ... ; | |
| 8012 | "RTN","IBC NEHLT",74, 0) | |
| 8013 | ... ; Fil e-Level Ev ent Code | |
| 8014 | "RTN","IBC NEHLT",75, 0) | |
| 8015 | ... S DAT AMFK("MFI- 3")=$G(IBS EG(4)) | |
| 8016 | "RTN","IBC NEHLT",76, 0) | |
| 8017 | .. ; | |
| 8018 | "RTN","IBC NEHLT",77, 0) | |
| 8019 | .. I SEG= "MFE" D | |
| 8020 | "RTN","IBC NEHLT",78, 0) | |
| 8021 | ... I $G( FLN)="" S ERFLG=1,MS G(1)="File Number no t found in MFN messa ge" Q | |
| 8022 | "RTN","IBC NEHLT",79, 0) | |
| 8023 | ... I '$$ VFILE^DILF D(FLN) S E RFLG=1,MSG (1)="File "_FLN_" no t found in the Data Dictionary " Q | |
| 8024 | "RTN","IBC NEHLT",80, 0) | |
| 8025 | ... ; | |
| 8026 | "RTN","IBC NEHLT",81, 0) | |
| 8027 | ... ; Ini tialize MF K Message (Applicati on Acknowl edgement) variables | |
| 8028 | "RTN","IBC NEHLT",82, 0) | |
| 8029 | ... ; Rec ord-Level Event Code | |
| 8030 | "RTN","IBC NEHLT",83, 0) | |
| 8031 | ... S DAT AMFK("MFE- 1")=$G(IBS EG(2)) | |
| 8032 | "RTN","IBC NEHLT",84, 0) | |
| 8033 | ... ; | |
| 8034 | "RTN","IBC NEHLT",85, 0) | |
| 8035 | ... ; Pri mary Key V alue | |
| 8036 | "RTN","IBC NEHLT",86, 0) | |
| 8037 | ... S DAT AMFK("MFE- 4")=$G(IBS EG(5)) | |
| 8038 | "RTN","IBC NEHLT",87, 0) | |
| 8039 | ... ; | |
| 8040 | "RTN","IBC NEHLT",88, 0) | |
| 8041 | ... ; Pri mary Key V alue Type | |
| 8042 | "RTN","IBC NEHLT",89, 0) | |
| 8043 | ... S DAT AMFK("MFE- 5")=$G(IBS EG(6)) | |
| 8044 | "RTN","IBC NEHLT",90, 0) | |
| 8045 | ... ; | |
| 8046 | "RTN","IBC NEHLT",91, 0) | |
| 8047 | ... ; Tra nsfer cont rol to e-P harmacy | |
| 8048 | "RTN","IBC NEHLT",92, 0) | |
| 8049 | ... D ^IB CNRHLT Q | |
| 8050 | "RTN","IBC NEHLT",93, 0) | |
| 8051 | .. ; | |
| 8052 | "RTN","IBC NEHLT",94, 0) | |
| 8053 | .. ; Tran sfer contr ol on othe r segments | |
| 8054 | "RTN","IBC NEHLT",95, 0) | |
| 8055 | .. I ",ZC M,ZP0,ZPB, ZPL,ZPT,ZR X,"[(","_S EG_",") D ^IBCNRHLT | |
| 8056 | "RTN","IBC NEHLT",96, 0) | |
| 8057 | . ; ** en d of obsol ete do-loo p upon nat ional rele ase of IB* 2*550 | |
| 8058 | "RTN","IBC NEHLT",97, 0) | |
| 8059 | . ; | |
| 8060 | "RTN","IBC NEHLT",98, 0) | |
| 8061 | . ; | |
| 8062 | "RTN","IBC NEHLT",99, 0) | |
| 8063 | . ;** Upo n release of IB*2*55 0 this if statement (I APP="II V") won't be necessa ry but it DOES NOT | |
| 8064 | "RTN","IBC NEHLT",100 ,0) | |
| 8065 | . ; hur t to leave it in mov ing forwar d as a saf ety valve. | |
| 8066 | "RTN","IBC NEHLT",101 ,0) | |
| 8067 | . I APP=" IIV" D | |
| 8068 | "RTN","IBC NEHLT",102 ,0) | |
| 8069 | .. I SEG= "MFI" D | |
| 8070 | "RTN","IBC NEHLT",103 ,0) | |
| 8071 | ... S FIL E=$G(IBSEG (2)) | |
| 8072 | "RTN","IBC NEHLT",104 ,0) | |
| 8073 | ... S FLN =$P(FILE,$ E(HLECH,1) ,1) | |
| 8074 | "RTN","IBC NEHLT",105 ,0) | |
| 8075 | .. ; | |
| 8076 | "RTN","IBC NEHLT",106 ,0) | |
| 8077 | .. I SEG= "MFE" D | |
| 8078 | "RTN","IBC NEHLT",107 ,0) | |
| 8079 | ... I $G( FLN)="" S ERFLG=1,MS G(1)="File Number no t found in MFN messa ge" Q | |
| 8080 | "RTN","IBC NEHLT",108 ,0) | |
| 8081 | ... I '$$ VFILE^DILF D(FLN) S E RFLG=1,MSG (1)="File "_FLN_" no t found in the Data Dictionary " Q | |
| 8082 | "RTN","IBC NEHLT",109 ,0) | |
| 8083 | ... ; | |
| 8084 | "RTN","IBC NEHLT",110 ,0) | |
| 8085 | ... I FLN '=365.12 D Q | |
| 8086 | "RTN","IBC NEHLT",111 ,0) | |
| 8087 | .... S DA TA=$G(IBSE G(5)) | |
| 8088 | "RTN","IBC NEHLT",112 ,0) | |
| 8089 | .... S ID =$$DECHL7^ IBCNEHL2($ P(DATA,$E( HLECH,1),1 )),DESC=$$ DECHL7^IBC NEHL2($P(D ATA,$E(HLE CH,1),2)) | |
| 8090 | "RTN","IBC NEHLT",113 ,0) | |
| 8091 | .... D TF IL | |
| 8092 | "RTN","IBC NEHLT",114 ,0) | |
| 8093 | ... ; | |
| 8094 | "RTN","IBC NEHLT",115 ,0) | |
| 8095 | ... ; Pul l the acti on code | |
| 8096 | "RTN","IBC NEHLT",116 ,0) | |
| 8097 | ... S IBC NACT=$G(IB SEG(2)) | |
| 8098 | "RTN","IBC NEHLT",117 ,0) | |
| 8099 | ... ; Eff ective Dat e | |
| 8100 | "RTN","IBC NEHLT",118 ,0) | |
| 8101 | ... S IBC NADT=$G(IB SEG(4)) | |
| 8102 | "RTN","IBC NEHLT",119 ,0) | |
| 8103 | .. ; | |
| 8104 | "RTN","IBC NEHLT",120 ,0) | |
| 8105 | .. I SEG= "ZP0" D | |
| 8106 | "RTN","IBC NEHLT",121 ,0) | |
| 8107 | ... S ID= $$DECHL7^I BCNEHL2(IB SEG(3)),NE WID=$$DECH L7^IBCNEHL 2(IBSEG(4) ) | |
| 8108 | "RTN","IBC NEHLT",122 ,0) | |
| 8109 | ... S DES C=$$DECHL7 ^IBCNEHL2( IBSEG(5)), HEDI=$$DEC HL7^IBCNEH L2(IBSEG(6 )),PEDI=$$ DECHL7^IBC NEHL2(IBSE G(7)) | |
| 8110 | "RTN","IBC NEHLT",123 ,0) | |
| 8111 | .. ; | |
| 8112 | "RTN","IBC NEHLT",124 ,0) | |
| 8113 | .. I SEG= "ZPA" D | |
| 8114 | "RTN","IBC NEHLT",125 ,0) | |
| 8115 | ... S STA T=$S(IBSEG (4)="Y":1, 1:0) | |
| 8116 | "RTN","IBC NEHLT",126 ,0) | |
| 8117 | ... S TSS N=IBSEG(5) ,REQSUB=IB SEG(7) | |
| 8118 | "RTN","IBC NEHLT",127 ,0) | |
| 8119 | ... S FSV DY=IBSEG(8 ),PSVDY=IB SEG(9) | |
| 8120 | "RTN","IBC NEHLT",128 ,0) | |
| 8121 | ... S TRU STED=$S(IB SEG(10)="N ":0,1:1) | |
| 8122 | "RTN","IBC NEHLT",129 ,0) | |
| 8123 | ... D PFI L | |
| 8124 | "RTN","IBC NEHLT",130 ,0) | |
| 8125 | Q | |
| 8126 | "RTN","IBC NEHLT",131 ,0) | |
| 8127 | ; | |
| 8128 | "RTN","IBC NEHLT",132 ,0) | |
| 8129 | PFIL ; Pa yer Table Filer | |
| 8130 | "RTN","IBC NEHLT",133 ,0) | |
| 8131 | ; Set th e action: | |
| 8132 | "RTN","IBC NEHLT",134 ,0) | |
| 8133 | ; MAD =Add, MUP= Update, MD C=Deactiva te, MAC=Re activate | |
| 8134 | "RTN","IBC NEHLT",135 ,0) | |
| 8135 | N OLDAF,O LDTF | |
| 8136 | "RTN","IBC NEHLT",136 ,0) | |
| 8137 | S IBCNADT =$$FMDATE^ HLFNC(IBCN ADT) | |
| 8138 | "RTN","IBC NEHLT",137 ,0) | |
| 8139 | I IBCNADT ="" S IBCN ADT=$$NOW^ XLFDT() | |
| 8140 | "RTN","IBC NEHLT",138 ,0) | |
| 8141 | ; If the action is MAD - Add the payer as new | |
| 8142 | "RTN","IBC NEHLT",139 ,0) | |
| 8143 | ; IB*582 /TAZ if th e action i s MUP and the entry doesn't ex ist, add t he payer a s new | |
| 8144 | "RTN","IBC NEHLT",140 ,0) | |
| 8145 | N IBNOK,I BAPP,IBID, IBDESC,IBS TR,IBCNTYP E | |
| 8146 | "RTN","IBC NEHLT",141 ,0) | |
| 8147 | S IBNOK=0 ,IBAPP=($T R(APP," ") =""),IBID= ($TR(ID," ")=""),IBD ESC=($TR(D ESC," ")=" "),IBNOK=I BAPP!IBID! IBDESC | |
| 8148 | "RTN","IBC NEHLT",142 ,0) | |
| 8149 | I IBNOK D G PFILX | |
| 8150 | "RTN","IBC NEHLT",143 ,0) | |
| 8151 | . S IBCNT YPE=$S(IBC NACT="MAD" :"Add",IBC NACT="MUP" :"Update", IBCNACT="M DC":"Deact ivate",IBC NACT="MAC" :"Reactiva te",1:"Unk nown") | |
| 8152 | "RTN","IBC NEHLT",144 ,0) | |
| 8153 | . S MSG(1 )=IBCNTYPE _" ("_IBCN ACT_") act ion receiv ed. Payer and/or App lication m ay be unkn own." | |
| 8154 | "RTN","IBC NEHLT",145 ,0) | |
| 8155 | . S MSG(2 )="" | |
| 8156 | "RTN","IBC NEHLT",146 ,0) | |
| 8157 | . S MSG(3 )="VA Nati onal : "_I D | |
| 8158 | "RTN","IBC NEHLT",147 ,0) | |
| 8159 | . S MSG(4 )="Payer N ame : "_DE SC | |
| 8160 | "RTN","IBC NEHLT",148 ,0) | |
| 8161 | . S MSG(5 )="Applica tion : "_A PP | |
| 8162 | "RTN","IBC NEHLT",149 ,0) | |
| 8163 | . S MSG(6 )="" | |
| 8164 | "RTN","IBC NEHLT",150 ,0) | |
| 8165 | . S MSG(7 )="Log a R emedy Tick et for thi s issue." | |
| 8166 | "RTN","IBC NEHLT",151 ,0) | |
| 8167 | . S MSG(8 )="" | |
| 8168 | "RTN","IBC NEHLT",152 ,0) | |
| 8169 | . S MSG(9 )="Please include in the Remed y Ticket t hat VISTA did not re ceive the required" | |
| 8170 | "RTN","IBC NEHLT",153 ,0) | |
| 8171 | . S MSG(1 0)="inform ation or t he accurat e informat ion to add /update th is Payer." | |
| 8172 | "RTN","IBC NEHLT",154 ,0) | |
| 8173 | . D MSG^I BCNEUT5($$ MGRP^IBCNE UT5(),"eIV payer tab les may be out of sy nch with m aster list ","MSG(") | |
| 8174 | "RTN","IBC NEHLT",155 ,0) | |
| 8175 | D FND I I EN<0 D MAD (DESC) | |
| 8176 | "RTN","IBC NEHLT",156 ,0) | |
| 8177 | ; | |
| 8178 | "RTN","IBC NEHLT",157 ,0) | |
| 8179 | S DESC=$E (DESC,1,80 ) ;rest riction of the field in the DD | |
| 8180 | "RTN","IBC NEHLT",158 ,0) | |
| 8181 | S DIC=$$R OOT^DILFD( FLN) | |
| 8182 | "RTN","IBC NEHLT",159 ,0) | |
| 8183 | S DR=".01 ///^S X=DE SC;.02//// ^S X=NEWID ;.05////^S X=PEDI;.0 6////^S X= HEDI" | |
| 8184 | "RTN","IBC NEHLT",160 ,0) | |
| 8185 | ; | |
| 8186 | "RTN","IBC NEHLT",161 ,0) | |
| 8187 | ; If new payer, ad d the Date /Time crea ted | |
| 8188 | "RTN","IBC NEHLT",162 ,0) | |
| 8189 | I NPFLG S DR=DR_";. 04///^S X= $$NOW^XLFD T()" | |
| 8190 | "RTN","IBC NEHLT",163 ,0) | |
| 8191 | S DIE=DIC ,DA=IEN D ^DIE | |
| 8192 | "RTN","IBC NEHLT",164 ,0) | |
| 8193 | ; | |
| 8194 | "RTN","IBC NEHLT",165 ,0) | |
| 8195 | ; Check for applic ation | |
| 8196 | "RTN","IBC NEHLT",166 ,0) | |
| 8197 | S DIC="^I BE(365.13, ",DIC(0)=" X",X=APP D ^DIC | |
| 8198 | "RTN","IBC NEHLT",167 ,0) | |
| 8199 | S AIEN=+Y I AIEN<1 D | |
| 8200 | "RTN","IBC NEHLT",168 ,0) | |
| 8201 | . S DLAYG O=365.13,D IC(0)="L", DIC("P")=D LAYGO | |
| 8202 | "RTN","IBC NEHLT",169 ,0) | |
| 8203 | . S DIE=D IC,X=APP | |
| 8204 | "RTN","IBC NEHLT",170 ,0) | |
| 8205 | . K DD,DO | |
| 8206 | "RTN","IBC NEHLT",171 ,0) | |
| 8207 | . D FILE^ DICN | |
| 8208 | "RTN","IBC NEHLT",172 ,0) | |
| 8209 | . K DO | |
| 8210 | "RTN","IBC NEHLT",173 ,0) | |
| 8211 | . S AIEN= +Y | |
| 8212 | "RTN","IBC NEHLT",174 ,0) | |
| 8213 | ; | |
| 8214 | "RTN","IBC NEHLT",175 ,0) | |
| 8215 | S APIEN=$ O(^IBE(365 .12,IEN,1, "B",AIEN," ")) | |
| 8216 | "RTN","IBC NEHLT",176 ,0) | |
| 8217 | I APIEN=" " D | |
| 8218 | "RTN","IBC NEHLT",177 ,0) | |
| 8219 | . S DLAYG O=365.121, DIC(0)="L" ,DIC("P")= DLAYGO,DA( 1)=IEN,X=A IEN | |
| 8220 | "RTN","IBC NEHLT",178 ,0) | |
| 8221 | . S DIC=" ^IBE(365.1 2,"_DA(1)_ ",1,",DIE= DIC | |
| 8222 | "RTN","IBC NEHLT",179 ,0) | |
| 8223 | . I '$D(^ IBE(365.12 ,IEN,1,0)) S ^IBE(36 5.12,IEN,1 ,0)="^365. 121P^^" | |
| 8224 | "RTN","IBC NEHLT",180 ,0) | |
| 8225 | . K DD,DO | |
| 8226 | "RTN","IBC NEHLT",181 ,0) | |
| 8227 | . D FILE^ DICN | |
| 8228 | "RTN","IBC NEHLT",182 ,0) | |
| 8229 | . K DO | |
| 8230 | "RTN","IBC NEHLT",183 ,0) | |
| 8231 | . S APIEN =+Y,NAFLG= 1 | |
| 8232 | "RTN","IBC NEHLT",184 ,0) | |
| 8233 | ; get cur rent value s for Acti ve and Tru sted flags | |
| 8234 | "RTN","IBC NEHLT",185 ,0) | |
| 8235 | S OLDAF=$ P(^IBE(365 .12,IEN,1, APIEN,0),U ,2),OLDTF= $P(^IBE(36 5.12,IEN,1 ,APIEN,0), U,7) | |
| 8236 | "RTN","IBC NEHLT",186 ,0) | |
| 8237 | S DA(1)=I EN,DA=APIE N,DIC="^IB E(365.12," _DA(1)_",1 ,",DR="" | |
| 8238 | "RTN","IBC NEHLT",187 ,0) | |
| 8239 | ; | |
| 8240 | "RTN","IBC NEHLT",188 ,0) | |
| 8241 | I IBCNACT ="MDC" S D R=DR_".11/ //^S X=1;. 12////^S X =IBCNADT;" ,STAT=0 | |
| 8242 | "RTN","IBC NEHLT",189 ,0) | |
| 8243 | I IBCNACT ="MAC" S D R=DR_".11/ //^S X=0;. 12///@;" | |
| 8244 | "RTN","IBC NEHLT",190 ,0) | |
| 8245 | S DR=DR_" .02///^S X =STAT;.06/ //^S X=$$N OW^XLFDT() ;.07///^S X=TRUSTED" | |
| 8246 | "RTN","IBC NEHLT",191 ,0) | |
| 8247 | I IBCNACT '="MDC" S DR=DR_";.0 8///^S X=R EQSUB;.1// /^S X=TSSN ;.14///^S X=FSVDY;.1 5///^S X=P SVDY" | |
| 8248 | "RTN","IBC NEHLT",192 ,0) | |
| 8249 | ; | |
| 8250 | "RTN","IBC NEHLT",193 ,0) | |
| 8251 | ; If new applicati on, add th e Date/Tim e created | |
| 8252 | "RTN","IBC NEHLT",194 ,0) | |
| 8253 | I NAFLG S DR=DR_";. 13///^S X= $$NOW^XLFD T()" | |
| 8254 | "RTN","IBC NEHLT",195 ,0) | |
| 8255 | ; | |
| 8256 | "RTN","IBC NEHLT",196 ,0) | |
| 8257 | S DIE=DIC D ^DIE | |
| 8258 | "RTN","IBC NEHLT",197 ,0) | |
| 8259 | S IBACK=" AA" | |
| 8260 | "RTN","IBC NEHLT",198 ,0) | |
| 8261 | ; Update flag logs | |
| 8262 | "RTN","IBC NEHLT",199 ,0) | |
| 8263 | I STAT'=O LDAF D UPD LOG("A",ST AT,IEN,API EN) | |
| 8264 | "RTN","IBC NEHLT",200 ,0) | |
| 8265 | I TRUSTED '=OLDTF D UPDLOG("T" ,TRUSTED,I EN,APIEN) | |
| 8266 | "RTN","IBC NEHLT",201 ,0) | |
| 8267 | I IBCNACT ="MDC" D M DC Q | |
| 8268 | "RTN","IBC NEHLT",202 ,0) | |
| 8269 | PFILX ; | |
| 8270 | "RTN","IBC NEHLT",203 ,0) | |
| 8271 | Q | |
| 8272 | "RTN","IBC NEHLT",204 ,0) | |
| 8273 | ; | |
| 8274 | "RTN","IBC NEHLT",205 ,0) | |
| 8275 | TFIL ; No n Payer Ta bles Filer | |
| 8276 | "RTN","IBC NEHLT",206 ,0) | |
| 8277 | ; Input: DESC - Fi eld Number | |
| 8278 | "RTN","IBC NEHLT",207 ,0) | |
| 8279 | ; ID - Fi eld Value | |
| 8280 | "RTN","IBC NEHLT",208 ,0) | |
| 8281 | ; FLN - Fi le Number | |
| 8282 | "RTN","IBC NEHLT",209 ,0) | |
| 8283 | N DA,DIC, DIE,DLAYGO ,DR,EXTRAC T,IEN,MAX, XX,X,Y ; IB*2.0*549 - Added D A,DIE,DR,E XTRACT,XX | |
| 8284 | "RTN","IBC NEHLT",210 ,0) | |
| 8285 | ; | |
| 8286 | "RTN","IBC NEHLT",211 ,0) | |
| 8287 | ; store t he FILENAM E, FIELDNA ME and VAL UE if the APP is IIV and FLN i s 350.9. - IB*2.0*5 06 | |
| 8288 | "RTN","IBC NEHLT",212 ,0) | |
| 8289 | ; For fil e #350.9, DESC repre sents the FIELD NUMB ER and ID represents the VALUE . | |
| 8290 | "RTN","IBC NEHLT",213 ,0) | |
| 8291 | I APP="II V",FLN=350 .9 D Q | |
| 8292 | "RTN","IBC NEHLT",214 ,0) | |
| 8293 | . S DIE=F LN,DA=1,DR =DESC_"/// "_ID | |
| 8294 | "RTN","IBC NEHLT",215 ,0) | |
| 8295 | . D ^DIE | |
| 8296 | "RTN","IBC NEHLT",216 ,0) | |
| 8297 | . S IBACK ="AA" | |
| 8298 | "RTN","IBC NEHLT",217 ,0) | |
| 8299 | ; | |
| 8300 | "RTN","IBC NEHLT",218 ,0) | |
| 8301 | ; IB*2.0* 549 Added if stateme nt | |
| 8302 | "RTN","IBC NEHLT",219 ,0) | |
| 8303 | I APP="II V",FLN=350 .9002 D Q | |
| 8304 | "RTN","IBC NEHLT",220 ,0) | |
| 8305 | . S EXTRA CT=$E(DESC ,1,4) ; Eith er "Buff", "Appt" or "EICD" | |
| 8306 | "RTN","IBC NEHLT",221 ,0) | |
| 8307 | . S XX=$S (EXTRACT=" Buff":1,EX TRACT="App t":2,EXTRA CT="EICD": 4,1:3) ; I B*2.0*621/ DM add EIC D | |
| 8308 | "RTN","IBC NEHLT",222 ,0) | |
| 8309 | . S DESC= $E(DESC,5, 99) ; Fiel d number | |
| 8310 | "RTN","IBC NEHLT",223 ,0) | |
| 8311 | . S DA(1) =1 | |
| 8312 | "RTN","IBC NEHLT",224 ,0) | |
| 8313 | . S DA=$O (^IBE(350. 9,1,51.17, "B",XX,"") ) ; Find correct m ultiple | |
| 8314 | "RTN","IBC NEHLT",225 ,0) | |
| 8315 | . ; | |
| 8316 | "RTN","IBC NEHLT",226 ,0) | |
| 8317 | . ; File the new va lue | |
| 8318 | "RTN","IBC NEHLT",227 ,0) | |
| 8319 | . S DIE=" ^IBE(350.9 ,1,51.17," | |
| 8320 | "RTN","IBC NEHLT",228 ,0) | |
| 8321 | . S DR=DE SC_"///"_I D | |
| 8322 | "RTN","IBC NEHLT",229 ,0) | |
| 8323 | . D ^DIE | |
| 8324 | "RTN","IBC NEHLT",230 ,0) | |
| 8325 | . S IBACK ="AA" | |
| 8326 | "RTN","IBC NEHLT",231 ,0) | |
| 8327 | ; | |
| 8328 | "RTN","IBC NEHLT",232 ,0) | |
| 8329 | ;IB*582/T AZ - Add n ew entries and updat e existing entries | |
| 8330 | "RTN","IBC NEHLT",233 ,0) | |
| 8331 | ; | |
| 8332 | "RTN","IBC NEHLT",234 ,0) | |
| 8333 | S DIC(0)= "X",X=ID,D IC=$$ROOT^ DILFD(FLN) | |
| 8334 | "RTN","IBC NEHLT",235 ,0) | |
| 8335 | D ^DIC S IEN=+Y | |
| 8336 | "RTN","IBC NEHLT",236 ,0) | |
| 8337 | ; don't u pdate exis ting entri es | |
| 8338 | "RTN","IBC NEHLT",237 ,0) | |
| 8339 | ;I IEN>0 Q | |
| 8340 | "RTN","IBC NEHLT",238 ,0) | |
| 8341 | ;Add new entry to t able | |
| 8342 | "RTN","IBC NEHLT",239 ,0) | |
| 8343 | I IEN<1 D | |
| 8344 | "RTN","IBC NEHLT",240 ,0) | |
| 8345 | . S DLAYG O=FLN,DIC( 0)="L" | |
| 8346 | "RTN","IBC NEHLT",241 ,0) | |
| 8347 | . K DD,DO D FILE^DI CN K DO | |
| 8348 | "RTN","IBC NEHLT",242 ,0) | |
| 8349 | ; | |
| 8350 | "RTN","IBC NEHLT",243 ,0) | |
| 8351 | ;Update D escription | |
| 8352 | "RTN","IBC NEHLT",244 ,0) | |
| 8353 | ; | |
| 8354 | "RTN","IBC NEHLT",245 ,0) | |
| 8355 | D FIELD^D ID(FLN,.02 ,,"FIELD L ENGTH","MA X") | |
| 8356 | "RTN","IBC NEHLT",246 ,0) | |
| 8357 | I MAX("FI ELD LENGTH ")>0 S DES C=$E(DESC, 1,MAX("FIE LD LENGTH" )) ; restr iction of the field in the DD | |
| 8358 | "RTN","IBC NEHLT",247 ,0) | |
| 8359 | ; add new entry to the table | |
| 8360 | "RTN","IBC NEHLT",248 ,0) | |
| 8361 | ;S DLAYGO =FLN,DIC(0 )="L",DIC( "DR")=".02 ///"_DESC | |
| 8362 | "RTN","IBC NEHLT",249 ,0) | |
| 8363 | ;S DLAYGO =FLN,DIC(0 )="L",DIC( "DR")=".02 ///^S X=DE SC" | |
| 8364 | "RTN","IBC NEHLT",250 ,0) | |
| 8365 | ;K DD,DO D FILE^DIC N K DO | |
| 8366 | "RTN","IBC NEHLT",251 ,0) | |
| 8367 | ;IB*2*601 /HN correc ted use of the DR va riable | |
| 8368 | "RTN","IBC NEHLT",252 ,0) | |
| 8369 | ;S DIE=DI C,DA=IEN,D IC("DR")=" .02///^S X =DESC" D ^ DIE | |
| 8370 | "RTN","IBC NEHLT",253 ,0) | |
| 8371 | S DIE=DIC ,DA=IEN,DR =".02///^S X=DESC" D ^DIE | |
| 8372 | "RTN","IBC NEHLT",254 ,0) | |
| 8373 | S IBACK=" AA" | |
| 8374 | "RTN","IBC NEHLT",255 ,0) | |
| 8375 | Q | |
| 8376 | "RTN","IBC NEHLT",256 ,0) | |
| 8377 | ; | |
| 8378 | "RTN","IBC NEHLT",257 ,0) | |
| 8379 | MAD(X) ; Add an ent ry | |
| 8380 | "RTN","IBC NEHLT",258 ,0) | |
| 8381 | ;IB*582/T AZ - Moved check to PFIL MAD i s called f or any rec ord that i s not foun d in the f ile. | |
| 8382 | "RTN","IBC NEHLT",259 ,0) | |
| 8383 | ;D FND | |
| 8384 | "RTN","IBC NEHLT",260 ,0) | |
| 8385 | ;I IEN>0 G MADX | |
| 8386 | "RTN","IBC NEHLT",261 ,0) | |
| 8387 | NEW DIC,D IE,DA,DLAY GO,Y,DR | |
| 8388 | "RTN","IBC NEHLT",262 ,0) | |
| 8389 | S DIC=$$R OOT^DILFD( FLN) | |
| 8390 | "RTN","IBC NEHLT",263 ,0) | |
| 8391 | S DLAYGO= FLN,DIC(0) ="L",DIC(" P")=DLAYGO ,DIE=DIC | |
| 8392 | "RTN","IBC NEHLT",264 ,0) | |
| 8393 | K DD,DO | |
| 8394 | "RTN","IBC NEHLT",265 ,0) | |
| 8395 | D FILE^DI CN | |
| 8396 | "RTN","IBC NEHLT",266 ,0) | |
| 8397 | K DO | |
| 8398 | "RTN","IBC NEHLT",267 ,0) | |
| 8399 | S IEN=+Y, NPFLG=1 | |
| 8400 | "RTN","IBC NEHLT",268 ,0) | |
| 8401 | MADX ; | |
| 8402 | "RTN","IBC NEHLT",269 ,0) | |
| 8403 | Q | |
| 8404 | "RTN","IBC NEHLT",270 ,0) | |
| 8405 | ; | |
| 8406 | "RTN","IBC NEHLT",271 ,0) | |
| 8407 | FND ; Fin d an exist ing Payer entry | |
| 8408 | "RTN","IBC NEHLT",272 ,0) | |
| 8409 | NEW DIC,D IE,X,DA,DL AYGO,Y,DR | |
| 8410 | "RTN","IBC NEHLT",273 ,0) | |
| 8411 | S X=ID,DI C(0)="X",D ="C",DIC=$ $ROOT^DILF D(FLN) | |
| 8412 | "RTN","IBC NEHLT",274 ,0) | |
| 8413 | ; | |
| 8414 | "RTN","IBC NEHLT",275 ,0) | |
| 8415 | ; Do a l ookup with the "C" c ross-refer ence | |
| 8416 | "RTN","IBC NEHLT",276 ,0) | |
| 8417 | D IX^DIC | |
| 8418 | "RTN","IBC NEHLT",277 ,0) | |
| 8419 | S IEN=+Y | |
| 8420 | "RTN","IBC NEHLT",278 ,0) | |
| 8421 | Q | |
| 8422 | "RTN","IBC NEHLT",279 ,0) | |
| 8423 | ; | |
| 8424 | "RTN","IBC NEHLT",280 ,0) | |
| 8425 | MDC ; Che ck for act ive transm issions an d cancel | |
| 8426 | "RTN","IBC NEHLT",281 ,0) | |
| 8427 | NEW STA,H IEN,RIEN,T QIEN | |
| 8428 | "RTN","IBC NEHLT",282 ,0) | |
| 8429 | F STA=1,2 ,4,6 S TQI EN="" D | |
| 8430 | "RTN","IBC NEHLT",283 ,0) | |
| 8431 | . F S TQ IEN=$O(^IB CN(365.1," AC",STA,TQ IEN)) Q:TQ IEN="" D | |
| 8432 | "RTN","IBC NEHLT",284 ,0) | |
| 8433 | .. ; | |
| 8434 | "RTN","IBC NEHLT",285 ,0) | |
| 8435 | .. ; If the record doesn't m atch the p ayer, quit | |
| 8436 | "RTN","IBC NEHLT",286 ,0) | |
| 8437 | .. I $P(^ IBCN(365.1 ,TQIEN,0), U,3)'=IEN Q | |
| 8438 | "RTN","IBC NEHLT",287 ,0) | |
| 8439 | .. ; | |
| 8440 | "RTN","IBC NEHLT",288 ,0) | |
| 8441 | .. ; Set the statu s to 'Canc elled' | |
| 8442 | "RTN","IBC NEHLT",289 ,0) | |
| 8443 | .. D SST^ IBCNEUT2(T QIEN,7) | |
| 8444 | "RTN","IBC NEHLT",290 ,0) | |
| 8445 | .. ; | |
| 8446 | "RTN","IBC NEHLT",291 ,0) | |
| 8447 | .. ; If a buffer e ntry, set to ! (bang ) | |
| 8448 | "RTN","IBC NEHLT",292 ,0) | |
| 8449 | .. S BUFF =$P(^IBCN( 365.1,TQIE N,0),U,5) | |
| 8450 | "RTN","IBC NEHLT",293 ,0) | |
| 8451 | .. I BUFF '="" D BUF F^IBCNEUT2 (BUFF,17) | |
| 8452 | "RTN","IBC NEHLT",294 ,0) | |
| 8453 | .. ; | |
| 8454 | "RTN","IBC NEHLT",295 ,0) | |
| 8455 | .. ; Cha nge any re sponses st atus also | |
| 8456 | "RTN","IBC NEHLT",296 ,0) | |
| 8457 | .. S HIEN =0 F S HI EN=$O(^IBC N(365.1,TQ IEN,2,HIEN )) Q:'HIEN D | |
| 8458 | "RTN","IBC NEHLT",297 ,0) | |
| 8459 | ... S RIE N=$P(^IBCN (365.1,TQI EN,2,HIEN, 0),U,3) | |
| 8460 | "RTN","IBC NEHLT",298 ,0) | |
| 8461 | ... ; If the Respo nse status is 'Respo nse Receiv ed', don't change it | |
| 8462 | "RTN","IBC NEHLT",299 ,0) | |
| 8463 | ... I $P( ^IBCN(365, RIEN,0),U, 6)=3 Q | |
| 8464 | "RTN","IBC NEHLT",300 ,0) | |
| 8465 | ... D RSP ^IBCNEUT2( RIEN,7) | |
| 8466 | "RTN","IBC NEHLT",301 ,0) | |
| 8467 | Q | |
| 8468 | "RTN","IBC NEHLT",302 ,0) | |
| 8469 | ; | |
| 8470 | "RTN","IBC NEHLT",303 ,0) | |
| 8471 | UPDLOG(FLA G,VALUE,PI EN,APIEN) ; Update a ctive/trus ted flag l ogs | |
| 8472 | "RTN","IBC NEHLT",304 ,0) | |
| 8473 | ; FLAG - "A" for Ac tive flag, "T" for T rusted fla g | |
| 8474 | "RTN","IBC NEHLT",305 ,0) | |
| 8475 | ; VALUE - new flag value (0 o r 1) | |
| 8476 | "RTN","IBC NEHLT",306 ,0) | |
| 8477 | ; PIEN - ien in PAY ER file (3 65.12) | |
| 8478 | "RTN","IBC NEHLT",307 ,0) | |
| 8479 | ; APIEN - ien in AP PLICATION sub-file ( 365.121) | |
| 8480 | "RTN","IBC NEHLT",308 ,0) | |
| 8481 | ; | |
| 8482 | "RTN","IBC NEHLT",309 ,0) | |
| 8483 | N FILE,IE NSTR,UPDT | |
| 8484 | "RTN","IBC NEHLT",310 ,0) | |
| 8485 | I $G(FLAG )=""!($G(V ALUE)="") Q | |
| 8486 | "RTN","IBC NEHLT",311 ,0) | |
| 8487 | I +$G(PIE N)=0!(+$G( APIEN)=0) Q | |
| 8488 | "RTN","IBC NEHLT",312 ,0) | |
| 8489 | S FILE=$S (FLAG="A": "365.1212" ,FLAG="T": "365.1213" ,1:"") I F ILE="" Q | |
| 8490 | "RTN","IBC NEHLT",313 ,0) | |
| 8491 | S IENSTR= "+1,"_APIE N_","_PIEN _"," | |
| 8492 | "RTN","IBC NEHLT",314 ,0) | |
| 8493 | S UPDT(FI LE,IENSTR, .01)=$$NOW ^XLFDT() | |
| 8494 | "RTN","IBC NEHLT",315 ,0) | |
| 8495 | S UPDT(FI LE,IENSTR, .02)=VALUE | |
| 8496 | "RTN","IBC NEHLT",316 ,0) | |
| 8497 | D UPDATE^ DIE("E","U PDT") | |
| 8498 | "RTN","IBC NEHLT",317 ,0) | |
| 8499 | Q | |
| 8500 | "RTN","IBC NEKIT") | |
| 8501 | 0^10^B1470 72833^B780 57141 | |
| 8502 | "RTN","IBC NEKIT",1,0 ) | |
| 8503 | IBCNEKIT ; DAOU/ESG - PURGE eIV DATA FILE S ;11-JUL- 2002 | |
| 8504 | "RTN","IBC NEKIT",2,0 ) | |
| 8505 | ;;2.0;INT EGRATED BI LLING;**18 4,271,316, 416,549,59 5,621**;21 -MAR-94;Bu ild 8 | |
| 8506 | "RTN","IBC NEKIT",3,0 ) | |
| 8507 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 8508 | "RTN","IBC NEKIT",4,0 ) | |
| 8509 | ; | |
| 8510 | "RTN","IBC NEKIT",5,0 ) | |
| 8511 | ; This ro utine hand les the pu rging of t he eIV dat a stored i n the | |
| 8512 | "RTN","IBC NEKIT",6,0 ) | |
| 8513 | ; eIV Tra nsmission Queue file (#365.1), the eIV R esponse fi le (#365) and | |
| 8514 | "RTN","IBC NEKIT",7,0 ) | |
| 8515 | ; the EIV EICD TRAC KING file (#365.18) IB*2.0*621 /DM | |
| 8516 | "RTN","IBC NEKIT",8,0 ) | |
| 8517 | ; User ca n pick a d ate range for the pu rge. Data created w ithin 6 mo nths | |
| 8518 | "RTN","IBC NEKIT",9,0 ) | |
| 8519 | ; cannot be purged. The actu al global kills are done by a background | |
| 8520 | "RTN","IBC NEKIT",10, 0) | |
| 8521 | ; task af ter hours (8:00pm). | |
| 8522 | "RTN","IBC NEKIT",11, 0) | |
| 8523 | ; | |
| 8524 | "RTN","IBC NEKIT",12, 0) | |
| 8525 | EN ; | |
| 8526 | "RTN","IBC NEKIT",13, 0) | |
| 8527 | NEW STOP, BEGDT,ENDD T,STATLIST ,IBVER | |
| 8528 | "RTN","IBC NEKIT",14, 0) | |
| 8529 | S IBVER=1 | |
| 8530 | "RTN","IBC NEKIT",15, 0) | |
| 8531 | D INIT I STOP G EXI T ; initialize /calculate default d ates | |
| 8532 | "RTN","IBC NEKIT",16, 0) | |
| 8533 | D DEFLT I STOP G EX IT ; allow user to change default e nd date if test syst em ;IB*2.0 *621 | |
| 8534 | "RTN","IBC NEKIT",17, 0) | |
| 8535 | D BEGDT I STOP G EX IT ; user inter face for b eginning d ate | |
| 8536 | "RTN","IBC NEKIT",18, 0) | |
| 8537 | D ENDDT I STOP G EX IT ; user inter face for e nding date | |
| 8538 | "RTN","IBC NEKIT",19, 0) | |
| 8539 | D CONFIRM I STOP G EXIT ; confirmati on message /final che ck | |
| 8540 | "RTN","IBC NEKIT",20, 0) | |
| 8541 | D QUEUE ; queuing pr ocess | |
| 8542 | "RTN","IBC NEKIT",21, 0) | |
| 8543 | EXIT ; | |
| 8544 | "RTN","IBC NEKIT",22, 0) | |
| 8545 | Q | |
| 8546 | "RTN","IBC NEKIT",23, 0) | |
| 8547 | ; | |
| 8548 | "RTN","IBC NEKIT",24, 0) | |
| 8549 | EN1 ; Auto mated Mont hly Purge *IB*2*595 | |
| 8550 | "RTN","IBC NEKIT",25, 0) | |
| 8551 | NEW STOP, BEGDT,ENDD T,STATLIST ,IBVER | |
| 8552 | "RTN","IBC NEKIT",26, 0) | |
| 8553 | S IBVER=2 | |
| 8554 | "RTN","IBC NEKIT",27, 0) | |
| 8555 | D INIT I STOP G EXI T1 ; initializ e/calculat e default dates | |
| 8556 | "RTN","IBC NEKIT",28, 0) | |
| 8557 | D QUEUE ; queuing pr ocess | |
| 8558 | "RTN","IBC NEKIT",29, 0) | |
| 8559 | EXIT1 ; | |
| 8560 | "RTN","IBC NEKIT",30, 0) | |
| 8561 | Q | |
| 8562 | "RTN","IBC NEKIT",31, 0) | |
| 8563 | PURGE ; Th is procedu re is queu ed to run in the bac kground an d does the | |
| 8564 | "RTN","IBC NEKIT",32, 0) | |
| 8565 | ; actual purging. Variables available from the T askMan cal l are: | |
| 8566 | "RTN","IBC NEKIT",33, 0) | |
| 8567 | ; | |
| 8568 | "RTN","IBC NEKIT",34, 0) | |
| 8569 | ; STATLIS T = list o f statuses that are OK to purg e | |
| 8570 | "RTN","IBC NEKIT",35, 0) | |
| 8571 | ; BEGD T = beginn ing date f or purging | |
| 8572 | "RTN","IBC NEKIT",36, 0) | |
| 8573 | ; ENDD T = ending date for purging | |
| 8574 | "RTN","IBC NEKIT",37, 0) | |
| 8575 | ; | |
| 8576 | "RTN","IBC NEKIT",38, 0) | |
| 8577 | ; First l oop throug h the eIV Transmissi on Queue f ile and de lete all | |
| 8578 | "RTN","IBC NEKIT",39, 0) | |
| 8579 | ; records in the da te range w hose statu s is in th e list | |
| 8580 | "RTN","IBC NEKIT",40, 0) | |
| 8581 | ; | |
| 8582 | "RTN","IBC NEKIT",41, 0) | |
| 8583 | N CNT,DA, DATE,DIK,H LIEN,PFLAG ,TQIEN,TQS ;IB*2.0 *549 added PFLAG | |
| 8584 | "RTN","IBC NEKIT",42, 0) | |
| 8585 | N IBWEXT, IBIORV ;IB*2.0 *621/DM ad ded IBWEXT ,IBIORV | |
| 8586 | "RTN","IBC NEKIT",43, 0) | |
| 8587 | S DATE=$O (^IBCN(365 .1,"AE",BE GDT),-1),C NT=0 | |
| 8588 | "RTN","IBC NEKIT",44, 0) | |
| 8589 | F S DATE =$O(^IBCN( 365.1,"AE" ,DATE)) Q: 'DATE!($P( DATE,".",1 )>ENDDT)!$ G(ZTSTOP) S TQIEN=0 F S TQIE N=$O(^IBCN (365.1,"AE ",DATE,TQI EN)) Q:'TQ IEN D Q: $G(ZTSTOP) | |
| 8590 | "RTN","IBC NEKIT",45, 0) | |
| 8591 | . S CNT=C NT+1 | |
| 8592 | "RTN","IBC NEKIT",46, 0) | |
| 8593 | . I $D(ZT QUEUED),CN T#100=0,$$ S^%ZTLOAD( ) S ZTSTOP =1 Q | |
| 8594 | "RTN","IBC NEKIT",47, 0) | |
| 8595 | . S TQS=$ P($G(^IBCN (365.1,TQI EN,0)),U,4 ) ; tr ans queue status | |
| 8596 | "RTN","IBC NEKIT",48, 0) | |
| 8597 | . S IBWEX T=$P($G(^I BCN(365.1, TQIEN,0)), U,10) ; IB *2.0*621/D M WHICH EX TRACT | |
| 8598 | "RTN","IBC NEKIT",49, 0) | |
| 8599 | . S IBIOR V=$P($G(^I BCN(365.1, TQIEN,0)), U,11) ; IB *2.0*621/D M QUERY FL AG | |
| 8600 | "RTN","IBC NEKIT",50, 0) | |
| 8601 | . I IBWEX T=4,IBIORV ="V" Q ; sk ip EICD Ve rification entries a s they | |
| 8602 | "RTN","IBC NEKIT",51, 0) | |
| 8603 | . ; wi ll be addr essed with EICD Iden tification s | |
| 8604 | "RTN","IBC NEKIT",52, 0) | |
| 8605 | . I '$F(S TATLIST,", "_TQS_",") Q ; mu st be in t he list | |
| 8606 | "RTN","IBC NEKIT",53, 0) | |
| 8607 | . I IBWEX T=4,IBIORV ="I" D CHK TRK(TQIEN) Q ; ch eck EIV EI CD TRACKIN G for purg e | |
| 8608 | "RTN","IBC NEKIT",54, 0) | |
| 8609 | . ; loop through th e HL7 mess ages multi ple and ki ll any res ponse | |
| 8610 | "RTN","IBC NEKIT",55, 0) | |
| 8611 | . ; recor ds that ar e found fo r this tra nsmission queue entr y | |
| 8612 | "RTN","IBC NEKIT",56, 0) | |
| 8613 | . ; IB*2. 0*621/DM P reserve an y TQ and r esponse th at has DO NOT PURGE set to 1 ( YES) | |
| 8614 | "RTN","IBC NEKIT",57, 0) | |
| 8615 | . S PFLAG =0,HLIEN=0 ,DIK="^IBC N(365," | |
| 8616 | "RTN","IBC NEKIT",58, 0) | |
| 8617 | . F S HL IEN=$O(^IB CN(365.1,T QIEN,2,HLI EN)) Q:'HL IEN D | |
| 8618 | "RTN","IBC NEKIT",59, 0) | |
| 8619 | .. S DA=$ P($G(^IBCN (365.1,TQI EN,2,HLIEN ,0)),U,3) Q:'DA | |
| 8620 | "RTN","IBC NEKIT",60, 0) | |
| 8621 | .. I +$$G ET1^DIQ(36 5,DA_",",. 11,"I") S PFLAG=1 Q ;"DO NOT PURGE" | |
| 8622 | "RTN","IBC NEKIT",61, 0) | |
| 8623 | .. D ^DIK | |
| 8624 | "RTN","IBC NEKIT",62, 0) | |
| 8625 | .. Q | |
| 8626 | "RTN","IBC NEKIT",63, 0) | |
| 8627 | . ; | |
| 8628 | "RTN","IBC NEKIT",64, 0) | |
| 8629 | . ; now w e can kill the trans mission qu eue entry itself | |
| 8630 | "RTN","IBC NEKIT",65, 0) | |
| 8631 | . ; as lo ng as ther e was no D O NOT PURG E response s IB*2.0*6 21/DM | |
| 8632 | "RTN","IBC NEKIT",66, 0) | |
| 8633 | . I 'PFLA G S DA=TQI EN,DIK="^I BCN(365.1, " D ^DIK K DA,DIK | |
| 8634 | "RTN","IBC NEKIT",67, 0) | |
| 8635 | . Q | |
| 8636 | "RTN","IBC NEKIT",68, 0) | |
| 8637 | ; | |
| 8638 | "RTN","IBC NEKIT",69, 0) | |
| 8639 | ; Check f or a stop request | |
| 8640 | "RTN","IBC NEKIT",70, 0) | |
| 8641 | I $G(ZTST OP) G PURG EX | |
| 8642 | "RTN","IBC NEKIT",71, 0) | |
| 8643 | ; | |
| 8644 | "RTN","IBC NEKIT",72, 0) | |
| 8645 | ; Now we must loop through th e eIV Resp onse file itself to purge any | |
| 8646 | "RTN","IBC NEKIT",73, 0) | |
| 8647 | ; respons e records that do no t have a c orrespondi ng transmi ssion | |
| 8648 | "RTN","IBC NEKIT",74, 0) | |
| 8649 | ; queue e ntry. The se are the unsolicit ed respons es. The s tatus of | |
| 8650 | "RTN","IBC NEKIT",75, 0) | |
| 8651 | ; these r esponses i s always ' response r eceived' s o we don't need to | |
| 8652 | "RTN","IBC NEKIT",76, 0) | |
| 8653 | ; check t he status. For this loop, star t from the very begi nning of | |
| 8654 | "RTN","IBC NEKIT",77, 0) | |
| 8655 | ; the fil e. | |
| 8656 | "RTN","IBC NEKIT",78, 0) | |
| 8657 | ; | |
| 8658 | "RTN","IBC NEKIT",79, 0) | |
| 8659 | S DATE="" ,DIK="^IBC N(365,",CN T=0 | |
| 8660 | "RTN","IBC NEKIT",80, 0) | |
| 8661 | F S DATE =$O(^IBCN( 365,"AE",D ATE)) Q:'D ATE!($P(DA TE,".",1)> ENDDT)!$G( ZTSTOP) S DA=0 F S DA=$O(^IB CN(365,"AE ",DATE,DA) ) Q:'DA D Q:$G(ZTS TOP) | |
| 8662 | "RTN","IBC NEKIT",81, 0) | |
| 8663 | . S CNT=C NT+1 | |
| 8664 | "RTN","IBC NEKIT",82, 0) | |
| 8665 | . I $D(ZT QUEUED),CN T#100=0,$$ S^%ZTLOAD( ) S ZTSTOP =1 Q | |
| 8666 | "RTN","IBC NEKIT",83, 0) | |
| 8667 | . ; | |
| 8668 | "RTN","IBC NEKIT",84, 0) | |
| 8669 | . ; If th ere is a p ointer to the transm ission que ue file, t hen we | |
| 8670 | "RTN","IBC NEKIT",85, 0) | |
| 8671 | . ; shoul d get out of this lo op because the purpo se of this section | |
| 8672 | "RTN","IBC NEKIT",86, 0) | |
| 8673 | . ; is to purge tho se respons es with no link to t he transmi ssion | |
| 8674 | "RTN","IBC NEKIT",87, 0) | |
| 8675 | . ; queue file. | |
| 8676 | "RTN","IBC NEKIT",88, 0) | |
| 8677 | . ; | |
| 8678 | "RTN","IBC NEKIT",89, 0) | |
| 8679 | . I $P($G (^IBCN(365 ,DA,0)),U, 5) Q | |
| 8680 | "RTN","IBC NEKIT",90, 0) | |
| 8681 | . D ^DIK | |
| 8682 | "RTN","IBC NEKIT",91, 0) | |
| 8683 | . Q | |
| 8684 | "RTN","IBC NEKIT",92, 0) | |
| 8685 | K DA,DIK | |
| 8686 | "RTN","IBC NEKIT",93, 0) | |
| 8687 | PURGEX ; | |
| 8688 | "RTN","IBC NEKIT",94, 0) | |
| 8689 | ; Tell Ta skManager to delete the task's record | |
| 8690 | "RTN","IBC NEKIT",95, 0) | |
| 8691 | I $D(ZTQU EUED) S ZT REQ="@" | |
| 8692 | "RTN","IBC NEKIT",96, 0) | |
| 8693 | Q | |
| 8694 | "RTN","IBC NEKIT",97, 0) | |
| 8695 | ; | |
| 8696 | "RTN","IBC NEKIT",98, 0) | |
| 8697 | INIT ; Thi s procedur e calculat es the def ault begin ning and e nding date s | |
| 8698 | "RTN","IBC NEKIT",99, 0) | |
| 8699 | ; and dis plays scre en message s about th is option to the use r. | |
| 8700 | "RTN","IBC NEKIT",100 ,0) | |
| 8701 | ; | |
| 8702 | "RTN","IBC NEKIT",101 ,0) | |
| 8703 | NEW DATE, FOUND,TQIE N,TQS,RPIE N,RPS | |
| 8704 | "RTN","IBC NEKIT",102 ,0) | |
| 8705 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
| 8706 | "RTN","IBC NEKIT",103 ,0) | |
| 8707 | ; | |
| 8708 | "RTN","IBC NEKIT",104 ,0) | |
| 8709 | S STOP=0 | |
| 8710 | "RTN","IBC NEKIT",105 ,0) | |
| 8711 | ; | |
| 8712 | "RTN","IBC NEKIT",106 ,0) | |
| 8713 | ; This is the list of statuse s that are OK to pur ge | |
| 8714 | "RTN","IBC NEKIT",107 ,0) | |
| 8715 | ; 3=Res ponse Rece ived | |
| 8716 | "RTN","IBC NEKIT",108 ,0) | |
| 8717 | ; 5=Com munication Failure | |
| 8718 | "RTN","IBC NEKIT",109 ,0) | |
| 8719 | ; 7=Can celled | |
| 8720 | "RTN","IBC NEKIT",110 ,0) | |
| 8721 | S STATLIS T=",3,5,7, " | |
| 8722 | "RTN","IBC NEKIT",111 ,0) | |
| 8723 | ; | |
| 8724 | "RTN","IBC NEKIT",112 ,0) | |
| 8725 | ; Try to find a beg inning dat e in the e IV Transmi ssion Queu e file | |
| 8726 | "RTN","IBC NEKIT",113 ,0) | |
| 8727 | S DATE="" ,FOUND=0,B EGDT=DT | |
| 8728 | "RTN","IBC NEKIT",114 ,0) | |
| 8729 | F S DATE =$O(^IBCN( 365.1,"AE" ,DATE)) Q: 'DATE!FOUN D S TQIEN =0 F S TQ IEN=$O(^IB CN(365.1," AE",DATE,T QIEN)) Q:' TQIEN D Q:FOUND | |
| 8730 | "RTN","IBC NEKIT",115 ,0) | |
| 8731 | . S TQS=$ P($G(^IBCN (365.1,TQI EN,0)),U,4 ) ; sta tus | |
| 8732 | "RTN","IBC NEKIT",116 ,0) | |
| 8733 | . I '$F(S TATLIST,", "_TQS_",") Q | |
| 8734 | "RTN","IBC NEKIT",117 ,0) | |
| 8735 | . S FOUND =1 | |
| 8736 | "RTN","IBC NEKIT",118 ,0) | |
| 8737 | . S BEGDT =$P(DATE," .",1) | |
| 8738 | "RTN","IBC NEKIT",119 ,0) | |
| 8739 | . Q | |
| 8740 | "RTN","IBC NEKIT",120 ,0) | |
| 8741 | ; | |
| 8742 | "RTN","IBC NEKIT",121 ,0) | |
| 8743 | ; If not successful , try to f ind a begi nning date in the eI V Response file. | |
| 8744 | "RTN","IBC NEKIT",122 ,0) | |
| 8745 | I 'FOUND D | |
| 8746 | "RTN","IBC NEKIT",123 ,0) | |
| 8747 | . S DATE= "" | |
| 8748 | "RTN","IBC NEKIT",124 ,0) | |
| 8749 | . F S DA TE=$O(^IBC N(365,"AE" ,DATE)) Q: 'DATE!FOUN D S RPIEN =0 F S RP IEN=$O(^IB CN(365,"AE ",DATE,RPI EN)) Q:'RP IEN D Q: FOUND | |
| 8750 | "RTN","IBC NEKIT",125 ,0) | |
| 8751 | .. S RPS= $P($G(^IBC N(365,RPIE N,0)),U,6) ; stat us | |
| 8752 | "RTN","IBC NEKIT",126 ,0) | |
| 8753 | .. I '$F( STATLIST," ,"_RPS_"," ) Q | |
| 8754 | "RTN","IBC NEKIT",127 ,0) | |
| 8755 | .. S FOUN D=1 | |
| 8756 | "RTN","IBC NEKIT",128 ,0) | |
| 8757 | .. S BEGD T=$P(DATE, ".",1) | |
| 8758 | "RTN","IBC NEKIT",129 ,0) | |
| 8759 | .. Q | |
| 8760 | "RTN","IBC NEKIT",130 ,0) | |
| 8761 | . Q | |
| 8762 | "RTN","IBC NEKIT",131 ,0) | |
| 8763 | ; | |
| 8764 | "RTN","IBC NEKIT",132 ,0) | |
| 8765 | ; default end date, Today min us 182 day s (approx 6 months) | |
| 8766 | "RTN","IBC NEKIT",133 ,0) | |
| 8767 | S ENDDT=$ $FMADD^XLF DT(DT,-182 ) | |
| 8768 | "RTN","IBC NEKIT",134 ,0) | |
| 8769 | ; | |
| 8770 | "RTN","IBC NEKIT",135 ,0) | |
| 8771 | ;I IBVER= 1,'FOUND!( BEGDT>ENDD T) D S ST OP=1 G INI TX ; IB*2. 0*621 | |
| 8772 | "RTN","IBC NEKIT",136 ,0) | |
| 8773 | I IBVER=1 ,'FOUND,'$ $PROD^XUPR OD(1)!(BEG DT>ENDDT) D S STOP= 1 G INITX | |
| 8774 | "RTN","IBC NEKIT",137 ,0) | |
| 8775 | . W !!?5, "Purging o f eIV data is not po ssible at this time. " | |
| 8776 | "RTN","IBC NEKIT",138 ,0) | |
| 8777 | . I 'FOUN D W !?5,"T here are n o entries in the fil e that are eligible to be",!?5 ,"purged o r there is no data i n the file ." | |
| 8778 | "RTN","IBC NEKIT",139 ,0) | |
| 8779 | . E W !? 5,"The old est date i n the file is ",$$FM TE^XLFDT(B EGDT,"5Z") ,".",!?5," Data canno t be purge d unless i t is at le ast 6 mont hs old." | |
| 8780 | "RTN","IBC NEKIT",140 ,0) | |
| 8781 | . W ! S D IR(0)="E" D ^DIR K D IR | |
| 8782 | "RTN","IBC NEKIT",141 ,0) | |
| 8783 | . Q | |
| 8784 | "RTN","IBC NEKIT",142 ,0) | |
| 8785 | I IBVER=2 ,'FOUND!(B EGDT>ENDDT ) D S STO P=1 G INIT X | |
| 8786 | "RTN","IBC NEKIT",143 ,0) | |
| 8787 | .; Send a MailMan m essage wit h Eligible Purge cou nts ; IB*2 .0*621 - U pdated Mes sage | |
| 8788 | "RTN","IBC NEKIT",144 ,0) | |
| 8789 | .N MGRP,M SG,IBXMY | |
| 8790 | "RTN","IBC NEKIT",145 ,0) | |
| 8791 | .S MSG(1) ="Purge El ectronic I nsurance V erificatio n (eIV) Da ta Files d id not fin d records" | |
| 8792 | "RTN","IBC NEKIT",146 ,0) | |
| 8793 | .S MSG(2) ="for stat ion "_+$$S ITE^VASITE ()_"." | |
| 8794 | "RTN","IBC NEKIT",147 ,0) | |
| 8795 | .S MSG(3) ="" | |
| 8796 | "RTN","IBC NEKIT",148 ,0) | |
| 8797 | .S MSG(4) ="The opti on runs au tomaticall y on a mon thly basis and purge s data fro m the" | |
| 8798 | "RTN","IBC NEKIT",149 ,0) | |
| 8799 | .S MSG(5) ="IIV RESP ONSE file (#365), th e IIV TRAN SMISSION Q UEUE file (#365.1), and the" | |
| 8800 | "RTN","IBC NEKIT",150 ,0) | |
| 8801 | .S MSG(6) ="EIV EICD TRACKING file (#365 .18). The data must be at lea st six mon ths old" | |
| 8802 | "RTN","IBC NEKIT",151 ,0) | |
| 8803 | .S MSG(7) ="before i t can be p urged. On ly insuran ce transac tions that have a tr ansmission " | |
| 8804 | "RTN","IBC NEKIT",152 ,0) | |
| 8805 | .S MSG(8) ="status o f ""Respon se Receive d"", ""Com munication Failure"" , or ""Can celled""" | |
| 8806 | "RTN","IBC NEKIT",153 ,0) | |
| 8807 | .S MSG(9) ="may be p urged." | |
| 8808 | "RTN","IBC NEKIT",154 ,0) | |
| 8809 | .; Set to IB site p arameter M AILGROUP - IBCNE EIV MESSAGE | |
| 8810 | "RTN","IBC NEKIT",155 ,0) | |
| 8811 | .S MGRP=$ $MGRP^IBCN EUT5() | |
| 8812 | "RTN","IBC NEKIT",156 ,0) | |
| 8813 | .S IBXMY( " P I I ")="" | |
| 8814 | "RTN","IBC NEKIT",157 ,0) | |
| 8815 | .D MSG^IB CNEUT5(MGR P,"eIV Pur ge No Data Found for Station " _+$$SITE^V ASITE(),"M SG(",,.IBX MY) | |
| 8816 | "RTN","IBC NEKIT",158 ,0) | |
| 8817 | .; Duplic ate messag e to Outlo ok group | |
| 8818 | "RTN","IBC NEKIT",159 ,0) | |
| 8819 | .; S MGRP =" P I I " | |
| 8820 | "RTN","IBC NEKIT",160 ,0) | |
| 8821 | .; D MSG^ IBCNEUT5(M GRP,"eIV D ata Backgr ound Purge ","MSG(") | |
| 8822 | "RTN","IBC NEKIT",161 ,0) | |
| 8823 | .Q | |
| 8824 | "RTN","IBC NEKIT",162 ,0) | |
| 8825 | ; | |
| 8826 | "RTN","IBC NEKIT",163 ,0) | |
| 8827 | ; At this point, we know that there are some entr ies eligib le for | |
| 8828 | "RTN","IBC NEKIT",164 ,0) | |
| 8829 | ; purging . Display a message to the us er about t his option . | |
| 8830 | "RTN","IBC NEKIT",165 ,0) | |
| 8831 | I IBVER=2 G INITX | |
| 8832 | "RTN","IBC NEKIT",166 ,0) | |
| 8833 | W @IOF | |
| 8834 | "RTN","IBC NEKIT",167 ,0) | |
| 8835 | W !?8,"Pu rge Electr onic Insur ance Verif ication (e IV) Data F iles" | |
| 8836 | "RTN","IBC NEKIT",168 ,0) | |
| 8837 | W !!!," T his option will allo w you to p urge data from the e IV Respons e File (#3 65)" | |
| 8838 | "RTN","IBC NEKIT",169 ,0) | |
| 8839 | W !," and the eIV T ransmissio n Queue Fi le (#365.1 ). The da ta must be at least six" | |
| 8840 | "RTN","IBC NEKIT",170 ,0) | |
| 8841 | W !," mon ths old be fore it ca n be purge d. Only i nsurance t ransaction s that hav e a" | |
| 8842 | "RTN","IBC NEKIT",171 ,0) | |
| 8843 | W !," tra nsmission status of ""Response Received" ", ""Commu nication F ailure"", or" | |
| 8844 | "RTN","IBC NEKIT",172 ,0) | |
| 8845 | W !," ""C ancelled"" may be pu rged. You will be a llowed to select a d ate range for" | |
| 8846 | "RTN","IBC NEKIT",173 ,0) | |
| 8847 | W !," thi s purging. The defa ult beginn ing date w ill be the date of t he oldest" | |
| 8848 | "RTN","IBC NEKIT",174 ,0) | |
| 8849 | W !," eli gible reco rd in the system. T he default ending da te will be six month s" | |
| 8850 | "RTN","IBC NEKIT",175 ,0) | |
| 8851 | W !," ago from toda y's date. You may m odify this default d ate range. However, you" | |
| 8852 | "RTN","IBC NEKIT",176 ,0) | |
| 8853 | W !," may not selec t an endin g date tha t is more recent tha n six mont hs ago." | |
| 8854 | "RTN","IBC NEKIT",177 ,0) | |
| 8855 | W !! | |
| 8856 | "RTN","IBC NEKIT",178 ,0) | |
| 8857 | INITX ; | |
| 8858 | "RTN","IBC NEKIT",179 ,0) | |
| 8859 | Q | |
| 8860 | "RTN","IBC NEKIT",180 ,0) | |
| 8861 | ; | |
| 8862 | "RTN","IBC NEKIT",181 ,0) | |
| 8863 | DEFLT ; I B*621/DW A dded to as sist with testing | |
| 8864 | "RTN","IBC NEKIT",182 ,0) | |
| 8865 | I IBVER=1 ,('$$PROD^ XUPROD(1)) D | |
| 8866 | "RTN","IBC NEKIT",183 ,0) | |
| 8867 | . W ?5,"* ** For Tes t Purposes Only:" | |
| 8868 | "RTN","IBC NEKIT",184 ,0) | |
| 8869 | . W !!?5, "In test s ystems one may overr ide the DE FAULT end date." | |
| 8870 | "RTN","IBC NEKIT",185 ,0) | |
| 8871 | . W !!?5, "Current d efault end date is T ODAY - 182 DAYS: "_$ $FMTE^XLFD T(ENDDT,"5 Z"),!! | |
| 8872 | "RTN","IBC NEKIT",186 ,0) | |
| 8873 | . NEW DIR ,X,Y,DTOUT ,DUOUT,DIR UT,DIROUT | |
| 8874 | "RTN","IBC NEKIT",187 ,0) | |
| 8875 | . S DIR(0 )="DOA^"_B EGDT_":"_D T_":AEX" | |
| 8876 | "RTN","IBC NEKIT",188 ,0) | |
| 8877 | . S DIR(" A")="Enter the purge default d ate: " | |
| 8878 | "RTN","IBC NEKIT",189 ,0) | |
| 8879 | . S DIR(" B")=$$FMTE ^XLFDT(END DT,"5Z") | |
| 8880 | "RTN","IBC NEKIT",190 ,0) | |
| 8881 | . S DIR(" ?")="This response m ust be a d ate betwee n "_$$FMTE ^XLFDT(BEG DT,"5Z")_" and "_$$F MTE^XLFDT( DT,"5Z")_" ." | |
| 8882 | "RTN","IBC NEKIT",191 ,0) | |
| 8883 | . D ^DIR K DIR | |
| 8884 | "RTN","IBC NEKIT",192 ,0) | |
| 8885 | . I $D(DI RUT)!'Y S STOP=1 G D EFLTX | |
| 8886 | "RTN","IBC NEKIT",193 ,0) | |
| 8887 | . S ENDDT =Y | |
| 8888 | "RTN","IBC NEKIT",194 ,0) | |
| 8889 | W !!! | |
| 8890 | "RTN","IBC NEKIT",195 ,0) | |
| 8891 | DEFLTX ; | |
| 8892 | "RTN","IBC NEKIT",196 ,0) | |
| 8893 | Q | |
| 8894 | "RTN","IBC NEKIT",197 ,0) | |
| 8895 | ; | |
| 8896 | "RTN","IBC NEKIT",198 ,0) | |
| 8897 | BEGDT ; Th is procedu re capture s the begi nning date from the user. | |
| 8898 | "RTN","IBC NEKIT",199 ,0) | |
| 8899 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
| 8900 | "RTN","IBC NEKIT",200 ,0) | |
| 8901 | S DIR(0)= "DOA^"_BEG DT_":"_END DT_":AEX" | |
| 8902 | "RTN","IBC NEKIT",201 ,0) | |
| 8903 | S DIR("A" )="Enter t he purge b egin date: " | |
| 8904 | "RTN","IBC NEKIT",202 ,0) | |
| 8905 | S DIR("B" )=$$FMTE^X LFDT(BEGDT ,"5Z") | |
| 8906 | "RTN","IBC NEKIT",203 ,0) | |
| 8907 | S DIR("?" )="This re sponse mus t be a dat e between "_$$FMTE^X LFDT(BEGDT ,"5Z")_" a nd "_$$FMT E^XLFDT(EN DDT,"5Z")_ "." | |
| 8908 | "RTN","IBC NEKIT",204 ,0) | |
| 8909 | D ^DIR K DIR | |
| 8910 | "RTN","IBC NEKIT",205 ,0) | |
| 8911 | I $D(DIRU T)!'Y S ST OP=1 G BEG DTX | |
| 8912 | "RTN","IBC NEKIT",206 ,0) | |
| 8913 | S BEGDT=Y | |
| 8914 | "RTN","IBC NEKIT",207 ,0) | |
| 8915 | BEGDTX ; | |
| 8916 | "RTN","IBC NEKIT",208 ,0) | |
| 8917 | Q | |
| 8918 | "RTN","IBC NEKIT",209 ,0) | |
| 8919 | ; | |
| 8920 | "RTN","IBC NEKIT",210 ,0) | |
| 8921 | ENDDT ; Th is procedu re capture s the endi ng date fr om the use r. | |
| 8922 | "RTN","IBC NEKIT",211 ,0) | |
| 8923 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
| 8924 | "RTN","IBC NEKIT",212 ,0) | |
| 8925 | W ! | |
| 8926 | "RTN","IBC NEKIT",213 ,0) | |
| 8927 | S DIR(0)= "DOA^"_BEG DT_":"_END DT_":AEX" | |
| 8928 | "RTN","IBC NEKIT",214 ,0) | |
| 8929 | S DIR("A" )=" Enter the purge end date: " | |
| 8930 | "RTN","IBC NEKIT",215 ,0) | |
| 8931 | S DIR("B" )=$$FMTE^X LFDT(ENDDT ,"5Z") | |
| 8932 | "RTN","IBC NEKIT",216 ,0) | |
| 8933 | S DIR("?" )="This re sponse mus t be a dat e between "_$$FMTE^X LFDT(BEGDT ,"5Z")_" a nd "_$$FMT E^XLFDT(EN DDT,"5Z")_ "." | |
| 8934 | "RTN","IBC NEKIT",217 ,0) | |
| 8935 | D ^DIR K DIR | |
| 8936 | "RTN","IBC NEKIT",218 ,0) | |
| 8937 | I $D(DIRU T)!'Y S ST OP=1 G END DTX | |
| 8938 | "RTN","IBC NEKIT",219 ,0) | |
| 8939 | S ENDDT=Y | |
| 8940 | "RTN","IBC NEKIT",220 ,0) | |
| 8941 | ENDDTX ; | |
| 8942 | "RTN","IBC NEKIT",221 ,0) | |
| 8943 | Q | |
| 8944 | "RTN","IBC NEKIT",222 ,0) | |
| 8945 | ; | |
| 8946 | "RTN","IBC NEKIT",223 ,0) | |
| 8947 | CONFIRM ; This proce dure displ ays a conf irmation m essage to the user a nd | |
| 8948 | "RTN","IBC NEKIT",224 ,0) | |
| 8949 | ; asks if it is OK to proceed with the purge. | |
| 8950 | "RTN","IBC NEKIT",225 ,0) | |
| 8951 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
| 8952 | "RTN","IBC NEKIT",226 ,0) | |
| 8953 | W !!!," Y ou want to purge all eIV data created be tween " | |
| 8954 | "RTN","IBC NEKIT",227 ,0) | |
| 8955 | W $$FMTE^ XLFDT(BEGD T,"5Z")," and ",$$FM TE^XLFDT(E NDDT,"5Z") ,"." | |
| 8956 | "RTN","IBC NEKIT",228 ,0) | |
| 8957 | W ! | |
| 8958 | "RTN","IBC NEKIT",229 ,0) | |
| 8959 | S DIR(0)= "YO",DIR(" A")=" OK t o continue " | |
| 8960 | "RTN","IBC NEKIT",230 ,0) | |
| 8961 | S DIR("B" )="NO" | |
| 8962 | "RTN","IBC NEKIT",231 ,0) | |
| 8963 | D ^DIR K DIR | |
| 8964 | "RTN","IBC NEKIT",232 ,0) | |
| 8965 | I 'Y S ST OP=1 | |
| 8966 | "RTN","IBC NEKIT",233 ,0) | |
| 8967 | CONFX ; | |
| 8968 | "RTN","IBC NEKIT",234 ,0) | |
| 8969 | Q | |
| 8970 | "RTN","IBC NEKIT",235 ,0) | |
| 8971 | ; | |
| 8972 | "RTN","IBC NEKIT",236 ,0) | |
| 8973 | QUEUE ; Th is procedu re queues the purge process fo r later at night. | |
| 8974 | "RTN","IBC NEKIT",237 ,0) | |
| 8975 | ; The con cept for q ueuing the purge cam e from the insurance buffer | |
| 8976 | "RTN","IBC NEKIT",238 ,0) | |
| 8977 | ; purge r outine, IB CNBPG. Th at purge p rocess is also hard- coded to | |
| 8978 | "RTN","IBC NEKIT",239 ,0) | |
| 8979 | ; be run at 8:00 PM just like this one is. | |
| 8980 | "RTN","IBC NEKIT",240 ,0) | |
| 8981 | ; | |
| 8982 | "RTN","IBC NEKIT",241 ,0) | |
| 8983 | NEW ZTRTN ,ZTDESC,ZT DTH,ZTIO,Z TUCI,ZTCPU ,ZTPRI,ZTS AVE,ZTKIL, ZTSYNC,ZTS K | |
| 8984 | "RTN","IBC NEKIT",242 ,0) | |
| 8985 | NEW DIR,X ,Y,DTOUT,D UOUT,DIRUT ,DIROUT | |
| 8986 | "RTN","IBC NEKIT",243 ,0) | |
| 8987 | ; | |
| 8988 | "RTN","IBC NEKIT",244 ,0) | |
| 8989 | ; IB*621/ DW Added l oop below to assist with testi ng | |
| 8990 | "RTN","IBC NEKIT",245 ,0) | |
| 8991 | I IBVER=1 ,('$$PROD^ XUPROD(1)) D I Y D PURGE^IBCN EKIT G QUE UEX | |
| 8992 | "RTN","IBC NEKIT",246 ,0) | |
| 8993 | . W !!!!, "*** TEST System onl y - you ma y run this immediate ly",! | |
| 8994 | "RTN","IBC NEKIT",247 ,0) | |
| 8995 | . S DIR(" A")="Do yo u want to run this n ow instead of taskin g it for 8 :00pm" | |
| 8996 | "RTN","IBC NEKIT",248 ,0) | |
| 8997 | . S DIR(0 )="Y",DIR( "B")="YES" | |
| 8998 | "RTN","IBC NEKIT",249 ,0) | |
| 8999 | . D ^DIR | |
| 9000 | "RTN","IBC NEKIT",250 ,0) | |
| 9001 | . I Y="^" S STOP=1 | |
| 9002 | "RTN","IBC NEKIT",251 ,0) | |
| 9003 | ; | |
| 9004 | "RTN","IBC NEKIT",252 ,0) | |
| 9005 | I STOP G QUEUEX ; IB*2.0*6 21 | |
| 9006 | "RTN","IBC NEKIT",253 ,0) | |
| 9007 | S ZTRTN=" PURGE^IBCN EKIT" ; TaskMan task entry point | |
| 9008 | "RTN","IBC NEKIT",254 ,0) | |
| 9009 | S ZTDESC= "Purge eIV Data" ; Task des cription | |
| 9010 | "RTN","IBC NEKIT",255 ,0) | |
| 9011 | S ZTDTH=D T_".20" ; start it at 8:00 P M tonight | |
| 9012 | "RTN","IBC NEKIT",256 ,0) | |
| 9013 | S ZTIO="" | |
| 9014 | "RTN","IBC NEKIT",257 ,0) | |
| 9015 | S ZTSAVE( "BEGDT")=" " | |
| 9016 | "RTN","IBC NEKIT",258 ,0) | |
| 9017 | S ZTSAVE( "ENDDT")=" " | |
| 9018 | "RTN","IBC NEKIT",259 ,0) | |
| 9019 | S ZTSAVE( "STATLIST" )="" | |
| 9020 | "RTN","IBC NEKIT",260 ,0) | |
| 9021 | D ^%ZTLOA D | |
| 9022 | "RTN","IBC NEKIT",261 ,0) | |
| 9023 | I IBVER=2 G QUEUEX | |
| 9024 | "RTN","IBC NEKIT",262 ,0) | |
| 9025 | I $G(ZTSK ) W !!," T ask# ",ZTS K," has be en schedul ed to purg e the eIV data tonig ht at 8:00 PM." | |
| 9026 | "RTN","IBC NEKIT",263 ,0) | |
| 9027 | E W !!," TaskManag er could n ot schedul e this tas k.",!," Co ntact IRM for techni cal assist ance." | |
| 9028 | "RTN","IBC NEKIT",264 ,0) | |
| 9029 | W ! S DIR (0)="E" D ^DIR K DIR | |
| 9030 | "RTN","IBC NEKIT",265 ,0) | |
| 9031 | QUEUEX ; | |
| 9032 | "RTN","IBC NEKIT",266 ,0) | |
| 9033 | Q | |
| 9034 | "RTN","IBC NEKIT",267 ,0) | |
| 9035 | ; | |
| 9036 | "RTN","IBC NEKIT",268 ,0) | |
| 9037 | CHKTRK(IBT Q1) ; IB*6 21, Evalua te associa ted record s for one EICD trans action | |
| 9038 | "RTN","IBC NEKIT",269 ,0) | |
| 9039 | ; IBTQ1 = EICD Iden tification TQ IEN | |
| 9040 | "RTN","IBC NEKIT",270 ,0) | |
| 9041 | ; | |
| 9042 | "RTN","IBC NEKIT",271 ,0) | |
| 9043 | N FILE,HL IEN,IBTQIE N1,IBTQIEN 2,IBFIELDS ,IBPURGE,I BSKIP,IBTQ IEN,IBTQS | |
| 9044 | "RTN","IBC NEKIT",272 ,0) | |
| 9045 | N IBTRKIE N,PFLAG | |
| 9046 | "RTN","IBC NEKIT",273 ,0) | |
| 9047 | ; | |
| 9048 | "RTN","IBC NEKIT",274 ,0) | |
| 9049 | S (IBSKIP ,PFLAG)=0 | |
| 9050 | "RTN","IBC NEKIT",275 ,0) | |
| 9051 | K IBPURGE | |
| 9052 | "RTN","IBC NEKIT",276 ,0) | |
| 9053 | S IBTQIEN 1=+$$FIND1 ^DIC(365.1 8,,"QX",IB TQ1,"B") | |
| 9054 | "RTN","IBC NEKIT",277 ,0) | |
| 9055 | Q:'IBTQIE N1 ; the passed TQ IEN is not in the tr acking fil e | |
| 9056 | "RTN","IBC NEKIT",278 ,0) | |
| 9057 | S IBPURGE ("EICD",36 5.1,IBTQ1) ="" ;E ICD TQ for identific ations | |
| 9058 | "RTN","IBC NEKIT",279 ,0) | |
| 9059 | S IBTQIEN =+$$GET1^D IQ(365.18, IBTQIEN1,. 06,"I") ;E ICD RESPON SE for ide ntificatio ns | |
| 9060 | "RTN","IBC NEKIT",280 ,0) | |
| 9061 | I IBTQIEN S IBPURGE ("EICD",36 5,IBTQIEN) ="" | |
| 9062 | "RTN","IBC NEKIT",281 ,0) | |
| 9063 | ; | |
| 9064 | "RTN","IBC NEKIT",282 ,0) | |
| 9065 | ; loop th rough the EICD verif ication en tries look ing for ex clusions | |
| 9066 | "RTN","IBC NEKIT",283 ,0) | |
| 9067 | S IBTRKIE N=0 F S I BTRKIEN=$O (^IBCN(365 .18,IBTQIE N1,"INS-FN D",IBTRKIE N)) Q:'IBT RKIEN D Q:IBSKIP | |
| 9068 | "RTN","IBC NEKIT",284 ,0) | |
| 9069 | . ; | |
| 9070 | "RTN","IBC NEKIT",285 ,0) | |
| 9071 | . ; check the 1 nod e data for associate d TQs & th eir respon ses | |
| 9072 | "RTN","IBC NEKIT",286 ,0) | |
| 9073 | . S IBTQI EN2=IBTRKI EN_","_IBT QIEN1_"," | |
| 9074 | "RTN","IBC NEKIT",287 ,0) | |
| 9075 | . K IBFIE LDS D GETS ^DIQ(365.1 85,IBTQIEN 2,"1.01:1. 04","I","I BFIELDS") | |
| 9076 | "RTN","IBC NEKIT",288 ,0) | |
| 9077 | . ; | |
| 9078 | "RTN","IBC NEKIT",289 ,0) | |
| 9079 | . I IBFIE LDS(365.18 5,IBTQIEN2 ,1.02,"I") ="" Q ; No TQ w as created | |
| 9080 | "RTN","IBC NEKIT",290 ,0) | |
| 9081 | . I IBFIE LDS(365.18 5,IBTQIEN2 ,1.02,"I") >ENDDT S I BSKIP=1 Q ; TQ not old enough | |
| 9082 | "RTN","IBC NEKIT",291 ,0) | |
| 9083 | . S IBTQI EN=+IBFIEL DS(365.185 ,IBTQIEN2, 1.01,"I") ; EICD VE R INQ TQ | |
| 9084 | "RTN","IBC NEKIT",292 ,0) | |
| 9085 | . S IBTQS =+$$GET1^D IQ(365.1,I BTQIEN_"," ,.04,"I") ; TQ Tran smission S tatus | |
| 9086 | "RTN","IBC NEKIT",293 ,0) | |
| 9087 | . I IBTQS ,('$F(STAT LIST,","_I BTQS_",")) S IBSKIP= 1 Q ; must be in the li st | |
| 9088 | "RTN","IBC NEKIT",294 ,0) | |
| 9089 | . ; | |
| 9090 | "RTN","IBC NEKIT",295 ,0) | |
| 9091 | . ; Loop thru all E ICD Verifi cations if any are D O NOT PURG E then kil l | |
| 9092 | "RTN","IBC NEKIT",296 ,0) | |
| 9093 | . ; nothi ng associa ted with i t | |
| 9094 | "RTN","IBC NEKIT",297 ,0) | |
| 9095 | . S HLIEN =0 | |
| 9096 | "RTN","IBC NEKIT",298 ,0) | |
| 9097 | . F S HL IEN=$O(^IB CN(365.1,I BTQIEN,2,H LIEN)) Q:' HLIEN!PFLA G D | |
| 9098 | "RTN","IBC NEKIT",299 ,0) | |
| 9099 | .. S DA=$ P($G(^IBCN (365.1,IBT QIEN,2,HLI EN,0)),U,3 ) Q:'DA | |
| 9100 | "RTN","IBC NEKIT",300 ,0) | |
| 9101 | .. I +$$G ET1^DIQ(36 5,DA_",",. 11,"I") S PFLAG=1 Q ;"DO NOT PURGE" | |
| 9102 | "RTN","IBC NEKIT",301 ,0) | |
| 9103 | .. S IBPU RGE("EICD" ,365,DA)=" " ; array of Verifi cations to purge (re sponses) | |
| 9104 | "RTN","IBC NEKIT",302 ,0) | |
| 9105 | . I PFLAG Q | |
| 9106 | "RTN","IBC NEKIT",303 ,0) | |
| 9107 | . S IBPUR GE("EICD", 365.1,IBTQ IEN)="" ; array of V erificatio ns to purg e (inquiri es) | |
| 9108 | "RTN","IBC NEKIT",304 ,0) | |
| 9109 | ; | |
| 9110 | "RTN","IBC NEKIT",305 ,0) | |
| 9111 | I PFLAG!I BSKIP K IB PURGE ; D O NOT PURG E is set o r Not all records ar e old enou gh | |
| 9112 | "RTN","IBC NEKIT",306 ,0) | |
| 9113 | ; | |
| 9114 | "RTN","IBC NEKIT",307 ,0) | |
| 9115 | I '$D(IBP URGE) Q ; No record s associat ed with th is entry t o purge | |
| 9116 | "RTN","IBC NEKIT",308 ,0) | |
| 9117 | S IBPURGE ("EICD",36 5.18,IBTQ1 )="" | |
| 9118 | "RTN","IBC NEKIT",309 ,0) | |
| 9119 | S FILE="" F S FILE =$O(IBPURG E("EICD",F ILE)) Q:'F ILE D | |
| 9120 | "RTN","IBC NEKIT",310 ,0) | |
| 9121 | . S DIK=" ^IBCN("_FI LE_"," | |
| 9122 | "RTN","IBC NEKIT",311 ,0) | |
| 9123 | . S DA="" F S DA=$ O(IBPURGE( "EICD",FIL E,DA)) Q:' DA D | |
| 9124 | "RTN","IBC NEKIT",312 ,0) | |
| 9125 | .. D ^DIK | |
| 9126 | "RTN","IBC NEKIT",313 ,0) | |
| 9127 | K IBPURGE ,DA,DIK | |
| 9128 | "RTN","IBC NEKIT",314 ,0) | |
| 9129 | Q | |
| 9130 | "RTN","IBC NEKIT",315 ,0) | |
| 9131 | ; | |
| 9132 | "RTN","IBC NEMS1") | |
| 9133 | 0^11^B7021 261^n/a | |
| 9134 | "RTN","IBC NEMS1",1,0 ) | |
| 9135 | IBCNEMS1 ; AITC/DM - Consolidat ed Mailman messages; 12-JUNE-2 018 | |
| 9136 | "RTN","IBC NEMS1",2,0 ) | |
| 9137 | ;;2.0;INT EGRATED BI LLING;**62 1**;21-MAR -94;Build 8 | |
| 9138 | "RTN","IBC NEMS1",3,0 ) | |
| 9139 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 9140 | "RTN","IBC NEMS1",4,0 ) | |
| 9141 | ; | |
| 9142 | "RTN","IBC NEMS1",5,0 ) | |
| 9143 | ; | |
| 9144 | "RTN","IBC NEMS1",6,0 ) | |
| 9145 | ; These r outines ar e being co nsolidated in one ar ea for eas e in maint enance | |
| 9146 | "RTN","IBC NEMS1",7,0 ) | |
| 9147 | ; The cal ling routi ne is resp onsible fo r setting the target MAILGROUP , Subject text | |
| 9148 | "RTN","IBC NEMS1",8,0 ) | |
| 9149 | ; and fin ally calli ng MSG^IBC NEUT5(...) to send t he actual Mailman me ssage | |
| 9150 | "RTN","IBC NEMS1",9,0 ) | |
| 9151 | ; | |
| 9152 | "RTN","IBC NEMS1",10, 0) | |
| 9153 | MSG001(MSG ,EXNAME) ; error msg for $$SDA PI^SDAMA30 1 appointm ent api is sue from a n extract | |
| 9154 | "RTN","IBC NEMS1",11, 0) | |
| 9155 | ; MSG is the global that will be popula ted with m essage tex t. | |
| 9156 | "RTN","IBC NEMS1",12, 0) | |
| 9157 | ; EXNAME is the ext ract that had the is sue (e.g. "EICD") | |
| 9158 | "RTN","IBC NEMS1",13, 0) | |
| 9159 | ; It is a ssumed tha t ^TMP($J, "SDAMA301" ) has been populated by the fa iled call | |
| 9160 | "RTN","IBC NEMS1",14, 0) | |
| 9161 | ; | |
| 9162 | "RTN","IBC NEMS1",15, 0) | |
| 9163 | N IBMSG,I BII | |
| 9164 | "RTN","IBC NEMS1",16, 0) | |
| 9165 | S MSG(1)= "On "_$$FM TE^XLFDT(D T)_" the " _EXNAME_" Extract fo r eIV enco untered" | |
| 9166 | "RTN","IBC NEMS1",17, 0) | |
| 9167 | S MSG(2)= "one or mo re errors while atte mpting to get Appoin tment data " | |
| 9168 | "RTN","IBC NEMS1",18, 0) | |
| 9169 | S MSG(3)= "from the scheduling package." | |
| 9170 | "RTN","IBC NEMS1",19, 0) | |
| 9171 | S MSG(4)= "" | |
| 9172 | "RTN","IBC NEMS1",20, 0) | |
| 9173 | S MSG(5)= "Error(s) encountere d: " | |
| 9174 | "RTN","IBC NEMS1",21, 0) | |
| 9175 | S MSG(6)= "" | |
| 9176 | "RTN","IBC NEMS1",22, 0) | |
| 9177 | S MSG(7)= " Error C ode Erro r Message" | |
| 9178 | "RTN","IBC NEMS1",23, 0) | |
| 9179 | S MSG(8)= " ------- --- ---- ---------" | |
| 9180 | "RTN","IBC NEMS1",24, 0) | |
| 9181 | S IBMSG=8 ,IBII=0 | |
| 9182 | "RTN","IBC NEMS1",25, 0) | |
| 9183 | F S IBII =$O(^TMP($ J,"SDAMA30 1",IBII)) Q:IBII="" S IBMSG=I BMSG+1,MSG (IBMSG)=" "_$$LJ^XL FSTR(IBII, 13)_$G(^TM P($J,"SDAM A301",IBII )) | |
| 9184 | "RTN","IBC NEMS1",26, 0) | |
| 9185 | S IBMSG=I BMSG+1,MSG (IBMSG)="" | |
| 9186 | "RTN","IBC NEMS1",27, 0) | |
| 9187 | S IBMSG=I BMSG+1,MSG (IBMSG)="A s a result of this e rror the e xtract was not done. The extr act" | |
| 9188 | "RTN","IBC NEMS1",28, 0) | |
| 9189 | S IBMSG=I BMSG+1,MSG (IBMSG)="w ill be att empted aga in the nex t night au tomaticall y. If you " | |
| 9190 | "RTN","IBC NEMS1",29, 0) | |
| 9191 | S IBMSG=I BMSG+1,MSG (IBMSG)="c ontinue to receive e rror messa ges you sh ould conta ct your IR M" | |
| 9192 | "RTN","IBC NEMS1",30, 0) | |
| 9193 | S IBMSG=I BMSG+1,MSG (IBMSG)="a nd possibl y call the Help Desk for assis tance." | |
| 9194 | "RTN","IBC NEMS1",31, 0) | |
| 9195 | ; | |
| 9196 | "RTN","IBC NEMS1",32, 0) | |
| 9197 | Q | |
| 9198 | "RTN","IBC NEMS1",33, 0) | |
| 9199 | ; | |
| 9200 | "RTN","IBC NEMS1",34, 0) | |
| 9201 | MSG002(MSG ,ERRGB,TQ) ; error m sg when wr iting to E IV EICD TR ACKING (#3 65.18) fro m IBCNEDE4 | |
| 9202 | "RTN","IBC NEMS1",35, 0) | |
| 9203 | ; MSG is the global that will be popula ted with m essage tex t. | |
| 9204 | "RTN","IBC NEMS1",36, 0) | |
| 9205 | ; ERRBG i s the ERRO R global t hat was pa ssed to a Fileman ^D IE call | |
| 9206 | "RTN","IBC NEMS1",37, 0) | |
| 9207 | ; TQ IEN of the ass ociated II V Transmis sion Queue | |
| 9208 | "RTN","IBC NEMS1",38, 0) | |
| 9209 | ; The use r should v erify that there is an existin g error be fore makin g this cal l | |
| 9210 | "RTN","IBC NEMS1",39, 0) | |
| 9211 | ; Set to IB site pa rameter MA ILGROUP | |
| 9212 | "RTN","IBC NEMS1",40, 0) | |
| 9213 | ; | |
| 9214 | "RTN","IBC NEMS1",41, 0) | |
| 9215 | S MSG(1)= "Tried to create an entry in t he EIV EIC D TRACKING file #365 .18" | |
| 9216 | "RTN","IBC NEMS1",42, 0) | |
| 9217 | S MSG(2)= "without s uccess." | |
| 9218 | "RTN","IBC NEMS1",43, 0) | |
| 9219 | S MSG(3)= "" | |
| 9220 | "RTN","IBC NEMS1",44, 0) | |
| 9221 | S MSG(4)= "Error enc ountered: "_$G(ERRGB ("DIERR",1 ,"TEXT",1) ) | |
| 9222 | "RTN","IBC NEMS1",45, 0) | |
| 9223 | S MSG(5)= "" | |
| 9224 | "RTN","IBC NEMS1",46, 0) | |
| 9225 | S MSG(6)= "The assoc iated IIV Transmissi on Queue I EN: "_TQ | |
| 9226 | "RTN","IBC NEMS1",47, 0) | |
| 9227 | S MSG(7)= "" | |
| 9228 | "RTN","IBC NEMS1",48, 0) | |
| 9229 | S MSG(8)= "If you co ntinue to receive th is error m essage, yo u should c ontact" | |
| 9230 | "RTN","IBC NEMS1",49, 0) | |
| 9231 | S MSG(9)= "your IRM and possib ly call th e Help Des k for assi stance." | |
| 9232 | "RTN","IBC NEMS1",50, 0) | |
| 9233 | Q | |
| 9234 | "RTN","IBC NEMS1",51, 0) | |
| 9235 | ; | |
| 9236 | "RTN","IBC NEPM") | |
| 9237 | 0^12^B1543 5667^B1504 0845 | |
| 9238 | "RTN","IBC NEPM",1,0) | |
| 9239 | IBCNEPM ;D AOU/ESG - PAYER MAIN TENANCE PA YER LIST S CREEN ;22- JAN-2003 | |
| 9240 | "RTN","IBC NEPM",2,0) | |
| 9241 | ;;2.0;INT EGRATED BI LLING;**18 4,601,621* *;21-MAR-9 4;Build 8 | |
| 9242 | "RTN","IBC NEPM",3,0) | |
| 9243 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 9244 | "RTN","IBC NEPM",4,0) | |
| 9245 | ; | |
| 9246 | "RTN","IBC NEPM",5,0) | |
| 9247 | Q | |
| 9248 | "RTN","IBC NEPM",6,0) | |
| 9249 | ; | |
| 9250 | "RTN","IBC NEPM",7,0) | |
| 9251 | HDR ; -- h eader code | |
| 9252 | "RTN","IBC NEPM",8,0) | |
| 9253 | S VALMHDR (1)="Payer s with pot ential mat ches to ac tive insur ance compa nies." | |
| 9254 | "RTN","IBC NEPM",9,0) | |
| 9255 | Q | |
| 9256 | "RTN","IBC NEPM",10,0 ) | |
| 9257 | ; | |
| 9258 | "RTN","IBC NEPM",11,0 ) | |
| 9259 | INIT ; -- init varia bles and l ist array | |
| 9260 | "RTN","IBC NEPM",12,0 ) | |
| 9261 | ; | |
| 9262 | "RTN","IBC NEPM",13,0 ) | |
| 9263 | ;Create s cratch glo bal of pay er w/ pote ntial matc hes missin g | |
| 9264 | "RTN","IBC NEPM",14,0 ) | |
| 9265 | KILL ^TMP ("IBCNEPM" ,$J) | |
| 9266 | "RTN","IBC NEPM",15,0 ) | |
| 9267 | NEW INS,D ATA,PROFID ,INSTID,IE N,APP,ACTI VE,PAYER | |
| 9268 | "RTN","IBC NEPM",16,0 ) | |
| 9269 | ; | |
| 9270 | "RTN","IBC NEPM",17,0 ) | |
| 9271 | ; First b uild a scr atch globa l cross re ference wi th all exi sting | |
| 9272 | "RTN","IBC NEPM",18,0 ) | |
| 9273 | ; profess ional and institutio nal EDI ID numbers i n file 36. | |
| 9274 | "RTN","IBC NEPM",19,0 ) | |
| 9275 | S INS=0 | |
| 9276 | "RTN","IBC NEPM",20,0 ) | |
| 9277 | F S INS= $O(^DIC(36 ,INS)) Q:' INS D | |
| 9278 | "RTN","IBC NEPM",21,0 ) | |
| 9279 | . I '$$AC TIVE^IBCNE UT4(INS) Q ; inactive ins co | |
| 9280 | "RTN","IBC NEPM",22,0 ) | |
| 9281 | . S DATA= $G(^DIC(36 ,INS,3)) | |
| 9282 | "RTN","IBC NEPM",23,0 ) | |
| 9283 | . I $P(DA TA,U,10)'= "" Q ; already linked to a payer | |
| 9284 | "RTN","IBC NEPM",24,0 ) | |
| 9285 | . S PROFI D=$P(DATA, U,2),INSTI D=$P(DATA, U,4) | |
| 9286 | "RTN","IBC NEPM",25,0 ) | |
| 9287 | . I PROFI D'="" S ^T MP("IBCNEP M",$J,"P", PROFID,INS )="" | |
| 9288 | "RTN","IBC NEPM",26,0 ) | |
| 9289 | . I INSTI D'="" S ^T MP("IBCNEP M",$J,"I", INSTID,INS )="" | |
| 9290 | "RTN","IBC NEPM",27,0 ) | |
| 9291 | . Q | |
| 9292 | "RTN","IBC NEPM",28,0 ) | |
| 9293 | ; | |
| 9294 | "RTN","IBC NEPM",29,0 ) | |
| 9295 | ; Next lo op through all payer s. Count up the num ber of ins urance | |
| 9296 | "RTN","IBC NEPM",30,0 ) | |
| 9297 | ; compani es that ha ve matchin g EDI ID n umbers but no payer links. | |
| 9298 | "RTN","IBC NEPM",31,0 ) | |
| 9299 | ; These a re possibl e payer-in surance co mpany link s that hav e not yet | |
| 9300 | "RTN","IBC NEPM",32,0 ) | |
| 9301 | ; been ma de. | |
| 9302 | "RTN","IBC NEPM",33,0 ) | |
| 9303 | ; | |
| 9304 | "RTN","IBC NEPM",34,0 ) | |
| 9305 | S IEN=0 | |
| 9306 | "RTN","IBC NEPM",35,0 ) | |
| 9307 | F S IEN= $O(^IBE(36 5.12,IEN)) Q:'IEN D | |
| 9308 | "RTN","IBC NEPM",36,0 ) | |
| 9309 | . I IEN=$ $GET1^DIQ( 350.9,"1," ,"MBI PAYE R","I") Q ;IB*2*601 /DM | |
| 9310 | "RTN","IBC NEPM",37,0 ) | |
| 9311 | . I IEN=$ $GET1^DIQ( 350.9,"1," ,"EICD PAY ER","I") Q ;IB*2.0* 621/DM | |
| 9312 | "RTN","IBC NEPM",38,0 ) | |
| 9313 | . S DATA= $G(^IBE(36 5.12,IEN,0 )) | |
| 9314 | "RTN","IBC NEPM",39,0 ) | |
| 9315 | . ; | |
| 9316 | "RTN","IBC NEPM",40,0 ) | |
| 9317 | . I '$$AC TAPP^IBCNE UT5(IEN) Q ; no act ive payer applicatio ns | |
| 9318 | "RTN","IBC NEPM",41,0 ) | |
| 9319 | . ; | |
| 9320 | "RTN","IBC NEPM",42,0 ) | |
| 9321 | . ; must have at le ast 1 nati onally act ive payer applicatio n | |
| 9322 | "RTN","IBC NEPM",43,0 ) | |
| 9323 | . S APP=0 ,ACTIVE=0 | |
| 9324 | "RTN","IBC NEPM",44,0 ) | |
| 9325 | . F S AP P=$O(^IBE( 365.12,IEN ,1,APP)) Q :'APP!(ACT IVE) D | |
| 9326 | "RTN","IBC NEPM",45,0 ) | |
| 9327 | .. I $P($ G(^IBE(365 .12,IEN,1, APP,0)),U, 2)=1 S ACT IVE=1 | |
| 9328 | "RTN","IBC NEPM",46,0 ) | |
| 9329 | . Q:'ACTI VE ; no nationall y active p ayer appli cation fou nd | |
| 9330 | "RTN","IBC NEPM",47,0 ) | |
| 9331 | . ; | |
| 9332 | "RTN","IBC NEPM",48,0 ) | |
| 9333 | . S PAYER =$P(DATA,U ),PROFID=$ P(DATA,U,5 ),INSTID=$ P(DATA,U,6 ) | |
| 9334 | "RTN","IBC NEPM",49,0 ) | |
| 9335 | . ; | |
| 9336 | "RTN","IBC NEPM",50,0 ) | |
| 9337 | . ; Look at the pay er's profe ssional ID and see h ow many un ique | |
| 9338 | "RTN","IBC NEPM",51,0 ) | |
| 9339 | . ; insur ance compa nies also have this profession al ID | |
| 9340 | "RTN","IBC NEPM",52,0 ) | |
| 9341 | . I PROFI D'="",$D(^ TMP("IBCNE PM",$J,"P" ,PROFID)) D | |
| 9342 | "RTN","IBC NEPM",53,0 ) | |
| 9343 | .. S INS= "" F S IN S=$O(^TMP( "IBCNEPM", $J,"P",PRO FID,INS)) Q:'INS D | |
| 9344 | "RTN","IBC NEPM",54,0 ) | |
| 9345 | ... S ^TM P("IBCNEPM ",$J,"INS" ,INS,IEN)= PAYER | |
| 9346 | "RTN","IBC NEPM",55,0 ) | |
| 9347 | ... I $D( ^TMP("IBCN EPM",$J,"P YR",PAYER, IEN,INS)) Q | |
| 9348 | "RTN","IBC NEPM",56,0 ) | |
| 9349 | ... S ^TM P("IBCNEPM ",$J,"PYR" ,PAYER,IEN ,INS)="" | |
| 9350 | "RTN","IBC NEPM",57,0 ) | |
| 9351 | ... S ^TM P("IBCNEPM ",$J,"PYR" ,PAYER,IEN )=$G(^TMP( "IBCNEPM", $J,"PYR",P AYER,IEN)) +1 ; incr ement tot | |
| 9352 | "RTN","IBC NEPM",58,0 ) | |
| 9353 | . ; | |
| 9354 | "RTN","IBC NEPM",59,0 ) | |
| 9355 | . ; Look at the pay er's insti tutional I D and see how many u nique | |
| 9356 | "RTN","IBC NEPM",60,0 ) | |
| 9357 | . ; insur ance compa nies also have this institutio nal ID | |
| 9358 | "RTN","IBC NEPM",61,0 ) | |
| 9359 | . I INSTI D'="",$D(^ TMP("IBCNE PM",$J,"I" ,INSTID)) D | |
| 9360 | "RTN","IBC NEPM",62,0 ) | |
| 9361 | .. S INS= "" F S IN S=$O(^TMP( "IBCNEPM", $J,"I",INS TID,INS)) Q:'INS D | |
| 9362 | "RTN","IBC NEPM",63,0 ) | |
| 9363 | ... S ^TM P("IBCNEPM ",$J,"INS" ,INS,IEN)= PAYER | |
| 9364 | "RTN","IBC NEPM",64,0 ) | |
| 9365 | ... I $D( ^TMP("IBCN EPM",$J,"P YR",PAYER, IEN,INS)) Q | |
| 9366 | "RTN","IBC NEPM",65,0 ) | |
| 9367 | ... S ^TM P("IBCNEPM ",$J,"PYR" ,PAYER,IEN ,INS)="" | |
| 9368 | "RTN","IBC NEPM",66,0 ) | |
| 9369 | ... S ^TM P("IBCNEPM ",$J,"PYR" ,PAYER,IEN )=$G(^TMP( "IBCNEPM", $J,"PYR",P AYER,IEN)) +1 ; incr ement tot | |
| 9370 | "RTN","IBC NEPM",67,0 ) | |
| 9371 | ; | |
| 9372 | "RTN","IBC NEPM",68,0 ) | |
| 9373 | D BUILD | |
| 9374 | "RTN","IBC NEPM",69,0 ) | |
| 9375 | ; | |
| 9376 | "RTN","IBC NEPM",70,0 ) | |
| 9377 | INITX ; | |
| 9378 | "RTN","IBC NEPM",71,0 ) | |
| 9379 | Q | |
| 9380 | "RTN","IBC NEPM",72,0 ) | |
| 9381 | ; | |
| 9382 | "RTN","IBC NEPM",73,0 ) | |
| 9383 | BUILD ; Th is procedu re builds the ListMa n display global bas ed on the | |
| 9384 | "RTN","IBC NEPM",74,0 ) | |
| 9385 | ; "PYR" a rea of the scratch g lobal. | |
| 9386 | "RTN","IBC NEPM",75,0 ) | |
| 9387 | ; | |
| 9388 | "RTN","IBC NEPM",76,0 ) | |
| 9389 | NEW LINE, PAYER,IEN, STRING,LIN KS | |
| 9390 | "RTN","IBC NEPM",77,0 ) | |
| 9391 | KILL ^TMP ("IBCNEPM" ,$J,1) | |
| 9392 | "RTN","IBC NEPM",78,0 ) | |
| 9393 | S LINE=0, (PAYER,IEN )="" | |
| 9394 | "RTN","IBC NEPM",79,0 ) | |
| 9395 | F S PAYE R=$O(^TMP( "IBCNEPM", $J,"PYR",P AYER)) Q:P AYER="" D | |
| 9396 | "RTN","IBC NEPM",80,0 ) | |
| 9397 | . F S IE N=$O(^TMP( "IBCNEPM", $J,"PYR",P AYER,IEN)) Q:IEN="" D | |
| 9398 | "RTN","IBC NEPM",81,0 ) | |
| 9399 | .. S STRI NG="",LINE =LINE+1 | |
| 9400 | "RTN","IBC NEPM",82,0 ) | |
| 9401 | .. S ^TMP ("IBCNEPM" ,$J,"IDX", LINE,IEN)= PAYER | |
| 9402 | "RTN","IBC NEPM",83,0 ) | |
| 9403 | .. S LINK S=^TMP("IB CNEPM",$J, "PYR",PAYE R,IEN) | |
| 9404 | "RTN","IBC NEPM",84,0 ) | |
| 9405 | .. S STRI NG=$$SETFL D^VALM1(LI NE,STRING, "LINE") | |
| 9406 | "RTN","IBC NEPM",85,0 ) | |
| 9407 | .. S STRI NG=$$SETFL D^VALM1(PA YER,STRING ,"PAYER") | |
| 9408 | "RTN","IBC NEPM",86,0 ) | |
| 9409 | .. S STRI NG=$$SETFL D^VALM1(LI NKS,STRING ,"LINKS") | |
| 9410 | "RTN","IBC NEPM",87,0 ) | |
| 9411 | .. D SET^ VALM10(LIN E,STRING) | |
| 9412 | "RTN","IBC NEPM",88,0 ) | |
| 9413 | ; | |
| 9414 | "RTN","IBC NEPM",89,0 ) | |
| 9415 | S VALMCNT =LINE | |
| 9416 | "RTN","IBC NEPM",90,0 ) | |
| 9417 | I VALMCNT =0 S VALMS G=" No Act ive Payers with pote ntial miss ing links. " | |
| 9418 | "RTN","IBC NEPM",91,0 ) | |
| 9419 | BUILDX ; | |
| 9420 | "RTN","IBC NEPM",92,0 ) | |
| 9421 | Q | |
| 9422 | "RTN","IBC NEPM",93,0 ) | |
| 9423 | ; | |
| 9424 | "RTN","IBC NEPM",94,0 ) | |
| 9425 | ; | |
| 9426 | "RTN","IBC NEPM",95,0 ) | |
| 9427 | HELP ; -- help code | |
| 9428 | "RTN","IBC NEPM",96,0 ) | |
| 9429 | N X S X=" ?" D DISP^ XQORM1 W ! ! | |
| 9430 | "RTN","IBC NEPM",97,0 ) | |
| 9431 | Q | |
| 9432 | "RTN","IBC NEPM",98,0 ) | |
| 9433 | ; | |
| 9434 | "RTN","IBC NEPM",99,0 ) | |
| 9435 | EXIT ; -- exit code | |
| 9436 | "RTN","IBC NEPM",100, 0) | |
| 9437 | Q | |
| 9438 | "RTN","IBC NEPM",101, 0) | |
| 9439 | ; | |
| 9440 | "RTN","IBC NEPM",102, 0) | |
| 9441 | EXPND ; -- expand co de | |
| 9442 | "RTN","IBC NEPM",103, 0) | |
| 9443 | Q | |
| 9444 | "RTN","IBC NEPM",104, 0) | |
| 9445 | ; | |
| 9446 | "RTN","IBC NERP0") | |
| 9447 | 0^27^B5584 263^B57076 94 | |
| 9448 | "RTN","IBC NERP0",1,0 ) | |
| 9449 | IBCNERP0 ; DAOU/BHS - IBCNE eIV STATISTIC AL REPORT (cont'd) ; 11-JUN-200 2 | |
| 9450 | "RTN","IBC NERP0",2,0 ) | |
| 9451 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 621**;21-M AR-94;Buil d 8 | |
| 9452 | "RTN","IBC NERP0",3,0 ) | |
| 9453 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 9454 | "RTN","IBC NERP0",4,0 ) | |
| 9455 | ; | |
| 9456 | "RTN","IBC NERP0",5,0 ) | |
| 9457 | ; eIV - I nsurance V erificatio n Interfac e | |
| 9458 | "RTN","IBC NERP0",6,0 ) | |
| 9459 | ; | |
| 9460 | "RTN","IBC NERP0",7,0 ) | |
| 9461 | ; PYR tag called by IBCNERP8 | |
| 9462 | "RTN","IBC NERP0",8,0 ) | |
| 9463 | ; | |
| 9464 | "RTN","IBC NERP0",9,0 ) | |
| 9465 | ; Cannot be called from top o f routine | |
| 9466 | "RTN","IBC NERP0",10, 0) | |
| 9467 | Q | |
| 9468 | "RTN","IBC NERP0",11, 0) | |
| 9469 | ; | |
| 9470 | "RTN","IBC NERP0",12, 0) | |
| 9471 | PYR(RTN,BD T,EDT,TOT) ; Determi ne Incomin g Data | |
| 9472 | "RTN","IBC NERP0",13, 0) | |
| 9473 | ; Input p arams: RTN -routine n ame for ^T MP($J), BD T-start dt /time, | |
| 9474 | "RTN","IBC NERP0",14, 0) | |
| 9475 | ; EDT-en d dt/time, **TOT-tot al records searched - used onl y for stat us | |
| 9476 | "RTN","IBC NERP0",15, 0) | |
| 9477 | ; checks when the process is queued (p assed by r eference) | |
| 9478 | "RTN","IBC NERP0",16, 0) | |
| 9479 | ; Output vars: Set ^TMP($J,RT N,"PYR",PA YER NAME,I EN of file 365.12)=" " | |
| 9480 | "RTN","IBC NERP0",17, 0) | |
| 9481 | N PIEN,PY R,CREATEDT ,APPIEN,AP PDATA | |
| 9482 | "RTN","IBC NERP0",18, 0) | |
| 9483 | ;S BDT=$P (BDT,"."), EDT=$P(EDT ,".") | |
| 9484 | "RTN","IBC NERP0",19, 0) | |
| 9485 | S PIEN=0 F S PIEN= $O(^IBE(36 5.12,PIEN) ) Q:'PIEN D | |
| 9486 | "RTN","IBC NERP0",20, 0) | |
| 9487 | . S TOT=T OT+1 | |
| 9488 | "RTN","IBC NERP0",21, 0) | |
| 9489 | . S CREAT EDT=$P($G( ^IBE(365.1 2,PIEN,0)) ,U,4) | |
| 9490 | "RTN","IBC NERP0",22, 0) | |
| 9491 | . I CREAT EDT=""!(CR EATEDT<BDT )!(CREATED T>EDT) Q | |
| 9492 | "RTN","IBC NERP0",23, 0) | |
| 9493 | . S PYR=$ P($G(^IBE( 365.12,PIE N,0)),U) | |
| 9494 | "RTN","IBC NERP0",24, 0) | |
| 9495 | . Q:PYR=" ~NO PAYER" ; u sed intern ally only - not a re al eIV pay er | |
| 9496 | "RTN","IBC NERP0",25, 0) | |
| 9497 | . ; | |
| 9498 | "RTN","IBC NERP0",26, 0) | |
| 9499 | . ; Get P ayer app m ultiple IE N | |
| 9500 | "RTN","IBC NERP0",27, 0) | |
| 9501 | . S APPIE N=$$PYRAPP ^IBCNEUT5( "IIV",PIEN ) | |
| 9502 | "RTN","IBC NERP0",28, 0) | |
| 9503 | . ; Must have eIV a pplication | |
| 9504 | "RTN","IBC NERP0",29, 0) | |
| 9505 | . I 'APPI EN Q | |
| 9506 | "RTN","IBC NERP0",30, 0) | |
| 9507 | . S APPDA TA=$G(^IBE (365.12,PI EN,1,APPIE N,0)) | |
| 9508 | "RTN","IBC NERP0",31, 0) | |
| 9509 | . ; Must be Nationa lly Active | |
| 9510 | "RTN","IBC NERP0",32, 0) | |
| 9511 | . I '$P(A PPDATA,U,2 ) Q | |
| 9512 | "RTN","IBC NERP0",33, 0) | |
| 9513 | . ; | |
| 9514 | "RTN","IBC NERP0",34, 0) | |
| 9515 | . S ^TMP( $J,RTN,"PY R",PYR,PIE N)="" | |
| 9516 | "RTN","IBC NERP0",35, 0) | |
| 9517 | Q | |
| 9518 | "RTN","IBC NERP0",36, 0) | |
| 9519 | ; | |
| 9520 | "RTN","IBC NERP0",37, 0) | |
| 9521 | HEADER(HDR DATA,PGC,P XT,MAX,CRT ,SITE,DTMR NG,MM) ; P rint heade r info for each pg | |
| 9522 | "RTN","IBC NERP0",38, 0) | |
| 9523 | ; Init va rs | |
| 9524 | "RTN","IBC NERP0",39, 0) | |
| 9525 | N CT,HDRC T,LIN,HDR | |
| 9526 | "RTN","IBC NERP0",40, 0) | |
| 9527 | ; | |
| 9528 | "RTN","IBC NERP0",41, 0) | |
| 9529 | ; Prompt to print n ext page f or reports to the sc reen | |
| 9530 | "RTN","IBC NERP0",42, 0) | |
| 9531 | I CRT,PGC >0,'$D(ZTQ UEUED) D I PXT G HE ADERX | |
| 9532 | "RTN","IBC NERP0",43, 0) | |
| 9533 | . I MAX<5 1 F LIN=1: 1:(MAX-$Y) W ! | |
| 9534 | "RTN","IBC NERP0",44, 0) | |
| 9535 | . S DIR(0 )="E" D ^D IR K DIR | |
| 9536 | "RTN","IBC NERP0",45, 0) | |
| 9537 | . I $D(DT OUT)!$D(DU OUT) S PXT =1 Q | |
| 9538 | "RTN","IBC NERP0",46, 0) | |
| 9539 | I $D(ZTQU EUED),$$S^ %ZTLOAD() S ZTSTOP=1 G HEADERX | |
| 9540 | "RTN","IBC NERP0",47, 0) | |
| 9541 | ; | |
| 9542 | "RTN","IBC NERP0",48, 0) | |
| 9543 | ; Update page ct | |
| 9544 | "RTN","IBC NERP0",49, 0) | |
| 9545 | S PGC=PGC +1 | |
| 9546 | "RTN","IBC NERP0",50, 0) | |
| 9547 | ; | |
| 9548 | "RTN","IBC NERP0",51, 0) | |
| 9549 | ; Update header bas ed on Mail Man messag e flag | |
| 9550 | "RTN","IBC NERP0",52, 0) | |
| 9551 | S HDRCT=0 | |
| 9552 | "RTN","IBC NERP0",53, 0) | |
| 9553 | S HDRCT=H DRCT+1,HDR DATA(HDRCT )="eIV Sta tistical R eport"_$$F O^IBCNEUT1 ($$FMTE^XL FDT($$NOW^ XLFDT,1)_" Page: "_ PGC,56,"R" ) | |
| 9554 | "RTN","IBC NERP0",54, 0) | |
| 9555 | ;S HDRDAT A(HDRCT)=$ $FO^IBCNEU T1(SITE,(8 0-$L(SITE) \2)+$L(SIT E),"R"),HD RCT=HDRCT+ 1 | |
| 9556 | "RTN","IBC NERP0",55, 0) | |
| 9557 | S HDR="Re port Timef rame: "_DT MRNG ; IB* 2.0*621 | |
| 9558 | "RTN","IBC NERP0",56, 0) | |
| 9559 | S HDRCT=H DRCT+1,HDR DATA(HDRCT )=$$FO^IBC NEUT1(HDR, (80-$L(HDR )\2)+$L(HD R),"R") ; IB*2.0*621 | |
| 9560 | "RTN","IBC NERP0",57, 0) | |
| 9561 | S HDRCT=H DRCT+1,HDR DATA(HDRCT )="" ; IB* 2.0*621 | |
| 9562 | "RTN","IBC NERP0",58, 0) | |
| 9563 | ; | |
| 9564 | "RTN","IBC NERP0",59, 0) | |
| 9565 | I MM S HD RCT=HDRCT+ 1,HDRDATA( HDRCT)="" | |
| 9566 | "RTN","IBC NERP0",60, 0) | |
| 9567 | ; Only wr ite out He ader for n on-MailMan message o utput | |
| 9568 | "RTN","IBC NERP0",61, 0) | |
| 9569 | I MM="" W @IOF F CT =1:1:HDRCT W !,?1,HD RDATA(CT) | |
| 9570 | "RTN","IBC NERP0",62, 0) | |
| 9571 | ; | |
| 9572 | "RTN","IBC NERP0",63, 0) | |
| 9573 | HEADERX ; HEADER exi t pt | |
| 9574 | "RTN","IBC NERP0",64, 0) | |
| 9575 | Q | |
| 9576 | "RTN","IBC NERP0",65, 0) | |
| 9577 | ; | |
| 9578 | "RTN","IBC NERP7") | |
| 9579 | 0^22^B3546 3903^B3043 6149 | |
| 9580 | "RTN","IBC NERP7",1,0 ) | |
| 9581 | IBCNERP7 ; DAOU/BHS - eIV STATI STICAL REP ORT ;10-JU N-2002 | |
| 9582 | "RTN","IBC NERP7",2,0 ) | |
| 9583 | ;;2.0;INT EGRATED BI LLING;**18 4,416,528, 621**;21-M AR-94;Buil d 8 | |
| 9584 | "RTN","IBC NERP7",3,0 ) | |
| 9585 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 9586 | "RTN","IBC NERP7",4,0 ) | |
| 9587 | ; | |
| 9588 | "RTN","IBC NERP7",5,0 ) | |
| 9589 | ; eIV - I nsurance V erificatio n Interfac e | |
| 9590 | "RTN","IBC NERP7",6,0 ) | |
| 9591 | ; | |
| 9592 | "RTN","IBC NERP7",7,0 ) | |
| 9593 | ; Input p arameter: N/A | |
| 9594 | "RTN","IBC NERP7",8,0 ) | |
| 9595 | ; Other r elevant va riables: | |
| 9596 | "RTN","IBC NERP7",9,0 ) | |
| 9597 | ; IBCNE RTN = "IBC NERP7" (cu rrent rout ine name f or queuein g the | |
| 9598 | "RTN","IBC NERP7",10, 0) | |
| 9599 | ; CO MPILE proc ess) | |
| 9600 | "RTN","IBC NERP7",11, 0) | |
| 9601 | ; IBCNE SPC("BEGDT M") = star t date/tim e for date /time rang e | |
| 9602 | "RTN","IBC NERP7",12, 0) | |
| 9603 | ; IBCNE SPC("ENDDT M") = end date/time for date/t ime range | |
| 9604 | "RTN","IBC NERP7",13, 0) | |
| 9605 | ; IBCNE SPC("SECTS ") = list of section s to displ ay on the report | |
| 9606 | "RTN","IBC NERP7",14, 0) | |
| 9607 | ; 1 = A ll (Outgoi ng, Incomi ng and Gen eral), | |
| 9608 | "RTN","IBC NERP7",15, 0) | |
| 9609 | ; 2 = O utgoing - Inquiry Re sponse dat a, | |
| 9610 | "RTN","IBC NERP7",16, 0) | |
| 9611 | ; 3 = I ncoming - Inquiry Tr ansmission data, | |
| 9612 | "RTN","IBC NERP7",17, 0) | |
| 9613 | ; 4 = G eneral - I ns Buffer data, Outs tanding | |
| 9614 | "RTN","IBC NERP7",18, 0) | |
| 9615 | ; I nquiries, Communicat ion Failur es, Retrie s | |
| 9616 | "RTN","IBC NERP7",19, 0) | |
| 9617 | ; may e qual a lis t of value s if '1' i s not the | |
| 9618 | "RTN","IBC NERP7",20, 0) | |
| 9619 | ; the o nly value | |
| 9620 | "RTN","IBC NERP7",21, 0) | |
| 9621 | ; IBCNE SPC("MM") = "", not for MailMa n message OR | |
| 9622 | "RTN","IBC NERP7",22, 0) | |
| 9623 | ; MAILGROU P, generat e as MailM an message for this | |
| 9624 | "RTN","IBC NERP7",23, 0) | |
| 9625 | ; MAILGRO UP as defi ned in IB site | |
| 9626 | "RTN","IBC NERP7",24, 0) | |
| 9627 | ; paramet ers | |
| 9628 | "RTN","IBC NERP7",25, 0) | |
| 9629 | ; IBOUT = "E" for Excel or "R" for re port forma t | |
| 9630 | "RTN","IBC NERP7",26, 0) | |
| 9631 | ; | |
| 9632 | "RTN","IBC NERP7",27, 0) | |
| 9633 | ; Only en ter routin e from EN or MAILMSG tags | |
| 9634 | "RTN","IBC NERP7",28, 0) | |
| 9635 | Q | |
| 9636 | "RTN","IBC NERP7",29, 0) | |
| 9637 | ; | |
| 9638 | "RTN","IBC NERP7",30, 0) | |
| 9639 | ; Entry p t | |
| 9640 | "RTN","IBC NERP7",31, 0) | |
| 9641 | EN ; | |
| 9642 | "RTN","IBC NERP7",32, 0) | |
| 9643 | ; Init va rs | |
| 9644 | "RTN","IBC NERP7",33, 0) | |
| 9645 | N STOP,IB CNERTN,POP ,IBCNESPC, IBOUT | |
| 9646 | "RTN","IBC NERP7",34, 0) | |
| 9647 | ; | |
| 9648 | "RTN","IBC NERP7",35, 0) | |
| 9649 | S STOP=0 | |
| 9650 | "RTN","IBC NERP7",36, 0) | |
| 9651 | S IBCNERT N="IBCNERP 7" | |
| 9652 | "RTN","IBC NERP7",37, 0) | |
| 9653 | W @IOF | |
| 9654 | "RTN","IBC NERP7",38, 0) | |
| 9655 | W !,"eIV Statistica l Report", ! | |
| 9656 | "RTN","IBC NERP7",39, 0) | |
| 9657 | W !,"Plea se select the timefr ame for wh ich to vie w the Insu rance" | |
| 9658 | "RTN","IBC NERP7",40, 0) | |
| 9659 | W !,"Veri fication s tatistics and curren t status." | |
| 9660 | "RTN","IBC NERP7",41, 0) | |
| 9661 | ; | |
| 9662 | "RTN","IBC NERP7",42, 0) | |
| 9663 | ; Default to MailMa n flag to No from th e EN tag | |
| 9664 | "RTN","IBC NERP7",43, 0) | |
| 9665 | S IBCNESP C("MM")="" | |
| 9666 | "RTN","IBC NERP7",44, 0) | |
| 9667 | ; | |
| 9668 | "RTN","IBC NERP7",45, 0) | |
| 9669 | ; Prompts for Payer Report | |
| 9670 | "RTN","IBC NERP7",46, 0) | |
| 9671 | ; Date Ra nge parame ters | |
| 9672 | "RTN","IBC NERP7",47, 0) | |
| 9673 | S10 D DTMR NG I STOP G EXIT | |
| 9674 | "RTN","IBC NERP7",48, 0) | |
| 9675 | ; Sort by parameter - Payer o r Total In quiries (P ayer Repor t) | |
| 9676 | "RTN","IBC NERP7",49, 0) | |
| 9677 | S20 D SECT S I STOP G :$$STOP^IB CNERP1 EXI T G S10 | |
| 9678 | "RTN","IBC NERP7",50, 0) | |
| 9679 | ; Select report typ e 528 - b aa | |
| 9680 | "RTN","IBC NERP7",51, 0) | |
| 9681 | S30 S IBOU T=$$OUT I STOP G:$$S TOP^IBCNER P1 EXIT G S20 | |
| 9682 | "RTN","IBC NERP7",52, 0) | |
| 9683 | ; Select the output device | |
| 9684 | "RTN","IBC NERP7",53, 0) | |
| 9685 | S50 D DEVI CE^IBCNERP 1(IBCNERTN ,.IBCNESPC ,IBOUT) I STOP G:$$S TOP^IBCNER P1 EXIT G S20 | |
| 9686 | "RTN","IBC NERP7",54, 0) | |
| 9687 | ; | |
| 9688 | "RTN","IBC NERP7",55, 0) | |
| 9689 | EXIT ; Qui t this rou tine | |
| 9690 | "RTN","IBC NERP7",56, 0) | |
| 9691 | Q | |
| 9692 | "RTN","IBC NERP7",57, 0) | |
| 9693 | ; | |
| 9694 | "RTN","IBC NERP7",58, 0) | |
| 9695 | ; | |
| 9696 | "RTN","IBC NERP7",59, 0) | |
| 9697 | DTMRNG ; D etermine t he start a nd end dat e/times fo r the repo rt | |
| 9698 | "RTN","IBC NERP7",60, 0) | |
| 9699 | ; Init va rs | |
| 9700 | "RTN","IBC NERP7",61, 0) | |
| 9701 | N DIR,X,Y ,DIRUT | |
| 9702 | "RTN","IBC NERP7",62, 0) | |
| 9703 | ; | |
| 9704 | "RTN","IBC NERP7",63, 0) | |
| 9705 | W ! | |
| 9706 | "RTN","IBC NERP7",64, 0) | |
| 9707 | ; | |
| 9708 | "RTN","IBC NERP7",65, 0) | |
| 9709 | S DIR(0)= "DO^::ERX" | |
| 9710 | "RTN","IBC NERP7",66, 0) | |
| 9711 | S DIR("A" )="Start D ATE/TIME" | |
| 9712 | "RTN","IBC NERP7",67, 0) | |
| 9713 | S DIR("?" ,1)=" E nter Start DATE/TIME for repor t range." | |
| 9714 | "RTN","IBC NERP7",68, 0) | |
| 9715 | S DIR("?" )=" The time elem ent is req uired." | |
| 9716 | "RTN","IBC NERP7",69, 0) | |
| 9717 | D ^DIR K DIR | |
| 9718 | "RTN","IBC NERP7",70, 0) | |
| 9719 | I $D(DIRU T) S STOP= 1 G DTMRNG X | |
| 9720 | "RTN","IBC NERP7",71, 0) | |
| 9721 | S IBCNESP C("BEGDTM" )=Y | |
| 9722 | "RTN","IBC NERP7",72, 0) | |
| 9723 | ; | |
| 9724 | "RTN","IBC NERP7",73, 0) | |
| 9725 | DTMRNG1 S DIR(0)="D^ ::ERX" | |
| 9726 | "RTN","IBC NERP7",74, 0) | |
| 9727 | S DIR("A" )=" End D ATE/TIME" | |
| 9728 | "RTN","IBC NERP7",75, 0) | |
| 9729 | S DIR("?" ,1)=" E nter End D ATE/TIME f or report range." | |
| 9730 | "RTN","IBC NERP7",76, 0) | |
| 9731 | S DIR("?" )=" The time elem ent is req uired." | |
| 9732 | "RTN","IBC NERP7",77, 0) | |
| 9733 | D ^DIR K DIR | |
| 9734 | "RTN","IBC NERP7",78, 0) | |
| 9735 | I $D(DIRU T) S STOP= 1 G DTMRNG X | |
| 9736 | "RTN","IBC NERP7",79, 0) | |
| 9737 | I Y<IBCNE SPC("BEGDT M") D G D TMRNG1 | |
| 9738 | "RTN","IBC NERP7",80, 0) | |
| 9739 | . W !," The End Date/Time must not p recede the Start Dat e/Time." | |
| 9740 | "RTN","IBC NERP7",81, 0) | |
| 9741 | . W !," Please r eenter." | |
| 9742 | "RTN","IBC NERP7",82, 0) | |
| 9743 | S IBCNESP C("ENDDTM" )=Y | |
| 9744 | "RTN","IBC NERP7",83, 0) | |
| 9745 | ; | |
| 9746 | "RTN","IBC NERP7",84, 0) | |
| 9747 | DTMRNGX ; DTMRNG exi t pt | |
| 9748 | "RTN","IBC NERP7",85, 0) | |
| 9749 | Q | |
| 9750 | "RTN","IBC NERP7",86, 0) | |
| 9751 | ; | |
| 9752 | "RTN","IBC NERP7",87, 0) | |
| 9753 | ; | |
| 9754 | "RTN","IBC NERP7",88, 0) | |
| 9755 | SECTS ; Pr ompt to al low users to include the avail able secti ons in the report | |
| 9756 | "RTN","IBC NERP7",89, 0) | |
| 9757 | ; Init va rs | |
| 9758 | "RTN","IBC NERP7",90, 0) | |
| 9759 | N DIR,X,Y ,DIRUT | |
| 9760 | "RTN","IBC NERP7",91, 0) | |
| 9761 | ; | |
| 9762 | "RTN","IBC NERP7",92, 0) | |
| 9763 | W ! | |
| 9764 | "RTN","IBC NERP7",93, 0) | |
| 9765 | ; IB*2.0* 621 - Upda ted Help T ext for En try 4 | |
| 9766 | "RTN","IBC NERP7",94, 0) | |
| 9767 | S DIR(0)= "L^1:4" | |
| 9768 | "RTN","IBC NERP7",95, 0) | |
| 9769 | S DIR("A" ,1)="Choos e all sect ions to be reviewed" | |
| 9770 | "RTN","IBC NERP7",96, 0) | |
| 9771 | S DIR("A" ,2)="1 - All = All r eport sect ions (Defa ult)" | |
| 9772 | "RTN","IBC NERP7",97, 0) | |
| 9773 | S DIR("A" ,3)="2 - Outgoing Data = Inqui ry Transmi ssion stat istics" | |
| 9774 | "RTN","IBC NERP7",98, 0) | |
| 9775 | S DIR("A" ,4)="3 - Incoming Data = Inqui ry Respons e statisti cs" | |
| 9776 | "RTN","IBC NERP7",99, 0) | |
| 9777 | S DIR("A" ,5)="4 - Current S tatus/Paye r Activity = Respo nses Pendi ng, Queued Inquiries ," | |
| 9778 | "RTN","IBC NERP7",100 ,0) | |
| 9779 | S DIR("A" ,6)=" Ins B uffer Entr ies, Payer Activity, etc." | |
| 9780 | "RTN","IBC NERP7",101 ,0) | |
| 9781 | S DIR("A" )="Select one or mor e sections : " | |
| 9782 | "RTN","IBC NERP7",102 ,0) | |
| 9783 | S DIR("B" )=1 | |
| 9784 | "RTN","IBC NERP7",103 ,0) | |
| 9785 | S DIR("?" ,1)=" Ple ase select one or mo re section s of the r eport to v iew." | |
| 9786 | "RTN","IBC NERP7",104 ,0) | |
| 9787 | S DIR("?" ,2)=" To select mul tiple sect ions, ente r a comma- separated list" | |
| 9788 | "RTN","IBC NERP7",105 ,0) | |
| 9789 | S DIR("?" ,3)=" (ex . 2,4)." | |
| 9790 | "RTN","IBC NERP7",106 ,0) | |
| 9791 | S DIR("?" ,4)=" 1 - Include all secti ons in the report. (Default)" | |
| 9792 | "RTN","IBC NERP7",107 ,0) | |
| 9793 | S DIR("?" ,5)=" 2 - Include statistic s on inqui ries trans mitted dur ing the" | |
| 9794 | "RTN","IBC NERP7",108 ,0) | |
| 9795 | S DIR("?" ,6)=" timefra me by extr act type." | |
| 9796 | "RTN","IBC NERP7",109 ,0) | |
| 9797 | S DIR("?" ,7)=" 3 - Include statistic s on respo nses recei ved during the" | |
| 9798 | "RTN","IBC NERP7",110 ,0) | |
| 9799 | S DIR("?" ,8)=" timefra me by extr act type." | |
| 9800 | "RTN","IBC NERP7",111 ,0) | |
| 9801 | S DIR("?" ,9)=" 4 - Include statistic s on the C urrent Sta tus of the system an d Payer" | |
| 9802 | "RTN","IBC NERP7",112 ,0) | |
| 9803 | S DIR("?" ,10)=" Activi ty. The to tals in th e Current Status sec tion--incl uding resp onses" | |
| 9804 | "RTN","IBC NERP7",113 ,0) | |
| 9805 | S DIR("?" ,11)=" pendin g, queued inquiries, deferred inquiries, insurance companies " | |
| 9806 | "RTN","IBC NERP7",114 ,0) | |
| 9807 | S DIR("?" ,12)=" withou t national ID, eIV P ayers disa bled local ly, and in surance bu ffer" | |
| 9808 | "RTN","IBC NERP7",115 ,0) | |
| 9809 | S DIR("?" ,13)=" entrie s--are ind ependent o f the repo rt date ra nge. The t otals in t he" | |
| 9810 | "RTN","IBC NERP7",116 ,0) | |
| 9811 | S DIR("?" ,14)=" Payer Activity s ection ref lect activ ity during the repor t date ran ge." | |
| 9812 | "RTN","IBC NERP7",117 ,0) | |
| 9813 | S DIR("?" )=" " | |
| 9814 | "RTN","IBC NERP7",118 ,0) | |
| 9815 | D ^DIR K DIR | |
| 9816 | "RTN","IBC NERP7",119 ,0) | |
| 9817 | I $D(DIRU T) S STOP= 1 G SECTSX | |
| 9818 | "RTN","IBC NERP7",120 ,0) | |
| 9819 | ; Default to all if 1 is incl uded OR if 2,3 and 4 are inclu ded in any | |
| 9820 | "RTN","IBC NERP7",121 ,0) | |
| 9821 | ; order | |
| 9822 | "RTN","IBC NERP7",122 ,0) | |
| 9823 | S Y=","_Y | |
| 9824 | "RTN","IBC NERP7",123 ,0) | |
| 9825 | I Y[(",1, ") S IBCNE SPC("SECTS ")=1 G SEC TSX | |
| 9826 | "RTN","IBC NERP7",124 ,0) | |
| 9827 | I Y[(",2, "),Y[(",3, "),Y[(",4, ") S IBCNE SPC("SECTS ")=1 G SEC TSX | |
| 9828 | "RTN","IBC NERP7",125 ,0) | |
| 9829 | S IBCNESP C("SECTS") =Y | |
| 9830 | "RTN","IBC NERP7",126 ,0) | |
| 9831 | ; | |
| 9832 | "RTN","IBC NERP7",127 ,0) | |
| 9833 | SECTSX ; S ECTS exit pt | |
| 9834 | "RTN","IBC NERP7",128 ,0) | |
| 9835 | Q | |
| 9836 | "RTN","IBC NERP7",129 ,0) | |
| 9837 | ; | |
| 9838 | "RTN","IBC NERP7",130 ,0) | |
| 9839 | ; | |
| 9840 | "RTN","IBC NERP7",131 ,0) | |
| 9841 | MAILMSG ; Tag to be called by TaskMan to generate report wit h default values | |
| 9842 | "RTN","IBC NERP7",132 ,0) | |
| 9843 | ; and sen d as MailM an message | |
| 9844 | "RTN","IBC NERP7",133 ,0) | |
| 9845 | ; Init va rs | |
| 9846 | "RTN","IBC NERP7",134 ,0) | |
| 9847 | N IBCNERT N,IBCNESPC ,EDT,BDT,T M,IBOUT | |
| 9848 | "RTN","IBC NERP7",135 ,0) | |
| 9849 | ; | |
| 9850 | "RTN","IBC NERP7",136 ,0) | |
| 9851 | ; -- set the mail m essage to display in a report format | |
| 9852 | "RTN","IBC NERP7",137 ,0) | |
| 9853 | S IBOUT=" R" | |
| 9854 | "RTN","IBC NERP7",138 ,0) | |
| 9855 | ; | |
| 9856 | "RTN","IBC NERP7",139 ,0) | |
| 9857 | ; Default report pa rameters | |
| 9858 | "RTN","IBC NERP7",140 ,0) | |
| 9859 | ; Start D ate/Time - End Date/ Time range | |
| 9860 | "RTN","IBC NERP7",141 ,0) | |
| 9861 | ; Determ ine start time based on IB sit e paramete r | |
| 9862 | "RTN","IBC NERP7",142 ,0) | |
| 9863 | S TM=$$GE T1^DIQ(350 .9,"1,",51 .03,"E") | |
| 9864 | "RTN","IBC NERP7",143 ,0) | |
| 9865 | I TM=""!( +TM=0) S T M="2400" | |
| 9866 | "RTN","IBC NERP7",144 ,0) | |
| 9867 | S EDT=$$D T^XLFDT | |
| 9868 | "RTN","IBC NERP7",145 ,0) | |
| 9869 | S BDT=$$F MADD^XLFDT (EDT,-1) | |
| 9870 | "RTN","IBC NERP7",146 ,0) | |
| 9871 | S IBCNESP C("BEGDTM" )=+(BDT_". "_TM) | |
| 9872 | "RTN","IBC NERP7",147 ,0) | |
| 9873 | S IBCNESP C("ENDDTM" )=+(EDT_". "_TM) | |
| 9874 | "RTN","IBC NERP7",148 ,0) | |
| 9875 | ; Display all secti ons | |
| 9876 | "RTN","IBC NERP7",149 ,0) | |
| 9877 | S IBCNESP C("SECTS") =1 | |
| 9878 | "RTN","IBC NERP7",150 ,0) | |
| 9879 | ; Set Mai lMan flag to IB site parameter MAILGROUP | |
| 9880 | "RTN","IBC NERP7",151 ,0) | |
| 9881 | S IBCNESP C("MM")=$$ MGRP^IBCNE UT5 | |
| 9882 | "RTN","IBC NERP7",152 ,0) | |
| 9883 | ; If ther e is no Ma ilGroup to send mess age - do n ot continu e | |
| 9884 | "RTN","IBC NERP7",153 ,0) | |
| 9885 | I IBCNESP C("MM")="" QUIT | |
| 9886 | "RTN","IBC NERP7",154 ,0) | |
| 9887 | ; If the send MailM an message parameter is turned off, stop the proce ss | |
| 9888 | "RTN","IBC NERP7",155 ,0) | |
| 9889 | I '$P($G( ^IBE(350.9 ,1,51)),U, 2) QUIT | |
| 9890 | "RTN","IBC NERP7",156 ,0) | |
| 9891 | ; | |
| 9892 | "RTN","IBC NERP7",157 ,0) | |
| 9893 | ; Set rou tine param eter | |
| 9894 | "RTN","IBC NERP7",158 ,0) | |
| 9895 | S IBCNERT N="IBCNERP 7" | |
| 9896 | "RTN","IBC NERP7",159 ,0) | |
| 9897 | ; | |
| 9898 | "RTN","IBC NERP7",160 ,0) | |
| 9899 | ; Initial ize scratc h global | |
| 9900 | "RTN","IBC NERP7",161 ,0) | |
| 9901 | KILL ^TMP ($J,IBCNER TN) | |
| 9902 | "RTN","IBC NERP7",162 ,0) | |
| 9903 | ; Compile the repor t data | |
| 9904 | "RTN","IBC NERP7",163 ,0) | |
| 9905 | D EN^IBCN ERP8(IBCNE RTN,.IBCNE SPC) | |
| 9906 | "RTN","IBC NERP7",164 ,0) | |
| 9907 | ; Print t he report - to MailM an | |
| 9908 | "RTN","IBC NERP7",165 ,0) | |
| 9909 | I '$G(ZTS TOP) D EN^ IBCNERP9(I BCNERTN,.I BCNESPC,IB OUT) | |
| 9910 | "RTN","IBC NERP7",166 ,0) | |
| 9911 | ; | |
| 9912 | "RTN","IBC NERP7",167 ,0) | |
| 9913 | ; Kill sc ratch glob al | |
| 9914 | "RTN","IBC NERP7",168 ,0) | |
| 9915 | KILL ^TMP ($J,IBCNER TN) | |
| 9916 | "RTN","IBC NERP7",169 ,0) | |
| 9917 | ; | |
| 9918 | "RTN","IBC NERP7",170 ,0) | |
| 9919 | ; Purge t he task re cord | |
| 9920 | "RTN","IBC NERP7",171 ,0) | |
| 9921 | I $D(ZTQU EUED) S ZT REQ="@" | |
| 9922 | "RTN","IBC NERP7",172 ,0) | |
| 9923 | ; | |
| 9924 | "RTN","IBC NERP7",173 ,0) | |
| 9925 | ; MAILMSG exit pt | |
| 9926 | "RTN","IBC NERP7",174 ,0) | |
| 9927 | Q | |
| 9928 | "RTN","IBC NERP7",175 ,0) | |
| 9929 | ; 528 - baa : Add option to ouput data in excel format | |
| 9930 | "RTN","IBC NERP7",176 ,0) | |
| 9931 | OUT() ; Pr ompt to al low users to select output for mat | |
| 9932 | "RTN","IBC NERP7",177 ,0) | |
| 9933 | N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y | |
| 9934 | "RTN","IBC NERP7",178 ,0) | |
| 9935 | W ! | |
| 9936 | "RTN","IBC NERP7",179 ,0) | |
| 9937 | S DIR(0)= "SA^E:Exce l;R:Report " | |
| 9938 | "RTN","IBC NERP7",180 ,0) | |
| 9939 | S DIR("A" )="(E)xcel Format or (R)eport Format: " | |
| 9940 | "RTN","IBC NERP7",181 ,0) | |
| 9941 | S DIR("B" )="Report" | |
| 9942 | "RTN","IBC NERP7",182 ,0) | |
| 9943 | D ^DIR I $D(DIRUT) S STOP=1 Q "" | |
| 9944 | "RTN","IBC NERP7",183 ,0) | |
| 9945 | Q Y | |
| 9946 | "RTN","IBC NERP7",184 ,0) | |
| 9947 | ; | |
| 9948 | "RTN","IBC NERP8") | |
| 9949 | 0^23^B1104 75563^B754 72595 | |
| 9950 | "RTN","IBC NERP8",1,0 ) | |
| 9951 | IBCNERP8 ; DAOU/BHS - IBCNE eIV STATISTIC AL REPORT COMPILE ;1 1-JUN-2002 | |
| 9952 | "RTN","IBC NERP8",2,0 ) | |
| 9953 | ;;2.0;INT EGRATED BI LLING;**18 4,271,345, 416,506,62 1**;21-MAR -94;Build 8 | |
| 9954 | "RTN","IBC NERP8",3,0 ) | |
| 9955 | ;;Per VA Directive 6402, thi s routine should not be modifi ed. | |
| 9956 | "RTN","IBC NERP8",4,0 ) | |
| 9957 | ; | |
| 9958 | "RTN","IBC NERP8",5,0 ) | |
| 9959 | ; eIV - I nsurance V erificatio n Interfac e | |
| 9960 | "RTN","IBC NERP8",6,0 ) | |
| 9961 | ; | |
| 9962 | "RTN","IBC NERP8",7,0 ) | |
| 9963 | ;Input va rs from IB CNERP7: | |
| 9964 | "RTN","IBC NERP8",8,0 ) | |
| 9965 | ; IBCNERT N = "IBCNE RP7" | |
| 9966 | "RTN","IBC NERP8",9,0 ) | |
| 9967 | ; **IBCNE SPC array ONLY passe d by refer ence ** | |
| 9968 | "RTN","IBC NERP8",10, 0) | |
| 9969 | ; IBCNESP C("BEGDTM" ) = Start Dt/Tm for rpt range | |
| 9970 | "RTN","IBC NERP8",11, 0) | |
| 9971 | ; IBCNESP C("ENDDTM" ) = End Dt /Tm for rp t range | |
| 9972 | "RTN","IBC NERP8",12, 0) | |
| 9973 | ; IBCNESP C("SECTS") = 1 - Al l sections OR ',' se p'd list o f 1 or mor e | |
| 9974 | "RTN","IBC NERP8",13, 0) | |
| 9975 | ; of the following (not all) | |
| 9976 | "RTN","IBC NERP8",14, 0) | |
| 9977 | ; 2 - Ou tgoing dat a, inq tra ns stats | |
| 9978 | "RTN","IBC NERP8",15, 0) | |
| 9979 | ; 3 - In coming dat a, resps r ec'd stats | |
| 9980 | "RTN","IBC NERP8",16, 0) | |
| 9981 | ; 4 - Cu rrent stat us, pendin g resps, q ueued inqs , deferred inqs, pay er | |
| 9982 | "RTN","IBC NERP8",17, 0) | |
| 9983 | ; st ats, ins b uf stats | |
| 9984 | "RTN","IBC NERP8",18, 0) | |
| 9985 | ; IBCNESP C("MM") = "" - do no t generate MailMan m essage OR MAILGROUP to | |
| 9986 | "RTN","IBC NERP8",19, 0) | |
| 9987 | ; send r eport to M ail Group as defined in the IB site para meters | |
| 9988 | "RTN","IBC NERP8",20, 0) | |
| 9989 | ;Output v ars: | |
| 9990 | "RTN","IBC NERP8",21, 0) | |
| 9991 | ; Based o n IBCNESPC ("SECTS") parameter the follow ing scratc h globals | |
| 9992 | "RTN","IBC NERP8",22, 0) | |
| 9993 | ; may be built | |
| 9994 | "RTN","IBC NERP8",23, 0) | |
| 9995 | ; 1 OR co ntains 2 - -> | |
| 9996 | "RTN","IBC NERP8",24, 0) | |
| 9997 | ; ^TMP($J ,RTN,"OUT" )=TotInq^I nsBufExtSu btotal^Pre RegExtSubt otal^... | |
| 9998 | "RTN","IBC NERP8",25, 0) | |
| 9999 | ; NonVer ifInsExtSu btotal^NoA ctInsExtSu btotal | |
| 10000 | "RTN","IBC NERP8",26, 0) | |
| 10001 | ; 1 OR co ntains 3 - -> | |
| 10002 | "RTN","IBC NERP8",27, 0) | |
| 10003 | ; ^TMP($J ,RTN,"IN") =TotResp^I nsBufExtSu btotal^Pre RegExtSubt otal^... | |
| 10004 | "RTN","IBC NERP8",28, 0) | |
| 10005 | ; NonVer ifInsExtSu btotal^NoA ctInsExtSu btotal | |
| 10006 | "RTN","IBC NERP8",29, 0) | |
| 10007 | ; 1 OR co ntains 4 - -> | |
| 10008 | "RTN","IBC NERP8",30, 0) | |
| 10009 | ; ^TMP($J ,RTN,"CUR" )=TotPendi ngResponse s^TotQueue dInquiries ^... | |
| 10010 | "RTN","IBC NERP8",31, 0) | |
| 10011 | ; TotDef erredInqui ries(Hold) ^TotInsCos w/oNationa lID^... | |
| 10012 | "RTN","IBC NERP8",32, 0) | |
| 10013 | ; ToteIV PyrsDisabl dLocally^T otUserActR eq^TotInsB ufVerified ^TotalManV erified... | |
| 10014 | "RTN","IBC NERP8",33, 0) | |
| 10015 | ; Totale IVVerified ^TotInsBuf Unverified ^! InsBufS ubtotal^.. . | |
| 10016 | "RTN","IBC NERP8",34, 0) | |
| 10017 | ; ? InsB ufSubtotal ^- InsBufS ubtotal^Ot her InsBuf Subtotal^. .. | |
| 10018 | "RTN","IBC NERP8",35, 0) | |
| 10019 | ; $ Esco latedBufSu btotal | |
| 10020 | "RTN","IBC NERP8",36, 0) | |
| 10021 | ; 1 OR co ntains 4 - -> | |
| 10022 | "RTN","IBC NERP8",37, 0) | |
| 10023 | ; ^TMP($J ,RTN,"PYR" ,PAYER,IEN )="" (lis t of new p ayers) | |
| 10024 | "RTN","IBC NERP8",38, 0) | |
| 10025 | ; | |
| 10026 | "RTN","IBC NERP8",39, 0) | |
| 10027 | ; Must ca ll at EN | |
| 10028 | "RTN","IBC NERP8",40, 0) | |
| 10029 | Q | |
| 10030 | "RTN","IBC NERP8",41, 0) | |
| 10031 | ; | |
| 10032 | "RTN","IBC NERP8",42, 0) | |
| 10033 | EN(IBCNERT N,IBCNESPC ) ; Entry pt | |
| 10034 | "RTN","IBC NERP8",43, 0) | |
| 10035 | ; Init va rs | |
| 10036 | "RTN","IBC NERP8",44, 0) | |
| 10037 | N IBBDT,I BEDT,IBSCT ,IBTOT,PIE CES,VALUE, CT | |
| 10038 | "RTN","IBC NERP8",45, 0) | |
| 10039 | ; | |
| 10040 | "RTN","IBC NERP8",46, 0) | |
| 10041 | I '$D(ZTQ UEUED),$G( IOST)["C-" W !!,"Com piling rep ort data . .." | |
| 10042 | "RTN","IBC NERP8",47, 0) | |
| 10043 | ; | |
| 10044 | "RTN","IBC NERP8",48, 0) | |
| 10045 | S IBTOT=0 | |
| 10046 | "RTN","IBC NERP8",49, 0) | |
| 10047 | ; | |
| 10048 | "RTN","IBC NERP8",50, 0) | |
| 10049 | ; Kill sc ratch glob al | |
| 10050 | "RTN","IBC NERP8",51, 0) | |
| 10051 | K ^TMP($J ,IBCNERTN) | |
| 10052 | "RTN","IBC NERP8",52, 0) | |
| 10053 | ; | |
| 10054 | "RTN","IBC NERP8",53, 0) | |
| 10055 | ; Init lo oping vars | |
| 10056 | "RTN","IBC NERP8",54, 0) | |
| 10057 | S IBBDT=$ G(IBCNESPC ("BEGDTM") ),IBEDT=$G (IBCNESPC( "ENDDTM")) | |
| 10058 | "RTN","IBC NERP8",55, 0) | |
| 10059 | S IBSCT=$ G(IBCNESPC ("SECTS")) | |
| 10060 | "RTN","IBC NERP8",56, 0) | |
| 10061 | ; | |
| 10062 | "RTN","IBC NERP8",57, 0) | |
| 10063 | I IBSCT=1 !$F(IBSCT, ",2,") D O UT(IBCNERT N,IBBDT,IB EDT,.IBTOT ) | |
| 10064 | "RTN","IBC NERP8",58, 0) | |
| 10065 | I $G(ZTST OP) G EXIT | |
| 10066 | "RTN","IBC NERP8",59, 0) | |
| 10067 | I IBSCT=1 !$F(IBSCT, ",3,") D I N(IBCNERTN ,IBBDT,IBE DT,.IBTOT) | |
| 10068 | "RTN","IBC NERP8",60, 0) | |
| 10069 | I $G(ZTST OP) G EXIT | |
| 10070 | "RTN","IBC NERP8",61, 0) | |
| 10071 | I IBSCT=1 !$F(IBSCT, ",4,") D C UR(IBCNERT N,IBBDT,IB EDT,.IBTOT ),PYR^IBCN ERP0(IBCNE RTN,IBBDT, IBEDT,.IBT OT) | |
| 10072 | "RTN","IBC NERP8",62, 0) | |
| 10073 | ; | |
| 10074 | "RTN","IBC NERP8",63, 0) | |
| 10075 | EXIT ; EN Exit pt | |
| 10076 | "RTN","IBC NERP8",64, 0) | |
| 10077 | Q | |
| 10078 | "RTN","IBC NERP8",65, 0) | |
| 10079 | ; | |
| 10080 | "RTN","IBC NERP8",66, 0) | |
| 10081 | IN(RTN,BDT ,EDT,TOT) ; Determin e Incoming Data | |
| 10082 | "RTN","IBC NERP8",67, 0) | |
| 10083 | ; Input p arams: RTN -routine n ame for ^T MP($J), BD T-start dt /time, | |
| 10084 | "RTN","IBC NERP8",68, 0) | |
| 10085 | ; EDT-en d dt/time, **TOT-tot al records searched - used onl y for stat us | |
| 10086 | "RTN","IBC NERP8",69, 0) | |
| 10087 | ; checks when the process is queued (p assed by r eference) | |
| 10088 | "RTN","IBC NERP8",70, 0) | |
| 10089 | ; Output vars: Set pcs of ^TM P($J,RTN," IN") as fo llows: | |
| 10090 | "RTN","IBC NERP8",71, 0) | |
| 10091 | ; 1=tota l Resps re c'd for da te/time ra nge | |
| 10092 | "RTN","IBC NERP8",72, 0) | |
| 10093 | ; 2=Ins Buf extrac t subtotal | |
| 10094 | "RTN","IBC NERP8",73, 0) | |
| 10095 | ; 3=Pre- Reg extrac t subtotal | |
| 10096 | "RTN","IBC NERP8",74, 0) | |
| 10097 | ; 4=Non- ver extrac t subtotal | |
| 10098 | "RTN","IBC NERP8",75, 0) | |
| 10099 | ; 5=No A ct Ins sub total | |
| 10100 | "RTN","IBC NERP8",76, 0) | |
| 10101 | ; | |
| 10102 | "RTN","IBC NERP8",77, 0) | |
| 10103 | ; Init va rs | |
| 10104 | "RTN","IBC NERP8",78, 0) | |
| 10105 | N IBDT,PY RIEN,PATIE N,IBPTR,IB TYP,RPTDAT A,TRANSIEN | |
| 10106 | "RTN","IBC NERP8",79, 0) | |
| 10107 | ; | |
| 10108 | "RTN","IBC NERP8",80, 0) | |
| 10109 | ; Loop th ru the eIV Resp File (#365) x- ref on Dat e/Time Res p Rec'd | |
| 10110 | "RTN","IBC NERP8",81, 0) | |
| 10111 | S IBDT=$O (^IBCN(365 ,"AD",BDT) ,-1) | |
| 10112 | "RTN","IBC NERP8",82, 0) | |
| 10113 | F S IBDT =$O(^IBCN( 365,"AD",I BDT)) Q:IB DT=""!(IBD T>EDT) D Q:$G(ZTST OP) | |
| 10114 | "RTN","IBC NERP8",83, 0) | |
| 10115 | . S PYRIE N=0 | |
| 10116 | "RTN","IBC NERP8",84, 0) | |
| 10117 | . F S PY RIEN=$O(^I BCN(365,"A D",IBDT,PY RIEN)) Q:' PYRIEN D Q:$G(ZTST OP) | |
| 10118 | "RTN","IBC NERP8",85, 0) | |
| 10119 | . . S PAT IEN=0 | |
| 10120 | "RTN","IBC NERP8",86, 0) | |
| 10121 | . . F S PATIEN=$O( ^IBCN(365, "AD",IBDT, PYRIEN,PAT IEN)) Q:'P ATIEN D Q:$G(ZTSTO P) | |
| 10122 | "RTN","IBC NERP8",87, 0) | |
| 10123 | . . . S I BPTR=0 | |
| 10124 | "RTN","IBC NERP8",88, 0) | |
| 10125 | . . . F S IBPTR=$O (^IBCN(365 ,"AD",IBDT ,PYRIEN,PA TIEN,IBPTR )) Q:'IBPT R D Q:$G (ZTSTOP) | |
| 10126 | "RTN","IBC NERP8",89, 0) | |
| 10127 | . . . . S TOT=TOT+1 | |
| 10128 | "RTN","IBC NERP8",90, 0) | |
| 10129 | . . . . I $D(ZTQUEU ED),TOT#10 0=0,$$S^%Z TLOAD() S ZTSTOP=1 Q | |
| 10130 | "RTN","IBC NERP8",91, 0) | |
| 10131 | . . . . ; Update to tal | |
| 10132 | "RTN","IBC NERP8",92, 0) | |
| 10133 | . . . . S $P(RPTDAT A,U,1)=$P( $G(RPTDATA ),U,1)+1 | |
| 10134 | "RTN","IBC NERP8",93, 0) | |
| 10135 | . . . . ; Update ex tract type total | |
| 10136 | "RTN","IBC NERP8",94, 0) | |
| 10137 | . . . . ; Get the d ata for th e report - build RPT DATA | |
| 10138 | "RTN","IBC NERP8",95, 0) | |
| 10139 | . . . . S IBTYP=5,T RANSIEN=$P ($G(^IBCN( 365,IBPTR, 0)),U,5) | |
| 10140 | "RTN","IBC NERP8",96, 0) | |
| 10141 | . . . . ; IB*2.0*62 1 | |
| 10142 | "RTN","IBC NERP8",97, 0) | |
| 10143 | . . . . S TQIEN=$P( $G(^IBCN(3 65,IBPTR,0 )),U,5) | |
| 10144 | "RTN","IBC NERP8",98, 0) | |
| 10145 | . . . . I TQIEN="" Q | |
| 10146 | "RTN","IBC NERP8",99, 0) | |
| 10147 | . . . . S IBTYP=$$G ET1^DIQ(36 5.1,TQIEN_ ",",.1,"I" ) | |
| 10148 | "RTN","IBC NERP8",100 ,0) | |
| 10149 | . . . . S IBQUERY=$ $GET1^DIQ( 365.1,TQIE N_",",.11, "I") | |
| 10150 | "RTN","IBC NERP8",101 ,0) | |
| 10151 | . . . . S IBMBI=$$G ET1^DIQ(36 5.1,TQIEN_ ",",.16,"I ") | |
| 10152 | "RTN","IBC NERP8",102 ,0) | |
| 10153 | . . . . I IBTYP'="" D | |
| 10154 | "RTN","IBC NERP8",103 ,0) | |
| 10155 | . . . . . I IBTYP=3 Q | |
| 10156 | "RTN","IBC NERP8",104 ,0) | |
| 10157 | . . . . . I IBTYP=1 D Q | |
| 10158 | "RTN","IBC NERP8",105 ,0) | |
| 10159 | . . . . . . I IBMBI ="MBIreque st" S $P(R PTDATA,U,6 )=$P($G(RP TDATA),U,6 )+1 ; MBI Request | |
| 10160 | "RTN","IBC NERP8",106 ,0) | |
| 10161 | . . . . . . I IBMBI '="MBIrequ est" S $P( RPTDATA,U, IBTYP+1)=$ P($G(RPTDA TA),U,IBTY P+1)+1 | |
| 10162 | "RTN","IBC NERP8",107 ,0) | |
| 10163 | . . . . . I IBTYP=4 D Q | |
| 10164 | "RTN","IBC NERP8",108 ,0) | |
| 10165 | . . . . . . I IBQUE RY="I" S $ P(RPTDATA, U,4)=$P($G (RPTDATA), U,4)+1 ; E ICD Querie s | |
| 10166 | "RTN","IBC NERP8",109 ,0) | |
| 10167 | . . . . . . I IBQUE RY="V" S $ P(RPTDATA, U,5)=$P($G (RPTDATA), U,5)+1 ; E ICD Verifi cation | |
| 10168 | "RTN","IBC NERP8",110 ,0) | |
| 10169 | . . . . . S:IBTYP=2 $P(RPTDAT A,U,3)=$P( $G(RPTDATA ),U,3)+1 | |
| 10170 | "RTN","IBC NERP8",111 ,0) | |
| 10171 | . . . . ; IB*2.0*62 1 - End IN Group | |
| 10172 | "RTN","IBC NERP8",112 ,0) | |
| 10173 | ; | |
| 10174 | "RTN","IBC NERP8",113 ,0) | |
| 10175 | I $G(ZTST OP) G INX | |
| 10176 | "RTN","IBC NERP8",114 ,0) | |
| 10177 | ; | |
| 10178 | "RTN","IBC NERP8",115 ,0) | |
| 10179 | ; Save da ta to glob al | |
| 10180 | "RTN","IBC NERP8",116 ,0) | |
| 10181 | S ^TMP($J ,RTN,"IN") =$G(RPTDAT A) | |
| 10182 | "RTN","IBC NERP8",117 ,0) | |
| 10183 | ; | |
| 10184 | "RTN","IBC NERP8",118 ,0) | |
| 10185 | INX ; IN e xit pt | |
| 10186 | "RTN","IBC NERP8",119 ,0) | |
| 10187 | Q | |
| 10188 | "RTN","IBC NERP8",120 ,0) | |
| 10189 | ; | |
| 10190 | "RTN","IBC NERP8",121 ,0) | |
| 10191 | OUT(RTN,BD T,EDT,TOT) ; Outgoin g Data | |
| 10192 | "RTN","IBC NERP8",122 ,0) | |
| 10193 | ;Input pa rams: RTN -routine n ame used a s subscrip t in ^TMP( $J), | |
| 10194 | "RTN","IBC NERP8",123 ,0) | |
| 10195 | ; BDT-sta rt date/ti me, EDT-en d date/tim e, **TOT-t otal recs searched-u sed | |
| 10196 | "RTN","IBC NERP8",124 ,0) | |
| 10197 | ; only fo r status c hecks when process i s queued ( passed by reference) | |
| 10198 | "RTN","IBC NERP8",125 ,0) | |
| 10199 | ;Output v ars: Set p cs of ^TMP ($J,RTN,"O UT") as fo llows: | |
| 10200 | "RTN","IBC NERP8",126 ,0) | |
| 10201 | ; 1=total Inqs tran smitted fo r timefram e | |
| 10202 | "RTN","IBC NERP8",127 ,0) | |
| 10203 | ; 2=Ins B uffer extr act subtot al | |
| 10204 | "RTN","IBC NERP8",128 ,0) | |
| 10205 | ; 3=Pre-R eg extract subtotal | |
| 10206 | "RTN","IBC NERP8",129 ,0) | |
| 10207 | ; 4=Non-V er extract subtotal | |
| 10208 | "RTN","IBC NERP8",130 ,0) | |
| 10209 | ; 5=No Ac t Ins subt otal | |
| 10210 | "RTN","IBC NERP8",131 ,0) | |
| 10211 | ; 6=MBI s ubtotal | |
| 10212 | "RTN","IBC NERP8",132 ,0) | |
| 10213 | ; | |
| 10214 | "RTN","IBC NERP8",133 ,0) | |
| 10215 | ; Init va rs | |
| 10216 | "RTN","IBC NERP8",134 ,0) | |
| 10217 | N IBDT,IB PTR,IBTYP, RPTDATA,TQ IEN | |
| 10218 | "RTN","IBC NERP8",135 ,0) | |
| 10219 | ; | |
| 10220 | "RTN","IBC NERP8",136 ,0) | |
| 10221 | ; Loop th ru the eIV Resp File (#365) by x-ref on Date/Time Resp Creat ed | |
| 10222 | "RTN","IBC NERP8",137 ,0) | |
| 10223 | ; Only c ount respo nses for u nique HL7 message ID s - filter out | |
| 10224 | "RTN","IBC NERP8",138 ,0) | |
| 10225 | ; unsoli cited resp onses as t hey artifi cially inf late the O utgoing Co unt | |
| 10226 | "RTN","IBC NERP8",139 ,0) | |
| 10227 | S IBDT=$O (^IBCN(365 ,"AE",BDT) ,-1) | |
| 10228 | "RTN","IBC NERP8",140 ,0) | |
| 10229 | F S IBDT =$O(^IBCN( 365,"AE",I BDT)) Q:IB DT=""!(IBD T>EDT) D Q:$G(ZTST OP) | |
| 10230 | "RTN","IBC NERP8",141 ,0) | |
| 10231 | . S IBPTR =0 | |
| 10232 | "RTN","IBC NERP8",142 ,0) | |
| 10233 | . F S IB PTR=$O(^IB CN(365,"AE ",IBDT,IBP TR)) Q:'IB PTR D Q: $G(ZTSTOP) | |
| 10234 | "RTN","IBC NERP8",143 ,0) | |
| 10235 | . . S TOT =TOT+1 | |
| 10236 | "RTN","IBC NERP8",144 ,0) | |
| 10237 | . . I $D( ZTQUEUED), TOT#100=0, $$S^%ZTLOA D() S ZTST OP=1 Q | |
| 10238 | "RTN","IBC NERP8",145 ,0) | |
| 10239 | . . ; Qui t, if resp onse was n ot O - ori ginal | |
| 10240 | "RTN","IBC NERP8",146 ,0) | |
| 10241 | . . I $P( $G(^IBCN(3 65,IBPTR,0 )),U,10)'= "O" Q | |
| 10242 | "RTN","IBC NERP8",147 ,0) | |
| 10243 | . . ; Upd ate total | |
| 10244 | "RTN","IBC NERP8",148 ,0) | |
| 10245 | . . S $P( RPTDATA,U, 1)=$P($G(R PTDATA),U, 1)+1 | |
| 10246 | "RTN","IBC NERP8",149 ,0) | |
| 10247 | . . ; Upd ate extrac t type tot al (1,2,3, 4) | |
| 10248 | "RTN","IBC NERP8",150 ,0) | |
| 10249 | . . S TQI EN=$P($G(^ IBCN(365,I BPTR,0)),U ,5) | |
| 10250 | "RTN","IBC NERP8",151 ,0) | |
| 10251 | . . I TQI EN="" Q | |
| 10252 | "RTN","IBC NERP8",152 ,0) | |
| 10253 | . . ; IB* 2.0*621 | |
| 10254 | "RTN","IBC NERP8",153 ,0) | |
| 10255 | . . ;S IB TYP=$P($G( ^IBCN(365. 1,TQIEN,0) ),U,10) | |
| 10256 | "RTN","IBC NERP8",154 ,0) | |
| 10257 | . . S IBT YP=$$GET1^ DIQ(365.1, TQIEN_",", .1,"I") | |
| 10258 | "RTN","IBC NERP8",155 ,0) | |
| 10259 | . . S IBQ UERY=$$GET 1^DIQ(365. 1,TQIEN_", ",.11,"I") | |
| 10260 | "RTN","IBC NERP8",156 ,0) | |
| 10261 | . . S IBM BI=$$GET1^ DIQ(365.1, TQIEN_",", .16,"I") | |
| 10262 | "RTN","IBC NERP8",157 ,0) | |
| 10263 | . . I IBT YP'="" D | |
| 10264 | "RTN","IBC NERP8",158 ,0) | |
| 10265 | . . . I I BTYP=3 Q | |
| 10266 | "RTN","IBC NERP8",159 ,0) | |
| 10267 | . . . I I BTYP=1 D Q | |
| 10268 | "RTN","IBC NERP8",160 ,0) | |
| 10269 | . . . . I IBMBI="MB Irequest" S $P(RPTDA TA,U,6)=$P ($G(RPTDAT A),U,6)+1 ; MBI Requ est | |
| 10270 | "RTN","IBC NERP8",161 ,0) | |
| 10271 | . . . . I IBMBI'="M BIrequest" S $P(RPTD ATA,U,IBTY P+1)=$P($G (RPTDATA), U,IBTYP+1) +1 | |
| 10272 | "RTN","IBC NERP8",162 ,0) | |
| 10273 | . . . I I BTYP=4 D Q | |
| 10274 | "RTN","IBC NERP8",163 ,0) | |
| 10275 | . . . . I IBQUERY=" I" S $P(RP TDATA,U,4) =$P($G(RPT DATA),U,4) +1 ; EICD Queries | |
| 10276 | "RTN","IBC NERP8",164 ,0) | |
| 10277 | . . . . I IBQUERY=" V" S $P(RP TDATA,U,5) =$P($G(RPT DATA),U,5) +1 ; EICD Verificati on | |
| 10278 | "RTN","IBC NERP8",165 ,0) | |
| 10279 | . . . S:I BTYP=2 $P( RPTDATA,U, 3)=$P($G(R PTDATA),U, 3)+1 | |
| 10280 | "RTN","IBC NERP8",166 ,0) | |
| 10281 | ; | |
| 10282 | "RTN","IBC NERP8",167 ,0) | |
| 10283 | I $G(ZTST OP) G OUTX | |
| 10284 | "RTN","IBC NERP8",168 ,0) | |
| 10285 | ; | |
| 10286 | "RTN","IBC NERP8",169 ,0) | |
| 10287 | ; Save da ta to glob al array | |
| 10288 | "RTN","IBC NERP8",170 ,0) | |
| 10289 | S ^TMP($J ,RTN,"OUT" )=$G(RPTDA TA) | |
| 10290 | "RTN","IBC NERP8",171 ,0) | |
| 10291 | ; | |
| 10292 | "RTN","IBC NERP8",172 ,0) | |
| 10293 | OUTX ; OUT exit pt | |
| 10294 | "RTN","IBC NERP8",173 ,0) | |
| 10295 | Q | |
| 10296 | "RTN","IBC NERP8",174 ,0) | |
| 10297 | ; | |
| 10298 | "RTN","IBC NERP8",175 ,0) | |
| 10299 | CUR(RTN,BD T,EDT,TOT) ; Current Status - stats - ti meframe in dependent | |
| 10300 | "RTN","IBC NERP8",176 ,0) | |
| 10301 | ; Input p arams: RTN -routine n ame as sub s in ^TMP( $J), **TOT -total rec s | |
| 10302 | "RTN","IBC NERP8",177 ,0) | |
| 10303 | ; search ed - used only for s tatus chec ks when th e process is queued | |
| 10304 | "RTN","IBC NERP8",178 ,0) | |
| 10305 | ; passed by refere nce | |
| 10306 | "RTN","IBC NERP8",179 ,0) | |
| 10307 | ; Output vars: Set pcs of ^TM P($J,RTN," CUR") as f ollows: | |
| 10308 | "RTN","IBC NERP8",180 ,0) | |
| 10309 | ; 1=tota l Pending Resps (Tra nsmitted-2 ) | |
| 10310 | "RTN","IBC NERP8",181 ,0) | |
| 10311 | ; 2=tota l Queued I nqs (Ready to Transm it-1/Retry -6) | |
| 10312 | "RTN","IBC NERP8",182 ,0) | |
| 10313 | ; 3=tota l Deferred Inqs (Hol d-4) | |
| 10314 | "RTN","IBC NERP8",183 ,0) | |
| 10315 | ; 4=Ins Cos w/o Na tional ID | |
| 10316 | "RTN","IBC NERP8",184 ,0) | |
| 10317 | ; 5=Paye rs w/eIV d isabled lo cally | |
| 10318 | "RTN","IBC NERP8",185 ,0) | |
| 10319 | ; 6=tota l user act ion requir ed (symbol '='*' or ' #' or '!' or '?' or '-') | |
| 10320 | "RTN","IBC NERP8",186 ,0) | |
| 10321 | ; 7=tota l Man. Ver 'd Ins Buf entries ( symbol='*' ) | |
| 10322 | "RTN","IBC NERP8",187 ,0) | |
| 10323 | ; 8=tota l eIV Proc essed Ver. (symbol=' +') | |
| 10324 | "RTN","IBC NERP8",188 ,0) | |
| 10325 | ; 9=tota l awaiting processin g (symbol= '?' or BLA NK) | |
| 10326 | "RTN","IBC NERP8",189 ,0) | |
| 10327 | ; 10=tot al Ins Buf entries w /symbol='# ' | |
| 10328 | "RTN","IBC NERP8",190 ,0) | |
| 10329 | ; 11=tot al Ins Buf entries w /symbol='! ' | |
| 10330 | "RTN","IBC NERP8",191 ,0) | |
| 10331 | ; 12=tot al Ins Buf entries w /symbol='? ' | |
| 10332 | "RTN","IBC NERP8",192 ,0) | |
| 10333 | ; 13=tot al Ins Buf entries w /symbol='- ' | |
| 10334 | "RTN","IBC NERP8",193 ,0) | |
| 10335 | ; 14=tot al Ins Buf fer entrie s w/symbol not in (' *','#','!' ,'?','-') | |
| 10336 | "RTN","IBC NERP8",194 ,0) | |
| 10337 | ; 15=tot al Ins Buf fer entrie s w/symbol ='$' | |
| 10338 | "RTN","IBC NERP8",195 ,0) | |
| 10339 | ; 16=tot al Ins Buf fet entrie s w/symbol = % ; IB*2 .0*621 - A dded 16-21 | |
| 10340 | "RTN","IBC NERP8",196 ,0) | |
| 10341 | ; 17=tot al Insuran ce Buffer | |
| 10342 | "RTN","IBC NERP8",197 ,0) | |
| 10343 | ; 18=Tot al Appoint ment | |
| 10344 | "RTN","IBC NERP8",198 ,0) | |
| 10345 | ; 19=tot al Ele Ins Cov Disco very (EICD ) | |
| 10346 | "RTN","IBC NERP8",199 ,0) | |
| 10347 | ; 20=tot al EICD Tr iggered Ei nsurance V erificatio n | |
| 10348 | "RTN","IBC NERP8",200 ,0) | |
| 10349 | ; 21=tot al MBI Inq uiry | |
| 10350 | "RTN","IBC NERP8",201 ,0) | |
| 10351 | ; ^TMP($ J,RTN,"CUR ","FLAGS", "A",Payer name,N) = active fla g timestam p ^ active flag sett ing | |
| 10352 | "RTN","IBC NERP8",202 ,0) | |
| 10353 | ; ^TMP($ J,RTN,"CUR ","FLAGS", "T",Payer name,N) = trusted fl ag timesta mp ^ trust ed flag se tting | |
| 10354 | "RTN","IBC NERP8",203 ,0) | |
| 10355 | ; | |
| 10356 | "RTN","IBC NERP8",204 ,0) | |
| 10357 | ; Init va rs | |
| 10358 | "RTN","IBC NERP8",205 ,0) | |
| 10359 | N RIEN,TQ IEN,ICIEN, IBIEN,RPTD ATA,IEN,IB SYMBOL,PIE CE,IBSTS,A PPIEN | |
| 10360 | "RTN","IBC NERP8",206 ,0) | |
| 10361 | N PIEN,TM P,APPDATA, XDT,PDATA | |
| 10362 | "RTN","IBC NERP8",207 ,0) | |
| 10363 | ; | |
| 10364 | "RTN","IBC NERP8",208 ,0) | |
| 10365 | S RPTDATA ="" | |
| 10366 | "RTN","IBC NERP8",209 ,0) | |
| 10367 | ; | |
| 10368 | "RTN","IBC NERP8",210 ,0) | |
| 10369 | ; Respons es pending (Transmit ted - 2) | |
| 10370 | "RTN","IBC NERP8",211 ,0) | |
| 10371 | S RIEN=0 | |
| 10372 | "RTN","IBC NERP8",212 ,0) | |
| 10373 | F S RIEN =$O(^IBCN( 365,"AC",2 ,RIEN)) Q: 'RIEN D Q:$G(ZTSTO P) | |
| 10374 | "RTN","IBC NERP8",213 ,0) | |
| 10375 | . S TOT= TOT+1 | |
| 10376 | "RTN","IBC NERP8",214 ,0) | |
| 10377 | . I $D(Z TQUEUED),T OT#100=0,$ $S^%ZTLOAD () S ZTSTO P=1 Q | |
| 10378 | "RTN","IBC NERP8",215 ,0) | |
| 10379 | . S $P(R PTDATA,U,1 )=$P(RPTDA TA,U,1)+1 | |
| 10380 | "RTN","IBC NERP8",216 ,0) | |
| 10381 | . ; IB*2 .0*621 | |
| 10382 | "RTN","IBC NERP8",217 ,0) | |
| 10383 | . S TQIE N=$P($G(^I BCN(365,RI EN,0)),U,5 ) | |
| 10384 | "RTN","IBC NERP8",218 ,0) | |
| 10385 | . I TQIE N="" Q | |
| 10386 | "RTN","IBC NERP8",219 ,0) | |
| 10387 | . S IBTY P=$$GET1^D IQ(365.1,T QIEN_",",. 1,"I") | |
| 10388 | "RTN","IBC NERP8",220 ,0) | |
| 10389 | . S IBQU ERY=$$GET1 ^DIQ(365.1 ,TQIEN_"," ,.11,"I") | |
| 10390 | "RTN","IBC NERP8",221 ,0) | |
| 10391 | . S IBMB I=$$GET1^D IQ(365.1,T QIEN_",",. 16,"I") | |
| 10392 | "RTN","IBC NERP8",222 ,0) | |
| 10393 | . I IBTY P'="" D | |
| 10394 | "RTN","IBC NERP8",223 ,0) | |
| 10395 | . . I IB TYP=3 Q | |
| 10396 | "RTN","IBC NERP8",224 ,0) | |
| 10397 | . . I IB TYP=1 D Q | |
| 10398 | "RTN","IBC NERP8",225 ,0) | |
| 10399 | . . . I IBMBI="MBI request" S $P(RPTDAT A,U,21)=$P ($G(RPTDAT A),U,21)+1 ; MBI Req uest | |
| 10400 | "RTN","IBC NERP8",226 ,0) | |
| 10401 | . . . I IBMBI'="MB Irequest" S $P(RPTDA TA,U,17)=$ P($G(RPTDA TA),U,17)+ 1 ; Insura nce Buffer | |
| 10402 | "RTN","IBC NERP8",227 ,0) | |
| 10403 | . S:IBTY P=2 $P(RPT DATA,U,18) =$P($G(RPT DATA),U,18 )+1 ; Appo intment | |
| 10404 | "RTN","IBC NERP8",228 ,0) | |
| 10405 | . I IBTY P=4 D Q | |
| 10406 | "RTN","IBC NERP8",229 ,0) | |
| 10407 | . . I IB QUERY="I" S $P(RPTDA TA,U,19)=$ P($G(RPTDA TA),U,19)+ 1 ; EICD Q ueries | |
| 10408 | "RTN","IBC NERP8",230 ,0) | |
| 10409 | . . I IB QUERY="V" S $P(RPTDA TA,U,20)=$ P($G(RPTDA TA),U,20)+ 1 ; EICD V erificatio n | |
| 10410 | "RTN","IBC NERP8",231 ,0) | |
| 10411 | . ; IB*2 .0*621 - E nd IN Grou p | |
| 10412 | "RTN","IBC NERP8",232 ,0) | |
| 10413 | ; | |
| 10414 | "RTN","IBC NERP8",233 ,0) | |
| 10415 | I $G(ZTST OP) G CURX | |
| 10416 | "RTN","IBC NERP8",234 ,0) | |
| 10417 | ; | |
| 10418 | "RTN","IBC NERP8",235 ,0) | |
| 10419 | ; Queued inquiries (Ready to Transmit - 1/Retry - 6) and | |
| 10420 | "RTN","IBC NERP8",236 ,0) | |
| 10421 | ; Deferre d inquirie s (Hold - 4) | |
| 10422 | "RTN","IBC NERP8",237 ,0) | |
| 10423 | F IBSTS=1 ,6,4 D Q: $G(ZTSTOP) | |
| 10424 | "RTN","IBC NERP8",238 ,0) | |
| 10425 | . S TQIEN =0 | |
| 10426 | "RTN","IBC NERP8",239 ,0) | |
| 10427 | . F S TQ IEN=$O(^IB CN(365.1," AC",IBSTS, TQIEN)) Q: 'TQIEN D Q:$G(ZTST OP) | |
| 10428 | "RTN","IBC NERP8",240 ,0) | |
| 10429 | . . S TO T=TOT+1 | |
| 10430 | "RTN","IBC NERP8",241 ,0) | |
| 10431 | . . I $D (ZTQUEUED) ,TOT#100=0 ,$$S^%ZTLO AD() S ZTS TOP=1 QUIT | |
| 10432 | "RTN","IBC NERP8",242 ,0) | |
| 10433 | . . I IB STS'=4 S $ P(RPTDATA, U,2)=$P(RP TDATA,U,2) +1 Q | |
| 10434 | "RTN","IBC NERP8",243 ,0) | |
| 10435 | . . S $P (RPTDATA,U ,3)=$P(RPT DATA,U,3)+ 1 | |
| 10436 | "RTN","IBC NERP8",244 ,0) | |
| 10437 | ; | |
| 10438 | "RTN","IBC NERP8",245 ,0) | |
| 10439 | I $G(ZTST OP) G CURX | |
| 10440 | "RTN","IBC NERP8",246 ,0) | |
| 10441 | ; | |
| 10442 | "RTN","IBC NERP8",247 ,0) | |
| 10443 | ; Payer s tats | |
| 10444 | "RTN","IBC NERP8",248 ,0) | |
| 10445 | ; Ins cos w/o Natio nal ID | |
| 10446 | "RTN","IBC NERP8",249 ,0) | |
| 10447 | S ICIEN=0 ,$P(RPTDAT A,U,4)=0 | |
| 10448 | "RTN","IBC NERP8",250 ,0) | |
| 10449 | F S ICIE N=$O(^DIC( 36,ICIEN)) Q:'ICIEN D Q:$G(Z TSTOP) | |
| 10450 | "RTN","IBC NERP8",251 ,0) | |
| 10451 | . S TOT= TOT+1 | |
| 10452 | "RTN","IBC NERP8",252 ,0) | |
| 10453 | . I $D(Z TQUEUED),T OT#100=0,$ $S^%ZTLOAD () S ZTSTO P=1 QUIT | |
| 10454 | "RTN","IBC NERP8",253 ,0) | |
| 10455 | . ; Excl ude inacti ve | |
| 10456 | "RTN","IBC NERP8",254 ,0) | |
| 10457 | . S TMP= $$ACTIVE^I BCNEUT4(IC IEN) I 'TM P Q | |
| 10458 | "RTN","IBC NERP8",255 ,0) | |
| 10459 | . ; Excl ude Medica id, etc. | |
| 10460 | "RTN","IBC NERP8",256 ,0) | |
| 10461 | . I $$EX CLUDE^IBCN EUT4($P(TM P,U,2)) Q | |
| 10462 | "RTN","IBC NERP8",257 ,0) | |
| 10463 | . ; Does a NATIONA L ID exist ? | |
| 10464 | "RTN","IBC NERP8",258 ,0) | |
| 10465 | . ; VA C BO defines 'No Natio nal ID' as lack of E DI IDs - f ields (#36 ,3.02) & ( #36,3.04) 3/4/14 | |
| 10466 | "RTN","IBC NERP8",259 ,0) | |
| 10467 | . ; This is *NOT* a check fo r the 'VA NATIONAL I D' associa ted with t he linked payer | |
| 10468 | "RTN","IBC NERP8",260 ,0) | |
| 10469 | . I ($$G ET1^DIQ(36 ,ICIEN_"," ,3.02)="") &($$GET1^D IQ(36,ICIE N_",",3.04 )="") S $P (RPTDATA,U ,4)=$P(RPT DATA,U,4)+ 1 Q | |
| 10470 | "RTN","IBC NERP8",261 ,0) | |
| 10471 | . Q | |
| 10472 | "RTN","IBC NERP8",262 ,0) | |
| 10473 | . ; Dete rmine asso c Payer | |
| 10474 | "RTN","IBC NERP8",263 ,0) | |
| 10475 | . ;S PIE N=$P($G(^D IC(36,ICIE N,3)),U,10 ) | |
| 10476 | "RTN","IBC NERP8",264 ,0) | |
| 10477 | . ; Miss ing payer link | |
| 10478 | "RTN","IBC NERP8",265 ,0) | |
| 10479 | . ;I 'PI EN S $P(RP TDATA,U,4) =$P(RPTDAT A,U,4)+1 Q | |
| 10480 | "RTN","IBC NERP8",266 ,0) | |
| 10481 | . ; Does a VA NATI ONAL ID ex ist? | |
| 10482 | "RTN","IBC NERP8",267 ,0) | |
| 10483 | . ;I $P( $G(^IBE(36 5.12,PIEN, 0)),U,2)'= "" Q | |
| 10484 | "RTN","IBC NERP8",268 ,0) | |
| 10485 | . ;S $P( RPTDATA,U, 4)=$P(RPTD ATA,U,4)+1 | |
| 10486 | "RTN","IBC NERP8",269 ,0) | |
| 10487 | ; | |
| 10488 | "RTN","IBC NERP8",270 ,0) | |
| 10489 | I $G(ZTST OP) G CURX | |
| 10490 | "RTN","IBC NERP8",271 ,0) | |
| 10491 | ; | |
| 10492 | "RTN","IBC NERP8",272 ,0) | |
| 10493 | ; eIV Pay ers disabl ed locally | |
| 10494 | "RTN","IBC NERP8",273 ,0) | |
| 10495 | S PIEN=0 | |
| 10496 | "RTN","IBC NERP8",274 ,0) | |
| 10497 | F S PIEN =$O(^IBE(3 65.12,PIEN )) Q:'PIEN D Q:$G( ZTSTOP) | |
| 10498 | "RTN","IBC NERP8",275 ,0) | |
| 10499 | . S TOT= TOT+1 | |
| 10500 | "RTN","IBC NERP8",276 ,0) | |
| 10501 | . I $D(Z TQUEUED),T OT#100=0,$ $S^%ZTLOAD () S ZTSTO P=1 Q | |
| 10502 | "RTN","IBC NERP8",277 ,0) | |
| 10503 | . S PDAT A=$G(^IBE( 365.12,PIE N,0)) | |
| 10504 | "RTN","IBC NERP8",278 ,0) | |
| 10505 | . ; Must have Nati onal ID | |
| 10506 | "RTN","IBC NERP8",279 ,0) | |
| 10507 | . I $P(P DATA,U,2)= "" Q | |
| 10508 | "RTN","IBC NERP8",280 ,0) | |
| 10509 | . ; Get Payer app multiple I EN | |
| 10510 | "RTN","IBC NERP8",281 ,0) | |
| 10511 | . S APPI EN=$$PYRAP P^IBCNEUT5 ("IIV",PIE N) | |
| 10512 | "RTN","IBC NERP8",282 ,0) | |
| 10513 | . ; Must have eIV applicatio n | |
| 10514 | "RTN","IBC NERP8",283 ,0) | |
| 10515 | . I 'APP IEN Q | |
| 10516 | "RTN","IBC NERP8",284 ,0) | |
| 10517 | . ; Get Active/Tru sted flag logs | |
| 10518 | "RTN","IBC NERP8",285 ,0) | |
| 10519 | . D GETF LAGS(PIEN, APPIEN,PDA TA,BDT,EDT ,.RPTDATA) | |
| 10520 | "RTN","IBC NERP8",286 ,0) | |
| 10521 | . ; | |
| 10522 | "RTN","IBC NERP8",287 ,0) | |
| 10523 | . S APPD ATA=$G(^IB E(365.12,P IEN,1,APPI EN,0)) | |
| 10524 | "RTN","IBC NERP8",288 ,0) | |
| 10525 | . ; Must be Nation ally Activ e | |
| 10526 | "RTN","IBC NERP8",289 ,0) | |
| 10527 | . I '$P( APPDATA,U, 2) Q | |
| 10528 | "RTN","IBC NERP8",290 ,0) | |
| 10529 | . ; Must not be Lo cally Acti ve | |
| 10530 | "RTN","IBC NERP8",291 ,0) | |
| 10531 | . I $P(A PPDATA,U,3 ) Q | |
| 10532 | "RTN","IBC NERP8",292 ,0) | |
| 10533 | . S $P(R PTDATA,U,5 )=$P(RPTDA TA,U,5)+1 | |
| 10534 | "RTN","IBC NERP8",293 ,0) | |
| 10535 | ; | |
| 10536 | "RTN","IBC NERP8",294 ,0) | |
| 10537 | I $G(ZTST OP) G CURX | |
| 10538 | "RTN","IBC NERP8",295 ,0) | |
| 10539 | ; | |
| 10540 | "RTN","IBC NERP8",296 ,0) | |
| 10541 | ; Buffer stats | |
| 10542 | "RTN","IBC NERP8",297 ,0) | |
| 10543 | ; Loop th ru the Ins Buffer Fi le (#355.3 3) | |
| 10544 | "RTN","IBC NERP8",298 ,0) | |
| 10545 | S IBIEN=0 ,XDT=0 | |
| 10546 | "RTN","IBC NERP8",299 ,0) | |
| 10547 | F S XDT= $O(^IBA(35 5.33,"AEST ","E",XDT) ) Q:XDT="" D Q:$G( ZTSTOP) | |
| 10548 | "RTN","IBC NERP8",300 ,0) | |
| 10549 | . F S IB IEN=$O(^IB A(355.33," AEST","E", XDT,IBIEN) ) Q:IBIEN= "" D Q:$ G(ZTSTOP) | |
| 10550 | "RTN","IBC NERP8",301 ,0) | |
| 10551 | . . S TOT =TOT+1 | |
| 10552 | "RTN","IBC NERP8",302 ,0) | |
| 10553 | . . I $D( ZTQUEUED), TOT#100=0, $$S^%ZTLOA D() S ZTST OP=1 Q | |
| 10554 | "RTN","IBC NERP8",303 ,0) | |
| 10555 | . . S IBS YMBOL=$$SY MBOL^IBCNB LL(IBIEN) | |
| 10556 | "RTN","IBC NERP8",304 ,0) | |
| 10557 | . . ; Det ermine pie ce to upda te based o n symbol | |
| 10558 | "RTN","IBC NERP8",305 ,0) | |
| 10559 | . . ; ('* ') = Man. Verified, ('#','!', '-','?',bl ank/null) = eIV Proc essing | |
| 10560 | "RTN","IBC NERP8",306 ,0) | |
| 10561 | . . ; ('+ ') = eIV P rocessed, ('$') = Es calated, A ctive poli cy | |
| 10562 | "RTN","IBC NERP8",307 ,0) | |
| 10563 | . . ; IB* 2.0*506/ta z Node 15 added. | |
| 10564 | "RTN","IBC NERP8",308 ,0) | |
| 10565 | . . ; IB* 2.0*621/ N ode 16 Add ed. | |
| 10566 | "RTN","IBC NERP8",309 ,0) | |
| 10567 | . . S PIE CE=$S(IBSY MBOL="*":7 ,IBSYMBOL= "+":8,IBSY MBOL="#":1 0,IBSYMBOL ="!":11,IB SYMBOL="-" :13,IBSYMB OL="?":12, IBSYMBOL=" $":15,IBSY MBOL="%":1 6,1:14) | |
| 10568 | "RTN","IBC NERP8",310 ,0) | |
| 10569 | . . I PIE CE=12!(PIE CE=14) S $ P(RPTDATA, U,9)=$P($G (RPTDATA), U,9)+1 | |
| 10570 | "RTN","IBC NERP8",311 ,0) | |
| 10571 | . . E S $P(RPTDATA ,U,6)=$P($ G(RPTDATA) ,U,6)+1 | |
| 10572 | "RTN","IBC NERP8",312 ,0) | |
| 10573 | . . S $P( RPTDATA,U, PIECE)=$P( $G(RPTDATA ),U,PIECE) +1 | |
| 10574 | "RTN","IBC NERP8",313 ,0) | |
| 10575 | ; | |
| 10576 | "RTN","IBC NERP8",314 ,0) | |
| 10577 | I $G(ZTST OP) G CURX | |
| 10578 | "RTN","IBC NERP8",315 ,0) | |
| 10579 | ; | |
| 10580 | "RTN","IBC NERP8",316 ,0) | |
| 10581 | ; Save da ta to glob al | |
| 10582 | "RTN","IBC NERP8",317 ,0) | |
| 10583 | M ^TMP($J ,RTN,"CUR" )=RPTDATA | |
| 10584 | "RTN","IBC NERP8",318 ,0) | |
| 10585 | ; | |
| 10586 | "RTN","IBC NERP8",319 ,0) | |
| 10587 | CURX ; CUR exit poin t | |
| 10588 | "RTN","IBC NERP8",320 ,0) | |
| 10589 | Q | |
| 10590 | "RTN","IBC NERP8",321 ,0) | |
| 10591 | ; | |
| 10592 | "RTN","IBC NERP8",322 ,0) | |
| 10593 | GETFLAGS(P IEN,APPIEN ,PDATA,BDT ,EDT,RPTDA TA) ; get Active/Tru sted flag logs | |
| 10594 | "RTN","IBC NERP8",323 ,0) | |
| 10595 | ; PIEN - Payer ien in file 36 5.12 | |
| 10596 | "RTN","IBC NERP8",324 ,0) | |
| 10597 | ; APPIEN - Applicat ion ien in subfile 3 65.121 | |
| 10598 | "RTN","IBC NERP8",325 ,0) | |
| 10599 | ; PDATA - 0 node of Payer fil e entry | |
| 10600 | "RTN","IBC NERP8",326 ,0) | |
| 10601 | ; BDT - S tart date/ time | |
| 10602 | "RTN","IBC NERP8",327 ,0) | |
| 10603 | ; EDT - E nd date/ti me | |
| 10604 | "RTN","IBC NERP8",328 ,0) | |
| 10605 | ; RPTDATA - output array, pas sed by ref erence | |
| 10606 | "RTN","IBC NERP8",329 ,0) | |
| 10607 | ; | |
| 10608 | "RTN","IBC NERP8",330 ,0) | |
| 10609 | N FLAGS,I EN,PNAME,T YP,TM,VAL, Z | |
| 10610 | "RTN","IBC NERP8",331 ,0) | |
| 10611 | S PNAME=$ P(PDATA,U) | |
| 10612 | "RTN","IBC NERP8",332 ,0) | |
| 10613 | F TYP=2,3 S TM=EDT, Z=0 F S T M=$O(^IBE( 365.12,PIE N,1,APPIEN ,TYP,"B",T M),-1) Q:T M=""!($$FM DIFF^XLFDT (TM,BDT,2) '>0) D | |
| 10614 | "RTN","IBC NERP8",333 ,0) | |
| 10615 | .S IEN=$O (^IBE(365. 12,PIEN,1, APPIEN,TYP ,"B",TM,"" )) | |
| 10616 | "RTN","IBC NERP8",334 ,0) | |
| 10617 | .S VAL=$$ EXTERNAL^D ILFD("365. 121"_TYP,. 02,,$P(^IB E(365.12,P IEN,1,APPI EN,TYP,IEN ,0),U,2)) | |
| 10618 | "RTN","IBC NERP8",335 ,0) | |
| 10619 | .S Z=Z+1, RPTDATA("F LAGS",$S(T YP=2:"A",1 :"T"),PNAM E,Z)=$$FMT E^XLFDT(TM ,"5ZS")_"^ "_VAL | |
| 10620 | "RTN","IBC NERP8",336 ,0) | |
| 10621 | .Q | |
| 10622 | "RTN","IBC NERP8",337 ,0) | |
| 10623 | Q | |
| 10624 | "RTN","IBC NERP9") | |
| 10625 | 0^24^B1831 72218^B133 982311 | |
| 10626 | "RTN","IBC NERP9",1,0 ) | |
| 10627 | IBCNERP9 ; DAOU/BHS - eIV STATI STICAL REP ORT PRINT ;12-JUN-20 02 | |
| 10628 | "RTN","IBC NERP9",2,0 ) | |
| 10629 | ;;2.0;INT EGRATED BI LLING;**18 4,271,416, 506,528,62 1**;21-MAR -94;Build 8 | |
| 10630 | "RTN","IBC NERP9",3,0 ) | |
| 10631 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 10632 | "RTN","IBC NERP9",4,0 ) | |
| 10633 | ; | |
| 10634 | "RTN","IBC NERP9",5,0 ) | |
| 10635 | ; eIV - I nsurance V erificatio n Interfac e | |
| 10636 | "RTN","IBC NERP9",6,0 ) | |
| 10637 | ; | |
| 10638 | "RTN","IBC NERP9",7,0 ) | |
| 10639 | ; Input v ariables f rom IBCNER P7: | |
| 10640 | "RTN","IBC NERP9",8,0 ) | |
| 10641 | ; IBCNER TN = "IBCN ERP7" | |
| 10642 | "RTN","IBC NERP9",9,0 ) | |
| 10643 | ; **IBCNE SPC array ONLY passe d by refer ence | |
| 10644 | "RTN","IBC NERP9",10, 0) | |
| 10645 | ; IBCNES PC("BEGDTM ") = Start Date/Time for date/ time repor t range | |
| 10646 | "RTN","IBC NERP9",11, 0) | |
| 10647 | ; IBCNES PC("ENDDTM ") = End D ate/Time f or date/ti me report range | |
| 10648 | "RTN","IBC NERP9",12, 0) | |
| 10649 | ; IBCNES PC("SECTS" ) = 1 - Al l, include s all sect ions OR | |
| 10650 | "RTN","IBC NERP9",13, 0) | |
| 10651 | ; list of one or more of th e followin g: | |
| 10652 | "RTN","IBC NERP9",14, 0) | |
| 10653 | ; 2 - O utgoing Da ta, Inquir y Transmis sion data, | |
| 10654 | "RTN","IBC NERP9",15, 0) | |
| 10655 | ; 3 - I ncoming Da ta, Inquir y Response data, | |
| 10656 | "RTN","IBC NERP9",16, 0) | |
| 10657 | ; 4 - G eneral Dat a, Insuran ce Buffer data, | |
| 10658 | "RTN","IBC NERP9",17, 0) | |
| 10659 | ; Commu nication F ailures, O utstanding Inquiries | |
| 10660 | "RTN","IBC NERP9",18, 0) | |
| 10661 | ; IBCNE SPC("MM") = "", do n ot generat e MailMan message OR | |
| 10662 | "RTN","IBC NERP9",19, 0) | |
| 10663 | ; MAILGROU P, mailgro up to send MailMan m essage to | |
| 10664 | "RTN","IBC NERP9",20, 0) | |
| 10665 | ; based o n IB site parameter | |
| 10666 | "RTN","IBC NERP9",21, 0) | |
| 10667 | ; Assum es report data exist s in ^TMP( $J,IBCNERT N,...) | |
| 10668 | "RTN","IBC NERP9",22, 0) | |
| 10669 | ; Based on IBCNES PC("SECTS" ) paramete r the foll owing scra tch global s | |
| 10670 | "RTN","IBC NERP9",23, 0) | |
| 10671 | ; will be built | |
| 10672 | "RTN","IBC NERP9",24, 0) | |
| 10673 | ; 1 OR contains 2 --> | |
| 10674 | "RTN","IBC NERP9",25, 0) | |
| 10675 | ; ^TMP ($J,RTN,"O UT")=TotIn q^InsBufEx tSubtotal^ PreRegExtS ubtotal^.. . | |
| 10676 | "RTN","IBC NERP9",26, 0) | |
| 10677 | ; NonVe rifInsExtS ubtotal^No ActInsExtS ubtotal | |
| 10678 | "RTN","IBC NERP9",27, 0) | |
| 10679 | ; 1 OR contains 3 --> | |
| 10680 | "RTN","IBC NERP9",28, 0) | |
| 10681 | ; ^TMP ($J,RTN,"I N")=TotRes p^InsBufEx tSubtotal^ PreRegExtS ubtotal^.. . | |
| 10682 | "RTN","IBC NERP9",29, 0) | |
| 10683 | ; NonVe rifInsExtS ubtotal^No ActInsExtS ubtotal | |
| 10684 | "RTN","IBC NERP9",30, 0) | |
| 10685 | ; 1 OR contains 4 --> | |
| 10686 | "RTN","IBC NERP9",31, 0) | |
| 10687 | ; ^TMP ($J,RTN,"C UR")=TotOu tstandingI nq^TotInqR etries^... | |
| 10688 | "RTN","IBC NERP9",32, 0) | |
| 10689 | ; TotIn qCommFailu re^TotInsB ufVerified ^... | |
| 10690 | "RTN","IBC NERP9",33, 0) | |
| 10691 | ; ManVe rifedSubto tal^eIVPro cessedSubt otal... | |
| 10692 | "RTN","IBC NERP9",34, 0) | |
| 10693 | ; TotIn sBufUnveri fied^! Ins BufSubtota l^... | |
| 10694 | "RTN","IBC NERP9",35, 0) | |
| 10695 | ; ? Ins BufSubtota l^- InsBuf Subtotal^. .. | |
| 10696 | "RTN","IBC NERP9",36, 0) | |
| 10697 | ; Other InsBufSub total^TQRe adyToTrans mit^... | |
| 10698 | "RTN","IBC NERP9",37, 0) | |
| 10699 | ; TQHol d^TQRetry | |
| 10700 | "RTN","IBC NERP9",38, 0) | |
| 10701 | ; and ^TMP($J,RT N","PYR",P AYER NAME, IEN of fil e 365.12)= "" | |
| 10702 | "RTN","IBC NERP9",39, 0) | |
| 10703 | ; IBOU T = "E" fo r Excel or "R" for r eport form at | |
| 10704 | "RTN","IBC NERP9",40, 0) | |
| 10705 | ; Must ca ll at EN | |
| 10706 | "RTN","IBC NERP9",41, 0) | |
| 10707 | Q | |
| 10708 | "RTN","IBC NERP9",42, 0) | |
| 10709 | ; | |
| 10710 | "RTN","IBC NERP9",43, 0) | |
| 10711 | EN(IBCNERT N,IBCNESPC ,IBOUT) ; Entry pt | |
| 10712 | "RTN","IBC NERP9",44, 0) | |
| 10713 | ; | |
| 10714 | "RTN","IBC NERP9",45, 0) | |
| 10715 | ; Init va rs | |
| 10716 | "RTN","IBC NERP9",46, 0) | |
| 10717 | N CRT,MAX CNT,IBPXT, IBPGC,IBBD T,IBEDT,IB SCT,IBMM,R ETRY,OUTIN Q,ATTEMPT | |
| 10718 | "RTN","IBC NERP9",47, 0) | |
| 10719 | N X,Y,DIR ,DTOUT,DUO UT,LIN,IBM BI,IBQUERY | |
| 10720 | "RTN","IBC NERP9",48, 0) | |
| 10721 | ; | |
| 10722 | "RTN","IBC NERP9",49, 0) | |
| 10723 | S IBBDT=$ G(IBCNESPC ("BEGDTM") ),IBEDT=$G (IBCNESPC( "ENDDTM")) | |
| 10724 | "RTN","IBC NERP9",50, 0) | |
| 10725 | S IBSCT=$ G(IBCNESPC ("SECTS")) ,IBMM=$G(I BCNESPC("M M")) | |
| 10726 | "RTN","IBC NERP9",51, 0) | |
| 10727 | ; | |
| 10728 | "RTN","IBC NERP9",52, 0) | |
| 10729 | S (IBPXT, IBPGC,CRT, MAXCNT)=0 | |
| 10730 | "RTN","IBC NERP9",53, 0) | |
| 10731 | ; | |
| 10732 | "RTN","IBC NERP9",54, 0) | |
| 10733 | ; Determi ne IO para meters if output dev ice is NOT MailMan m essage | |
| 10734 | "RTN","IBC NERP9",55, 0) | |
| 10735 | I IBMM="" D | |
| 10736 | "RTN","IBC NERP9",56, 0) | |
| 10737 | . I IOST[ "C-" S MAX CNT=IOSL-3 ,CRT=1 Q | |
| 10738 | "RTN","IBC NERP9",57, 0) | |
| 10739 | . S MAXCN T=IOSL-6,C RT=0 | |
| 10740 | "RTN","IBC NERP9",58, 0) | |
| 10741 | ; | |
| 10742 | "RTN","IBC NERP9",59, 0) | |
| 10743 | D PRINT(I BCNERTN,IB BDT,IBEDT, IBSCT,IBMM ,.IBPGC,.I BPXT,MAXCN T,CRT,IBOU T) | |
| 10744 | "RTN","IBC NERP9",60, 0) | |
| 10745 | I $G(ZTST OP)!IBPXT G EXIT | |
| 10746 | "RTN","IBC NERP9",61, 0) | |
| 10747 | I CRT,IBP GC>0,'$D(Z TQUEUED) D G EXIT | |
| 10748 | "RTN","IBC NERP9",62, 0) | |
| 10749 | . I MAXCN T<51 F LIN =1:1:(MAXC NT-$Y) W ! | |
| 10750 | "RTN","IBC NERP9",63, 0) | |
| 10751 | . S DIR(0 )="E" D ^D IR K DIR | |
| 10752 | "RTN","IBC NERP9",64, 0) | |
| 10753 | ; | |
| 10754 | "RTN","IBC NERP9",65, 0) | |
| 10755 | EXIT ; Exi t pt | |
| 10756 | "RTN","IBC NERP9",66, 0) | |
| 10757 | Q | |
| 10758 | "RTN","IBC NERP9",67, 0) | |
| 10759 | ; | |
| 10760 | "RTN","IBC NERP9",68, 0) | |
| 10761 | ; | |
| 10762 | "RTN","IBC NERP9",69, 0) | |
| 10763 | PRINT(RTN, BDT,EDT,SC T,MM,PGC,P XT,MAX,CRT ,IBOUT) ; Print data | |
| 10764 | "RTN","IBC NERP9",70, 0) | |
| 10765 | ; Init va rs | |
| 10766 | "RTN","IBC NERP9",71, 0) | |
| 10767 | N EORMSG, NONEMSG,LI NECT,DISPD ATA,HDRDAT A,OFFSET,T MP,DTMRNG, SITE | |
| 10768 | "RTN","IBC NERP9",72, 0) | |
| 10769 | ; | |
| 10770 | "RTN","IBC NERP9",73, 0) | |
| 10771 | S LINECT= 0 | |
| 10772 | "RTN","IBC NERP9",74, 0) | |
| 10773 | ; | |
| 10774 | "RTN","IBC NERP9",75, 0) | |
| 10775 | ; Build E nd-Of-Repo rt Message for displ ay | |
| 10776 | "RTN","IBC NERP9",76, 0) | |
| 10777 | S EORMSG= "*** END O F REPORT * **" | |
| 10778 | "RTN","IBC NERP9",77, 0) | |
| 10779 | S OFFSET= 80-$L(EORM SG)\2 | |
| 10780 | "RTN","IBC NERP9",78, 0) | |
| 10781 | S EORMSG= $$FO^IBCNE UT1(EORMSG ,OFFSET+$L (EORMSG)," R") | |
| 10782 | "RTN","IBC NERP9",79, 0) | |
| 10783 | ; Build N o-Data-Fou nd Message for displ ay | |
| 10784 | "RTN","IBC NERP9",80, 0) | |
| 10785 | S NONEMSG ="* * * N O D A T A F O U N D * * *" | |
| 10786 | "RTN","IBC NERP9",81, 0) | |
| 10787 | S OFFSET= 80-$L(NONE MSG)\2 | |
| 10788 | "RTN","IBC NERP9",82, 0) | |
| 10789 | S NONEMSG =$$FO^IBCN EUT1(NONEM SG,OFFSET+ $L(NONEMSG ),"R") | |
| 10790 | "RTN","IBC NERP9",83, 0) | |
| 10791 | ; Build S ite for di splay | |
| 10792 | "RTN","IBC NERP9",84, 0) | |
| 10793 | S SITE=$P ($$SITE^VA SITE,U,2) | |
| 10794 | "RTN","IBC NERP9",85, 0) | |
| 10795 | ; Build D ate/Time R ange for d isplay | |
| 10796 | "RTN","IBC NERP9",86, 0) | |
| 10797 | ; Build Date/Time display fo r Starting date/time | |
| 10798 | "RTN","IBC NERP9",87, 0) | |
| 10799 | S TMP=$$F MTE^XLFDT( BDT,"5Z") | |
| 10800 | "RTN","IBC NERP9",88, 0) | |
| 10801 | S DTMRNG= $P(TMP,"@" )_" "_$P(T MP,"@",2) | |
| 10802 | "RTN","IBC NERP9",89, 0) | |
| 10803 | ; Calcul ate Date/T ime displa y for Endi ng date/ti me | |
| 10804 | "RTN","IBC NERP9",90, 0) | |
| 10805 | S TMP=$$F MTE^XLFDT( EDT,"5Z") | |
| 10806 | "RTN","IBC NERP9",91, 0) | |
| 10807 | S DTMRNG= DTMRNG_" - "_$P(TMP, "@")_" "_$ P(TMP,"@", 2) | |
| 10808 | "RTN","IBC NERP9",92, 0) | |
| 10809 | ; | |
| 10810 | "RTN","IBC NERP9",93, 0) | |
| 10811 | ; Print h eader to D ISPDATA fo r MailMan message ON LY | |
| 10812 | "RTN","IBC NERP9",94, 0) | |
| 10813 | I IBOUT=" R" D HEADE R^IBCNERP0 (.HDRDATA, .PGC,.PXT, MAX,CRT,SI TE,DTMRNG, MM) | |
| 10814 | "RTN","IBC NERP9",95, 0) | |
| 10815 | I MM'="" M DISPDATA =HDRDATA S LINECT=+$ O(DISPDATA (""),-1) | |
| 10816 | "RTN","IBC NERP9",96, 0) | |
| 10817 | I MM="" K ILL HDRDAT A | |
| 10818 | "RTN","IBC NERP9",97, 0) | |
| 10819 | ; | |
| 10820 | "RTN","IBC NERP9",98, 0) | |
| 10821 | ; If glob al does no t exist - display No Data mess age | |
| 10822 | "RTN","IBC NERP9",99, 0) | |
| 10823 | I '$D(^TM P($J,RTN)) S LINECT= LINECT+1,D ISPDATA(LI NECT)=NONE MSG G PRIN T2 | |
| 10824 | "RTN","IBC NERP9",100 ,0) | |
| 10825 | ; | |
| 10826 | "RTN","IBC NERP9",101 ,0) | |
| 10827 | ; Display Outgoing Data - if selected | |
| 10828 | "RTN","IBC NERP9",102 ,0) | |
| 10829 | I SCT=1!( SCT[2) D I PXT!$G(Z TSTOP) G P RINTX | |
| 10830 | "RTN","IBC NERP9",103 ,0) | |
| 10831 | . ; Build lines of data to di splay | |
| 10832 | "RTN","IBC NERP9",104 ,0) | |
| 10833 | . D DATA( .DISPDATA, .LINECT,RT N,"OUT",MM ,IBOUT) | |
| 10834 | "RTN","IBC NERP9",105 ,0) | |
| 10835 | ; | |
| 10836 | "RTN","IBC NERP9",106 ,0) | |
| 10837 | ; Display Incoming Data - if selected | |
| 10838 | "RTN","IBC NERP9",107 ,0) | |
| 10839 | I SCT=1!( SCT[3) D I PXT!$G(Z TSTOP) G P RINTX | |
| 10840 | "RTN","IBC NERP9",108 ,0) | |
| 10841 | . ; Build lines of data to di splay | |
| 10842 | "RTN","IBC NERP9",109 ,0) | |
| 10843 | . D DATA( .DISPDATA, .LINECT,RT N,"IN",MM, IBOUT) | |
| 10844 | "RTN","IBC NERP9",110 ,0) | |
| 10845 | ; | |
| 10846 | "RTN","IBC NERP9",111 ,0) | |
| 10847 | ; Display General D ata - if s elected | |
| 10848 | "RTN","IBC NERP9",112 ,0) | |
| 10849 | I SCT=1!( SCT[4) D I PXT!$G(Z TSTOP) G P RINTX | |
| 10850 | "RTN","IBC NERP9",113 ,0) | |
| 10851 | . ; Build lines of data to di splay | |
| 10852 | "RTN","IBC NERP9",114 ,0) | |
| 10853 | . D DATA( .DISPDATA, .LINECT,RT N,"CUR",MM ,IBOUT) | |
| 10854 | "RTN","IBC NERP9",115 ,0) | |
| 10855 | . D DATA( .DISPDATA, .LINECT,RT N,"PYR",MM ,IBOUT) | |
| 10856 | "RTN","IBC NERP9",116 ,0) | |
| 10857 | . D DATA( .DISPDATA, .LINECT,RT N,"FLG",MM ,IBOUT) | |
| 10858 | "RTN","IBC NERP9",117 ,0) | |
| 10859 | ; | |
| 10860 | "RTN","IBC NERP9",118 ,0) | |
| 10861 | PRINT2 S L INECT=LINE CT+1 | |
| 10862 | "RTN","IBC NERP9",119 ,0) | |
| 10863 | S DISPDAT A(LINECT)= EORMSG | |
| 10864 | "RTN","IBC NERP9",120 ,0) | |
| 10865 | ; | |
| 10866 | "RTN","IBC NERP9",121 ,0) | |
| 10867 | I MM="" D LINE(.DIS PDATA,.PGC ,.PXT,MAX, CRT,SITE,D TMRNG,MM) | |
| 10868 | "RTN","IBC NERP9",122 ,0) | |
| 10869 | ; Generat e MailMan message, i f flag is set | |
| 10870 | "RTN","IBC NERP9",123 ,0) | |
| 10871 | I MM'="" D MSG^IBCN EUT5(MM,"* * eIV Stat istical Rp t **","DIS PDATA(") | |
| 10872 | "RTN","IBC NERP9",124 ,0) | |
| 10873 | ; | |
| 10874 | "RTN","IBC NERP9",125 ,0) | |
| 10875 | PRINTX ; P RINT exit pt | |
| 10876 | "RTN","IBC NERP9",126 ,0) | |
| 10877 | Q | |
| 10878 | "RTN","IBC NERP9",127 ,0) | |
| 10879 | ; | |
| 10880 | "RTN","IBC NERP9",128 ,0) | |
| 10881 | LINE(DISPD ATA,PGC,PX T,MAX,CRT, SITE,DTMRN G,MM) ; Pr int line o f data | |
| 10882 | "RTN","IBC NERP9",129 ,0) | |
| 10883 | ; Init va rs | |
| 10884 | "RTN","IBC NERP9",130 ,0) | |
| 10885 | N CT,II,A RRAY,NWPG | |
| 10886 | "RTN","IBC NERP9",131 ,0) | |
| 10887 | ; | |
| 10888 | "RTN","IBC NERP9",132 ,0) | |
| 10889 | S NWPG=0 | |
| 10890 | "RTN","IBC NERP9",133 ,0) | |
| 10891 | S CT=+$O( DISPDATA(" "),-1) | |
| 10892 | "RTN","IBC NERP9",134 ,0) | |
| 10893 | I $Y+1+CT >MAX,PGC>1 D HEADER^ IBCNERP0(. ARRAY,.PGC ,.PXT,MAX, CRT,SITE,D TMRNG,MM) S NWPG=1 I PXT!$G(ZT STOP) G LI NEX | |
| 10894 | "RTN","IBC NERP9",135 ,0) | |
| 10895 | F II=1:1: CT D Q:PX T!$G(ZTSTO P) | |
| 10896 | "RTN","IBC NERP9",136 ,0) | |
| 10897 | . I $Y+1> MAX!('PGC) D HEADER^ IBCNERP0(. ARRAY,.PGC ,.PXT,MAX, CRT,SITE,D TMRNG,MM) S NWPG=1 I PXT!$G(ZT STOP) Q | |
| 10898 | "RTN","IBC NERP9",137 ,0) | |
| 10899 | . I 'NWPG !(NWPG&($D (DISPDATA( II)))) I $ G(DISPDATA (II))'="" W !,?1,DIS PDATA(II) | |
| 10900 | "RTN","IBC NERP9",138 ,0) | |
| 10901 | . I NWPG S NWPG=0 | |
| 10902 | "RTN","IBC NERP9",139 ,0) | |
| 10903 | ; | |
| 10904 | "RTN","IBC NERP9",140 ,0) | |
| 10905 | LINEX ; LI NE exit pt | |
| 10906 | "RTN","IBC NERP9",141 ,0) | |
| 10907 | Q | |
| 10908 | "RTN","IBC NERP9",142 ,0) | |
| 10909 | ; | |
| 10910 | "RTN","IBC NERP9",143 ,0) | |
| 10911 | DATA(DISPD ATA,LINECT ,RTN,TYPE, MM,IBOUT) ; Format l ines of da ta to be p rinted | |
| 10912 | "RTN","IBC NERP9",144 ,0) | |
| 10913 | ; Init va rs | |
| 10914 | "RTN","IBC NERP9",145 ,0) | |
| 10915 | ; 528 - b aa : added code to o utput to E xcel | |
| 10916 | "RTN","IBC NERP9",146 ,0) | |
| 10917 | N DASHES, PEND,RPTDA TA,CT,DEFI NQ,INSCOS, PAYERS,QUE INQ,TXT,TY PE1 | |
| 10918 | "RTN","IBC NERP9",147 ,0) | |
| 10919 | ; | |
| 10920 | "RTN","IBC NERP9",148 ,0) | |
| 10921 | S $P(DASH ES,"=",14) ="",TYPE1= TYPE ; IB* 2.0*621 | |
| 10922 | "RTN","IBC NERP9",149 ,0) | |
| 10923 | I LINECT> 0,MM="" S LINECT=LIN ECT+1,DISP DATA(LINEC T)="" | |
| 10924 | "RTN","IBC NERP9",150 ,0) | |
| 10925 | ; | |
| 10926 | "RTN","IBC NERP9",151 ,0) | |
| 10927 | ; Copy re port data to local v ariable | |
| 10928 | "RTN","IBC NERP9",152 ,0) | |
| 10929 | S RPTDATA =$G(^TMP($ J,RTN,TYPE )) ; does not w ork for "P YR" | |
| 10930 | "RTN","IBC NERP9",153 ,0) | |
| 10931 | ; Outgoin g and Inco ming Total s | |
| 10932 | "RTN","IBC NERP9",154 ,0) | |
| 10933 | I TYPE="O UT"!(TYPE= "IN") D S :IBOUT="R" LINECT=LI NECT+1,DIS PDATA(LINE CT)=" " G DATAX ; I B*2.0*621 | |
| 10934 | "RTN","IBC NERP9",155 ,0) | |
| 10935 | . S LINEC T=LINECT+1 | |
| 10936 | "RTN","IBC NERP9",156 ,0) | |
| 10937 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1($S (TYPE="OUT ":"Outgoin g Data (In quiries Se nt)",1:"In coming Dat a (Respons es Receive d)"),46)_$ $FO^IBCNEU T1(+$P(RPT DATA,U,1), 14,"R") ; IB*2.0*621 | |
| 10938 | "RTN","IBC NERP9",157 ,0) | |
| 10939 | . I IBOUT ="E" S DIS PDATA(LINE CT)=$S(TYP E="OUT":"O UTGOING DA TA",1:"INC OMING DATA ")_U_+$P(R PTDATA,U,1 ) | |
| 10940 | "RTN","IBC NERP9",158 ,0) | |
| 10941 | . S LINEC T=LINECT+1 | |
| 10942 | "RTN","IBC NERP9",159 ,0) | |
| 10943 | . I IBOUT ="R" S DIS PDATA(LINE CT)=DASHES ; IB*2.0* 621 | |
| 10944 | "RTN","IBC NERP9",160 ,0) | |
| 10945 | . F CT=1: 1:5 D ; U pdated for IB*2.0*62 1 | |
| 10946 | "RTN","IBC NERP9",161 ,0) | |
| 10947 | . . N TYP E ; | |
| 10948 | "RTN","IBC NERP9",162 ,0) | |
| 10949 | . . I TYP E1="IN" S TYPE=$S(CT =1:"Insura nce Buffer ",CT=2:"Ap pointment" ,CT=3:"Ele ctronic In surance Co verage Dis covery (EI CD)",CT=4: "EICD-Trig gered eIns urance Ver ification" ,CT=5:"MBI Response" ) | |
| 10950 | "RTN","IBC NERP9",163 ,0) | |
| 10951 | . . I TYP E1="OUT" S TYPE=$S(C T=1:"Insur ance Buffe r",CT=2:"A ppointment ",CT=3:"El ectronic I nsurance C overage Di scovery (E ICD)",CT=4 :"EICD-Tri ggered eIn surance Ve rification ",CT=5:"MB I Inquiry" ) | |
| 10952 | "RTN","IBC NERP9",164 ,0) | |
| 10953 | . . S LIN ECT=LINECT +1 | |
| 10954 | "RTN","IBC NERP9",165 ,0) | |
| 10955 | . . I IBO UT="E" S D ISPDATA(LI NECT)=TYPE _U_+$P(RPT DATA,U,CT+ 1) | |
| 10956 | "RTN","IBC NERP9",166 ,0) | |
| 10957 | . . I IBO UT="R" S D ISPDATA(LI NECT)=$$FO ^IBCNEUT1( " "_TYPE ,50)_$$FO^ IBCNEUT1(+ $P(RPTDATA ,U,CT+1),2 5,"R") | |
| 10958 | "RTN","IBC NERP9",167 ,0) | |
| 10959 | ; | |
| 10960 | "RTN","IBC NERP9",168 ,0) | |
| 10961 | ; General Data | |
| 10962 | "RTN","IBC NERP9",169 ,0) | |
| 10963 | I TYPE="C UR" D G D ATAX | |
| 10964 | "RTN","IBC NERP9",170 ,0) | |
| 10965 | . S LINEC T=LINECT+1 ; IB*2.0* 621 - Adde d Status L abel | |
| 10966 | "RTN","IBC NERP9",171 ,0) | |
| 10967 | . I IBOUT ="R" S DIS PDATA(LINE CT)="Curre nt Status" | |
| 10968 | "RTN","IBC NERP9",172 ,0) | |
| 10969 | . I IBOUT ="E" S DIS PDATA(LINE CT)="CURRE NT STATUS" | |
| 10970 | "RTN","IBC NERP9",173 ,0) | |
| 10971 | . I IBOUT ="R" S LIN ECT=LINECT +1 | |
| 10972 | "RTN","IBC NERP9",174 ,0) | |
| 10973 | . I IBOUT ="R" S DIS PDATA(LINE CT)="===== =========" | |
| 10974 | "RTN","IBC NERP9",175 ,0) | |
| 10975 | . ; Respo nses Pendi ng | |
| 10976 | "RTN","IBC NERP9",176 ,0) | |
| 10977 | . S PEND= +$P(RPTDAT A,U,1) | |
| 10978 | "RTN","IBC NERP9",177 ,0) | |
| 10979 | . S LINEC T=LINECT+1 | |
| 10980 | "RTN","IBC NERP9",178 ,0) | |
| 10981 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Respo nses Pendi ng"_U_PEND | |
| 10982 | "RTN","IBC NERP9",179 ,0) | |
| 10983 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("R esponses P ending:",4 6)_$$FO^IB CNEUT1(PEN D,14,"R") | |
| 10984 | "RTN","IBC NERP9",180 ,0) | |
| 10985 | . ; IB*2. 0*621 | |
| 10986 | "RTN","IBC NERP9",181 ,0) | |
| 10987 | . ; Insur ance Buffe r | |
| 10988 | "RTN","IBC NERP9",182 ,0) | |
| 10989 | . S PEND= +$P(RPTDAT A,U,17) | |
| 10990 | "RTN","IBC NERP9",183 ,0) | |
| 10991 | . S LINEC T=LINECT+1 | |
| 10992 | "RTN","IBC NERP9",184 ,0) | |
| 10993 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Insur ance Buffe r"_U_PEND | |
| 10994 | "RTN","IBC NERP9",185 ,0) | |
| 10995 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" Insuranc e Buffer", 60)_$$FO^I BCNEUT1(PE ND,15,"R") | |
| 10996 | "RTN","IBC NERP9",186 ,0) | |
| 10997 | . ; Appoi ntment | |
| 10998 | "RTN","IBC NERP9",187 ,0) | |
| 10999 | . S PEND= +$P(RPTDAT A,U,18) | |
| 11000 | "RTN","IBC NERP9",188 ,0) | |
| 11001 | . S LINEC T=LINECT+1 | |
| 11002 | "RTN","IBC NERP9",189 ,0) | |
| 11003 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Appoi ntment"_U_ PEND | |
| 11004 | "RTN","IBC NERP9",190 ,0) | |
| 11005 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" Appointm ent",60)_$ $FO^IBCNEU T1(PEND,15 ,"R") | |
| 11006 | "RTN","IBC NERP9",191 ,0) | |
| 11007 | . ; Elect ronic Insu rance Cove rage Disco very (EICD ) | |
| 11008 | "RTN","IBC NERP9",192 ,0) | |
| 11009 | . S PEND= +$P(RPTDAT A,U,19) | |
| 11010 | "RTN","IBC NERP9",193 ,0) | |
| 11011 | . S LINEC T=LINECT+1 | |
| 11012 | "RTN","IBC NERP9",194 ,0) | |
| 11013 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Elect ronic Insu rance Cove rage Disco very (EICD )"_U_PEND | |
| 11014 | "RTN","IBC NERP9",195 ,0) | |
| 11015 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" Electron ic Insuran ce Coverag e Discover y (EICD)", 60)_$$FO^I BCNEUT1(PE ND,15,"R") | |
| 11016 | "RTN","IBC NERP9",196 ,0) | |
| 11017 | . ; EICD- Triggered eInsurance Verificat ion | |
| 11018 | "RTN","IBC NERP9",197 ,0) | |
| 11019 | . S PEND= +$P(RPTDAT A,U,20) | |
| 11020 | "RTN","IBC NERP9",198 ,0) | |
| 11021 | . S LINEC T=LINECT+1 | |
| 11022 | "RTN","IBC NERP9",199 ,0) | |
| 11023 | . I IBOUT ="E" S DIS PDATA(LINE CT)="EICD- Triggered eInsurance Verificat ion"_U_PEN D | |
| 11024 | "RTN","IBC NERP9",200 ,0) | |
| 11025 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" EICD-Tri ggered eIn surance Ve rification ",60)_$$FO ^IBCNEUT1( PEND,15,"R ") | |
| 11026 | "RTN","IBC NERP9",201 ,0) | |
| 11027 | . ; MBI I nquiry | |
| 11028 | "RTN","IBC NERP9",202 ,0) | |
| 11029 | . S PEND= +$P(RPTDAT A,U,21) | |
| 11030 | "RTN","IBC NERP9",203 ,0) | |
| 11031 | . S LINEC T=LINECT+1 | |
| 11032 | "RTN","IBC NERP9",204 ,0) | |
| 11033 | . I IBOUT ="E" S DIS PDATA(LINE CT)="MBI I nquiry"_U_ PEND | |
| 11034 | "RTN","IBC NERP9",205 ,0) | |
| 11035 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" MBI Inqu iry",60)_$ $FO^IBCNEU T1(PEND,15 ,"R") | |
| 11036 | "RTN","IBC NERP9",206 ,0) | |
| 11037 | . ; IB*2. 0*621 - En d | |
| 11038 | "RTN","IBC NERP9",207 ,0) | |
| 11039 | . ; Queue d Inqs | |
| 11040 | "RTN","IBC NERP9",208 ,0) | |
| 11041 | . S QUEIN Q=+$P(RPTD ATA,U,2) | |
| 11042 | "RTN","IBC NERP9",209 ,0) | |
| 11043 | . S LINEC T=LINECT+1 | |
| 11044 | "RTN","IBC NERP9",210 ,0) | |
| 11045 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Queue d Inquirie s"_U_QUEIN Q | |
| 11046 | "RTN","IBC NERP9",211 ,0) | |
| 11047 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("Q ueued Inqu iries:",46 )_$$FO^IBC NEUT1(QUEI NQ,14,"R") | |
| 11048 | "RTN","IBC NERP9",212 ,0) | |
| 11049 | . ; Defer red Inqs | |
| 11050 | "RTN","IBC NERP9",213 ,0) | |
| 11051 | . S DEFIN Q=+$P(RPTD ATA,U,3) | |
| 11052 | "RTN","IBC NERP9",214 ,0) | |
| 11053 | . S LINEC T=LINECT+1 | |
| 11054 | "RTN","IBC NERP9",215 ,0) | |
| 11055 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Defer red Inquir ies:"_U_DE FINQ | |
| 11056 | "RTN","IBC NERP9",216 ,0) | |
| 11057 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("D eferred In quiries:", 46)_$$FO^I BCNEUT1(DE FINQ,14,"R ") | |
| 11058 | "RTN","IBC NERP9",217 ,0) | |
| 11059 | . ; Ins C os w/o Nat ID | |
| 11060 | "RTN","IBC NERP9",218 ,0) | |
| 11061 | . S INSCO S=+$P(RPTD ATA,U,4) | |
| 11062 | "RTN","IBC NERP9",219 ,0) | |
| 11063 | . S LINEC T=LINECT+1 | |
| 11064 | "RTN","IBC NERP9",220 ,0) | |
| 11065 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Insur ance Compa nies w/o N ational ID "_U_INSCOS | |
| 11066 | "RTN","IBC NERP9",221 ,0) | |
| 11067 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("I nsurance C ompanies w /o Nationa l ID:",46) _$$FO^IBCN EUT1(INSCO S,14,"R") | |
| 11068 | "RTN","IBC NERP9",222 ,0) | |
| 11069 | . ; Payer s disabled locally | |
| 11070 | "RTN","IBC NERP9",223 ,0) | |
| 11071 | . S PAYER S=+$P(RPTD ATA,U,5) | |
| 11072 | "RTN","IBC NERP9",224 ,0) | |
| 11073 | . S LINEC T=LINECT+1 | |
| 11074 | "RTN","IBC NERP9",225 ,0) | |
| 11075 | . I IBOUT ="E" S DIS PDATA(LINE CT)="eIV P ayers Disa bled Local ly"_U_PAYE RS | |
| 11076 | "RTN","IBC NERP9",226 ,0) | |
| 11077 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("e IV Payers Disabled L ocally:",4 6)_$$FO^IB CNEUT1(PAY ERS,14,"R" ) | |
| 11078 | "RTN","IBC NERP9",227 ,0) | |
| 11079 | . I IBOUT ="R" S LIN ECT=LINECT +1 | |
| 11080 | "RTN","IBC NERP9",228 ,0) | |
| 11081 | . I IBOUT ="R" S DIS PDATA(LINE CT)=" " | |
| 11082 | "RTN","IBC NERP9",229 ,0) | |
| 11083 | . ; Insur ance Buffe r statisti cs | |
| 11084 | "RTN","IBC NERP9",230 ,0) | |
| 11085 | . S LINEC T=LINECT+1 | |
| 11086 | "RTN","IBC NERP9",231 ,0) | |
| 11087 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Insur ance Buffe r Entries: "_U_($P(R PTDATA,U,6 )+$P(RPTDA TA,U,9)) | |
| 11088 | "RTN","IBC NERP9",232 ,0) | |
| 11089 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1("I nsurance B uffer Entr ies: ",46) _$$FO^IBCN EUT1(($P(R PTDATA,U,9 )+$P(RPTDA TA,U,9)),1 4,"R") | |
| 11090 | "RTN","IBC NERP9",233 ,0) | |
| 11091 | . ; *,+,# ,! or - s ymbol entr ies - User action re quired | |
| 11092 | "RTN","IBC NERP9",234 ,0) | |
| 11093 | . S LINEC T=LINECT+1 | |
| 11094 | "RTN","IBC NERP9",235 ,0) | |
| 11095 | . I IBOUT ="E" S DIS PDATA(LINE CT)="User Action Req uired"_U_+ $P(RPTDATA ,U,6) | |
| 11096 | "RTN","IBC NERP9",236 ,0) | |
| 11097 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" User Acti on Require d: ",46)_$ $FO^IBCNEU T1(+$P(RPT DATA,U,6), 22,"R") | |
| 11098 | "RTN","IBC NERP9",237 ,0) | |
| 11099 | . I IBOUT ="R" F CT= 8,15,16,13 ,10,11 D ; IB*2.0*6 21 | |
| 11100 | "RTN","IBC NERP9",238 ,0) | |
| 11101 | . . S LIN ECT=LINECT +1 | |
| 11102 | "RTN","IBC NERP9",239 ,0) | |
| 11103 | . . ; Add ed # to re port | |
| 11104 | "RTN","IBC NERP9",240 ,0) | |
| 11105 | . . S TYP E=" # o f " | |
| 11106 | "RTN","IBC NERP9",241 ,0) | |
| 11107 | . . I CT= 7 S TXT="* entries ( User Verif ied policy )" | |
| 11108 | "RTN","IBC NERP9",242 ,0) | |
| 11109 | . . I CT= 8 S TXT="+ entries ( Payer indi cated Acti ve policy) " | |
| 11110 | "RTN","IBC NERP9",243 ,0) | |
| 11111 | . . I CT= 10 S TXT=" # entries (Policy st atus undet ermined)" | |
| 11112 | "RTN","IBC NERP9",244 ,0) | |
| 11113 | . . I CT= 11 S TXT=" ! entries (eIV needs user assi stance for entry)" | |
| 11114 | "RTN","IBC NERP9",245 ,0) | |
| 11115 | . . I CT= 13 S TXT=" - entries (Payer ind icated Ina ctive poli cy)" | |
| 11116 | "RTN","IBC NERP9",246 ,0) | |
| 11117 | . . I CT= 15 S TXT=" $ entries (Escalated , Active p olicy)" | |
| 11118 | "RTN","IBC NERP9",247 ,0) | |
| 11119 | . . I CT= 16 S TXT=" % entries (MBI value received) " ; IB*2.0 *621 | |
| 11120 | "RTN","IBC NERP9",248 ,0) | |
| 11121 | . . S TYP E=TYPE_TXT | |
| 11122 | "RTN","IBC NERP9",249 ,0) | |
| 11123 | . . S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(TY PE,56)_$$F O^IBCNEUT1 (+$P(RPTDA TA,U,CT),1 9,"R") | |
| 11124 | "RTN","IBC NERP9",250 ,0) | |
| 11125 | . ; | |
| 11126 | "RTN","IBC NERP9",251 ,0) | |
| 11127 | . S LINEC T=LINECT+1 | |
| 11128 | "RTN","IBC NERP9",252 ,0) | |
| 11129 | . I IBOUT ="E" S DIS PDATA(LINE CT)="Entri es Awaitin g Processi ng"_U_+$P( RPTDATA,U, 9) | |
| 11130 | "RTN","IBC NERP9",253 ,0) | |
| 11131 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" Entries A waiting Pr ocessing: ",46)_$$FO ^IBCNEUT1( +$P(RPTDAT A,U,9),22, "R") | |
| 11132 | "RTN","IBC NERP9",254 ,0) | |
| 11133 | . ; Subto tal of ? e ntries (eI V is waiti ng for a r esponse) | |
| 11134 | "RTN","IBC NERP9",255 ,0) | |
| 11135 | . S LINEC T=LINECT+1 | |
| 11136 | "RTN","IBC NERP9",256 ,0) | |
| 11137 | . I IBOUT ="E" S DIS PDATA(LINE CT)="# of ? entries (eIV is wa iting for a response )"_U_+$P(R PTDATA,U,1 2) | |
| 11138 | "RTN","IBC NERP9",257 ,0) | |
| 11139 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" # of ? entries (e IV is wait ing for a response)" ,56)_$$FO^ IBCNEUT1(+ $P(RPTDATA ,U,12),19, "R") | |
| 11140 | "RTN","IBC NERP9",258 ,0) | |
| 11141 | . ; Subto tal of bla nk entries (yet to b e processe d or accep ted) | |
| 11142 | "RTN","IBC NERP9",259 ,0) | |
| 11143 | . S LINEC T=LINECT+1 | |
| 11144 | "RTN","IBC NERP9",260 ,0) | |
| 11145 | . I IBOUT ="E" S DIS PDATA(LINE CT)="# of blank entr ies (yet t o be proce ssed or ac cepted)"_U _+$P(RPTDA TA,U,14) | |
| 11146 | "RTN","IBC NERP9",261 ,0) | |
| 11147 | . I IBOUT ="R" S DIS PDATA(LINE CT)=$$FO^I BCNEUT1(" # of bl ank entrie s (yet to be process ed or acce pted)",56) _$$FO^IBCN EUT1(+$P(R PTDATA,U,1 4),19,"R") | |
| 11148 | "RTN","IBC NERP9",262 ,0) | |
| 11149 | ; | |
| 11150 | "RTN","IBC NERP9",263 ,0) | |
| 11151 | ; Blank L ine | |
| 11152 | "RTN","IBC NERP9",264 ,0) | |
| 11153 | S LINECT= LINECT+1 ; IB*2.0*62 1 | |
| 11154 | "RTN","IBC NERP9",265 ,0) | |
| 11155 | I IBOUT=" R" S DISPD ATA(LINECT )=" " ; IB *2.0*621 | |
| 11156 | "RTN","IBC NERP9",266 ,0) | |
| 11157 | ; New Pay ers added to File 36 5.12 | |
| 11158 | "RTN","IBC NERP9",267 ,0) | |
| 11159 | I TYPE="P YR" D G D ATAX | |
| 11160 | "RTN","IBC NERP9",268 ,0) | |
| 11161 | . ; Payer s added to file 365. 12 | |
| 11162 | "RTN","IBC NERP9",269 ,0) | |
| 11163 | . D DATAX | |
| 11164 | "RTN","IBC NERP9",270 ,0) | |
| 11165 | . S LINEC T=LINECT+1 ; IB*2.0* 621 | |
| 11166 | "RTN","IBC NERP9",271 ,0) | |
| 11167 | . I IBOUT ="E" S DIS PDATA(LINE CT)="PAYER ACTIVITY (During Re port Date Range)" ; IB*2.0*621 | |
| 11168 | "RTN","IBC NERP9",272 ,0) | |
| 11169 | . I IBOUT ="R" S DIS PDATA(LINE CT)="Payer Activity (During Re port Date Range)" ; IB*2.0*621 | |
| 11170 | "RTN","IBC NERP9",273 ,0) | |
| 11171 | . I IBOUT ="R" S LIN ECT=LINECT +1 | |
| 11172 | "RTN","IBC NERP9",274 ,0) | |
| 11173 | . I IBOUT ="R" S DIS PDATA(LINE CT)="===== =========" | |
| 11174 | "RTN","IBC NERP9",275 ,0) | |
| 11175 | . S LINEC T=LINECT+1 | |
| 11176 | "RTN","IBC NERP9",276 ,0) | |
| 11177 | . S DISPD ATA(LINECT )="New eIV Payers re ceived" | |
| 11178 | "RTN","IBC NERP9",277 ,0) | |
| 11179 | . S LINEC T=LINECT+1 | |
| 11180 | "RTN","IBC NERP9",278 ,0) | |
| 11181 | . I '$D(^ TMP($J,RTN ,TYPE)) S DISPDATA(L INECT)=" N o new Paye rs added" Q | |
| 11182 | "RTN","IBC NERP9",279 ,0) | |
| 11183 | . S DISPD ATA(LINECT )=" Pleas e link the associate d active i nsurance c ompanies t o these pa yers at yo ur" | |
| 11184 | "RTN","IBC NERP9",280 ,0) | |
| 11185 | . S LINEC T=LINECT+1 ,DISPDATA( LINECT)=" earliest convenienc e. Locall y activate the payer s after yo u link ins urance" | |
| 11186 | "RTN","IBC NERP9",281 ,0) | |
| 11187 | . S LINEC T=LINECT+1 ,DISPDATA( LINECT)=" companies to them. For furth er details regarding this proc ess, pleas e refer" | |
| 11188 | "RTN","IBC NERP9",282 ,0) | |
| 11189 | . S LINEC T=LINECT+1 ,DISPDATA( LINECT)=" to the In tegrated B illing eIV Interface User Guid e." | |
| 11190 | "RTN","IBC NERP9",283 ,0) | |
| 11191 | . N PYR,P IEN | |
| 11192 | "RTN","IBC NERP9",284 ,0) | |
| 11193 | . S PYR=" ",PIEN="" F S PYR=$ O(^TMP($J, RTN,TYPE,P YR)) Q:PYR ="" D | |
| 11194 | "RTN","IBC NERP9",285 ,0) | |
| 11195 | . . F S PIEN=$O(^T MP($J,RTN, TYPE,PYR,P IEN)) Q:'P IEN D | |
| 11196 | "RTN","IBC NERP9",286 ,0) | |
| 11197 | . . . S L INECT=LINE CT+1 | |
| 11198 | "RTN","IBC NERP9",287 ,0) | |
| 11199 | . . . I I BOUT="E" S DISPDATA( LINECT)=PY R Q | |
| 11200 | "RTN","IBC NERP9",288 ,0) | |
| 11201 | . . . I I BOUT="R" S DISPDATA( LINECT)=" "_PYR | |
| 11202 | "RTN","IBC NERP9",289 ,0) | |
| 11203 | ; | |
| 11204 | "RTN","IBC NERP9",290 ,0) | |
| 11205 | ; Active/ Trusted fl ag logs | |
| 11206 | "RTN","IBC NERP9",291 ,0) | |
| 11207 | I TYPE="F LG" D G D ATAX ; IB* 2.0*621 Ad ded Payer Received | |
| 11208 | "RTN","IBC NERP9",292 ,0) | |
| 11209 | .N DATA,P NAME,Z,FLG | |
| 11210 | "RTN","IBC NERP9",293 ,0) | |
| 11211 | .F FLG="A ","T" D | |
| 11212 | "RTN","IBC NERP9",294 ,0) | |
| 11213 | ..I FLG=" A" D | |
| 11214 | "RTN","IBC NERP9",295 ,0) | |
| 11215 | ...I IBOU T="R" S DI SPDATA(LIN ECT)=" " | |
| 11216 | "RTN","IBC NERP9",296 ,0) | |
| 11217 | ...S LINE CT=LINECT+ 1,DISPDATA (LINECT)=" National P ayers - AC TIVE flag changes at FSC:" | |
| 11218 | "RTN","IBC NERP9",297 ,0) | |
| 11219 | ...Q | |
| 11220 | "RTN","IBC NERP9",298 ,0) | |
| 11221 | ..I FLG=" T" D | |
| 11222 | "RTN","IBC NERP9",299 ,0) | |
| 11223 | ...I IBOU T="R" S LI NECT=LINEC T+1,DISPDA TA(LINECT) =" " | |
| 11224 | "RTN","IBC NERP9",300 ,0) | |
| 11225 | ...S LINE CT=LINECT+ 1,DISPDATA (LINECT)=" Nationally Active Pa yers - TRU STED flag changes at FSC:" | |
| 11226 | "RTN","IBC NERP9",301 ,0) | |
| 11227 | ...Q | |
| 11228 | "RTN","IBC NERP9",302 ,0) | |
| 11229 | ..I '$D(^ TMP($J,RTN ,"CUR","FL AGS",FLG)) S LINECT= LINECT+1,D ISPDATA(LI NECT)=" No informati on availab le",LINECT =LINECT+1 Q | |
| 11230 | "RTN","IBC NERP9",303 ,0) | |
| 11231 | ..S PNAME ="" F S P NAME=$O(^T MP($J,RTN, "CUR","FLA GS",FLG,PN AME)) Q:PN AME="" D | |
| 11232 | "RTN","IBC NERP9",304 ,0) | |
| 11233 | ...S Z="" F S Z=$O (^TMP($J,R TN,"CUR"," FLAGS",FLG ,PNAME,Z)) Q:Z="" D | |
| 11234 | "RTN","IBC NERP9",305 ,0) | |
| 11235 | ....S DAT A=$G(^TMP( $J,RTN,"CU R","FLAGS" ,FLG,PNAME ,Z)) | |
| 11236 | "RTN","IBC NERP9",306 ,0) | |
| 11237 | ....S LIN ECT=LINECT +1 | |
| 11238 | "RTN","IBC NERP9",307 ,0) | |
| 11239 | ....I IBO UT="E" S D ISPDATA(LI NECT)=PNAM E_U_$P(DAT A,U)_U_$P( DATA,U,2) | |
| 11240 | "RTN","IBC NERP9",308 ,0) | |
| 11241 | ....I IBO UT="R" S D ISPDATA(LI NECT)=$$FO ^IBCNEUT1( " "_PNAME, 47)_$$FO^I BCNEUT1($P (DATA,U),1 9)_" Set: "_$P(DATA, U,2) | |
| 11242 | "RTN","IBC NERP9",309 ,0) | |
| 11243 | ....Q | |
| 11244 | "RTN","IBC NERP9",310 ,0) | |
| 11245 | ...Q | |
| 11246 | "RTN","IBC NERP9",311 ,0) | |
| 11247 | .Q | |
| 11248 | "RTN","IBC NERP9",312 ,0) | |
| 11249 | DATAX ; DA TA exit pt | |
| 11250 | "RTN","IBC NERP9",313 ,0) | |
| 11251 | S LINECT= LINECT+1 | |
| 11252 | "RTN","IBC NERP9",314 ,0) | |
| 11253 | S DISPDAT A(LINECT)= "" | |
| 11254 | "RTN","IBC NERP9",315 ,0) | |
| 11255 | Q | |
| 11256 | "RTN","IBC NERP9",316 ,0) | |
| 11257 | ; | |
| 11258 | "RTN","IBC NEUT5") | |
| 11259 | 0^25^B6325 2821^B5733 4702 | |
| 11260 | "RTN","IBC NEUT5",1,0 ) | |
| 11261 | IBCNEUT5 ; DAOU/ALA - eIV MISC. UTILITIES ;20-JUN-2 002 | |
| 11262 | "RTN","IBC NEUT5",2,0 ) | |
| 11263 | ;;2.0;INT EGRATED BI LLING;**18 4,284,271, 416,621**; 21-MAR-94; Build 8 | |
| 11264 | "RTN","IBC NEUT5",3,0 ) | |
| 11265 | ;;Per VHA Directive 6402, thi s routine should not be modifi ed. | |
| 11266 | "RTN","IBC NEUT5",4,0 ) | |
| 11267 | ; | |
| 11268 | "RTN","IBC NEUT5",5,0 ) | |
| 11269 | ;**Progra m Descript ion** | |
| 11270 | "RTN","IBC NEUT5",6,0 ) | |
| 11271 | ; This p rogram con tains some general u tilities o r function s | |
| 11272 | "RTN","IBC NEUT5",7,0 ) | |
| 11273 | ; | |
| 11274 | "RTN","IBC NEUT5",8,0 ) | |
| 11275 | Q | |
| 11276 | "RTN","IBC NEUT5",9,0 ) | |
| 11277 | ; | |
| 11278 | "RTN","IBC NEUT5",10, 0) | |
| 11279 | MSG(MGRP,X MSUB,XMTEX T,FROMFLAG ,XMY) ; S end a Mail Man Messag e | |
| 11280 | "RTN","IBC NEUT5",11, 0) | |
| 11281 | ; | |
| 11282 | "RTN","IBC NEUT5",12, 0) | |
| 11283 | ; Input Parameters | |
| 11284 | "RTN","IBC NEUT5",13, 0) | |
| 11285 | ; MGRP = Mailgrou p Name (op tional) | |
| 11286 | "RTN","IBC NEUT5",14, 0) | |
| 11287 | ; XMSUB = Subject Line (req uired) | |
| 11288 | "RTN","IBC NEUT5",15, 0) | |
| 11289 | ; XMTEX T = Messag e Text Arr ay Name in open form at: "MSG( " (require d) | |
| 11290 | "RTN","IBC NEUT5",16, 0) | |
| 11291 | ; FROMF LAG = Flag indicatin g from who m the mess age is sen t (optiona l) | |
| 11292 | "RTN","IBC NEUT5",17, 0) | |
| 11293 | ; false/und efined: f rom the sp ecific, no n-human eI V user | |
| 11294 | "RTN","IBC NEUT5",18, 0) | |
| 11295 | ; true: f rom the ac tual user (DUZ) | |
| 11296 | "RTN","IBC NEUT5",19, 0) | |
| 11297 | ; XMY = recipient s array; p ass by ref erence (op tional) | |
| 11298 | "RTN","IBC NEUT5",20, 0) | |
| 11299 | ; The possi ble recipi ents are t he sender, the Mail Group in t he | |
| 11300 | "RTN","IBC NEUT5",21, 0) | |
| 11301 | ; first par ameter, an d anybody else alrea dy defined in the XM Y | |
| 11302 | "RTN","IBC NEUT5",22, 0) | |
| 11303 | ; array whe n this par ameter is used. | |
| 11304 | "RTN","IBC NEUT5",23, 0) | |
| 11305 | ; | |
| 11306 | "RTN","IBC NEUT5",24, 0) | |
| 11307 | ; New Mai lMan varia bles and a lso some F ileMan var iables. T he FileMan | |
| 11308 | "RTN","IBC NEUT5",25, 0) | |
| 11309 | ; variabl es are use d and not cleaned up when send ing to ext ernal | |
| 11310 | "RTN","IBC NEUT5",26, 0) | |
| 11311 | ; interne t addresse s. | |
| 11312 | "RTN","IBC NEUT5",27, 0) | |
| 11313 | NEW DIFRO M,XMDUZ,XM DUN,XMZ,XM MG,XMSTRIP ,XMROU,XMY BLOB | |
| 11314 | "RTN","IBC NEUT5",28, 0) | |
| 11315 | NEW D0,D1 ,D2,DG,DIC ,DICR,DISY S,DIW | |
| 11316 | "RTN","IBC NEUT5",29, 0) | |
| 11317 | NEW TMPSU B,TMPTEXT, TMPY,XX | |
| 11318 | "RTN","IBC NEUT5",30, 0) | |
| 11319 | ; | |
| 11320 | "RTN","IBC NEUT5",31, 0) | |
| 11321 | I $G(FROM FLAG),$G(D UZ) S XMDU Z=DUZ | |
| 11322 | "RTN","IBC NEUT5",32, 0) | |
| 11323 | E S XMDU Z="eIV INT ERFACE (IB )" | |
| 11324 | "RTN","IBC NEUT5",33, 0) | |
| 11325 | I $G(MGRP )'="" S XM Y("G."_MGR P)="" | |
| 11326 | "RTN","IBC NEUT5",34, 0) | |
| 11327 | ; If no r ecipients are define d, send to postmaste r | |
| 11328 | "RTN","IBC NEUT5",35, 0) | |
| 11329 | I '$D(XMY ) S XMY(.5 )="" | |
| 11330 | "RTN","IBC NEUT5",36, 0) | |
| 11331 | I $G(DUZ) S XMY(DUZ )="" | |
| 11332 | "RTN","IBC NEUT5",37, 0) | |
| 11333 | ; Store o ff subject , array re ference an d array of recipient s | |
| 11334 | "RTN","IBC NEUT5",38, 0) | |
| 11335 | S TMPSUB= XMSUB,TMPT EXT=XMTEXT | |
| 11336 | "RTN","IBC NEUT5",39, 0) | |
| 11337 | M TMPY=XM Y | |
| 11338 | "RTN","IBC NEUT5",40, 0) | |
| 11339 | D ^XMD | |
| 11340 | "RTN","IBC NEUT5",41, 0) | |
| 11341 | ; | |
| 11342 | "RTN","IBC NEUT5",42, 0) | |
| 11343 | ; Error l ogic | |
| 11344 | "RTN","IBC NEUT5",43, 0) | |
| 11345 | ; If ther e's an err or message and the m essage was not origi nally sent | |
| 11346 | "RTN","IBC NEUT5",44, 0) | |
| 11347 | ; to the postmaster , then sen d a messag e to the p ostmaster with this | |
| 11348 | "RTN","IBC NEUT5",45, 0) | |
| 11349 | ; error m essage. | |
| 11350 | "RTN","IBC NEUT5",46, 0) | |
| 11351 | ; | |
| 11352 | "RTN","IBC NEUT5",47, 0) | |
| 11353 | I $D(XMMG ),'$D(TMPY (.5)) D | |
| 11354 | "RTN","IBC NEUT5",48, 0) | |
| 11355 | . S XMY(. 5)="" | |
| 11356 | "RTN","IBC NEUT5",49, 0) | |
| 11357 | . S XMTEX T=TMPTEXT, XMSUB="Mai lMan Error " | |
| 11358 | "RTN","IBC NEUT5",50, 0) | |
| 11359 | . ; Add X MMG error message as the first line of t he message | |
| 11360 | "RTN","IBC NEUT5",51, 0) | |
| 11361 | . S XX=99 9999 | |
| 11362 | "RTN","IBC NEUT5",52, 0) | |
| 11363 | . F S XX =$O(@(XMTE XT_"XX)"), -1) Q:'XX S @(XMTEX T_"XX+3)") =@(XMTEXT_ "XX)") | |
| 11364 | "RTN","IBC NEUT5",53, 0) | |
| 11365 | . S @(XMT EXT_"1)")= " MailMa n Error: "_XMMG | |
| 11366 | "RTN","IBC NEUT5",54, 0) | |
| 11367 | . S @(XMT EXT_"2)")= "Original Subject: "_TMPSUB | |
| 11368 | "RTN","IBC NEUT5",55, 0) | |
| 11369 | . S @(XMT EXT_"3)")= "------Ori ginal Mess age------" | |
| 11370 | "RTN","IBC NEUT5",56, 0) | |
| 11371 | . D ^XMD | |
| 11372 | "RTN","IBC NEUT5",57, 0) | |
| 11373 | . Q | |
| 11374 | "RTN","IBC NEUT5",58, 0) | |
| 11375 | Q | |
| 11376 | "RTN","IBC NEUT5",59, 0) | |
| 11377 | ; | |
| 11378 | "RTN","IBC NEUT5",60, 0) | |
| 11379 | ; | |
| 11380 | "RTN","IBC NEUT5",61, 0) | |
| 11381 | BFEXIST(DF N,INSNAME) ; Functio n returns 1 if an En tered Ins Buffer Fil e | |
| 11382 | "RTN","IBC NEUT5",62, 0) | |
| 11383 | ; entry e xists with the same DFN and IN SNAME, oth erwise it returns a 0 | |
| 11384 | "RTN","IBC NEUT5",63, 0) | |
| 11385 | ; | |
| 11386 | "RTN","IBC NEUT5",64, 0) | |
| 11387 | ; DFN - P atient DFN | |
| 11388 | "RTN","IBC NEUT5",65, 0) | |
| 11389 | ; INSNAME - Insuran ce Company Name File 36 - Fiel d .01 | |
| 11390 | "RTN","IBC NEUT5",66, 0) | |
| 11391 | ; | |
| 11392 | "RTN","IBC NEUT5",67, 0) | |
| 11393 | NEW EXIST ,IEN | |
| 11394 | "RTN","IBC NEUT5",68, 0) | |
| 11395 | S EXIST=0 | |
| 11396 | "RTN","IBC NEUT5",69, 0) | |
| 11397 | S INSNAME =$$TRIM^XL FSTR(INSNA ME) ; tri mmed | |
| 11398 | "RTN","IBC NEUT5",70, 0) | |
| 11399 | I ('DFN)! (INSNAME=" ") G BFEXI T | |
| 11400 | "RTN","IBC NEUT5",71, 0) | |
| 11401 | ; | |
| 11402 | "RTN","IBC NEUT5",72, 0) | |
| 11403 | S IEN=0 | |
| 11404 | "RTN","IBC NEUT5",73, 0) | |
| 11405 | F S IEN= $O(^IBA(35 5.33,"C",D FN,IEN)) Q :'IEN!EXIS T D | |
| 11406 | "RTN","IBC NEUT5",74, 0) | |
| 11407 | . ; Quit if status is NOT 'E ntered' | |
| 11408 | "RTN","IBC NEUT5",75, 0) | |
| 11409 | . I $P($ G(^IBA(355 .33,IEN,0) ),U,4)'="E " Q | |
| 11410 | "RTN","IBC NEUT5",76, 0) | |
| 11411 | . ; Quit if Ins Bu ffer Ins C o Name (tr immed) is NOT EQUAL to | |
| 11412 | "RTN","IBC NEUT5",77, 0) | |
| 11413 | . ; the Ins Co Na me paramet er (trimme d) | |
| 11414 | "RTN","IBC NEUT5",78, 0) | |
| 11415 | . I $$TR IM^XLFSTR( $P($G(^IBA (355.33,IE N,20)),U)) '=INSNAME Q | |
| 11416 | "RTN","IBC NEUT5",79, 0) | |
| 11417 | . ; Matc h found | |
| 11418 | "RTN","IBC NEUT5",80, 0) | |
| 11419 | . S EXIS T=1 | |
| 11420 | "RTN","IBC NEUT5",81, 0) | |
| 11421 | . Q | |
| 11422 | "RTN","IBC NEUT5",82, 0) | |
| 11423 | BFEXIT ; | |
| 11424 | "RTN","IBC NEUT5",83, 0) | |
| 11425 | Q EXIST | |
| 11426 | "RTN","IBC NEUT5",84, 0) | |
| 11427 | ; | |
| 11428 | "RTN","IBC NEUT5",85, 0) | |
| 11429 | ; | |
| 11430 | "RTN","IBC NEUT5",86, 0) | |
| 11431 | MGRP() ; G et the Mai l Group fo r the eIV Interface - IB Site Parameters (51.04) | |
| 11432 | "RTN","IBC NEUT5",87, 0) | |
| 11433 | Q $$GET1^ DIQ(350.9, "1,",51.04 ,"E") | |
| 11434 | "RTN","IBC NEUT5",88, 0) | |
| 11435 | ; | |
| 11436 | "RTN","IBC NEUT5",89, 0) | |
| 11437 | ; | |
| 11438 | "RTN","IBC NEUT5",90, 0) | |
| 11439 | PYRAPP(APP ,PAYERIEN) ; Get the Payer App lication m ultiple IE N | |
| 11440 | "RTN","IBC NEUT5",91, 0) | |
| 11441 | ; based o n the paye r applicat ion name a nd payer i en. | |
| 11442 | "RTN","IBC NEUT5",92, 0) | |
| 11443 | ; | |
| 11444 | "RTN","IBC NEUT5",93, 0) | |
| 11445 | NEW MIEN, APPIEN,DIS YS | |
| 11446 | "RTN","IBC NEUT5",94, 0) | |
| 11447 | S MIEN="" | |
| 11448 | "RTN","IBC NEUT5",95, 0) | |
| 11449 | S APPIEN= $$FIND1^DI C(365.13,, "X",APP,"B ") | |
| 11450 | "RTN","IBC NEUT5",96, 0) | |
| 11451 | I 'APPIEN G PYRAPPX | |
| 11452 | "RTN","IBC NEUT5",97, 0) | |
| 11453 | I '$G(PAY ERIEN) G P YRAPPX | |
| 11454 | "RTN","IBC NEUT5",98, 0) | |
| 11455 | S MIEN=$O (^IBE(365. 12,PAYERIE N,1,"B",AP PIEN,"")) | |
| 11456 | "RTN","IBC NEUT5",99, 0) | |
| 11457 | PYRAPPX ; | |
| 11458 | "RTN","IBC NEUT5",100 ,0) | |
| 11459 | Q MIEN | |
| 11460 | "RTN","IBC NEUT5",101 ,0) | |
| 11461 | ; | |
| 11462 | "RTN","IBC NEUT5",102 ,0) | |
| 11463 | ; | |
| 11464 | "RTN","IBC NEUT5",103 ,0) | |
| 11465 | ACTAPP(IEN ) ; Active payer app lications | |
| 11466 | "RTN","IBC NEUT5",104 ,0) | |
| 11467 | ; This fu nction wil l return 1 if any of the payer applicati ons for | |
| 11468 | "RTN","IBC NEUT5",105 ,0) | |
| 11469 | ; this pa yer (being passed in by the pa yer IEN) a re NOT dea ctivated. | |
| 11470 | "RTN","IBC NEUT5",106 ,0) | |
| 11471 | ; This sh ould not b e confused with the other paye r applicat ion fields | |
| 11472 | "RTN","IBC NEUT5",107 ,0) | |
| 11473 | ; such as national active or local acti ve. The d eactivated field is | |
| 11474 | "RTN","IBC NEUT5",108 ,0) | |
| 11475 | ; the .11 field in the payer applicatio n multiple . | |
| 11476 | "RTN","IBC NEUT5",109 ,0) | |
| 11477 | ; | |
| 11478 | "RTN","IBC NEUT5",110 ,0) | |
| 11479 | ; This fu nction is invoked by the FileM an data di ctionary a s a screen | |
| 11480 | "RTN","IBC NEUT5",111 ,0) | |
| 11481 | ; for the Payer fie ld (#3.1) in the Ins urance com pany file (#36). | |
| 11482 | "RTN","IBC NEUT5",112 ,0) | |
| 11483 | ; | |
| 11484 | "RTN","IBC NEUT5",113 ,0) | |
| 11485 | NEW APPIE N,ACTAPP,A PPDATA | |
| 11486 | "RTN","IBC NEUT5",114 ,0) | |
| 11487 | S APPIEN= 0,ACTAPP=" ",IEN=+$G( IEN) | |
| 11488 | "RTN","IBC NEUT5",115 ,0) | |
| 11489 | F S APPI EN=$O(^IBE (365.12,IE N,1,APPIEN )) Q:'APPI EN D Q:A CTAPP | |
| 11490 | "RTN","IBC NEUT5",116 ,0) | |
| 11491 | . S APPDA TA=$G(^IBE (365.12,IE N,1,APPIEN ,0)) | |
| 11492 | "RTN","IBC NEUT5",117 ,0) | |
| 11493 | . I $P(AP PDATA,U,11 ) Q | |
| 11494 | "RTN","IBC NEUT5",118 ,0) | |
| 11495 | . I $P(AP PDATA,U,12 ) Q | |
| 11496 | "RTN","IBC NEUT5",119 ,0) | |
| 11497 | . S ACTAP P=1 | |
| 11498 | "RTN","IBC NEUT5",120 ,0) | |
| 11499 | . Q | |
| 11500 | "RTN","IBC NEUT5",121 ,0) | |
| 11501 | Q ACTAPP | |
| 11502 | "RTN","IBC NEUT5",122 ,0) | |
| 11503 | ; | |
| 11504 | "RTN","IBC NEUT5",123 ,0) | |
| 11505 | ADDTQ(DFN, PAYER,SRVD T,FDAYS,EI CDEXT) ; F unction - Returns f lag (0/1) | |
| 11506 | "RTN","IBC NEUT5",124 ,0) | |
| 11507 | ; 1 - TQ File entry can be ad ded as the service d ate for th e patient | |
| 11508 | "RTN","IBC NEUT5",125 ,0) | |
| 11509 | ; and payer >= MAX TQ ser vice date + Freshnes s Days | |
| 11510 | "RTN","IBC NEUT5",126 ,0) | |
| 11511 | ; 0 - oth erwise | |
| 11512 | "RTN","IBC NEUT5",127 ,0) | |
| 11513 | ; | |
| 11514 | "RTN","IBC NEUT5",128 ,0) | |
| 11515 | ; Input: | |
| 11516 | "RTN","IBC NEUT5",129 ,0) | |
| 11517 | ; DFN - Patient DFN (File #2) | |
| 11518 | "RTN","IBC NEUT5",130 ,0) | |
| 11519 | ; PAYER - Payer IE N (File #3 65.12) | |
| 11520 | "RTN","IBC NEUT5",131 ,0) | |
| 11521 | ; SRVDT - Service dt for pot ential TQ entry | |
| 11522 | "RTN","IBC NEUT5",132 ,0) | |
| 11523 | ; FDAYS - Freshnes s Days par am (by ext ract type) | |
| 11524 | "RTN","IBC NEUT5",133 ,0) | |
| 11525 | ; EICDEX T - 1 OR 0 (Is this from the E ICD extrac t?) ;IB*2. 0*621 - Re named para meter to E ICD extrac t | |
| 11526 | "RTN","IBC NEUT5",134 ,0) | |
| 11527 | ; | |
| 11528 | "RTN","IBC NEUT5",135 ,0) | |
| 11529 | N ADDTQ,M AXDT | |
| 11530 | "RTN","IBC NEUT5",136 ,0) | |
| 11531 | ; | |
| 11532 | "RTN","IBC NEUT5",137 ,0) | |
| 11533 | S ADDTQ=1 | |
| 11534 | "RTN","IBC NEUT5",138 ,0) | |
| 11535 | I ($G(DFN )="")!($G( SRVDT)="") !($G(FDAYS )="") S AD DTQ=0 G AD DTQX | |
| 11536 | "RTN","IBC NEUT5",139 ,0) | |
| 11537 | I ($G(EIC DEXT)="")! ($G(PAYER) ="") S ADD TQ=0 G ADD TQX | |
| 11538 | "RTN","IBC NEUT5",140 ,0) | |
| 11539 | ; | |
| 11540 | "RTN","IBC NEUT5",141 ,0) | |
| 11541 | ; MAX TQ Service Da te | |
| 11542 | "RTN","IBC NEUT5",142 ,0) | |
| 11543 | S MAXDT=$ $TQMAXSV(D FN,$G(PAYE R),$G(EICD EXT)) | |
| 11544 | "RTN","IBC NEUT5",143 ,0) | |
| 11545 | I MAXDT=" " G ADDTQX | |
| 11546 | "RTN","IBC NEUT5",144 ,0) | |
| 11547 | ; If Serv ice Date < Max Servi ce Date + Freshness Days, do n ot add | |
| 11548 | "RTN","IBC NEUT5",145 ,0) | |
| 11549 | I SRVDT'> $$FMADD^XL FDT(MAXDT, FDAYS) S A DDTQ=0 | |
| 11550 | "RTN","IBC NEUT5",146 ,0) | |
| 11551 | ; | |
| 11552 | "RTN","IBC NEUT5",147 ,0) | |
| 11553 | ADDTQX ; A DDTQ exit pt | |
| 11554 | "RTN","IBC NEUT5",148 ,0) | |
| 11555 | Q ADDTQ | |
| 11556 | "RTN","IBC NEUT5",149 ,0) | |
| 11557 | ; | |
| 11558 | "RTN","IBC NEUT5",150 ,0) | |
| 11559 | TQUPDSV(DF N,PAYER,SR VDT) ; Upd ate servic e dates & freshness dates for TQ | |
| 11560 | "RTN","IBC NEUT5",151 ,0) | |
| 11561 | ; entries awaiting transmissi on | |
| 11562 | "RTN","IBC NEUT5",152 ,0) | |
| 11563 | ; | |
| 11564 | "RTN","IBC NEUT5",153 ,0) | |
| 11565 | N SVDT,ST S,ERACT,CS RVDT,CSPAN ,SPAN,DA,H L7IEN,RIEN | |
| 11566 | "RTN","IBC NEUT5",154 ,0) | |
| 11567 | ; | |
| 11568 | "RTN","IBC NEUT5",155 ,0) | |
| 11569 | I ($G(DFN )="")!($G( PAYER)="") !($G(SRVDT )="") G TQ UPDSVX | |
| 11570 | "RTN","IBC NEUT5",156 ,0) | |
| 11571 | ; | |
| 11572 | "RTN","IBC NEUT5",157 ,0) | |
| 11573 | ; Loop th ru all inq uiries to be transmi tted to up date the s ervice dat e | |
| 11574 | "RTN","IBC NEUT5",158 ,0) | |
| 11575 | ; Statuse s: Ready to Transmi t(1), Hold (4) and Re try(6) | |
| 11576 | "RTN","IBC NEUT5",159 ,0) | |
| 11577 | S SVDT="" | |
| 11578 | "RTN","IBC NEUT5",160 ,0) | |
| 11579 | F S SVDT =$O(^IBCN( 365.1,"AD" ,DFN,PAYER ,SVDT)) Q: 'SVDT D | |
| 11580 | "RTN","IBC NEUT5",161 ,0) | |
| 11581 | . S DA=0 | |
| 11582 | "RTN","IBC NEUT5",162 ,0) | |
| 11583 | . F S DA =$O(^IBCN( 365.1,"AD" ,DFN,PAYER ,SVDT,DA)) Q:'DA D | |
| 11584 | "RTN","IBC NEUT5",163 ,0) | |
| 11585 | .. ; TQ S tatus | |
| 11586 | "RTN","IBC NEUT5",164 ,0) | |
| 11587 | .. S STS= $P($G(^IBC N(365.1,DA ,0)),U,4) | |
| 11588 | "RTN","IBC NEUT5",165 ,0) | |
| 11589 | .. ; Chec k to see i f record i s still sc heduled to be transm itted. | |
| 11590 | "RTN","IBC NEUT5",166 ,0) | |
| 11591 | .. ; If s o, update the servic e date if the new se rvice date and curre nt | |
| 11592 | "RTN","IBC NEUT5",167 ,0) | |
| 11593 | .. ; serv ice date a re both in the past or future and the ne w service | |
| 11594 | "RTN","IBC NEUT5",168 ,0) | |
| 11595 | .. ; date is closer to Today. Also, if the curre nt service date is i n | |
| 11596 | "RTN","IBC NEUT5",169 ,0) | |
| 11597 | .. ; the future and the new s ervice dat e is in th e past, up date with the | |
| 11598 | "RTN","IBC NEUT5",170 ,0) | |
| 11599 | .. ; new service da te. | |
| 11600 | "RTN","IBC NEUT5",171 ,0) | |
| 11601 | .. ; If n ot Ready t o Transmit (1), Hold( 4) and Ret ry(6), qui t | |
| 11602 | "RTN","IBC NEUT5",172 ,0) | |
| 11603 | .. I STS' =1,STS'=4, STS'=6 Q | |
| 11604 | "RTN","IBC NEUT5",173 ,0) | |
| 11605 | .. ; If H old and la st Respons e returned Error Act ion - Plea se resubmi t | |
| 11606 | "RTN","IBC NEUT5",174 ,0) | |
| 11607 | .. ; Orig inal Trans action (P) - do not update | |
| 11608 | "RTN","IBC NEUT5",175 ,0) | |
| 11609 | .. I STS= 4 S ERACT= "" D I ER ACT="P" Q | |
| 11610 | "RTN","IBC NEUT5",176 ,0) | |
| 11611 | .. . ; La st msg sen t | |
| 11612 | "RTN","IBC NEUT5",177 ,0) | |
| 11613 | .. . S HL 7IEN=$O(^I BCN(365.1, DA,2," "), -1) Q:'HL7 IEN | |
| 11614 | "RTN","IBC NEUT5",178 ,0) | |
| 11615 | .. . ; As soc eIV Re sponse IEN | |
| 11616 | "RTN","IBC NEUT5",179 ,0) | |
| 11617 | .. . S RI EN=$P($G(^ IBCN(365.1 ,DA,2,HL7I EN,0)),U,3 ) Q:'RIEN | |
| 11618 | "RTN","IBC NEUT5",180 ,0) | |
| 11619 | .. . ; Er ror Action IEN (365. 018) | |
| 11620 | "RTN","IBC NEUT5",181 ,0) | |
| 11621 | .. . S ER ACT=$P($G( ^IBCN(365, RIEN,1)),U ,15) Q:'ER ACT | |
| 11622 | "RTN","IBC NEUT5",182 ,0) | |
| 11623 | .. . S ER ACT=$P($G( ^IBE(365.0 18,ERACT,0 )),U,1) | |
| 11624 | "RTN","IBC NEUT5",183 ,0) | |
| 11625 | .. ; | |
| 11626 | "RTN","IBC NEUT5",184 ,0) | |
| 11627 | .. ; Curr ent servic e date for TQ entry | |
| 11628 | "RTN","IBC NEUT5",185 ,0) | |
| 11629 | .. S CSRV DT=$P($G(^ IBCN(365.1 ,DA,0)),U, 12) | |
| 11630 | "RTN","IBC NEUT5",186 ,0) | |
| 11631 | .. ; If c urrent ser vice date is today ( DT), do no t update | |
| 11632 | "RTN","IBC NEUT5",187 ,0) | |
| 11633 | .. I CSRV DT=DT Q | |
| 11634 | "RTN","IBC NEUT5",188 ,0) | |
| 11635 | .. ; If n ew service date is i n the futu re and cur rent servi ce date is in | |
| 11636 | "RTN","IBC NEUT5",189 ,0) | |
| 11637 | .. ; the past, do n ot update | |
| 11638 | "RTN","IBC NEUT5",190 ,0) | |
| 11639 | .. I SRVD T>DT,CSRVD T<DT Q | |
| 11640 | "RTN","IBC NEUT5",191 ,0) | |
| 11641 | .. ; If n ew service date is t oday, upda te | |
| 11642 | "RTN","IBC NEUT5",192 ,0) | |
| 11643 | .. I SRVD T=DT D SAV ETQ^IBCNEU T2(DA,SRVD T),SAVFRSH (DA,+$$FMD IFF^XLFDT( SRVDT,CSRV DT,1)) Q | |
| 11644 | "RTN","IBC NEUT5",193 ,0) | |
| 11645 | .. ; If b oth curren t and new service da tes are in the past or future, | |
| 11646 | "RTN","IBC NEUT5",194 ,0) | |
| 11647 | .. ; only update, w hen new se rvice date is closer to today (DT). | |
| 11648 | "RTN","IBC NEUT5",195 ,0) | |
| 11649 | .. I ((CS RVDT<DT)&( SRVDT<DT)) !((CSRVDT> DT)&(SRVDT >DT)) D Q | |
| 11650 | "RTN","IBC NEUT5",196 ,0) | |
| 11651 | .. . S CS PAN=$$FMDI FF^XLFDT(C SRVDT,DT,1 ),SPAN=$$F MDIFF^XLFD T(SRVDT,DT ,1) | |
| 11652 | "RTN","IBC NEUT5",197 ,0) | |
| 11653 | .. . I CS PAN<0 S CS PAN=-CSPAN | |
| 11654 | "RTN","IBC NEUT5",198 ,0) | |
| 11655 | .. . I SP AN<0 S SPA N=-SPAN | |
| 11656 | "RTN","IBC NEUT5",199 ,0) | |
| 11657 | .. . I SP AN<CSPAN D SAVETQ^IB CNEUT2(DA, SRVDT),SAV FRSH(DA,+$ $FMDIFF^XL FDT(SRVDT, CSRVDT,1)) | |
| 11658 | "RTN","IBC NEUT5",200 ,0) | |
| 11659 | .. ; If n ew service date is i n the past and curre nt service date is i n | |
| 11660 | "RTN","IBC NEUT5",201 ,0) | |
| 11661 | .. ; the future, up date | |
| 11662 | "RTN","IBC NEUT5",202 ,0) | |
| 11663 | .. I SRVD T<CSRVDT D SAVETQ^IB CNEUT2(DA, SRVDT),SAV FRSH(DA,+$ $FMDIFF^XL FDT(SRVDT, CSRVDT,1)) Q | |
| 11664 | "RTN","IBC NEUT5",203 ,0) | |
| 11665 | .. Q | |
| 11666 | "RTN","IBC NEUT5",204 ,0) | |
| 11667 | TQUPDSVX ; TQUPDSV e xit pt | |
| 11668 | "RTN","IBC NEUT5",205 ,0) | |
| 11669 | Q | |
| 11670 | "RTN","IBC NEUT5",206 ,0) | |
| 11671 | ; | |
| 11672 | "RTN","IBC NEUT5",207 ,0) | |
| 11673 | TQMAXSV(DF N,PAYER,EI CDEXT) ; R eturns MAX (TQ Servic e Date) fo r Patient & Payer | |
| 11674 | "RTN","IBC NEUT5",208 ,0) | |
| 11675 | ; Input: | |
| 11676 | "RTN","IBC NEUT5",209 ,0) | |
| 11677 | ; DFN - Patien t DFN (2) | |
| 11678 | "RTN","IBC NEUT5",210 ,0) | |
| 11679 | ; PAYER - Payer IEN (365.1 2) (If no PAYER pass ed in, che ck them al l) | |
| 11680 | "RTN","IBC NEUT5",211 ,0) | |
| 11681 | ; EICDEX T - 1 OR 0 (Is this from the E ICD extrac t?) | |
| 11682 | "RTN","IBC NEUT5",212 ,0) | |
| 11683 | ; | |
| 11684 | "RTN","IBC NEUT5",213 ,0) | |
| 11685 | ; Output: | |
| 11686 | "RTN","IBC NEUT5",214 ,0) | |
| 11687 | ; TQMAXS V - MAX (m ost recent ) service date from TQ entry f or Patient & | |
| 11688 | "RTN","IBC NEUT5",215 ,0) | |
| 11689 | ; Payer | |
| 11690 | "RTN","IBC NEUT5",216 ,0) | |
| 11691 | ; | |
| 11692 | "RTN","IBC NEUT5",217 ,0) | |
| 11693 | ; IB*621 reworked t his functi on to igno re TQ entr ies with s tatuses of | |
| 11694 | "RTN","IBC NEUT5",218 ,0) | |
| 11695 | ; "Respo nse Receiv ed" for EI CD for whi ch the Res ponse indi cated a "C learinghou se Timeout " | |
| 11696 | "RTN","IBC NEUT5",219 ,0) | |
| 11697 | N TQMAXSV | |
| 11698 | "RTN","IBC NEUT5",220 ,0) | |
| 11699 | S TQMAXSV ="" | |
| 11700 | "RTN","IBC NEUT5",221 ,0) | |
| 11701 | I $G(DFN) ="" G TQMA XSVX | |
| 11702 | "RTN","IBC NEUT5",222 ,0) | |
| 11703 | ; | |
| 11704 | "RTN","IBC NEUT5",223 ,0) | |
| 11705 | N ERTXT,I BSKIP,IBTQ S,IENS,LAS TBYP,STATL IST,TQIEN | |
| 11706 | "RTN","IBC NEUT5",224 ,0) | |
| 11707 | ; This is the list of statuse s that are to be ign ored for E ICD extrac t only | |
| 11708 | "RTN","IBC NEUT5",225 ,0) | |
| 11709 | ; 3=Res ponse Rece ived | |
| 11710 | "RTN","IBC NEUT5",226 ,0) | |
| 11711 | S STATLIS T=",3," | |
| 11712 | "RTN","IBC NEUT5",227 ,0) | |
| 11713 | ; | |
| 11714 | "RTN","IBC NEUT5",228 ,0) | |
| 11715 | S LASTBYP ="" | |
| 11716 | "RTN","IBC NEUT5",229 ,0) | |
| 11717 | F S LAST BYP=$O(^IB CN(365.1," AD",DFN,PA YER,LASTBY P)) Q:LAST BYP="" D | |
| 11718 | "RTN","IBC NEUT5",230 ,0) | |
| 11719 | . S TQIEN ="" | |
| 11720 | "RTN","IBC NEUT5",231 ,0) | |
| 11721 | . F S TQ IEN=$O(^IB CN(365.1," AD",DFN,PA YER,LASTBY P,TQIEN)) Q:TQIEN="" D | |
| 11722 | "RTN","IBC NEUT5",232 ,0) | |
| 11723 | .. S IBSK IP=0 | |
| 11724 | "RTN","IBC NEUT5",233 ,0) | |
| 11725 | .. I EICD EXT D Q:I BSKIP | |
| 11726 | "RTN","IBC NEUT5",234 ,0) | |
| 11727 | .. . S IB TQS=+$$GET 1^DIQ(365. 1,TQIEN_", ",.04,"I") ; TQ T ransmissio n Status | |
| 11728 | "RTN","IBC NEUT5",235 ,0) | |
| 11729 | .. . I IB TQS,'($F(S TATLIST,", "_IBTQS_", ")) Q | |
| 11730 | "RTN","IBC NEUT5",236 ,0) | |
| 11731 | .. . S IE NS="1,"_TQ IEN_",",RI EN=$$GET1^ DIQ(365.16 ,IENS,.03, "I") | |
| 11732 | "RTN","IBC NEUT5",237 ,0) | |
| 11733 | .. . S ER TXT=$$GET1 ^DIQ(365,R IEN_",",4. 01) I $$UP ^XLFSTR(ER TXT)["TIME OUT" S IBS KIP=1 ; ke ep looking | |
| 11734 | "RTN","IBC NEUT5",238 ,0) | |
| 11735 | .. I LAST BYP>TQMAXS V S TQMAXS V=LASTBYP | |
| 11736 | "RTN","IBC NEUT5",239 ,0) | |
| 11737 | ; | |
| 11738 | "RTN","IBC NEUT5",240 ,0) | |
| 11739 | TQMAXSVX ; TQMAXSV e xit pt | |
| 11740 | "RTN","IBC NEUT5",241 ,0) | |
| 11741 | Q TQMAXSV | |
| 11742 | "RTN","IBC NEUT5",242 ,0) | |
| 11743 | ; | |
| 11744 | "RTN","IBC NEUT5",243 ,0) | |
| 11745 | SAVFRSH(TQ IEN,DTDIFF ) ; Update TQ freshn ess date b ased on se rvice date diff | |
| 11746 | "RTN","IBC NEUT5",244 ,0) | |
| 11747 | ; | |
| 11748 | "RTN","IBC NEUT5",245 ,0) | |
| 11749 | N DIE,DA, FDT,DR,D,D 0,DI,DIC,D Q,X | |
| 11750 | "RTN","IBC NEUT5",246 ,0) | |
| 11751 | I $G(TQIE N)="" Q | |
| 11752 | "RTN","IBC NEUT5",247 ,0) | |
| 11753 | S FDT=$P( $G(^IBCN(3 65.1,TQIEN ,0)),U,17) | |
| 11754 | "RTN","IBC NEUT5",248 ,0) | |
| 11755 | ; Note - will only update if FDT > 0. | |
| 11756 | "RTN","IBC NEUT5",249 ,0) | |
| 11757 | S FDT=$$F MADD^XLFDT (FDT,+DTDI FF) | |
| 11758 | "RTN","IBC NEUT5",250 ,0) | |
| 11759 | S DIE="^I BCN(365.1, ",DA=TQIEN ,DR=".17// //"_FDT | |
| 11760 | "RTN","IBC NEUT5",251 ,0) | |
| 11761 | D ^DIE | |
| 11762 | "RTN","IBC NEUT5",252 ,0) | |
| 11763 | Q | |
| 11764 | "RTN","IBC NEUT5",253 ,0) | |
| 11765 | ; | |
| 11766 | "RTN","IBJ PI") | |
| 11767 | 0^13^B5411 0191^B4341 8759 | |
| 11768 | "RTN","IBJ PI",1,0) | |
| 11769 | IBJPI ;DAO U/BHS - IB JP eIV SIT E PARAMETE RS SCREEN ;01-APR-20 15 | |
| 11770 | "RTN","IBJ PI",2,0) | |
| 11771 | ;;2.0;INT EGRATED BI LLING;**18 4,271,316, 416,438,47 9,506,528, 549,601,62 1**;21-MAR -94;Build 8 | |
| 11772 | "RTN","IBJ PI",3,0) | |
| 11773 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 11774 | "RTN","IBJ PI",4,0) | |
| 11775 | ; | |
| 11776 | "RTN","IBJ PI",5,0) | |
| 11777 | ; eIV - E lectronic Insurance Verificati on Interfa ce paramet ers | |
| 11778 | "RTN","IBJ PI",6,0) | |
| 11779 | ; | |
| 11780 | "RTN","IBJ PI",7,0) | |
| 11781 | EN ; main entry pt f or IBJP II V SITE PAR AMS | |
| 11782 | "RTN","IBJ PI",8,0) | |
| 11783 | N CTRLCOL ,POP,VALMC NT,VALMHDR ,X,%DT | |
| 11784 | "RTN","IBJ PI",9,0) | |
| 11785 | D EN^VALM ("IBJP IIV SITE PARA METERS") | |
| 11786 | "RTN","IBJ PI",10,0) | |
| 11787 | Q | |
| 11788 | "RTN","IBJ PI",11,0) | |
| 11789 | ; | |
| 11790 | "RTN","IBJ PI",12,0) | |
| 11791 | HDR ; head er | |
| 11792 | "RTN","IBJ PI",13,0) | |
| 11793 | S VALMHDR (1)="Only authorized persons m ay edit th is data." | |
| 11794 | "RTN","IBJ PI",14,0) | |
| 11795 | Q | |
| 11796 | "RTN","IBJ PI",15,0) | |
| 11797 | ; | |
| 11798 | "RTN","IBJ PI",16,0) | |
| 11799 | INIT ; ini t vars & l ist array | |
| 11800 | "RTN","IBJ PI",17,0) | |
| 11801 | K ^TMP($J ,"IBJPI") | |
| 11802 | "RTN","IBJ PI",18,0) | |
| 11803 | ; Kills d ata and vi deo contro l arrays w ith active list | |
| 11804 | "RTN","IBJ PI",19,0) | |
| 11805 | D CLEAN^V ALM10 | |
| 11806 | "RTN","IBJ PI",20,0) | |
| 11807 | D BLD | |
| 11808 | "RTN","IBJ PI",21,0) | |
| 11809 | Q | |
| 11810 | "RTN","IBJ PI",22,0) | |
| 11811 | ; | |
| 11812 | "RTN","IBJ PI",23,0) | |
| 11813 | HELP ; hel p | |
| 11814 | "RTN","IBJ PI",24,0) | |
| 11815 | ; IB*2.0* 601,IB*2.0 *621/DM ad just help text | |
| 11816 | "RTN","IBJ PI",25,0) | |
| 11817 | D FULL^VA LM1 | |
| 11818 | "RTN","IBJ PI",26,0) | |
| 11819 | W @IOF | |
| 11820 | "RTN","IBJ PI",27,0) | |
| 11821 | W !,"This screen di splays all of the eI V Site Par ameters us ed to mana ge the" | |
| 11822 | "RTN","IBJ PI",28,0) | |
| 11823 | W !,"eIV applicatio n used for electroni c Insuranc e Verifica tion." | |
| 11824 | "RTN","IBJ PI",29,0) | |
| 11825 | W !!,"The General P arameters section co ncerns ove rall param eters for" | |
| 11826 | "RTN","IBJ PI",30,0) | |
| 11827 | W !,"moni toring the interface and contr olling eIV communica tion betwe en" | |
| 11828 | "RTN","IBJ PI",31,0) | |
| 11829 | W !,"Vist A and the EC located in Austin ." | |
| 11830 | "RTN","IBJ PI",32,0) | |
| 11831 | W !!,"The Batch Ext racts sect ion concer ns extract -specific parameters " | |
| 11832 | "RTN","IBJ PI",33,0) | |
| 11833 | W !,"incl uding acti ve/inactiv e status a nd selecti on criteri a. Paramet ers" | |
| 11834 | "RTN","IBJ PI",34,0) | |
| 11835 | W !,"asso ciated wit h a specif ic extract may also be detaile d here." | |
| 11836 | "RTN","IBJ PI",35,0) | |
| 11837 | D PAUSE^V ALM1 | |
| 11838 | "RTN","IBJ PI",36,0) | |
| 11839 | W @IOF | |
| 11840 | "RTN","IBJ PI",37,0) | |
| 11841 | S VALMBCK ="R" | |
| 11842 | "RTN","IBJ PI",38,0) | |
| 11843 | Q | |
| 11844 | "RTN","IBJ PI",39,0) | |
| 11845 | ; | |
| 11846 | "RTN","IBJ PI",40,0) | |
| 11847 | EXIT ; exi t | |
| 11848 | "RTN","IBJ PI",41,0) | |
| 11849 | K ^TMP($J ,"IBJPI") | |
| 11850 | "RTN","IBJ PI",42,0) | |
| 11851 | D CLEAN^V ALM10 | |
| 11852 | "RTN","IBJ PI",43,0) | |
| 11853 | Q | |
| 11854 | "RTN","IBJ PI",44,0) | |
| 11855 | ; | |
| 11856 | "RTN","IBJ PI",45,0) | |
| 11857 | BLD ; Crea tes the bo dy of the worklist | |
| 11858 | "RTN","IBJ PI",46,0) | |
| 11859 | ; IB*2.0* 549 - rewr ote this e ntire meth od and all methods c alled from it to | |
| 11860 | "RTN","IBJ PI",47,0) | |
| 11861 | ; chan ge to a to tally new display of fields | |
| 11862 | "RTN","IBJ PI",48,0) | |
| 11863 | N ELINEL, ELINER,SLI NE,STARTR | |
| 11864 | "RTN","IBJ PI",49,0) | |
| 11865 | S VALMCNT =0,SLINE=1 | |
| 11866 | "RTN","IBJ PI",50,0) | |
| 11867 | D BLDGENE (SLINE,.EL INEL) ; Build Edit able Gener al Paramet ers | |
| 11868 | "RTN","IBJ PI",51,0) | |
| 11869 | D BLDGENN L(ELINEL,. STARTR,.EL INEL) ; Build Non- Editable G en Param l eft | |
| 11870 | "RTN","IBJ PI",52,0) | |
| 11871 | D BLDGENN R(STARTR,. ELINER) ; Build Non- Editable G en Param R ight | |
| 11872 | "RTN","IBJ PI",53,0) | |
| 11873 | S SLINE=$ S(ELINEL>E LINER:ELIN EL,1:ELINE R) | |
| 11874 | "RTN","IBJ PI",54,0) | |
| 11875 | D BLDGENN B(SLINE,.E LINEL) ; Build Non- Editable B ottom Para ms | |
| 11876 | "RTN","IBJ PI",55,0) | |
| 11877 | D BLDBE(E LINEL,.ELI NEL) ; Build Batc h Extract Gen Parame ters | |
| 11878 | "RTN","IBJ PI",56,0) | |
| 11879 | S VALMCNT =ELINEL-1 | |
| 11880 | "RTN","IBJ PI",57,0) | |
| 11881 | Q | |
| 11882 | "RTN","IBJ PI",58,0) | |
| 11883 | ; | |
| 11884 | "RTN","IBJ PI",59,0) | |
| 11885 | BLDGENE(SL INE,ELINE) ; Build t he General Editable Parameters Section | |
| 11886 | "RTN","IBJ PI",60,0) | |
| 11887 | ; Input: SLINE - Starting Section L ine Number | |
| 11888 | "RTN","IBJ PI",61,0) | |
| 11889 | ; ELINE - Current Ending Sec tion Line Number | |
| 11890 | "RTN","IBJ PI",62,0) | |
| 11891 | ; Output: ELINE - Updated Ending Sec tion Line Number | |
| 11892 | "RTN","IBJ PI",63,0) | |
| 11893 | ; | |
| 11894 | "RTN","IBJ PI",64,0) | |
| 11895 | ; IB*2.0* 621/DM adj usted this area to g et SSVI pa rameters o n the same line | |
| 11896 | "RTN","IBJ PI",65,0) | |
| 11897 | N XX | |
| 11898 | "RTN","IBJ PI",66,0) | |
| 11899 | S ELINE=$ $SETN("Gen eral Param eters (edi table)",SL INE,1,1) | |
| 11900 | "RTN","IBJ PI",67,0) | |
| 11901 | S ELINE=$ $SET(" Medi care Payer : ",$$GET1 ^DIQ(350.9 ,"1,",51.2 5),ELINE,1 ) | |
| 11902 | "RTN","IBJ PI",68,0) | |
| 11903 | S ELINE=$ $SET(" HMS Directory : ",$$GET1 ^DIQ(350.9 ,"1,",13.0 1),ELINE,1 ) | |
| 11904 | "RTN","IBJ PI",69,0) | |
| 11905 | S ELINE=$ $SET(" EII Active : ",$$GET1 ^DIQ(350.9 ,"1,",13.0 2),ELINE,1 ) | |
| 11906 | "RTN","IBJ PI",70,0) | |
| 11907 | ; | |
| 11908 | "RTN","IBJ PI",71,0) | |
| 11909 | S XX=$$GE T1^DIQ(350 .9,"1,",10 0,"I"),XX= $S(XX:"YES ",1:"NO") | |
| 11910 | "RTN","IBJ PI",72,0) | |
| 11911 | S ELINE=$ $SET(" SS VI Enabled : ",XX,ELI NE,1) ; IB*2*528/ baa | |
| 11912 | "RTN","IBJ PI",73,0) | |
| 11913 | S XX=$$GE T1^DIQ(350 .9,"1,",10 3,"I") | |
| 11914 | "RTN","IBJ PI",74,0) | |
| 11915 | S ELINE=$ $SET("Days to retain SSVI data : ",XX,ELI NE-1,38) ; IB*2*528/ baa | |
| 11916 | "RTN","IBJ PI",75,0) | |
| 11917 | Q | |
| 11918 | "RTN","IBJ PI",76,0) | |
| 11919 | ; | |
| 11920 | "RTN","IBJ PI",77,0) | |
| 11921 | BLDGENNL(S LINE,START R,ELINE) ; Build the Left port ion of the General | |
| 11922 | "RTN","IBJ PI",78,0) | |
| 11923 | ; Non-Edi table Para meters Sec tion | |
| 11924 | "RTN","IBJ PI",79,0) | |
| 11925 | ; Input: SLINE - Starting Section L ine Number | |
| 11926 | "RTN","IBJ PI",80,0) | |
| 11927 | ; ELINE - Current Ending Sec tion Line Number | |
| 11928 | "RTN","IBJ PI",81,0) | |
| 11929 | ; Output: STARTR - Line to start disp laying Gen eral Non-E ditable Ri ght | |
| 11930 | "RTN","IBJ PI",82,0) | |
| 11931 | ; Section | |
| 11932 | "RTN","IBJ PI",83,0) | |
| 11933 | ; ELINE - Updated Ending Sec tion Line Number | |
| 11934 | "RTN","IBJ PI",84,0) | |
| 11935 | ; | |
| 11936 | "RTN","IBJ PI",85,0) | |
| 11937 | N XX | |
| 11938 | "RTN","IBJ PI",86,0) | |
| 11939 | S ELINE=$ $SET("",$J ("",40),SL INE,1) ; Spacing Bl ank Line | |
| 11940 | "RTN","IBJ PI",87,0) | |
| 11941 | S ELINE=$ $SETN("Gen eral Param eters (non -editable) ",ELINE,1, 1) | |
| 11942 | "RTN","IBJ PI",88,0) | |
| 11943 | S STARTR= ELINE ; Start of R ight Secti on | |
| 11944 | "RTN","IBJ PI",89,0) | |
| 11945 | S ELINE=$ $SET(" Fres hness Days : ",$$GET1 ^DIQ(350.9 ,"1,",51.0 1),ELINE,1 ) | |
| 11946 | "RTN","IBJ PI",90,0) | |
| 11947 | S ELINE=$ $SET(" Ti meout Days : ",$$GET1 ^DIQ(350.9 ,"1,",51.0 5),ELINE,1 ) | |
| 11948 | "RTN","IBJ PI",91,0) | |
| 11949 | S ELINE=$ $SET(" Timeout M ailman Msg : ",$$GET1 ^DIQ(350.9 ,"1,",51.0 7),ELINE,1 ) | |
| 11950 | "RTN","IBJ PI",92,0) | |
| 11951 | S ELINE=$ $SET(" D efault STC : ",$$GET1 ^DIQ(350.9 ,"1,",60.0 1),ELINE,1 ) | |
| 11952 | "RTN","IBJ PI",93,0) | |
| 11953 | S ELINE=$ $SET(" Ma ster Switc h Realtime : ",$$GET1 ^DIQ(350.9 ,"1,",51.2 7),ELINE,1 ) | |
| 11954 | "RTN","IBJ PI",94,0) | |
| 11955 | S ELINE=$ $SET(" CMS MBI Payer : ",$$GET1 ^DIQ(350.9 ,"1,","MBI PAYER"),E LINE,1) ; IB*2.0*601 /DM | |
| 11956 | "RTN","IBJ PI",95,0) | |
| 11957 | S ELINE=$ $SET(" EICD Payer : ",$$GET1 ^DIQ(350.9 ,"1,","EIC D PAYER"), ELINE,1) ; IB*2.0*62 1/DM | |
| 11958 | "RTN","IBJ PI",96,0) | |
| 11959 | Q | |
| 11960 | "RTN","IBJ PI",97,0) | |
| 11961 | ; | |
| 11962 | "RTN","IBJ PI",98,0) | |
| 11963 | BLDGENNR(S LINE,ELINE ) ; Build the Right portion of the Gener al | |
| 11964 | "RTN","IBJ PI",99,0) | |
| 11965 | ; Non-Edi table Para meters Sec tion | |
| 11966 | "RTN","IBJ PI",100,0) | |
| 11967 | ; Input: SLINE - Starting Section L ine Number | |
| 11968 | "RTN","IBJ PI",101,0) | |
| 11969 | ; ELINE - Current Ending Sec tion Line Number | |
| 11970 | "RTN","IBJ PI",102,0) | |
| 11971 | ; Output: ELINE - Updated Ending Sec tion Line Number | |
| 11972 | "RTN","IBJ PI",103,0) | |
| 11973 | ; | |
| 11974 | "RTN","IBJ PI",104,0) | |
| 11975 | S ELINE=S LINE | |
| 11976 | "RTN","IBJ PI",105,0) | |
| 11977 | S ELINE=$ $SET(" H L7 Maximum Number: " ,$$GET1^DI Q(350.9,"1 ,",51.15), ELINE,41) | |
| 11978 | "RTN","IBJ PI",106,0) | |
| 11979 | S ELINE=$ $SET(" Ret ry Flag: " ,$$GET1^DI Q(350.9,"1 ,",51.26), ELINE,41) | |
| 11980 | "RTN","IBJ PI",107,0) | |
| 11981 | S ELINE=$ $SET(" Number of Retries: " ,$$GET1^DI Q(350.9,"1 ,",51.06), ELINE,41) | |
| 11982 | "RTN","IBJ PI",108,0) | |
| 11983 | S ELINE=$ $SET(" Mai l Group: " ,$$MGRP^IB CNEUT5,ELI NE,41) | |
| 11984 | "RTN","IBJ PI",109,0) | |
| 11985 | S ELINE=$ $SET("Mast er Switch Nightly: " ,$$GET1^DI Q(350.9,"1 ,",51.28), ELINE,41) | |
| 11986 | "RTN","IBJ PI",110,0) | |
| 11987 | Q | |
| 11988 | "RTN","IBJ PI",111,0) | |
| 11989 | ; | |
| 11990 | "RTN","IBJ PI",112,0) | |
| 11991 | BLDGENNB(S LINE,ELINE ) ; Build the Genera l Non-Edit able Botto m Paramete rs Section | |
| 11992 | "RTN","IBJ PI",113,0) | |
| 11993 | ; Input: SLINE - Starting Section L ine Number | |
| 11994 | "RTN","IBJ PI",114,0) | |
| 11995 | ; ELINE - Current Ending Sec tion Line Number | |
| 11996 | "RTN","IBJ PI",115,0) | |
| 11997 | ; Output: ELINE - Updated Ending Sec tion Line Number | |
| 11998 | "RTN","IBJ PI",116,0) | |
| 11999 | ; | |
| 12000 | "RTN","IBJ PI",117,0) | |
| 12001 | N XX | |
| 12002 | "RTN","IBJ PI",118,0) | |
| 12003 | S ELINE=$ $SET("",$J ("",40),SL INE,1) ; Spacing Bl ank Line | |
| 12004 | "RTN","IBJ PI",119,0) | |
| 12005 | S XX=$$GE T1^DIQ(350 .9,"1,",51 .2) | |
| 12006 | "RTN","IBJ PI",120,0) | |
| 12007 | S:XX="" X X="NO" | |
| 12008 | "RTN","IBJ PI",121,0) | |
| 12009 | S ELINE=$ $SET("Send MailMan M essage if Communicat ion Proble m: ",XX,EL INE,1) | |
| 12010 | "RTN","IBJ PI",122,0) | |
| 12011 | S XX=$$GE T1^DIQ(350 .9,"1,",51 .02) | |
| 12012 | "RTN","IBJ PI",123,0) | |
| 12013 | S:XX="" X X="NO" | |
| 12014 | "RTN","IBJ PI",124,0) | |
| 12015 | S XX=$$GE T1^DIQ(350 .9,"1,",51 .02)_" at "_$$GET1^D IQ(350.9," 1,",51.03) | |
| 12016 | "RTN","IBJ PI",125,0) | |
| 12017 | S ELINE=$ $SET(" R eceive Mai lMan Messa ge, Daily Statistica l: ",XX,EL INE,1) | |
| 12018 | "RTN","IBJ PI",126,0) | |
| 12019 | Q | |
| 12020 | "RTN","IBJ PI",127,0) | |
| 12021 | ; | |
| 12022 | "RTN","IBJ PI",128,0) | |
| 12023 | BLDBE(SLIN E,ELINE) ; Build the Batch Ext ract Param eters Sect ion | |
| 12024 | "RTN","IBJ PI",129,0) | |
| 12025 | ; Input: SLINE - Starting Section L ine Number | |
| 12026 | "RTN","IBJ PI",130,0) | |
| 12027 | ; ELINE - Current Ending Sec tion Line Number | |
| 12028 | "RTN","IBJ PI",131,0) | |
| 12029 | ; Output: ELINE - Updated Ending Sec tion Line Number | |
| 12030 | "RTN","IBJ PI",132,0) | |
| 12031 | ; | |
| 12032 | "RTN","IBJ PI",133,0) | |
| 12033 | N IBEX,IB EX1,IBEX2, IBEX3,IBII VB,IBST,IE N | |
| 12034 | "RTN","IBJ PI",134,0) | |
| 12035 | S ELINE=$ $SET("",$J ("",40),EL INE,1) ; Spacing Bl ank Line | |
| 12036 | "RTN","IBJ PI",135,0) | |
| 12037 | S ELINE=$ $SETN("Bat ch Extract s",ELINE,1 ,1) | |
| 12038 | "RTN","IBJ PI",136,0) | |
| 12039 | S ELINE=$ $SET(" Ext ract S election Maximum # to","",E LINE,1) | |
| 12040 | "RTN","IBJ PI",137,0) | |
| 12041 | S ELINE=$ $SETN("Nam e On/Off C riteria Extract/ Day",ELINE ,1,"",1) | |
| 12042 | "RTN","IBJ PI",138,0) | |
| 12043 | ; | |
| 12044 | "RTN","IBJ PI",139,0) | |
| 12045 | ; Loop th ru extract s | |
| 12046 | "RTN","IBJ PI",140,0) | |
| 12047 | S IEN=0 | |
| 12048 | "RTN","IBJ PI",141,0) | |
| 12049 | F D Q:' IEN | |
| 12050 | "RTN","IBJ PI",142,0) | |
| 12051 | . S IEN=$ O(^IBE(350 .9,1,51.17 ,IEN)) | |
| 12052 | "RTN","IBJ PI",143,0) | |
| 12053 | . Q:'IEN | |
| 12054 | "RTN","IBJ PI",144,0) | |
| 12055 | . S IBIIV B=$G(^IBE( 350.9,1,51 .17,IEN,0) ) ; Batch Extr act multip le line | |
| 12056 | "RTN","IBJ PI",145,0) | |
| 12057 | . S IBEX= +$P(IBIIVB ,"^",1) ; Type | |
| 12058 | "RTN","IBJ PI",146,0) | |
| 12059 | . Q:'$F(" .1.2.","." _IBEX_".") | |
| 12060 | "RTN","IBJ PI",147,0) | |
| 12061 | . S IBST= $$FO^IBCNE UT1($S($P( IBIIVB,"^" ,1)'="":$$ GET1^DIQ(3 50.9002,IE N_",1,",.0 1,"E"),1:" "),14) | |
| 12062 | "RTN","IBJ PI",148,0) | |
| 12063 | . S IBST= IBST_$$FO^ IBCNEUT1($ S(+$P(IBII VB,"^",2): "ON",1:"OF F"),9) | |
| 12064 | "RTN","IBJ PI",149,0) | |
| 12065 | . S IBEX1 =$S(+$P(IB IIVB,U,3)' =0:+$P(IBI IVB,"^",3) ,1:$P(IBII VB,"^",3)) | |
| 12066 | "RTN","IBJ PI",150,0) | |
| 12067 | . S IBEX2 =$S(+$P(IB IIVB,U,4)' =0:+$P(IBI IVB,"^",4) ,1:$P(IBII VB,"^",4)) | |
| 12068 | "RTN","IBJ PI",151,0) | |
| 12069 | . S IBST= IBST_$$FO^ IBCNEUT1($ S(IBEX=1:" n/a",IBEX= 2:IBEX1,IB EX=3:IBEX1 _"/"_IBEX2 ,1:"ERROR" ),13) | |
| 12070 | "RTN","IBJ PI",152,0) | |
| 12071 | . S IBST= IBST_$$FO^ IBCNEUT1($ S(+$P(IBII VB,"^",5): +$P(IBIIVB ,"^",5),1: $P(IBIIVB, "^",5)),14 ) | |
| 12072 | "RTN","IBJ PI",153,0) | |
| 12073 | . S ELINE =$$SET(IBS T,"",ELINE ,1) | |
| 12074 | "RTN","IBJ PI",154,0) | |
| 12075 | ; IB*2.0* 621/DM dis play EICD extract (# 4), eventu ally, othe r extracts will migr ate to thi s structur e | |
| 12076 | "RTN","IBJ PI",155,0) | |
| 12077 | S ELINE=$ $SET("",$J ("",40),EL INE,1) ; Spacing Bl ank Line | |
| 12078 | "RTN","IBJ PI",156,0) | |
| 12079 | S ELINE=$ $SET("",$J ("",40),EL INE,1) ; Spacing Bl ank Line | |
| 12080 | "RTN","IBJ PI",157,0) | |
| 12081 | S ELINE=$ $SET(" Ext ract S tart Days Days Aft er Maximum # to","", ELINE,1) | |
| 12082 | "RTN","IBJ PI",158,0) | |
| 12083 | S ELINE=$ $SETN("Nam e On/Off F rom Today Start Freq. Extract /Day",ELIN E,1,"",1) | |
| 12084 | "RTN","IBJ PI",159,0) | |
| 12085 | I $$GET1^ DIQ(350.90 02,"4,1,", .01)="EICD " D | |
| 12086 | "RTN","IBJ PI",160,0) | |
| 12087 | . S IBEX= $$SETTINGS ^IBCNEDE7( 4) ; colle ct EICD pa rameters | |
| 12088 | "RTN","IBJ PI",161,0) | |
| 12089 | . S IBST= $$FO^IBCNE UT1("EICD" ,14) | |
| 12090 | "RTN","IBJ PI",162,0) | |
| 12091 | . S IBST= IBST_$$FO^ IBCNEUT1($ S(+IBEX:"O N",1:"OFF" ),9) | |
| 12092 | "RTN","IBJ PI",163,0) | |
| 12093 | . S IBST= IBST_$$FO^ IBCNEUT1(+ $P(IBEX,"^ ",6),13) ; Start Day s | |
| 12094 | "RTN","IBJ PI",164,0) | |
| 12095 | . S IBST= IBST_$$FO^ IBCNEUT1(+ $P(IBEX,"^ ",7),13) ; Days Afte r | |
| 12096 | "RTN","IBJ PI",165,0) | |
| 12097 | . S IBST= IBST_$$FO^ IBCNEUT1(+ $P(IBEX,"^ ",8),8) ; Frequency | |
| 12098 | "RTN","IBJ PI",166,0) | |
| 12099 | . S IBST= IBST_$$FO^ IBCNEUT1(+ $P(IBEX,"^ ",4),8) ; Max extrac t | |
| 12100 | "RTN","IBJ PI",167,0) | |
| 12101 | . S ELINE =$$SET(IBS T,"",ELINE ,1) | |
| 12102 | "RTN","IBJ PI",168,0) | |
| 12103 | Q | |
| 12104 | "RTN","IBJ PI",169,0) | |
| 12105 | ; | |
| 12106 | "RTN","IBJ PI",170,0) | |
| 12107 | SET(LABEL, DATA,LINE, COL) ; Set s text int o the body of the wo rklist | |
| 12108 | "RTN","IBJ PI",171,0) | |
| 12109 | ; Input: LABEL - Label te xt to set into the l ine | |
| 12110 | "RTN","IBJ PI",172,0) | |
| 12111 | ; DATA - Field Da ta to set into the l ine | |
| 12112 | "RTN","IBJ PI",173,0) | |
| 12113 | ; LINE - Line to set LABEL and DATA i nto | |
| 12114 | "RTN","IBJ PI",174,0) | |
| 12115 | ; COL - Starting column po sition in LINE to in sert | |
| 12116 | "RTN","IBJ PI",175,0) | |
| 12117 | ; LABEL_DA TA text | |
| 12118 | "RTN","IBJ PI",176,0) | |
| 12119 | ; Returns : LINE - Updated Line by 1 | |
| 12120 | "RTN","IBJ PI",177,0) | |
| 12121 | ; | |
| 12122 | "RTN","IBJ PI",178,0) | |
| 12123 | N IBY | |
| 12124 | "RTN","IBJ PI",179,0) | |
| 12125 | S IBY=LAB EL_DATA | |
| 12126 | "RTN","IBJ PI",180,0) | |
| 12127 | D SET1(IB Y,LINE,COL ,$L(IBY)) | |
| 12128 | "RTN","IBJ PI",181,0) | |
| 12129 | S LINE=LI NE+1 | |
| 12130 | "RTN","IBJ PI",182,0) | |
| 12131 | Q LINE | |
| 12132 | "RTN","IBJ PI",183,0) | |
| 12133 | ; | |
| 12134 | "RTN","IBJ PI",184,0) | |
| 12135 | SETN(TITLE ,LINE,COL, RV,ULINE) ; Sets a f ield Secti on title i nto the bo dy of the worklist | |
| 12136 | "RTN","IBJ PI",185,0) | |
| 12137 | ; Input: TITLE - Text to be used fo r the fiel d Section Title | |
| 12138 | "RTN","IBJ PI",186,0) | |
| 12139 | ; LINE - Line num ber in the body to i nsert the field sect ion title | |
| 12140 | "RTN","IBJ PI",187,0) | |
| 12141 | ; COL - Starting Column po sition to set Sectio n Title in to | |
| 12142 | "RTN","IBJ PI",188,0) | |
| 12143 | ; RV - 1 - Set Reverse Vi deo, 0 or null don't use Rever se Video | |
| 12144 | "RTN","IBJ PI",189,0) | |
| 12145 | ; Opti onal, defa ults to "" | |
| 12146 | "RTN","IBJ PI",190,0) | |
| 12147 | ; ULINE - 1 - Set Underline, 0 or null don't use underline | |
| 12148 | "RTN","IBJ PI",191,0) | |
| 12149 | ; Opti onal, defa ults to "" | |
| 12150 | "RTN","IBJ PI",192,0) | |
| 12151 | ; Returns : LINE - Line num ber increa sed by 1 | |
| 12152 | "RTN","IBJ PI",193,0) | |
| 12153 | ; | |
| 12154 | "RTN","IBJ PI",194,0) | |
| 12155 | N IBY | |
| 12156 | "RTN","IBJ PI",195,0) | |
| 12157 | S IBY=" " _TITLE_" " | |
| 12158 | "RTN","IBJ PI",196,0) | |
| 12159 | D SET1(IB Y,LINE,COL ,$L(IBY),$ G(RV),$G(U LINE)) | |
| 12160 | "RTN","IBJ PI",197,0) | |
| 12161 | S LINE=LI NE+1 | |
| 12162 | "RTN","IBJ PI",198,0) | |
| 12163 | Q LINE | |
| 12164 | "RTN","IBJ PI",199,0) | |
| 12165 | ; | |
| 12166 | "RTN","IBJ PI",200,0) | |
| 12167 | SET1(TEXT, LINE,COL,W IDTH,RV,UL INE) ; Set s the TMP array with body data | |
| 12168 | "RTN","IBJ PI",201,0) | |
| 12169 | ; Input: TEXT - Text t o be set i nto the sp ecified li ne | |
| 12170 | "RTN","IBJ PI",202,0) | |
| 12171 | ; LINE - Line t o set TEXT into | |
| 12172 | "RTN","IBJ PI",203,0) | |
| 12173 | ; COL - Column of LINE t o set TEXT into | |
| 12174 | "RTN","IBJ PI",204,0) | |
| 12175 | ; WIDTH - Width of the TEX T being se t into lin e | |
| 12176 | "RTN","IBJ PI",205,0) | |
| 12177 | ; RV - 1 - Se t Reverse Video, 0 o r null don 't use | |
| 12178 | "RTN","IBJ PI",206,0) | |
| 12179 | ; Re verse Vide o | |
| 12180 | "RTN","IBJ PI",207,0) | |
| 12181 | ; Option al, defaul ts to "" | |
| 12182 | "RTN","IBJ PI",208,0) | |
| 12183 | ; ULINE - 1 - Se t Underlin e, 0 or nu ll don't u se | |
| 12184 | "RTN","IBJ PI",209,0) | |
| 12185 | ; Un derline | |
| 12186 | "RTN","IBJ PI",210,0) | |
| 12187 | ; Option al, defaul ts to "" | |
| 12188 | "RTN","IBJ PI",211,0) | |
| 12189 | ; ^TMP($J, "IBJPI") - Current ^TMP arra y | |
| 12190 | "RTN","IBJ PI",212,0) | |
| 12191 | ; Output: ^TMP($J, "IBJPI") - Updated ^TMP arra y | |
| 12192 | "RTN","IBJ PI",213,0) | |
| 12193 | ; | |
| 12194 | "RTN","IBJ PI",214,0) | |
| 12195 | N IBX | |
| 12196 | "RTN","IBJ PI",215,0) | |
| 12197 | S IBX=$G( ^TMP($J,"I BJPI",LINE ,0)) | |
| 12198 | "RTN","IBJ PI",216,0) | |
| 12199 | S IBX=$$S ETSTR^VALM 1(TEXT,IBX ,COL,WIDTH ) | |
| 12200 | "RTN","IBJ PI",217,0) | |
| 12201 | D SET^VAL M10(LINE,I BX) | |
| 12202 | "RTN","IBJ PI",218,0) | |
| 12203 | D:$G(RV)' ="" CNTRL^ VALM10(LIN E,COL,WIDT H,IORVON,I ORVOFF) | |
| 12204 | "RTN","IBJ PI",219,0) | |
| 12205 | D:$G(ULIN E)'="" CNT RL^VALM10( LINE,COL,W IDTH,IOUON ,IOUOFF) | |
| 12206 | "RTN","IBJ PI",220,0) | |
| 12207 | Q | |
| 12208 | "RTN","IBJ PI",221,0) | |
| 12209 | ; | |
| 12210 | "RTN","IBY 621PO") | |
| 12211 | 0^14^B1684 7703^n/a | |
| 12212 | "RTN","IBY 621PO",1,0 ) | |
| 12213 | IBY621PO ; AITC/DM - Post-Insta llation fo r IB patch 621; 22-M AY-2018 | |
| 12214 | "RTN","IBY 621PO",2,0 ) | |
| 12215 | ;;2.0;INT EGRATED BI LLING;**62 1**;21-MAR -94;Build 8 | |
| 12216 | "RTN","IBY 621PO",3,0 ) | |
| 12217 | ;;Per VA Directive 6402, this routine s hould not be modifie d. | |
| 12218 | "RTN","IBY 621PO",4,0 ) | |
| 12219 | ; | |
| 12220 | "RTN","IBY 621PO",5,0 ) | |
| 12221 | POST ; POS T ROUTINE( S) | |
| 12222 | "RTN","IBY 621PO",6,0 ) | |
| 12223 | N IBXPD,X PDIDTOT | |
| 12224 | "RTN","IBY 621PO",7,0 ) | |
| 12225 | S XPDIDTO T=3 | |
| 12226 | "RTN","IBY 621PO",8,0 ) | |
| 12227 | ; | |
| 12228 | "RTN","IBY 621PO",9,0 ) | |
| 12229 | ; Create/ update the EICD extr act | |
| 12230 | "RTN","IBY 621PO",10, 0) | |
| 12231 | D CHKEICD (1) | |
| 12232 | "RTN","IBY 621PO",11, 0) | |
| 12233 | ; | |
| 12234 | "RTN","IBY 621PO",12, 0) | |
| 12235 | ; Send si te registr ation mess age to FSC | |
| 12236 | "RTN","IBY 621PO",13, 0) | |
| 12237 | D REGMSG( 2) | |
| 12238 | "RTN","IBY 621PO",14, 0) | |
| 12239 | ; | |
| 12240 | "RTN","IBY 621PO",15, 0) | |
| 12241 | ; Check/r emove any link from an insuran ce to the National E ICD Payer | |
| 12242 | "RTN","IBY 621PO",16, 0) | |
| 12243 | D CHKLNK( 3) | |
| 12244 | "RTN","IBY 621PO",17, 0) | |
| 12245 | ; | |
| 12246 | "RTN","IBY 621PO",18, 0) | |
| 12247 | ; Display s the 'Don e' message and finis hes the pr ogress bar | |
| 12248 | "RTN","IBY 621PO",19, 0) | |
| 12249 | D MES^XPD UTL("") | |
| 12250 | "RTN","IBY 621PO",20, 0) | |
| 12251 | D MES^XPD UTL("POST- Install Co mpleted.") | |
| 12252 | "RTN","IBY 621PO",21, 0) | |
| 12253 | Q | |
| 12254 | "RTN","IBY 621PO",22, 0) | |
| 12255 | ; | |
| 12256 | "RTN","IBY 621PO",23, 0) | |
| 12257 | REGMSG(IBX PD) ; send site regi stration m essage to FSC | |
| 12258 | "RTN","IBY 621PO",24, 0) | |
| 12259 | D BMES^XP DUTL(" STE P "_IBXPD_ " of "_XPD IDTOT) | |
| 12260 | "RTN","IBY 621PO",25, 0) | |
| 12261 | D MES^XPD UTL("----- --------") | |
| 12262 | "RTN","IBY 621PO",26, 0) | |
| 12263 | D MES^XPD UTL("Sendi ng site re gistration message t o FSC ... ") | |
| 12264 | "RTN","IBY 621PO",27, 0) | |
| 12265 | ; | |
| 12266 | "RTN","IBY 621PO",28, 0) | |
| 12267 | I '$$PROD ^XUPROD(1) D MES^XPD UTL(" N/A - Not a pr oduction a ccount - N o site reg istration message se nt") G REG MSGQ | |
| 12268 | "RTN","IBY 621PO",29, 0) | |
| 12269 | D MES^XPD UTL("Sendi ng site re gistration message t o FSC ... ") | |
| 12270 | "RTN","IBY 621PO",30, 0) | |
| 12271 | D ^IBCNEH LM | |
| 12272 | "RTN","IBY 621PO",31, 0) | |
| 12273 | ; | |
| 12274 | "RTN","IBY 621PO",32, 0) | |
| 12275 | REGMSGQ ; | |
| 12276 | "RTN","IBY 621PO",33, 0) | |
| 12277 | Q | |
| 12278 | "RTN","IBY 621PO",34, 0) | |
| 12279 | ; | |
| 12280 | "RTN","IBY 621PO",35, 0) | |
| 12281 | CHKLNK(IBX PD) ; Due to a timin g issue wi th the Nat ional EICD Payer | |
| 12282 | "RTN","IBY 621PO",36, 0) | |
| 12283 | ;It's pos sible that a client linked an insurance to the EIC D payer | |
| 12284 | "RTN","IBY 621PO",37, 0) | |
| 12285 | ;This is not allowe d. Any suc h link wil l be remov ed | |
| 12286 | "RTN","IBY 621PO",38, 0) | |
| 12287 | N IBEICDP Y,IBIEN | |
| 12288 | "RTN","IBY 621PO",39, 0) | |
| 12289 | D BMES^XP DUTL(" STE P "_IBXPD_ " of "_XPD IDTOT) | |
| 12290 | "RTN","IBY 621PO",40, 0) | |
| 12291 | D MES^XPD UTL("----- --------") | |
| 12292 | "RTN","IBY 621PO",41, 0) | |
| 12293 | D MES^XPD UTL("Verif ying Insur ance links to payers ...") | |
| 12294 | "RTN","IBY 621PO",42, 0) | |
| 12295 | ; | |
| 12296 | "RTN","IBY 621PO",43, 0) | |
| 12297 | S IBEICDP Y=0 | |
| 12298 | "RTN","IBY 621PO",44, 0) | |
| 12299 | S IBEICDP Y=$O(^IBE( 365.12,"B" ,"ELECTRON IC COVERAG E DISCOVER Y",IBEICDP Y)) | |
| 12300 | "RTN","IBY 621PO",45, 0) | |
| 12301 | I 'IBEICD PY D BMES^ XPDUTL("Th e Electron ic Insuran ce Coverag e Discover y Payer ha s not been establish ed") G CHK LNKQ | |
| 12302 | "RTN","IBY 621PO",46, 0) | |
| 12303 | S IBIEN=0 | |
| 12304 | "RTN","IBY 621PO",47, 0) | |
| 12305 | F S IBIE N=$O(^DIC( 36,"AC",IB EICDPY,IBI EN)) Q:'IB IEN D | |
| 12306 | "RTN","IBY 621PO",48, 0) | |
| 12307 | . S DIE=" ^DIC(36,", DA=IBIEN,D R="3.1///@ " D ^DIE ; remove th e link | |
| 12308 | "RTN","IBY 621PO",49, 0) | |
| 12309 | . W !,"In surance:"_ IBIEN_" "_ $$GET1^DIQ (36,IBIEN_ ",","NAME" ) | |
| 12310 | "RTN","IBY 621PO",50, 0) | |
| 12311 | . K DIE,D A,DR | |
| 12312 | "RTN","IBY 621PO",51, 0) | |
| 12313 | ; | |
| 12314 | "RTN","IBY 621PO",52, 0) | |
| 12315 | CHKLNKQ ; | |
| 12316 | "RTN","IBY 621PO",53, 0) | |
| 12317 | Q | |
| 12318 | "RTN","IBY 621PO",54, 0) | |
| 12319 | ; | |
| 12320 | "RTN","IBY 621PO",55, 0) | |
| 12321 | CHKEICD(IB XPD) ; Cre ate or upd ate the EI CD Extract | |
| 12322 | "RTN","IBY 621PO",56, 0) | |
| 12323 | N IBFDA,I BSETIEN,IB ERR,IBEXT4 ,IBEXTIEN | |
| 12324 | "RTN","IBY 621PO",57, 0) | |
| 12325 | D BMES^XP DUTL(" STE P "_IBXPD_ " of "_XPD IDTOT) | |
| 12326 | "RTN","IBY 621PO",58, 0) | |
| 12327 | D MES^XPD UTL("----- --------") | |
| 12328 | "RTN","IBY 621PO",59, 0) | |
| 12329 | D MES^XPD UTL("Creat e/update t he EICD Ex tract para meters... ") | |
| 12330 | "RTN","IBY 621PO",60, 0) | |
| 12331 | ; | |
| 12332 | "RTN","IBY 621PO",61, 0) | |
| 12333 | S IBEXT4= +$$FIND1^D IC(350.900 2,",1,","B QX","4","B ") | |
| 12334 | "RTN","IBY 621PO",62, 0) | |
| 12335 | I 'IBEXT4 D G CHKE ICDQ | |
| 12336 | "RTN","IBY 621PO",63, 0) | |
| 12337 | . W !," C reating a new EICD b atch extra ct record. .." | |
| 12338 | "RTN","IBY 621PO",64, 0) | |
| 12339 | . S IBEXT IEN="+1,1, " | |
| 12340 | "RTN","IBY 621PO",65, 0) | |
| 12341 | . S IBSET IEN(1)=4 ; for safety , force ne w IEN to 4 | |
| 12342 | "RTN","IBY 621PO",66, 0) | |
| 12343 | . S IBFDA (350.9002, IBEXTIEN,. 01)="4" ; BATCH EX TRACTS | |
| 12344 | "RTN","IBY 621PO",67, 0) | |
| 12345 | . S IBFDA (350.9002, IBEXTIEN,. 02)="1" ; Active? | |
| 12346 | "RTN","IBY 621PO",68, 0) | |
| 12347 | . S IBFDA (350.9002, IBEXTIEN,. 03)="" ; SELECTIO N CRITERIA #1 | |
| 12348 | "RTN","IBY 621PO",69, 0) | |
| 12349 | . S IBFDA (350.9002, IBEXTIEN,. 04)="" ; SELECTIO N CRITERIA #2 | |
| 12350 | "RTN","IBY 621PO",70, 0) | |
| 12351 | . S IBFDA (350.9002, IBEXTIEN,. 05)=99999 ; MAXIMUM EXTRACT NU MBER | |
| 12352 | "RTN","IBY 621PO",71, 0) | |
| 12353 | . S IBFDA (350.9002, IBEXTIEN,. 06)="1" ; SUPPRESS BUFFER CR EATION | |
| 12354 | "RTN","IBY 621PO",72, 0) | |
| 12355 | . S IBFDA (350.9002, IBEXTIEN,. 07)=31 ; START DA YS | |
| 12356 | "RTN","IBY 621PO",73, 0) | |
| 12357 | . S IBFDA (350.9002, IBEXTIEN,. 08)=9 ; DAYS AFT ER START | |
| 12358 | "RTN","IBY 621PO",74, 0) | |
| 12359 | . S IBFDA (350.9002, IBEXTIEN,. 09)=365 ; FREQUENC Y | |
| 12360 | "RTN","IBY 621PO",75, 0) | |
| 12361 | . ; | |
| 12362 | "RTN","IBY 621PO",76, 0) | |
| 12363 | . D UPDAT E^DIE(,"IB FDA","IBSE TIEN","IBE RR") | |
| 12364 | "RTN","IBY 621PO",77, 0) | |
| 12365 | . I $G(IB ERR("DIERR ",1,"TEXT" ,1))'="" W !,"ISSUE CREATING E XTRACT: "_ $G(IBERR(" DIERR",1," TEXT",1)) | |
| 12366 | "RTN","IBY 621PO",78, 0) | |
| 12367 | ; | |
| 12368 | "RTN","IBY 621PO",79, 0) | |
| 12369 | I IBEXT4 D G CHKEI CDQ | |
| 12370 | "RTN","IBY 621PO",80, 0) | |
| 12371 | . W !," U pdating ex isting EIC D batch ex tract reco rd..." | |
| 12372 | "RTN","IBY 621PO",81, 0) | |
| 12373 | . S IBEXT IEN=IBEXT4 _",1," | |
| 12374 | "RTN","IBY 621PO",82, 0) | |
| 12375 | . S IBFDA (350.9002, IBEXTIEN,. 02)="1" ; Active? | |
| 12376 | "RTN","IBY 621PO",83, 0) | |
| 12377 | . S IBFDA (350.9002, IBEXTIEN,. 03)="" ; SELECTIO N CRITERIA #1 | |
| 12378 | "RTN","IBY 621PO",84, 0) | |
| 12379 | . S IBFDA (350.9002, IBEXTIEN,. 04)="" ; SELECTIO N CRITERIA #2 | |
| 12380 | "RTN","IBY 621PO",85, 0) | |
| 12381 | . S IBFDA (350.9002, IBEXTIEN,. 05)=99999 ; MAXIMUM EXTRACT NU MBER | |
| 12382 | "RTN","IBY 621PO",86, 0) | |
| 12383 | . S IBFDA (350.9002, IBEXTIEN,. 06)="1" ; SUPPRESS BUFFER CR EATION | |
| 12384 | "RTN","IBY 621PO",87, 0) | |
| 12385 | . S IBFDA (350.9002, IBEXTIEN,. 07)=31 ; START DA YS | |
| 12386 | "RTN","IBY 621PO",88, 0) | |
| 12387 | . S IBFDA (350.9002, IBEXTIEN,. 08)=9 ; DAYS AFT ER START | |
| 12388 | "RTN","IBY 621PO",89, 0) | |
| 12389 | . S IBFDA (350.9002, IBEXTIEN,. 09)=365 ; FREQUENC Y | |
| 12390 | "RTN","IBY 621PO",90, 0) | |
| 12391 | . ; | |
| 12392 | "RTN","IBY 621PO",91, 0) | |
| 12393 | . D FILE^ DIE(,"IBFD A","IBERR" ) | |
| 12394 | "RTN","IBY 621PO",92, 0) | |
| 12395 | . I $G(IB ERR("DIERR ",1,"TEXT" ,1))'="" W !,"ISSUE UPDATING E XTRACT: "_ $G(IBERR(" DIERR",1," TEXT",1)) | |
| 12396 | "RTN","IBY 621PO",93, 0) | |
| 12397 | ; | |
| 12398 | "RTN","IBY 621PO",94, 0) | |
| 12399 | CHKEICDQ ; | |
| 12400 | "RTN","IBY 621PO",95, 0) | |
| 12401 | Q | |
| 12402 | "RTN","IBY 621PO",96, 0) | |
| 12403 | ; | |
| 12404 | "UP",350.9 ,350.9002, -1) | |
| 12405 | 350.9^51.1 7 | |
| 12406 | "UP",350.9 ,350.9002, 0) | |
| 12407 | 350.9002 | |
| 12408 | "VER") | |
| 12409 | 8.0^22.2 | |
| 12410 | "^DD",2,2, 2001,0) | |
| 12411 | DATE LAST EICD RUN^D ^^INS;1^S %DT="EX" D ^%DT S X= Y K:X<1 X | |
| 12412 | "^DD",2,2, 2001,3) | |
| 12413 | Enter the date the l ast EICD I dentificat ion inquir y was run for this p atient. | |
| 12414 | "^DD",2,2, 2001,21,0) | |
| 12415 | ^^2^2^3180 607^ | |
| 12416 | "^DD",2,2, 2001,21,1, 0) | |
| 12417 | This field contains the date t hat the la st EICD Id entificati on inquiry was | |
| 12418 | "^DD",2,2, 2001,21,2, 0) | |
| 12419 | transmitte d to the F inancial S ervices Ce nter (FSC) . | |
| 12420 | "^DD",2,2, 2001,23,0) | |
| 12421 | ^^2^2^3180 607^ | |
| 12422 | "^DD",2,2, 2001,23,1, 0) | |
| 12423 | When the H ealth Leve l 7 (HL7) message fo r an EICD Identifica tion inqui ry | |
| 12424 | "^DD",2,2, 2001,23,2, 0) | |
| 12425 | is actuall y transmit ted, VistA will popu late this date. | |
| 12426 | "^DD",2,2, 2001,"DT") | |
| 12427 | 3180607 | |
| 12428 | "^DD",350. 9,350.9,51 .17,0) | |
| 12429 | BATCH EXTR ACTS^350.9 002S^^51.1 7;0 | |
| 12430 | "^DD",350. 9,350.9,51 .17,21,0) | |
| 12431 | ^.001^5^5^ 3180522^^ | |
| 12432 | "^DD",350. 9,350.9,51 .17,21,1,0 ) | |
| 12433 | This field identifie s each of the four d ata extrac ts that eI V uses | |
| 12434 | "^DD",350. 9,350.9,51 .17,21,2,0 ) | |
| 12435 | to find in surance da ta via ver ification inquiries. | |
| 12436 | "^DD",350. 9,350.9,51 .17,21,3,0 ) | |
| 12437 | ||
| 12438 | "^DD",350. 9,350.9,51 .17,21,4,0 ) | |
| 12439 | Buffer, ap pointment, non-verif ied Insura nce and | |
| 12440 | "^DD",350. 9,350.9,51 .17,21,5,0 ) | |
| 12441 | EICD (form erly No In surance ). | |
| 12442 | "^DD",350. 9,350.9,51 .31,0) | |
| 12443 | EICD PAYER ^P365.12'^ IBE(365.12 ,^51;31^Q | |
| 12444 | "^DD",350. 9,350.9,51 .31,3) | |
| 12445 | Select the EICD entr y from the Payer fil e. | |
| 12446 | "^DD",350. 9,350.9,51 .31,21,0) | |
| 12447 | ^^3^3^3180 523^ | |
| 12448 | "^DD",350. 9,350.9,51 .31,21,1,0 ) | |
| 12449 | This field identifie s the Nati onal payer utilized when | |
| 12450 | "^DD",350. 9,350.9,51 .31,21,2,0 ) | |
| 12451 | performing an Electr onic Insur ance Cover age Discov ery | |
| 12452 | "^DD",350. 9,350.9,51 .31,21,3,0 ) | |
| 12453 | (EICD) inq uiry for a Veteran. | |
| 12454 | "^DD",350. 9,350.9,51 .31,23,0) | |
| 12455 | ^^5^5^3180 523^ | |
| 12456 | "^DD",350. 9,350.9,51 .31,23,1,0 ) | |
| 12457 | This field is a poin ter to the EICD paye r | |
| 12458 | "^DD",350. 9,350.9,51 .31,23,2,0 ) | |
| 12459 | table (#36 5.12). It is set via a table u pdate from FSC. | |
| 12460 | "^DD",350. 9,350.9,51 .31,23,3,0 ) | |
| 12461 | It was int roduced wi th IB*2.0* 621 and sh ould not | |
| 12462 | "^DD",350. 9,350.9,51 .31,23,4,0 ) | |
| 12463 | have to ch ange unles s the EICD payer get s changed. | |
| 12464 | "^DD",350. 9,350.9,51 .31,23,5,0 ) | |
| 12465 | It is only editable via FileMa n. Edit wi th extreme care. | |
| 12466 | "^DD",350. 9,350.9,51 .31,"DT") | |
| 12467 | 3180523 | |
| 12468 | "^DD",350. 9,350.9002 ,0) | |
| 12469 | BATCH EXTR ACTS SUB-F IELD^^.09^ 9 | |
| 12470 | "^DD",350. 9,350.9002 ,0,"NM","B ATCH EXTRA CTS") | |
| 12471 | ||
| 12472 | "^DD",350. 9,350.9002 ,.01,0) | |
| 12473 | BATCH EXTR ACTS^MRS^1 :Buffer;2: Appt;3:Non -verified; 4:EICD;^0; 1^Q | |
| 12474 | "^DD",350. 9,350.9002 ,.01,1,0) | |
| 12475 | ^.1 | |
| 12476 | "^DD",350. 9,350.9002 ,.01,1,1,0 ) | |
| 12477 | 350.9002^B | |
| 12478 | "^DD",350. 9,350.9002 ,.01,1,1,1 ) | |
| 12479 | S ^IBE(350 .9,DA(1),5 1.17,"B",$ E(X,1,30), DA)="" | |
| 12480 | "^DD",350. 9,350.9002 ,.01,1,1,2 ) | |
| 12481 | K ^IBE(350 .9,DA(1),5 1.17,"B",$ E(X,1,30), DA) | |
| 12482 | "^DD",350. 9,350.9002 ,.01,1,1," %D",0) | |
| 12483 | ^^1^1^3020 612^ | |
| 12484 | "^DD",350. 9,350.9002 ,.01,1,1," %D",1,0) | |
| 12485 | Standard " B" cross-r eference | |
| 12486 | "^DD",350. 9,350.9002 ,.01,3) | |
| 12487 | Enter a co de from th e list. | |
| 12488 | "^DD",350. 9,350.9002 ,.01,21,0) | |
| 12489 | ^^5^5^3180 522^ | |
| 12490 | "^DD",350. 9,350.9002 ,.01,21,1, 0) | |
| 12491 | This field identifie s each of the four d ata extrac ts that eI V uses | |
| 12492 | "^DD",350. 9,350.9002 ,.01,21,2, 0) | |
| 12493 | to find da ta to requ est insura nce verifi cation. | |
| 12494 | "^DD",350. 9,350.9002 ,.01,21,3, 0) | |
| 12495 | ||
| 12496 | "^DD",350. 9,350.9002 ,.01,21,4, 0) | |
| 12497 | Buffer, ap pointment, non-verif ied Insura nce and | |
| 12498 | "^DD",350. 9,350.9002 ,.01,21,5, 0) | |
| 12499 | EICD (form erly No In surance ). | |
| 12500 | "^DD",350. 9,350.9002 ,.01,"DT") | |
| 12501 | 3180522 | |
| 12502 | "^DD",350. 9,350.9002 ,.05,0) | |
| 12503 | MAXIMUM EX TRACT NUMB ER^RNJ5,0^ ^0;5^K:+X' =X!(X>9999 9)!(X<10)! (X?.E1"."1 .N) X | |
| 12504 | "^DD",350. 9,350.9002 ,.05,3) | |
| 12505 | Type a num ber betwee n 10 and 9 9999, 0 De cimal Digi ts | |
| 12506 | "^DD",350. 9,350.9002 ,.05,21,0) | |
| 12507 | ^.001^2^2^ 3180522^^ | |
| 12508 | "^DD",350. 9,350.9002 ,.05,21,1, 0) | |
| 12509 | This field allows a site to re strict the daily num ber of rec ords | |
| 12510 | "^DD",350. 9,350.9002 ,.05,21,2, 0) | |
| 12511 | extracted and placed in the eI V Transmis sion Queue . | |
| 12512 | "^DD",350. 9,350.9002 ,.05,"DT") | |
| 12513 | 3180522 | |
| 12514 | "^DD",350. 9,350.9002 ,.07,0) | |
| 12515 | START DAYS ^NJ2,0^^0; 7^K:+X'=X! (X>31)!(X< 7)!(X?.E1" ."1.N) X | |
| 12516 | "^DD",350. 9,350.9002 ,.07,3) | |
| 12517 | Type a num ber betwee n 7 and 31 , 0 decima l digits. | |
| 12518 | "^DD",350. 9,350.9002 ,.07,21,0) | |
| 12519 | ^^11^11^31 80625^ | |
| 12520 | "^DD",350. 9,350.9002 ,.07,21,1, 0) | |
| 12521 | This param eter is th e number o f days add ed to toda y to form the | |
| 12522 | "^DD",350. 9,350.9002 ,.07,21,2, 0) | |
| 12523 | extract's start date used to d etermine w hether a r ecord | |
| 12524 | "^DD",350. 9,350.9002 ,.07,21,3, 0) | |
| 12525 | should be extracted or not. | |
| 12526 | "^DD",350. 9,350.9002 ,.07,21,4, 0) | |
| 12527 | ||
| 12528 | "^DD",350. 9,350.9002 ,.07,21,5, 0) | |
| 12529 | To date, t his parame ter is onl y used by the EICD e xtract (#4 ), formerl y | |
| 12530 | "^DD",350. 9,350.9002 ,.07,21,6, 0) | |
| 12531 | "No Insura nce". | |
| 12532 | "^DD",350. 9,350.9002 ,.07,21,7, 0) | |
| 12533 | ||
| 12534 | "^DD",350. 9,350.9002 ,.07,21,8, 0) | |
| 12535 | For EICD, this indi cates how far in the future a Patient ca n be sched uled | |
| 12536 | "^DD",350. 9,350.9002 ,.07,21,9, 0) | |
| 12537 | for an app ointment a nd be elig ible for e xtract. If the value is 21, th en a | |
| 12538 | "^DD",350. 9,350.9002 ,.07,21,10 ,0) | |
| 12539 | patient wi ll be elig ible for e xtract if their appo intment is no earlie r | |
| 12540 | "^DD",350. 9,350.9002 ,.07,21,11 ,0) | |
| 12541 | than 21 da ys from th e extract date (curr ent date). | |
| 12542 | "^DD",350. 9,350.9002 ,.07,"DT") | |
| 12543 | 3180625 | |
| 12544 | "^DD",350. 9,350.9002 ,.08,0) | |
| 12545 | DAYS AFTER START^NJ2 ,0^^0;8^K: +X'=X!(X>2 0)!(X<0)!( X?.E1"."1. N) X | |
| 12546 | "^DD",350. 9,350.9002 ,.08,3) | |
| 12547 | Type a num ber betwee n 0 and 20 , 0 decima l digits. | |
| 12548 | "^DD",350. 9,350.9002 ,.08,21,0) | |
| 12549 | ^^12^12^31 80522^ | |
| 12550 | "^DD",350. 9,350.9002 ,.08,21,1, 0) | |
| 12551 | This param eter is ad ded to the start dat e, calcula ted using "START DAY S", | |
| 12552 | "^DD",350. 9,350.9002 ,.08,21,2, 0) | |
| 12553 | to form th e extract' s end date used to d etermine w hether a r ecord shou ld | |
| 12554 | "^DD",350. 9,350.9002 ,.08,21,3, 0) | |
| 12555 | be extract ed or not. | |
| 12556 | "^DD",350. 9,350.9002 ,.08,21,4, 0) | |
| 12557 | ||
| 12558 | "^DD",350. 9,350.9002 ,.08,21,5, 0) | |
| 12559 | To date, t his parame ter is onl y used by the EICD e xtract (#4 ), formerl y | |
| 12560 | "^DD",350. 9,350.9002 ,.08,21,6, 0) | |
| 12561 | "No Insura nce". | |
| 12562 | "^DD",350. 9,350.9002 ,.08,21,7, 0) | |
| 12563 | ||
| 12564 | "^DD",350. 9,350.9002 ,.08,21,8, 0) | |
| 12565 | For EICD, this indic ates how f ar in the future a p atient fro m the star t | |
| 12566 | "^DD",350. 9,350.9002 ,.08,21,9, 0) | |
| 12567 | date, calc ulated usi ng "START DAYS", tha t a schedu led appoin tment must be | |
| 12568 | "^DD",350. 9,350.9002 ,.08,21,10 ,0) | |
| 12569 | within in order to b e eligible for extra ct. If th e value is 9, then a | |
| 12570 | "^DD",350. 9,350.9002 ,.08,21,11 ,0) | |
| 12571 | patient wi ll be elig ible for e xtract if their appo intment is no earlie r | |
| 12572 | "^DD",350. 9,350.9002 ,.08,21,12 ,0) | |
| 12573 | than start date and is no furt her than s tart date + 9. | |
| 12574 | "^DD",350. 9,350.9002 ,.08,"DT") | |
| 12575 | 3180522 | |
| 12576 | "^DD",350. 9,350.9002 ,.09,0) | |
| 12577 | FREQUENCY^ NJ3,0^^0;9 ^K:+X'=X!( X>365)!(X< 90)!(X?.E1 "."1.N) X | |
| 12578 | "^DD",350. 9,350.9002 ,.09,3) | |
| 12579 | Type a num ber betwee n 90 and 3 65, 0 deci mal digits . | |
| 12580 | "^DD",350. 9,350.9002 ,.09,21,0) | |
| 12581 | ^^10^10^31 80522^ | |
| 12582 | "^DD",350. 9,350.9002 ,.09,21,1, 0) | |
| 12583 | This param eter is si milar to t he FRESHNE SS DAYS pa rameter in that it | |
| 12584 | "^DD",350. 9,350.9002 ,.09,21,2, 0) | |
| 12585 | represents how long the extrac t must wai t before a n attempt to re-veri fy | |
| 12586 | "^DD",350. 9,350.9002 ,.09,21,3, 0) | |
| 12587 | the insura nce for th e patient. | |
| 12588 | "^DD",350. 9,350.9002 ,.09,21,4, 0) | |
| 12589 | ||
| 12590 | "^DD",350. 9,350.9002 ,.09,21,5, 0) | |
| 12591 | To date, t his parame ter is onl y used by the EICD e xtract (#4 ), formerl y | |
| 12592 | "^DD",350. 9,350.9002 ,.09,21,6, 0) | |
| 12593 | "No Insura nce". | |
| 12594 | "^DD",350. 9,350.9002 ,.09,21,7, 0) | |
| 12595 | ||
| 12596 | "^DD",350. 9,350.9002 ,.09,21,8, 0) | |
| 12597 | For EICD, If the val ue is 365, this mean s that eIV can attem pt to | |
| 12598 | "^DD",350. 9,350.9002 ,.09,21,9, 0) | |
| 12599 | re-verify the lack o f insuranc e for a pa tient 366 days after the last time | |
| 12600 | "^DD",350. 9,350.9002 ,.09,21,10 ,0) | |
| 12601 | an EICD in quiry was run. | |
| 12602 | "^DD",350. 9,350.9002 ,.09,"DT") | |
| 12603 | 3180522 | |
| 12604 | "^DD",365. 1,365.1,.1 ,0) | |
| 12605 | WHICH EXTR ACT^S^1:Bu ffer;2:App t;3:Non-ve rified;4:E ICD;^0;10^ Q | |
| 12606 | "^DD",365. 1,365.1,.1 ,3) | |
| 12607 | Enter a co de from th e list. | |
| 12608 | "^DD",365. 1,365.1,.1 ,21,0) | |
| 12609 | ^^2^2^3180 515^ | |
| 12610 | "^DD",365. 1,365.1,.1 ,21,1,0) | |
| 12611 | This field identifie s which da ta extract that the transmissi on | |
| 12612 | "^DD",365. 1,365.1,.1 ,21,2,0) | |
| 12613 | record was generated from. | |
| 12614 | "^DD",365. 1,365.1,.1 ,23,0) | |
| 12615 | ^^2^2^3180 515^ | |
| 12616 | "^DD",365. 1,365.1,.1 ,23,1,0) | |
| 12617 | Patch IB*2 *621 renam ed data ex tract (#4) | |
| 12618 | "^DD",365. 1,365.1,.1 ,23,2,0) | |
| 12619 | from "No I nsurance" to "EICD". | |
| 12620 | "^DD",365. 1,365.1,.1 ,"DT") | |
| 12621 | 3180515 | |
| 12622 | "^DD",365. 1,365.1,.2 1,0) | |
| 12623 | EICD INS-F ND IEN^P36 5.18'^IBCN (365.18,^0 ;21^Q | |
| 12624 | "^DD",365. 1,365.1,.2 1,3) | |
| 12625 | Select the EICD data record re turned fro m an Ident ification response. | |
| 12626 | "^DD",365. 1,365.1,.2 1,21,0) | |
| 12627 | ^^3^3^3180 606^ | |
| 12628 | "^DD",365. 1,365.1,.2 1,21,1,0) | |
| 12629 | This field points to discovere d insuranc e returned from an E ICD | |
| 12630 | "^DD",365. 1,365.1,.2 1,21,2,0) | |
| 12631 | Identifica tion respo nse. The d ata will b e used to track an E ICD | |
| 12632 | "^DD",365. 1,365.1,.2 1,21,3,0) | |
| 12633 | Verificati on inquiry and respo nse. | |
| 12634 | "^DD",365. 1,365.1,.2 1,23,0) | |
| 12635 | ^^2^2^3180 606^ | |
| 12636 | "^DD",365. 1,365.1,.2 1,23,1,0) | |
| 12637 | This field points to the "INS- FND" node multiple c ontained i n EIV EICD | |
| 12638 | "^DD",365. 1,365.1,.2 1,23,2,0) | |
| 12639 | TRACKING ( #365.18) F ILE. | |
| 12640 | "^DD",365. 1,365.1,.2 1,"DT") | |
| 12641 | 3180606 | |
| 12642 | "^DD",365. 18,365.18, 0) | |
| 12643 | FIELD^^5^8 | |
| 12644 | "^DD",365. 18,365.18, 0,"DT") | |
| 12645 | 3180717 | |
| 12646 | "^DD",365. 18,365.18, 0,"IX","B" ,365.18,.0 1) | |
| 12647 | ||
| 12648 | "^DD",365. 18,365.18, 0,"IX","C" ,365.185,1 .01) | |
| 12649 | ||
| 12650 | "^DD",365. 18,365.18, 0,"IX","D" ,365.185,1 .03) | |
| 12651 | ||
| 12652 | "^DD",365. 18,365.18, 0,"IX","E" ,365.18,.0 4) | |
| 12653 | ||
| 12654 | "^DD",365. 18,365.18, 0,"IX","F" ,365.18,.0 5) | |
| 12655 | ||
| 12656 | "^DD",365. 18,365.18, 0,"NM","EI V EICD TRA CKING") | |
| 12657 | ||
| 12658 | "^DD",365. 18,365.18, 0,"PT",365 .1,.21) | |
| 12659 | ||
| 12660 | "^DD",365. 18,365.18, .01,0) | |
| 12661 | EICD TRANS MISSION^RP 365.1'^IBC N(365.1,^0 ;1^Q | |
| 12662 | "^DD",365. 18,365.18, .01,1,0) | |
| 12663 | ^.1 | |
| 12664 | "^DD",365. 18,365.18, .01,1,1,0) | |
| 12665 | 365.18^B | |
| 12666 | "^DD",365. 18,365.18, .01,1,1,1) | |
| 12667 | S ^IBCN(36 5.18,"B",$ E(X,1,30), DA)="" | |
| 12668 | "^DD",365. 18,365.18, .01,1,1,2) | |
| 12669 | K ^IBCN(36 5.18,"B",$ E(X,1,30), DA) | |
| 12670 | "^DD",365. 18,365.18, .01,3) | |
| 12671 | Select the IIV TRANS MISSION QU EUE record associate d with thi s EICD Ide ntificatio n inquiry. | |
| 12672 | "^DD",365. 18,365.18, .01,21,0) | |
| 12673 | ^^2^2^3180 612^ | |
| 12674 | "^DD",365. 18,365.18, .01,21,1,0 ) | |
| 12675 | This is th e IIV TRAN SMISSION Q UEUE recor d associat ed with th is EICD | |
| 12676 | "^DD",365. 18,365.18, .01,21,2,0 ) | |
| 12677 | Identifica tion inqui ry. | |
| 12678 | "^DD",365. 18,365.18, .01,23,0) | |
| 12679 | ^^2^2^3180 605^ | |
| 12680 | "^DD",365. 18,365.18, .01,23,1,0 ) | |
| 12681 | VistA popu lates this field wit h a pointe r to the I IV TRANSMI SSION QUEU E | |
| 12682 | "^DD",365. 18,365.18, .01,23,2,0 ) | |
| 12683 | (#365.1). | |
| 12684 | "^DD",365. 18,365.18, .01,"DT") | |
| 12685 | 3180612 | |
| 12686 | "^DD",365. 18,365.18, .02,0) | |
| 12687 | EICD DATE CREATED^D^ ^0;2^S %DT ="EX" D ^% DT S X=Y K :X<1 X | |
| 12688 | "^DD",365. 18,365.18, .02,3) | |
| 12689 | Enter the date that the associ ated IIV T RANSMISSIO N QUEUE en try was cr eated. | |
| 12690 | "^DD",365. 18,365.18, .02,21,0) | |
| 12691 | ^^2^2^3180 605^ | |
| 12692 | "^DD",365. 18,365.18, .02,21,1,0 ) | |
| 12693 | This is th e date tha t the IIV TRANSMISSI ON QUEUE e ntry was c reated for an | |
| 12694 | "^DD",365. 18,365.18, .02,21,2,0 ) | |
| 12695 | EICD Ident ification inquiry. | |
| 12696 | "^DD",365. 18,365.18, .02,23,0) | |
| 12697 | ^^2^2^3180 608^ | |
| 12698 | "^DD",365. 18,365.18, .02,23,1,0 ) | |
| 12699 | This is th e date tha t the IIV TRANSMISSI ON QUEUE e ntry point ed to by | |
| 12700 | "^DD",365. 18,365.18, .02,23,2,0 ) | |
| 12701 | the EICD T RANSMISSIO N (#365.18 ,.01) fiel d was crea ted. | |
| 12702 | "^DD",365. 18,365.18, .02,"DT") | |
| 12703 | 3180612 | |
| 12704 | "^DD",365. 18,365.18, .03,0) | |
| 12705 | EICD PAYER ^P365.12'^ IBE(365.12 ,^0;3^Q | |
| 12706 | "^DD",365. 18,365.18, .03,3) | |
| 12707 | Select the EICD Iden tification inquiry N ational PA YER. | |
| 12708 | "^DD",365. 18,365.18, .03,21,0) | |
| 12709 | ^^2^2^3180 612^ | |
| 12710 | "^DD",365. 18,365.18, .03,21,1,0 ) | |
| 12711 | This is th e National EICD PAYE R entry us ed when cr eating an EICD | |
| 12712 | "^DD",365. 18,365.18, .03,21,2,0 ) | |
| 12713 | Identifica tion inqui ry. | |
| 12714 | "^DD",365. 18,365.18, .03,23,0) | |
| 12715 | ^^3^3^3180 606^ | |
| 12716 | "^DD",365. 18,365.18, .03,23,1,0 ) | |
| 12717 | When an EI CD Identif ication in quiry is c reated, th is field i s populate d | |
| 12718 | "^DD",365. 18,365.18, .03,23,2,0 ) | |
| 12719 | with The " EICD PAYER " from IB SITE PARAM ETERS (#35 0.9,51.31) which | |
| 12720 | "^DD",365. 18,365.18, .03,23,3,0 ) | |
| 12721 | is a point er to the proper Nat ional PAYE R (#365.12 ). | |
| 12722 | "^DD",365. 18,365.18, .03,"DT") | |
| 12723 | 3180612 | |
| 12724 | "^DD",365. 18,365.18, .04,0) | |
| 12725 | EICD TRACE NUMBER^FJ 30^^0;4^K: $L(X)>30!( $L(X)<3) X | |
| 12726 | "^DD",365. 18,365.18, .04,1,0) | |
| 12727 | ^.1 | |
| 12728 | "^DD",365. 18,365.18, .04,1,1,0) | |
| 12729 | 365.18^E | |
| 12730 | "^DD",365. 18,365.18, .04,1,1,1) | |
| 12731 | S ^IBCN(36 5.18,"E",$ E(X,1,30), DA)="" | |
| 12732 | "^DD",365. 18,365.18, .04,1,1,2) | |
| 12733 | K ^IBCN(36 5.18,"E",$ E(X,1,30), DA) | |
| 12734 | "^DD",365. 18,365.18, .04,1,1,3) | |
| 12735 | DO NOT DEL ETE | |
| 12736 | "^DD",365. 18,365.18, .04,1,1,"% D",0) | |
| 12737 | ^^2^2^3180 712^ | |
| 12738 | "^DD",365. 18,365.18, .04,1,1,"% D",1,0) | |
| 12739 | This cross reference allows th e enrtry t o be looke d up by th e EICD TRA CE | |
| 12740 | "^DD",365. 18,365.18, .04,1,1,"% D",2,0) | |
| 12741 | NUMBER. | |
| 12742 | "^DD",365. 18,365.18, .04,1,1,"D T") | |
| 12743 | 3180712 | |
| 12744 | "^DD",365. 18,365.18, .04,3) | |
| 12745 | Enter the EICD Ident ification response T race numbe r, must be 3-30 char acters in length. | |
| 12746 | "^DD",365. 18,365.18, .04,21,0) | |
| 12747 | ^^3^3^3180 608^^ | |
| 12748 | "^DD",365. 18,365.18, .04,21,1,0 ) | |
| 12749 | This is th e IIV RESP ONSE TRACE NUMBER (# 365,.09) a ssociated with an EI CD | |
| 12750 | "^DD",365. 18,365.18, .04,21,2,0 ) | |
| 12751 | Identifica tion respo nse that t races back to the EI CD TRANSMI SSION | |
| 12752 | "^DD",365. 18,365.18, .04,21,3,0 ) | |
| 12753 | (#365.18,. 01) field. | |
| 12754 | "^DD",365. 18,365.18, .04,"DT") | |
| 12755 | 3180712 | |
| 12756 | "^DD",365. 18,365.18, .05,0) | |
| 12757 | EICD PATIE NT^P2'^DPT (^0;5^Q | |
| 12758 | "^DD",365. 18,365.18, .05,1,0) | |
| 12759 | ^.1 | |
| 12760 | "^DD",365. 18,365.18, .05,1,1,0) | |
| 12761 | 365.18^F | |
| 12762 | "^DD",365. 18,365.18, .05,1,1,1) | |
| 12763 | S ^IBCN(36 5.18,"F",$ E(X,1,30), DA)="" | |
| 12764 | "^DD",365. 18,365.18, .05,1,1,2) | |
| 12765 | K ^IBCN(36 5.18,"F",$ E(X,1,30), DA) | |
| 12766 | "^DD",365. 18,365.18, .05,1,1,3) | |
| 12767 | DO NOT DEL ETE | |
| 12768 | "^DD",365. 18,365.18, .05,1,1,"% D",0) | |
| 12769 | ^^2^2^3180 712^ | |
| 12770 | "^DD",365. 18,365.18, .05,1,1,"% D",1,0) | |
| 12771 | This cross reference allows th e enrtry t o be looke d up by th e EICD | |
| 12772 | "^DD",365. 18,365.18, .05,1,1,"% D",2,0) | |
| 12773 | PATIENT. | |
| 12774 | "^DD",365. 18,365.18, .05,1,1,"D T") | |
| 12775 | 3180712 | |
| 12776 | "^DD",365. 18,365.18, .05,3) | |
| 12777 | Enter the EICD Ident ification inquiry Pa tient. | |
| 12778 | "^DD",365. 18,365.18, .05,21,0) | |
| 12779 | ^^1^1^3180 612^ | |
| 12780 | "^DD",365. 18,365.18, .05,21,1,0 ) | |
| 12781 | This is th e PATIENT record ass ociated wi th an EICD Identific ation inqu iry. | |
| 12782 | "^DD",365. 18,365.18, .05,"DT") | |
| 12783 | 3180712 | |
| 12784 | "^DD",365. 18,365.18, .06,0) | |
| 12785 | EICD RESPO NSE^P365'^ IBCN(365,^ 0;6^Q | |
| 12786 | "^DD",365. 18,365.18, .06,3) | |
| 12787 | Select the IIV RESPO NSE entry associated with an E ICD Identi fication. | |
| 12788 | "^DD",365. 18,365.18, .06,21,0) | |
| 12789 | ^^2^2^3180 612^ | |
| 12790 | "^DD",365. 18,365.18, .06,21,1,0 ) | |
| 12791 | This is th e IIV RESP ONSE file record ass ociated wi th an EICD | |
| 12792 | "^DD",365. 18,365.18, .06,21,2,0 ) | |
| 12793 | Identifica tion respo nse. | |
| 12794 | "^DD",365. 18,365.18, .06,"DT") | |
| 12795 | 3180612 | |
| 12796 | "^DD",365. 18,365.18, .07,0) | |
| 12797 | EICD RESPO NSE RESULT ^S^0:Error ;1:Active Policies F ound;2:No Active Pol icies Foun d;3:Cleari nghouse Ti meout;^0;7 ^Q | |
| 12798 | "^DD",365. 18,365.18, .07,3) | |
| 12799 | Enter an E ICD Identi fication r esponse re sult code. | |
| 12800 | "^DD",365. 18,365.18, .07,21,0) | |
| 12801 | ^.001^2^2^ 3180717^^ | |
| 12802 | "^DD",365. 18,365.18, .07,21,1,0 ) | |
| 12803 | This field contains a result c ode based on respons e data ret urned | |
| 12804 | "^DD",365. 18,365.18, .07,21,2,0 ) | |
| 12805 | from an EI CD Identif ication in quiry. | |
| 12806 | "^DD",365. 18,365.18, .07,"DT") | |
| 12807 | 3180717 | |
| 12808 | "^DD",365. 18,365.18, 5,0) | |
| 12809 | INSURANCE DISCOVERED ^365.185A^ ^INS-FND;0 | |
| 12810 | "^DD",365. 18,365.18, 5,21,0) | |
| 12811 | ^.001^3^3^ 3180703^^^ ^ | |
| 12812 | "^DD",365. 18,365.18, 5,21,1,0) | |
| 12813 | When an EI CD Identif ication re sponse ret urns with one or mor e | |
| 12814 | "^DD",365. 18,365.18, 5,21,2,0) | |
| 12815 | discovered policies, they are detailed i n this sub -file to b e used whe n | |
| 12816 | "^DD",365. 18,365.18, 5,21,3,0) | |
| 12817 | creating V erificatio n inquirie s. | |
| 12818 | "^DD",365. 18,365.185 ,0) | |
| 12819 | INSURANCE DISCOVERED SUB-FIELD ^^.15^19 | |
| 12820 | "^DD",365. 18,365.185 ,0,"DT") | |
| 12821 | 3180712 | |
| 12822 | "^DD",365. 18,365.185 ,0,"IX","B ",365.185, .01) | |
| 12823 | ||
| 12824 | "^DD",365. 18,365.185 ,0,"NM","I NSURANCE D ISCOVERED" ) | |
| 12825 | ||
| 12826 | "^DD",365. 18,365.185 ,0,"UP") | |
| 12827 | 365.18 | |
| 12828 | "^DD",365. 18,365.185 ,.01,0) | |
| 12829 | PAYER VA I D^FJ10^^0; 1^K:$L(X)> 10!($L(X)< 1) X | |
| 12830 | "^DD",365. 18,365.185 ,.01,1,0) | |
| 12831 | ^.1 | |
| 12832 | "^DD",365. 18,365.185 ,.01,1,1,0 ) | |
| 12833 | 365.185^B | |
| 12834 | "^DD",365. 18,365.185 ,.01,1,1,1 ) | |
| 12835 | S ^IBCN(36 5.18,DA(1) ,"INS-FND" ,"B",$E(X, 1,30),DA)= "" | |
| 12836 | "^DD",365. 18,365.185 ,.01,1,1,2 ) | |
| 12837 | K ^IBCN(36 5.18,DA(1) ,"INS-FND" ,"B",$E(X, 1,30),DA) | |
| 12838 | "^DD",365. 18,365.185 ,.01,3) | |
| 12839 | Enter the EICD Ident ification response P ayer VA ID , must be 1-10 chara cters in l ength. | |
| 12840 | "^DD",365. 18,365.185 ,.01,21,0) | |
| 12841 | ^^3^3^3180 608^ | |
| 12842 | "^DD",365. 18,365.185 ,.01,21,1, 0) | |
| 12843 | This is th e PAYER VA NATIONAL ID returne d from an EICD Ident ification | |
| 12844 | "^DD",365. 18,365.185 ,.01,21,2, 0) | |
| 12845 | response. The ID cou ld be "UNK NOWN" and/ or not ava ilable in the PAYER | |
| 12846 | "^DD",365. 18,365.185 ,.01,21,3, 0) | |
| 12847 | file. It m ay be used when crea ting a Ver ification inquiry. | |
| 12848 | "^DD",365. 18,365.185 ,.01,23,0) | |
| 12849 | ^^2^2^3180 608^ | |
| 12850 | "^DD",365. 18,365.185 ,.01,23,1, 0) | |
| 12851 | The return ed PAYER V A NATIONAL ID may no t be a val id entry i n the PAYE R | |
| 12852 | "^DD",365. 18,365.185 ,.01,23,2, 0) | |
| 12853 | (#365.12,. 02) file. The ID cou ld also be "UNKNOWN" . | |
| 12854 | "^DD",365. 18,365.185 ,.01,"DT") | |
| 12855 | 3180608 | |
| 12856 | "^DD",365. 18,365.185 ,.02,0) | |
| 12857 | PAYER NAME ^FJ80^^0;2 ^K:$L(X)>8 0!($L(X)<1 ) X | |
| 12858 | "^DD",365. 18,365.185 ,.02,3) | |
| 12859 | Enter the EICD Ident ification response P ayer Name, must be 1 -80 charac ters in le ngth. | |
| 12860 | "^DD",365. 18,365.185 ,.02,21,0) | |
| 12861 | ^^4^4^3180 608^ | |
| 12862 | "^DD",365. 18,365.185 ,.02,21,1, 0) | |
| 12863 | When the P AYER VA ID (#365.185 ,.01) is " UNKNOWN", or not fou nd in the | |
| 12864 | "^DD",365. 18,365.185 ,.02,21,2, 0) | |
| 12865 | PAYER (#36 5.12) file , this PAY ER NAME wi ll be used to popula te the | |
| 12866 | "^DD",365. 18,365.185 ,.02,21,3, 0) | |
| 12867 | INSURANCE COMPANY NA ME when cr eating an INSURANCE VERIFICATI ON PROCESS OR | |
| 12868 | "^DD",365. 18,365.185 ,.02,21,4, 0) | |
| 12869 | (#355.33) entry for manual pro cessing. | |
| 12870 | "^DD",365. 18,365.185 ,.02,"DT") | |
| 12871 | 3180608 | |
| 12872 | "^DD",365. 18,365.185 ,.03,0) | |
| 12873 | GROUP NUMB ER^FJ17^^0 ;3^K:$L(X) >17!($L(X) <2) X | |
| 12874 | "^DD",365. 18,365.185 ,.03,3) | |
| 12875 | Enter the EICD Ident ification response G roup Numbe r, must be 2-17 char acters in length. | |
| 12876 | "^DD",365. 18,365.185 ,.03,21,0) | |
| 12877 | ^^2^2^3180 605^ | |
| 12878 | "^DD",365. 18,365.185 ,.03,21,1, 0) | |
| 12879 | This is th e Group nu mber retur ned in an EICD Ident ification response, it | |
| 12880 | "^DD",365. 18,365.185 ,.03,21,2, 0) | |
| 12881 | will be us ed when cr eating a V erificatio n inquiry. | |
| 12882 | "^DD",365. 18,365.185 ,.03,"DT") | |
| 12883 | 3180608 | |
| 12884 | "^DD",365. 18,365.185 ,.04,0) | |
| 12885 | SUBSCRIBER ID^FJ80^^ 0;4^K:$L(X )>80!($L(X )<3) X | |
| 12886 | "^DD",365. 18,365.185 ,.04,3) | |
| 12887 | Enter the EICD Ident ification response S ubscriber ID, must b e 3-80 cha racters in length. | |
| 12888 | "^DD",365. 18,365.185 ,.04,21,0) | |
| 12889 | ^^2^2^3180 605^ | |
| 12890 | "^DD",365. 18,365.185 ,.04,21,1, 0) | |
| 12891 | This is th e Subscrib er ID retu rned in an EICD Iden tification response, it | |
| 12892 | "^DD",365. 18,365.185 ,.04,21,2, 0) | |
| 12893 | will be us ed when cr eating a V erificatio n inquiry. | |
| 12894 | "^DD",365. 18,365.185 ,.04,"DT") | |
| 12895 | 3180608 | |
| 12896 | "^DD",365. 18,365.185 ,.05,0) | |
| 12897 | MEMBER ID^ FJ20^^0;5^ K:$L(X)>20 !($L(X)<1) X | |
| 12898 | "^DD",365. 18,365.185 ,.05,3) | |
| 12899 | Enter the EICD Ident ification response M ember ID, must be 1- 20 charact ers in len gth. | |
| 12900 | "^DD",365. 18,365.185 ,.05,21,0) | |
| 12901 | ^^2^2^3180 605^ | |
| 12902 | "^DD",365. 18,365.185 ,.05,21,1, 0) | |
| 12903 | This is th e Member I D returned in an EIC D Identifi cation res ponse, it | |
| 12904 | "^DD",365. 18,365.185 ,.05,21,2, 0) | |
| 12905 | will be us ed when cr eating a V erificatio n inquiry. | |
| 12906 | "^DD",365. 18,365.185 ,.05,"DT") | |
| 12907 | 3180608 | |
| 12908 | "^DD",365. 18,365.185 ,.06,0) | |
| 12909 | SUBSCRIBER SSN^FJ13^ ^0;6^K:$L( X)>13!($L( X)<9) X | |
| 12910 | "^DD",365. 18,365.185 ,.06,3) | |
| 12911 | Enter the EICD Ident ification response S ubscriber SSN, must be 9-13 ch aracters i n length. | |
| 12912 | "^DD",365. 18,365.185 ,.06,21,0) | |
| 12913 | ^^2^2^3180 703^ | |
| 12914 | "^DD",365. 18,365.185 ,.06,21,1, 0) | |
| 12915 | This is th e Subscrib er SSN ret urned in a n EICD Ide ntificatio n response . It | |
| 12916 | "^DD",365. 18,365.185 ,.06,21,2, 0) | |
| 12917 | may be use d to furth er researc h the resp onse. | |
| 12918 | "^DD",365. 18,365.185 ,.06,"DT") | |
| 12919 | 3180703 | |
| 12920 | "^DD",365. 18,365.185 ,.07,0) | |
| 12921 | INSURED DO B^D^^0;7^S %DT="EX" D ^%DT S X =Y K:Y<1 X | |
| 12922 | "^DD",365. 18,365.185 ,.07,3) | |
| 12923 | Enter the EICD Ident ification response I nsured (Su bscriber) Date of Bi rth. | |
| 12924 | "^DD",365. 18,365.185 ,.07,21,0) | |
| 12925 | ^^2^2^3180 608^ | |
| 12926 | "^DD",365. 18,365.185 ,.07,21,1, 0) | |
| 12927 | This is th e Insured DOB (Subsc riber) ret urned in a n EICD Ide ntificatio n | |
| 12928 | "^DD",365. 18,365.185 ,.07,21,2, 0) | |
| 12929 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12930 | "^DD",365. 18,365.185 ,.07,"DT") | |
| 12931 | 3180608 | |
| 12932 | "^DD",365. 18,365.185 ,.08,0) | |
| 12933 | INSURED SE X^S^F:FEMA LE;M:MALE; ^0;8^Q | |
| 12934 | "^DD",365. 18,365.185 ,.08,3) | |
| 12935 | Enter the EICD Ident ification response I nsured (Su bscriber) sex, (M or F). | |
| 12936 | "^DD",365. 18,365.185 ,.08,21,0) | |
| 12937 | ^^2^2^3180 608^ | |
| 12938 | "^DD",365. 18,365.185 ,.08,21,1, 0) | |
| 12939 | This is th e Insured sex (Subsc riber) ret urned in a n EICD Ide ntificatio n | |
| 12940 | "^DD",365. 18,365.185 ,.08,21,2, 0) | |
| 12941 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12942 | "^DD",365. 18,365.185 ,.08,"DT") | |
| 12943 | 3180608 | |
| 12944 | "^DD",365. 18,365.185 ,.09,0) | |
| 12945 | NAME OF IN SURED^FJ30 ^^0;9^K:$L (X)>30!($L (X)<2) X | |
| 12946 | "^DD",365. 18,365.185 ,.09,3) | |
| 12947 | Enter the EICD Ident ification response I nsured (Su bscriber) name, must be 2-30 c haracters in length. | |
| 12948 | "^DD",365. 18,365.185 ,.09,21,0) | |
| 12949 | ^^2^2^3180 608^ | |
| 12950 | "^DD",365. 18,365.185 ,.09,21,1, 0) | |
| 12951 | This is th e Insured name (Subs criber) re turned in an EICD Id entificati on | |
| 12952 | "^DD",365. 18,365.185 ,.09,21,2, 0) | |
| 12953 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12954 | "^DD",365. 18,365.185 ,.09,"DT") | |
| 12955 | 3180608 | |
| 12956 | "^DD",365. 18,365.185 ,.1,0) | |
| 12957 | SUBSCRIBER ADDRESS L INE 1^FJ55 ^^0;10^K:$ L(X)>55!($ L(X)<1) X | |
| 12958 | "^DD",365. 18,365.185 ,.1,3) | |
| 12959 | Enter the EICD Ident ification response S ubscriber addr line 1, must be 1-55 char acters in length. | |
| 12960 | "^DD",365. 18,365.185 ,.1,21,0) | |
| 12961 | ^^2^2^3180 605^ | |
| 12962 | "^DD",365. 18,365.185 ,.1,21,1,0 ) | |
| 12963 | This is th e Subscrib er address line 1 re turned in an EICD Id entificati on | |
| 12964 | "^DD",365. 18,365.185 ,.1,21,2,0 ) | |
| 12965 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12966 | "^DD",365. 18,365.185 ,.1,"DT") | |
| 12967 | 3180608 | |
| 12968 | "^DD",365. 18,365.185 ,.11,0) | |
| 12969 | SUBSCRIBER ADDRESS L INE 2^FJ55 ^^0;11^K:$ L(X)>55!($ L(X)<1) X | |
| 12970 | "^DD",365. 18,365.185 ,.11,3) | |
| 12971 | Enter the EICD Ident ification response S ubscriber addr line 2, must be 1-55 char acters in length. | |
| 12972 | "^DD",365. 18,365.185 ,.11,21,0) | |
| 12973 | ^^2^2^3180 605^ | |
| 12974 | "^DD",365. 18,365.185 ,.11,21,1, 0) | |
| 12975 | This is th e Subscrib er address line 2 re turned in an EICD Id entificati on | |
| 12976 | "^DD",365. 18,365.185 ,.11,21,2, 0) | |
| 12977 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12978 | "^DD",365. 18,365.185 ,.11,"DT") | |
| 12979 | 3180608 | |
| 12980 | "^DD",365. 18,365.185 ,.12,0) | |
| 12981 | SUBSCRIBER ADDRESS C ITY^FJ30^^ 0;12^K:$L( X)>30!($L( X)<1) X | |
| 12982 | "^DD",365. 18,365.185 ,.12,3) | |
| 12983 | Enter the EICD Ident ification response S ubscriber addr city, must be 1 -30 charac ters in le ngth. | |
| 12984 | "^DD",365. 18,365.185 ,.12,21,0) | |
| 12985 | ^^2^2^3180 605^ | |
| 12986 | "^DD",365. 18,365.185 ,.12,21,1, 0) | |
| 12987 | This is th e Subscrib er address city retu rned in an EICD Iden tification | |
| 12988 | "^DD",365. 18,365.185 ,.12,21,2, 0) | |
| 12989 | response, it will be used when creating a Verifica tion inqui ry. | |
| 12990 | "^DD",365. 18,365.185 ,.12,"DT") | |
| 12991 | 3180608 | |
| 12992 | "^DD",365. 18,365.185 ,.13,0) | |
| 12993 | SUBSCRIBER ADDRESS S TATE^P5'^D IC(5,^0;13 ^Q | |
| 12994 | "^DD",365. 18,365.185 ,.13,3) | |
| 12995 | Enter the EICD Ident ification response S ubscriber addr state . | |
| 12996 | "^DD",365. 18,365.185 ,.13,21,0) | |
| 12997 | ^^2^2^3180 605^ | |
| 12998 | "^DD",365. 18,365.185 ,.13,21,1, 0) | |
| 12999 | This is th e Subscrib er address state ret urned in a n EICD Ide ntificatio n | |
| 13000 | "^DD",365. 18,365.185 ,.13,21,2, 0) | |
| 13001 | response, it will be used when creating a Verifica tion inqui ry. | |
| 13002 | "^DD",365. 18,365.185 ,.13,"DT") | |
| 13003 | 3180608 | |
| 13004 | "^DD",365. 18,365.185 ,.14,0) | |
| 13005 | SUBSCRIBER ADDRESS Z IP^FJ15^^0 ;14^K:$L(X )>15!($L(X )<1) X | |
| 13006 | "^DD",365. 18,365.185 ,.14,3) | |
| 13007 | Enter the EICD Ident ification response S ubscriber addr zip, must be 1- 15 charact ers in len gth. | |
| 13008 | "^DD",365. 18,365.185 ,.14,21,0) | |
| 13009 | ^^2^2^3180 605^ | |
| 13010 | "^DD",365. 18,365.185 ,.14,21,1, 0) | |
| 13011 | This is th e Subscrib er address zip retur ned in an EICD Ident ification | |
| 13012 | "^DD",365. 18,365.185 ,.14,21,2, 0) | |
| 13013 | response, it will be used when creating a Verifica tion inqui ry. | |
| 13014 | "^DD",365. 18,365.185 ,.14,"DT") | |
| 13015 | 3180608 | |
| 13016 | "^DD",365. 18,365.185 ,.15,0) | |
| 13017 | DEPENDENT POLICY (Y/ N?)^S^0:N; 1:Y;^0;15^ Q | |
| 13018 | "^DD",365. 18,365.185 ,.15,3) | |
| 13019 | Enter Y if this is a Dependent Policy, o therwise e nter N. | |
| 13020 | "^DD",365. 18,365.185 ,.15,21,0) | |
| 13021 | ^^2^2^3180 703^ | |
| 13022 | "^DD",365. 18,365.185 ,.15,21,1, 0) | |
| 13023 | This field will be s et to 1 an y time the re is a GT 1 record a ssociated with | |
| 13024 | "^DD",365. 18,365.185 ,.15,21,2, 0) | |
| 13025 | an EICD Id entificati on respons e. | |
| 13026 | "^DD",365. 18,365.185 ,.15,"DT") | |
| 13027 | 3180703 | |
| 13028 | "^DD",365. 18,365.185 ,1.01,0) | |
| 13029 | EICD VER I NQ TRANSMI SSION^P365 .1'^IBCN(3 65.1,^1;1^ Q | |
| 13030 | "^DD",365. 18,365.185 ,1.01,1,0) | |
| 13031 | ^.1 | |
| 13032 | "^DD",365. 18,365.185 ,1.01,1,1, 0) | |
| 13033 | 365.18^C | |
| 13034 | "^DD",365. 18,365.185 ,1.01,1,1, 1) | |
| 13035 | S ^IBCN(36 5.18,"C",$ E(X,1,30), DA(1),DA)= "" | |
| 13036 | "^DD",365. 18,365.185 ,1.01,1,1, 2) | |
| 13037 | K ^IBCN(36 5.18,"C",$ E(X,1,30), DA(1),DA) | |
| 13038 | "^DD",365. 18,365.185 ,1.01,1,1, 3) | |
| 13039 | DO NOT DEL ETE | |
| 13040 | "^DD",365. 18,365.185 ,1.01,1,1, "%D",0) | |
| 13041 | ^.101^2^2^ 3180712^^^ ^ | |
| 13042 | "^DD",365. 18,365.185 ,1.01,1,1, "%D",1,0) | |
| 13043 | The cross- reference allows qui ckly locat ing the EI CD VER INQ TRANSMISS ION | |
| 13044 | "^DD",365. 18,365.185 ,1.01,1,1, "%D",2,0) | |
| 13045 | record fro m an IIV T RANSMISSIO N QUEUE en try. | |
| 13046 | "^DD",365. 18,365.185 ,1.01,1,1, "DT") | |
| 13047 | 3180605 | |
| 13048 | "^DD",365. 18,365.185 ,1.01,3) | |
| 13049 | Select the IIV TRANS MISSION QU EUE record associate d with thi s EICD Ver ification inquiry. | |
| 13050 | "^DD",365. 18,365.185 ,1.01,21,0 ) | |
| 13051 | ^^2^2^3180 612^ | |
| 13052 | "^DD",365. 18,365.185 ,1.01,21,1 ,0) | |
| 13053 | This is th e IIV TRAN SMISSION Q UEUE recor d associat ed with an EICD | |
| 13054 | "^DD",365. 18,365.185 ,1.01,21,2 ,0) | |
| 13055 | Verificati on inquiry . | |
| 13056 | "^DD",365. 18,365.185 ,1.01,23,0 ) | |
| 13057 | ^^2^2^3180 608^ | |
| 13058 | "^DD",365. 18,365.185 ,1.01,23,1 ,0) | |
| 13059 | VistA popu lates this field wit h a pointe r to the I IV TRANSMI SSION QUEU E | |
| 13060 | "^DD",365. 18,365.185 ,1.01,23,2 ,0) | |
| 13061 | (#365.1) a ssociated with an EI CD Verific ation inqu iry. | |
| 13062 | "^DD",365. 18,365.185 ,1.01,"DT" ) | |
| 13063 | 3180712 | |
| 13064 | "^DD",365. 18,365.185 ,1.02,0) | |
| 13065 | EICD VER I NQ DATE CR EATED^D^^1 ;2^S %DT=" EX" D ^%DT S X=Y K:X <1 X | |
| 13066 | "^DD",365. 18,365.185 ,1.02,3) | |
| 13067 | Enter the date that the associ ated IIV T RANSMISSIO N QUEUE en try was cr eated. | |
| 13068 | "^DD",365. 18,365.185 ,1.02,21,0 ) | |
| 13069 | ^^2^2^3180 608^^^^ | |
| 13070 | "^DD",365. 18,365.185 ,1.02,21,1 ,0) | |
| 13071 | This is th e date tha t the IIV Transmissi on Queue e ntry was c reated for an | |
| 13072 | "^DD",365. 18,365.185 ,1.02,21,2 ,0) | |
| 13073 | EICD Verif ication in quiry. | |
| 13074 | "^DD",365. 18,365.185 ,1.02,23,0 ) | |
| 13075 | ^^2^2^3180 608^^ | |
| 13076 | "^DD",365. 18,365.185 ,1.02,23,1 ,0) | |
| 13077 | This is th e date tha t the IIV TRANSMISSI ON QUEUE e ntry point ed to by E ICD | |
| 13078 | "^DD",365. 18,365.185 ,1.02,23,2 ,0) | |
| 13079 | VER INQ TR ANSMISSION (365.185, 1.01) fiel d was crea ted. | |
| 13080 | "^DD",365. 18,365.185 ,1.02,"DT" ) | |
| 13081 | 3180608 | |
| 13082 | "^DD",365. 18,365.185 ,1.03,0) | |
| 13083 | EICD VER R ESPONSE^P3 65'^IBCN(3 65,^1;3^Q | |
| 13084 | "^DD",365. 18,365.185 ,1.03,1,0) | |
| 13085 | ^.1 | |
| 13086 | "^DD",365. 18,365.185 ,1.03,1,1, 0) | |
| 13087 | 365.18^D | |
| 13088 | "^DD",365. 18,365.185 ,1.03,1,1, 1) | |
| 13089 | S ^IBCN(36 5.18,"D",$ E(X,1,30), DA(1),DA)= "" | |
| 13090 | "^DD",365. 18,365.185 ,1.03,1,1, 2) | |
| 13091 | K ^IBCN(36 5.18,"D",$ E(X,1,30), DA(1),DA) | |
| 13092 | "^DD",365. 18,365.185 ,1.03,1,1, 3) | |
| 13093 | DO NOT DEL ETE | |
| 13094 | "^DD",365. 18,365.185 ,1.03,1,1, "%D",0) | |
| 13095 | ^.101^2^2^ 3180712^^^ | |
| 13096 | "^DD",365. 18,365.185 ,1.03,1,1, "%D",1,0) | |
| 13097 | The cross- reference allows qui ckly locat ing the EI CD VER RES PONSE reco rd | |
| 13098 | "^DD",365. 18,365.185 ,1.03,1,1, "%D",2,0) | |
| 13099 | from an II V RESPONSE entry. | |
| 13100 | "^DD",365. 18,365.185 ,1.03,1,1, "DT") | |
| 13101 | 3180605 | |
| 13102 | "^DD",365. 18,365.185 ,1.03,3) | |
| 13103 | Select the IIV RESPO NSE entry associated with an E ICD Verifi cation. | |
| 13104 | "^DD",365. 18,365.185 ,1.03,21,0 ) | |
| 13105 | ^^2^2^3180 612^ | |
| 13106 | "^DD",365. 18,365.185 ,1.03,21,1 ,0) | |
| 13107 | This is th e IIV RESP ONSE file record ass ociated wi th an EICD Verificat ion | |
| 13108 | "^DD",365. 18,365.185 ,1.03,21,2 ,0) | |
| 13109 | response. | |
| 13110 | "^DD",365. 18,365.185 ,1.03,"DT" ) | |
| 13111 | 3180712 | |
| 13112 | "^DD",365. 18,365.185 ,1.04,0) | |
| 13113 | EICD VER R ESPONSE RE SULT^S^0:E RROR;1:ACT IVE POLICY ;2:INACTIV E POLICY;3 :AMBIGUOUS ;^1;4^Q | |
| 13114 | "^DD",365. 18,365.185 ,1.04,3) | |
| 13115 | Enter the EICD Verif ication re sponse res ult code. | |
| 13116 | "^DD",365. 18,365.185 ,1.04,21,0 ) | |
| 13117 | ^^2^2^3180 605^ | |
| 13118 | "^DD",365. 18,365.185 ,1.04,21,1 ,0) | |
| 13119 | This field contains a result c ode based on respons e data ret urned from an | |
| 13120 | "^DD",365. 18,365.185 ,1.04,21,2 ,0) | |
| 13121 | EICD Verif ication in quiry. | |
| 13122 | "^DD",365. 18,365.185 ,1.04,"DT" ) | |
| 13123 | 3180608 | |
| 13124 | "^DIC",365 .18,365.18 ,0) | |
| 13125 | EIV EICD T RACKING^36 5.18 | |
| 13126 | "^DIC",365 .18,365.18 ,0,"GL") | |
| 13127 | ^IBCN(365. 18, | |
| 13128 | "^DIC",365 .18,365.18 ,"%D",0) | |
| 13129 | ^1.001^4^4 ^3180612^^ | |
| 13130 | "^DIC",365 .18,365.18 ,"%D",1,0) | |
| 13131 | This file allows Vis tA to trac k data ass ociated wi th the | |
| 13132 | "^DIC",365 .18,365.18 ,"%D",2,0) | |
| 13133 | Electronic Insurance Coverage Discovery (EICD) ext ract proce ss. | |
| 13134 | "^DIC",365 .18,365.18 ,"%D",3,0) | |
| 13135 | Both Ident ification and Verifi cation EIC D transact ions (inqu ires and | |
| 13136 | "^DIC",365 .18,365.18 ,"%D",4,0) | |
| 13137 | responses) are detai led an tra cked in th is file. | |
| 13138 | "^DIC",365 .18,"B","E IV EICD TR ACKING",36 5.18) | |
| 13139 | ||
| 13140 | "BLD",1097 2,6) | |
| 13141 | 6^ | |
| 13142 | $END KID I B*2.0*621 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.