Produced by Araxis Merge on 2/15/2018 4:26:11 PM Eastern Standard 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 | eBilling_Bld22_IB_2_608.zip | TAS eBill SDD US131 2487 2503 v2.00.docx | Tue Dec 19 16:22:03 2017 UTC |
| 2 | eBilling_Bld22_IB_2_608.zip | TAS eBill SDD US131 2487 2503 v2.00.docx | Thu Feb 15 18:03:24 2018 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 1 | 9900 |
| Changed | 0 | 0 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | TAS eBilli ng SDD | |
| 2 | US131 | |
| 3 | US-2487 | |
| 4 | US-2503 | |
| 5 | V2.00 | |
| 6 | System Des ign Docume nt | |
| 7 | IB*2.0*592 | |
| 8 | ||
| 9 | ||
| 10 | ||
| 11 | ||
| 12 | Department of Vetera ns Affairs | |
| 13 | August 201 7 | |
| 14 | Version 2. 00 | |
| 15 | User Story Number: US-131, | |
| 16 | US-2487, | |
| 17 | US-2503 | |
| 18 | User Story Name: Cr eate 837D Transactio n, | |
| 19 | Ins urance Com pany Entry /Edit – De ntal, | |
| 20 | Pro vider ID Maintenanc e – Dental | |
| 21 | Product Ba cklog ID: n/a | |
| 22 | Design/Ass umptions: | |
| 23 | The design for this user story is going on the fol lowing ass umptions: | |
| 24 | The data r equired by a biller to complet e a bill f or Dental services w ill be ava ilable to the biller for manua l entry in to a claim . | |
| 25 | FSC has re quested th at the Den tal Claims be in a b atch separ ate from 8 37 Profess ional and Institutio nal claims . | |
| 26 | VistA will provide t he non-X12 n data ele ment VAMC Site/Div I D to the c learinghou se so they can creat e their cl aims repor ts that th ey return to VistA. | |
| 27 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define a primary payer ID – EDI – Den tal Payer Primary ID . | |
| 28 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define the follow ing form-b ased provi der IDs fo r the Form Type J430 D: | |
| 29 | Billing Pr ovider Sec ondary IDs | |
| 30 | Additional Billing P rovider Se c. IDs | |
| 31 | VA-Lab/Fac ility Seco ndary IDs | |
| 32 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define required I D types fo r the foll owing prov ider types for the F orm Type J 430D: | |
| 33 | Attending/ Rendering | |
| 34 | Referring | |
| 35 | Assistant Surgeon | |
| 36 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define a mailing address fo r Dental C laims: | |
| 37 | Pointer to another p ayer’s add ress if de ntal claim s are proc essed by a nother pay er | |
| 38 | Address Li ne 1 – Req uired | |
| 39 | Address Li ne 2 – Opt ional | |
| 40 | City – Req uired | |
| 41 | State – Re quired | |
| 42 | ZIP – Requ ired (vali d 9 charac ter code) | |
| 43 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define a FAX numb er associa ted with t he Dental Address | |
| 44 | Insurance Company En try/Edit – The IB Sy stem will provide th e ability for users to define a telephon e number a ssociated with the D ental Addr ess | |
| 45 | Provider ID Mainten ance – The IB System will prov ide the ab ility for users to d efine the following provider I D types by the Form Type J430D : | |
| 46 | VA Provide r Own ID | |
| 47 | VA Provide r Insuranc e ID | |
| 48 | VA Provide r IDs by C are Units | |
| 49 | Non-VA Pro vider Own ID | |
| 50 | Non-VA Pro vider Insu rance ID | |
| 51 | Non-VA Fac ility Own ID | |
| 52 | Non-VA Fac ility Insu rance ID | |
| 53 | Default In surance ID s | |
| 54 | ||
| 55 | Resolution Summary: | |
| 56 | To resolve this requ est, the f ollowing b ullet item s will nee d to be wo rked on: | |
| 57 | Modify the process i n which th e 837 tran saction is created t o force a separate b atch be cr eated for Dental cla ims. | |
| 58 | Modify all areas of software t o handle t he dental claim form type (J43 0D) approp riately. | |
| 59 | Design Con straints: | |
| 60 | This SDD i s dependen t upon the following User Stor ies: | |
| 61 | US1108 (En ter/Edit D ental Clai ms) | |
| 62 | US2488 (Up date Repor ts – Form Type J430D ) | |
| 63 | US1109 (Cr eate Denta l Form/Upd ate Autobi ller) | |
| 64 | IOC Sites must provi de Dental Services t o their bi llable Vet erans. | |
| 65 | FSC must p rovide tes ting resou rces. | |
| 66 | HCCH must provide te sting reso urces. | |
| 67 | Detailed D esign: | |
| 68 | ||
| 69 | The follow ing routin es need to be modifi ed in orde r to allow for the c reation an d processi ng of an 8 37D transa ction. | |
| 70 | ||
| 71 | Routines | |
| 72 | Activities | |
| 73 | Routine Na me | |
| 74 | IBCE837 | |
| 75 | Enhancemen t Category | |
| 76 | New | |
| 77 | Modify | |
| 78 | Delete | |
| 79 | No Change | |
| 80 | RTM | |
| 81 | ||
| 82 | Related Op tions | |
| 83 | None | |
| 84 | Related Ro utines | |
| 85 | Routines “ Called By” | |
| 86 | Routines “ Called” | |
| 87 | ||
| 88 | ||
| 89 | ||
| 90 | ||
| 91 | Data Dicti onary (DD) Reference s | |
| 92 | IB SITE PA RAMETERS [ #350.9] | |
| 93 | EDI TRANSM IT BILL [# 364] | |
| 94 | BILL/CLAIM S [#399] | |
| 95 | BILL FORM TYPE [#353 ] | |
| 96 | INSURANCE COMPANY [# 36] | |
| 97 | ||
| 98 | Related Pr otocols | |
| 99 | None | |
| 100 | Related In tegration Control Re gistration s (ICRs) | |
| 101 | None | |
| 102 | Data Passi ng | |
| 103 | Input | |
| 104 | Output Re ference | |
| 105 | Both | |
| 106 | Global Re ference | |
| 107 | Local | |
| 108 | Input Attr ibute Name and Defin ition | |
| 109 | Name: | |
| 110 | Definition : | |
| 111 | Output Att ribute Nam e and Defi nition | |
| 112 | Name: | |
| 113 | Definition : | |
| 114 | Current Lo gic | |
| 115 | IBCE837 ;A LB/TMP - O UTPUT FOR 837 TRANSM ISSION ;8/ 6/03 10:48 am ;;2.0;I NTEGRATED BILLING;** 137,191,19 7,232,296, 349,547**; 21-MAR-94; Build 119 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ;EN ; Au to-txmt N IBSITE8,IB RUN,X,X1,X 2,DA,DIE,D R K ^TMP(" IBRESUBMIT ",$J),^TMP ("IBONE",$ J) S IBSIT E8=$G(^IBE (350.9,1,8 )),IBRUN=1 Q:'$P(IBS ITE8,U,3)! '$P(IBSITE 8,U,10) I '$$MGCHK^I BCE(0) Q I $P(IBSITE 8,U,5) D Q:'IBRUN . S X2=+$P( IBSITE8,U, 3),X1=$P(I BSITE8,U,5 ) D C^%DTC . I X>DT S IBRUN=0 Q D QTXMT^ IBCE837B(I BSITE8) I $P(IBSITE8 ,U,5)'=DT S DIE="^IB E(350.9,", DR="8.05// //"_DT,DA= 1 D ^DIE Q ;SETUP(IB EXTRP) ; T xmn set up ; IBEXTRP =1 prnt 83 7 data N I B K ^TMP(" IBXMSG",$J ),^TMP("IB TXMT",$J), ^TMP("IBHD R",$J),^TM P("IBHDR1" ,$J),^TMP( "IBXERR",$ J),IBXERR, ^TMP("IBXI NS",$J),^T MP("IBTX", $J),^TMP(" IBEDI_TEST _BATCH",$J ) ; Chk ex tract runn ing Q:$G(I BEXTRP) ; Chk resubm it tst I $ P($G(^TMP( "IBRESUBMI T",$J)),U, 4) S ^TMP( "IBEDI_TES T_BATCH",$ J)=1 Q I ' $D(^TMP("I BRESUBMIT" ,$J)),'$D( ^TMP("IBON E",$J)) D Q:$D(IBXE RR) . L +^ IBA(364,0) :5 . I '$T D Q .. S IBXERR=1, ^TMP("IBXE RR",$J,1)= "A PREVIOU S EDI EXTR ACT IS RUN NING - ANO THER CANNO T BE START ED "_$$FMT E^XLFDT($$ NOW^XLFDT( ),2) ; I $ D(^TMP("IB RESUBMIT", $J)) D Q: $D(IBXERR) .N Z,Z0 . S Z0=$P($G (^TMP("IBR ESUBMIT",$ J)),U,2),Z =$$LOCK^IB CEM02(364. 1,Z0) .I ' Z D ..S IB XERR=1 ..S ^TMP("IBR ESUBMIT",$ J,"IBXERR" ,1)="Anoth er user is currently processin g batch "_ Z0_". Batc h NOT resu bmitted." .I 'Z D .. S IBXERR=1 ..S ^TMP( "IBRESUBMI T",$J,"IBX ERR",1)="A nother use r is curre ntly proce ssing batc h "_Z0_". Batch NOT resubmitte d." ..S ^T MP("IBRESU BMIT",$J," IBXERR",2) ="Resubmit was attem pted by: " _$P($G(^VA (200,DUZ,0 )),U)_" (" _DUZ_")" I $D(^TMP(" IBONE",$J) ) S IB=$G( ^($J))+1 D Q:$D(IBX ERR) .N Z, Z0 .S Z0=$ O(^TMP("IB ONE",$J,"" )),Z=$$LOC K^IBCEM02( 364,Z0) .I 'Z D ..S IBXERR=1 . .S ^TMP("I BONE",$J," IBXERR",1) ="Another user is cu rrently pr ocessing b ill "_$P($ G(^DGCR(39 9,+$G(^IBA (364,Z0,0) ),0)),U)_" . Bill NOT "_$P("^re ",U,IB)_"s ubmitted." ..S ^TMP( "IBONE",$J ,"IBXERR", 2)=$P("S^R es",U,IB)_ "ubmit was attempted by: "_$P( $G(^VA(200 ,DUZ,0)),U )_" ("_DUZ _")" Q ;FI ND ; Find/ sort by CM S-1500/UB- 04, test/l ive, ins I D # & div ; N IBX,IB 0,IBCBH,IB INS,IBXIEN ,IBNID,IBG BL,IBTXTES T,IBBTYP,I B837R,IBDI V,IBNOTX,I BTXST,IBTE ST,IBSEC,I BNF K ^TMP ($J,"BILL" ),^TMP("IB ICT",$J) ; S IBGBL=$ S($D(^TMP( "IBONE",$J )):"^TMP(" "IBONE""," _$J_")",$D (^TMP("IBS ELX",$J)): "^TMP(""IB SELX"","_$ J_")",'$D( ^TMP("IBRE SUBMIT",$J )):"^IBA(3 64,""ASTAT "",""X"")" ,1:"^TMP(" "IBRESUBMI T"","_$J_" )") S IBTE ST=+$G(^TM P("IBEDI_T EST_BATCH" ,$J)) ; S IBX="" F S IBX=$O(@ IBGBL@(IBX )) Q:'IBX D .;IB 54 7, If resu bmitting a locally p rinted cla im to test via RCB, there is n o entry in 364 yet, so pass th e NEW flag .;S IBXIE N=+$G(^IBA (364,IBX,0 )),IB0=$G( ^DGCR(399, IBXIEN,0)) .;S IBTXS T=$$TXMT^I BCEF4(IBXI EN,.IBNOTX ) .S IBXIE N=+$G(^IBA (364,IBX,0 )),IBNF="" .I $G(IBL OC)=1,$G(I BTYPPTC)=" TEST" S IB XIEN=IBX,I BNF=1 .S I B0=$G(^DGC R(399,IBXI EN,0)) .S IBTXST=$$T XMT^IBCEF4 (IBXIEN,.I BNOTX,IBNF ) .Q:IBTXS T="" ; no txmt .Q:$ S(IB0="":1 ,$P(IB0,U, 13)>4&'IBT EST:1,1:$D (^TMP($J," BILL",$P(I B0,U)))) . S IBCBH=$P (IB0,U,21) S:"PST"'[ IBCBH!(IBC BH="") IBC BH="P" .S IBINS=$P($ G(^DGCR(39 9,IBXIEN," I"_($F("PS T",IBCBH)- 1))),U) .S IBTXTEST= $S(IBTEST: 2,1:+$$TES T^IBCEF4(I BXIEN)) .S IBBTYP=$P ("P^I",U,( $$FT^IBCEF (IBXIEN)=3 )+1)_"-"_I BTXTEST .Q :$$TESTPT^ IBCEU($P(I B0,U,2))&' IBTXTEST ;Test pt . ; .I IBTXT EST=1 D TE STLIM^IBCE 837A(.IBIN S) .; .I I BINS,$P(IB 0,U,2) D . . D SETVAR ^IBCE837A( IBXIEN,IBI NS,IB0,.IB SEC,.IBNID ,.IB837R,. IBDIV) ..S :'$D(^TMP( "IBXINS",$ J,IBDIV_U_ IBBTYP,IBN ID)) ^(IBN ID)=IBINS S ^TMP("IB TXMT",$J,I BDIV_U_IBB TYP,IB837R _U_IBSEC,I BNID,$P(IB 0,U,2),IBX IEN_U_IBX) =IBX .; .S ^TMP($J," BILL",$P(I B0,U))="" ; I $D(^TM P("IBTXMT" ,$J)) S ^T MP("IBXDAT A",$J)=IBN ID K ^TMP( $J,"BILL") Q ;OUTPUT ; 837 ; N IB837,IBS ITE,IBMAX, IBQUEUE,IB TQUEUE,IBN ID,IBCT,IB CTM,IBSIZE ,IBBILL,IB LCNT,IBDFN ,IBREF,IBS IZEM,IBPAR MS,IBD,IBD ESC,IBINS, IBQ,IB3,IB BTYP,IBTXT EST,IBDEFP RT,IB837R, IBBTYPX ; K ^TMP("IB CE-BATCH", $J) S IBSI TE=$G(^IBE (350.9,1,8 )),IBMAX=$ P(IBSITE,U ,4),IB837= +$O(^IBE(3 53,"B","IB 837 TRANS MISSION",0 )),IB837=$ S($P($G(^I BE(353,+IB 837,2)),U, 8):$P(^(2) ,U,8),1:IB 837) S:'IB MAX IBMAX= 999 ; I 'I B837 D Q . N IBZ,XM BODY . S X MBODY="IBZ " . S IBZ( 1)="The tr ansmission form for sending el ectronic c laims is n ot in your form file ",IBZ(2)=" NO CLAIMS WERE OUTPU T - FORM = IB 837 TR ANSMISSION " . D ERRM SG^IBCE837 A(XMBODY) ; S (IBCT, IBCTM,IBSI ZE)=0,IBQU EUE=$P(IBS ITE,U),IBT QUEUE=$P(I BSITE,U,9) ,IBDESC="" ; Q:IBQUE UE=""&(IBT QUEUE="") ; S IBQ="" ,IBBTYPX=" " ; Sort: div_^_bill type_-_te st stat,in s co trans mission de stination^ sec status ,dfn,claim # F S IB BTYPX=$O(^ TMP("IBTXM T",$J,IBBT YPX)),IBBT YP=$P(IBBT YPX,U,2) D :IBCTM CHK NEW^IBCE83 7A(IBQ,.IB BILL,.IBCT M,IBDESC,I BBTYP,"",I BSITE,.IBS IZE) Q:IBB TYPX="" D . S IBDEF PRT=$S($E( IBBTYP)="P ":"SPRINT" ,1:"SPRINT ") . S IBT XTEST=+$P( IBBTYP,"-" ,2),IBQ=$S ('IBTXTEST :IBQUEUE,I BTXTEST=2: "MCT",1:IB TQUEUE) . Q:IBQ="" ; Queue . ; . S IBD= $S($E(IBBT YP)="P":"P ROF",1:"IN ST")_" CLA IMS-"_$$HT E^XLFDT($H ,2)_" " . S IBDESC=$ S('$P(IBSI TE,U,7):$S ('IBTXTEST :"",1:"TES T ")_IBD,1 :"") . ; . S IB837R= "" . F S IB837R=$O( ^TMP("IBTX MT",$J,IBB TYPX,IB837 R)) D:IBCT M CHKNEW^I BCE837A(IB Q,.IBBILL, .IBCTM,IBD ESC,IBBTYP ,"",IBSITE ,.IBSIZE) Q:IB837R=" " D .. S (IBINS,IBN ID)="",IBL CNT=0 .. F S IBNID= $O(^TMP("I BTXMT",$J, IBBTYPX,IB 837R,IBNID )) K ^TMP( "IBHDR1",$ J) D:IBCTM CHKNEW^IB CE837A(IBQ ,.IBBILL,. IBCTM,IBDE SC,IBBTYP, IBINS,IBSI TE,.IBSIZE ) Q:IBNID= "" D ...; ...S IBDF N=0,IBINS= +$G(^TMP(" IBXINS",$J ,IBBTYPX,I BNID)) ... ; ...I $P (IBSITE,U, 7) D ; 1 ins/batch .... S IBL CNT=0 .... S IBDESC= $E($S('IBT XTEST:"",1 :"TEST ")_ IBD_$P($G( ^DIC(36,IB INS,0)),U) ,1,80) ... ; ...F S IBDFN=$O( ^TMP("IBTX MT",$J,IBB TYPX,IB837 R,IBNID,IB DFN)) Q:'I BDFN S IB REF="" F S IBREF=$O (^TMP("IBT XMT",$J,IB BTYPX,IB83 7R,IBNID,I BDFN,IBREF )) Q:'IBRE F D ....I '(IBCTM#I BMAX),IBCT M D MAILIT ^IBCE837A( IBQ,.IBBIL L,.IBCTM," ",IBDESC,I BBTYP,IBIN S) S IBSIZ E=0 ;excee ds max # . ...D BILLP ARM^IBCEFG 0(+IBREF,. IBPARMS) . ...S IBSIZ EM=$$EXTRA CT^IBCEFG( IB837,+IBR EF,1,.IBPA RMS) ....I (IBSIZEM+ IBSIZE)>30 000,IBSIZE D ; exce eds max si ze .....D MAILIT^IBC E837A(IBQ, .IBBILL,.I BCTM,"",IB DESC,IBBTY P,IBINS) S IBSIZE=0 K ^TMP("IB XDATA",$J) S IBSIZEM =$$EXTRACT ^IBCEFG(IB 837,+IBREF ,1,.IBPARM S) ....I ' IBSIZEM D: 'IBCTM Q ..... D CH KBTCH^IBCE 837A(+$G(^ TMP("IBHDR ",$J))) K ^TMP("IBHD R",$J) ... .S IBCT=IB CT+1,IBCTM =IBCTM+1 . ...D:$D(^T MP("IBXDAT A",$J)) ME SSAGE(.IBL CNT,$P(IBR EF,U,2),.I BBILL,.IBC TM,.IBSIZE ,IBSIZEM," ",IBBTYP,I BINS) ..; ..I $G(IBT XTEST)=1 S IBINS=0 F S IBINS= $O(^TMP("I BICT",$J,I BINS)) Q:' IBINS S I B3=$G(^DIC (36,IBINS, 3)) D ... N DIE,DA,D R ...S DIE ="^DIC(36, ",DA=IBINS ,DR="3.05/ ///"_DT_"; 3.07////"_ ($S($P(IB3 ,U,5)'=DT: 0,1:$P(IB3 ,U,7))+^TM P("IBICT", $J,IBINS)) D ^DIE ; I $O(^TMP( "IBXERR",$ J,"")) D ;Error to mail grp . N XMTO,XMB ODY,XMDUZ, XMSUBJ,IBC T,IBERR .K ^TMP("IBX MSG",$J) . S ^TMP("IB XMSG",$J,1 )="The fol lowing aut horized bi ll(s) were not trans mitted due to errors indicated .",^(2)="O nce the er rors are c orrected, the bill(s ) will be included i n the next run.",^(3 )=" " .; . S IBERR=0, IBCT=3 .F S IBERR=$ O(^TMP("IB XERR",$J,I BERR)) Q:' IBERR S I BCT=IBCT+1 ,^TMP("IBX MSG",$J,IB CT)="Bill #: "_$P($G (^DGCR(399 ,IBERR,0)) ,U),IBCT=I BCT+1,^TMP ("IBXMSG", $J,IBCT)=$ J("",5)_^T MP("IBXERR ",$J,IBERR ) .S XMBOD Y="^TMP("" IBXMSG""," _$J_")" D ERRMSG^IBC E837A(XMBO DY) .; .K ^TMP("IBXM SG",$J),^T MP("IBICT" ,$J) ; I $ O(^TMP("IB CE-BATCH", $J,"")) D .N IB,IB0, IBL,IBT,IB X,XMTO,XMD UZ,XMSUBJ, IBRESUB,IB TESTB,XMZ .S IBRESUB =$D(^TMP(" IBRESUBMIT ",$J)) .; .S IBT(1)= "The follo wing batch es were "_ $S('IBRESU B:"",1:"re -")_"submi tted to Au stin "_$S( IBTXTEST'= 2:"",1:"as TEST ")_$ $HTE^XLFDT ($H,"2D")_ ":" .S IBT (2)=$S('IB RESUB:" ", 1:" [Resub mitted by: "_$P($G(^ VA(200,+DU Z,0)),U)_" (#"_DUZ_" )]") S:IBR ESUB IBT(3 )=" " .; . S IBL=$S(' IBRESUB:2, 1:3),IB="" .F S IB= $O(^TMP("I BCE-BATCH" ,$J,IB)) Q :IB="" S IBL=IBL+1, IB0=$G(^(I B)) D .. S IBX=IB .. I $P(IB0, U,3)'="",I BTXTEST=2 S IBX=$P(I B0,U,3)_" (AS BATCH "_IB_")" . .S IBT(IBL )=" "_IBX_ " "_$P($G( ^IBA(364.1 ,+IB0,0)), U,8),IBL=I BL+1,IBT(I BL)=" ("_+ $P(IB0,U,2 )_" bills) " .; .S XM TO("I:G.IB EDI")="", XMDUZ="",X MBODY="IBT ",XMSUBJ=" EDI 837 "_ $S('IBRESU B:"",1:"RE -")_"SUBMI SSION BATC H LIST"_$S (IBTXTEST' =2:"",1:" FOR TEST") .D SENDMS G^XMXAPI(X MDUZ,XMSUB J,XMBODY,. XMTO,,.XMZ ) .; .S:IB RESUB ^TMP ("IBRESUBM IT",$J,0)= 1 Q ;CLEAN UP ; moved D CLEANUP ^IBCE837A Q ;MESSAGE (IBLCNT,IB IEN,IBBILL ,IBCTM,IBS IZE,IBSIZE M,IBDUZ,IB BTYP,IBINS ) ; Create msg in ^T MP("IBXMSG ",$J) ;IBL CNT = last msg line extracted ;IBIEN = i en file 36 4 bill ent ry ;IBBILL = array f ile 364 ie n's of bil ls being s ent ; IBBI LL(IEN)="" ;IBSIZE = # bytes i n msg ;IBS IZEM = # b ytes in re cord to be added to msg ;IBCTM = # bills in batch ;IBDUZ = u ser ien ru nning extr act (Postm aster if a uto) ;IBBT YP = x-y w here x = P for prof, I for ins t ; y = 1 for test, 0 for live txmt ;IBI NS = ien o f 1 ins co for batch ; N IB,IB L,IB1,IB2, IB3,IBQ,IB REC,IBDEL S IBDEL=$O (^IBA(364. 5,"B","N-S EGMENT DEL IMITER","" )),IBDEL=$ P($G(^IBA( 364.5,+IBD EL,0)),U,8 ) S:IBDEL= "" IBDEL=" ~" S IBSIZ E=IBSIZE+I BSIZEM,IB1 ="",IBREC= "" F S IB 1=$O(^TMP( "IBXDATA", $J,1,IB1)) Q:IB1="" D .S (IBR EC,IB2)="" .F S IB2 =$O(^TMP(" IBXDATA",$ J,1,IB1,IB 2)) Q:$S(I B2="":1,IB 1=1:"",1:' $O(^(IB2,1 ))) D ..S IB3="",IBR EC="" ..F S IB3=$O( ^TMP("IBXD ATA",$J,1, IB1,IB2,IB 3)) D:IB3= ""&($L(IBR EC)) SETG Q:IB3="" S:$S(IB3=1 :1,1:$P(IB REC,U)'="" ) $P(IBREC ,U,IB3)=$$ UP^XLFSTR( ^TMP("IBXD ATA",$J,1, IB1,IB2,IB 3)) S IBBI LL(IBIEN)= "" K ^TMP( "IBXDATA", $J) Q ;SET HDR ; hdr for curr b atch S ^TM P("IBHDR", $J)=$G(^TM P("IBXDATA ",$J,1,5,1 ,2)) Q ;SE THDR1 ; hd r node for curr ins S ^TMP("IB HDR1",$J)= $G(^TMP("I BXDATA",$J ,1,20,1,8) ) Q ;SETG ; msg glob al for eac h segment S IBREC=$T R(IBREC,IB DEL) S IBR EC=IBREC_I BDEL,IBSIZ E=IBSIZE+$ L(IBDEL) S IBLCNT=IB LCNT+1,^TM P("IBXMSG" ,$J,IBLCNT )=IBREC Q ;ONE ; Txm t 1 or mor e bills fo r test or in 'X' sta tus for li ve Q:'$$MG CHK^IBCE(0 ) D SETUP( 0) I '$D(I BXERR) D F IND,OUTPUT D CLEANUP ^IBCE837A Q ; | |
| 116 | Modified L ogic (Chan ges are in bold) | |
| 117 | IBCE837 ;A LB/TMP - O UTPUT FOR 837 TRANSM ISSION ;8/ 6/03 10:48 am ;;2.0;I NTEGRATED BILLING;** 137,191,19 7,232,296, 349,547,59 2**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;EN ; Auto-txm t N IBSITE 8,IBRUN,X, X1,X2,DA,D IE,DR K ^T MP("IBRESU BMIT",$J), ^TMP("IBON E",$J) S I BSITE8=$G( ^IBE(350.9 ,1,8)),IBR UN=1 Q:'$P (IBSITE8,U ,3)!'$P(IB SITE8,U,10 ) I '$$MGC HK^IBCE(0) Q I $P(IB SITE8,U,5) D Q:'IBR UN . S X2= +$P(IBSITE 8,U,3),X1= $P(IBSITE8 ,U,5) D C^ %DTC . I X >DT S IBRU N=0 Q D QT XMT^IBCE83 7B(IBSITE8 ) I $P(IBS ITE8,U,5)' =DT S DIE= "^IBE(350. 9,",DR="8. 05////"_DT ,DA=1 D ^D IE Q ;SETU P(IBEXTRP) ; Txmn se t up ; IBE XTRP=1 prn t 837 data N IB K ^T MP("IBXMSG ",$J),^TMP ("IBTXMT", $J),^TMP(" IBHDR",$J) ,^TMP("IBH DR1",$J),^ TMP("IBXER R",$J),IBX ERR,^TMP(" IBXINS",$J ),^TMP("IB TX",$J),^T MP("IBEDI_ TEST_BATCH ",$J) ; Ch k extract running Q: $G(IBEXTRP ) ; Chk re submit tst I $P($G(^ TMP("IBRES UBMIT",$J) ),U,4) S ^ TMP("IBEDI _TEST_BATC H",$J)=1 Q I '$D(^TM P("IBRESUB MIT",$J)), '$D(^TMP(" IBONE",$J) ) D Q:$D( IBXERR) . L +^IBA(36 4,0):5 . I '$T D Q .. S IBXER R=1,^TMP(" IBXERR",$J ,1)="A PRE VIOUS EDI EXTRACT IS RUNNING - ANOTHER C ANNOT BE S TARTED "_$ $FMTE^XLFD T($$NOW^XL FDT(),2) ; I $D(^TMP ("IBRESUBM IT",$J)) D Q:$D(IBX ERR) .N Z, Z0 .S Z0=$ P($G(^TMP( "IBRESUBMI T",$J)),U, 2),Z=$$LOC K^IBCEM02( 364.1,Z0) .I 'Z D .. S IBXERR=1 ..S ^TMP( "IBRESUBMI T",$J,"IBX ERR",1)="A nother use r is curre ntly proce ssing batc h "_Z0_". Batch NOT resubmitte d." .I 'Z D ..S IBXE RR=1 ..S ^ TMP("IBRES UBMIT",$J, "IBXERR",1 )="Another user is c urrently p rocessing batch "_Z0 _". Batch NOT resubm itted." .. S ^TMP("IB RESUBMIT", $J,"IBXERR ",2)="Resu bmit was a ttempted b y: "_$P($G (^VA(200,D UZ,0)),U)_ " ("_DUZ_" )" I $D(^T MP("IBONE" ,$J)) S IB =$G(^($J)) +1 D Q:$D (IBXERR) . N Z,Z0 .S Z0=$O(^TMP ("IBONE",$ J,"")),Z=$ $LOCK^IBCE M02(364,Z0 ) .I 'Z D ..S IBXERR =1 ..S ^TM P("IBONE", $J,"IBXERR ",1)="Anot her user i s currentl y processi ng bill "_ $P($G(^DGC R(399,+$G( ^IBA(364,Z 0,0)),0)), U)_". Bill NOT "_$P( "^re",U,IB )_"submitt ed." ..S ^ TMP("IBONE ",$J,"IBXE RR",2)=$P( "S^Res",U, IB)_"ubmit was attem pted by: " _$P($G(^VA (200,DUZ,0 )),U)_" (" _DUZ_")" Q ;FIND ; F ind/sort b y CMS-1500 /UB-04, te st/live, i ns ID # & div ; N IB X,IB0,IBCB H,IBINS,IB XIEN,IBNID ,IBGBL,IBT XTEST,IBBT YP,IB837R, IBDIV,IBNO TX,IBTXST, IBTEST,IBS EC,IBNF K ^TMP($J,"B ILL"),^TMP ("IBICT",$ J) ; S IBG BL=$S($D(^ TMP("IBONE ",$J)):"^T MP(""IBONE "","_$J_") ",$D(^TMP( "IBSELX",$ J)):"^TMP( ""IBSELX"" ,"_$J_")", '$D(^TMP(" IBRESUBMIT ",$J)):"^I BA(364,""A STAT"",""X "")",1:"^T MP(""IBRES UBMIT"","_ $J_")") S IBTEST=+$G (^TMP("IBE DI_TEST_BA TCH",$J)) ; S IBX="" F S IBX= $O(@IBGBL@ (IBX)) Q:' IBX D .;I B 547, If resubmitti ng a local ly printed claim to test via R CB, there is no entr y in 364 y et, so pas s the NEW flag .;S I BXIEN=+$G( ^IBA(364,I BX,0)),IB0 =$G(^DGCR( 399,IBXIEN ,0)) .;S I BTXST=$$TX MT^IBCEF4( IBXIEN,.IB NOTX) .S I BXIEN=+$G( ^IBA(364,I BX,0)),IBN F="" .I $G (IBLOC)=1, $G(IBTYPPT C)="TEST" S IBXIEN=I BX,IBNF=1 .S IB0=$G( ^DGCR(399, IBXIEN,0)) .S IBTXST =$$TXMT^IB CEF4(IBXIE N,.IBNOTX, IBNF) .Q:I BTXST="" ; no txmt .Q:$S(IB0= "":1,$P(IB 0,U,13)>4& 'IBTEST:1, 1:$D(^TMP( $J,"BILL", $P(IB0,U)) )) .S IBCB H=$P(IB0,U ,21) S:"PS T"'[IBCBH! (IBCBH="") IBCBH="P" .S IBINS= $P($G(^DGC R(399,IBXI EN,"I"_($F ("PST",IBC BH)-1))),U ) .S IBTXT EST=$S(IBT EST:2,1:+$ $TEST^IBCE F4(IBXIEN) ) .;JWS:IB *2.0*592:U S131 - EDI Dental Cl aim .S IBB TYP=$P("P^ I^D",U,$S( $$FT^IBCEF (IBXIEN)=7 :3,1:($$FT ^IBCEF(IBX IEN)=3)+1) )_"-"_IBTX TEST .Q:$$ TESTPT^IBC EU($P(IB0, U,2))&'IBT XTEST ;Te st pt .; . I IBTXTEST =1 D TESTL IM^IBCE837 A(.IBINS) .; .I IBIN S,$P(IB0,U ,2) D .. D SETVAR^IB CE837A(IBX IEN,IBINS, IB0,.IBSEC ,.IBNID,.I B837R,.IBD IV) ..S:'$ D(^TMP("IB XINS",$J,I BDIV_U_IBB TYP,IBNID) ) ^(IBNID) =IBINS S ^ TMP("IBTXM T",$J,IBDI V_U_IBBTYP ,IB837R_U_ IBSEC,IBNI D,$P(IB0,U ,2),IBXIEN _U_IBX)=IB X .; .S ^T MP($J,"BIL L",$P(IB0, U))="" ; I $D(^TMP(" IBTXMT",$J )) S ^TMP( "IBXDATA", $J)=IBNID K ^TMP($J, "BILL") Q ;OUTPUT ; 837 ; N IB 837,IBSITE ,IBMAX,IBQ UEUE,IBTQU EUE,IBNID, IBCT,IBCTM ,IBSIZE,IB BILL,IBLCN T,IBDFN,IB REF,IBSIZE M,IBPARMS, IBD,IBDESC ,IBINS,IBQ ,IB3,IBBTY P,IBTXTEST ,IBDEFPRT, IB837R,IBB TYPX ; K ^ TMP("IBCE- BATCH",$J) S IBSITE= $G(^IBE(35 0.9,1,8)), IBMAX=$P(I BSITE,U,4) ,IB837=+$O (^IBE(353, "B","IB 83 7 TRANSMIS SION",0)), IB837=$S($ P($G(^IBE( 353,+IB837 ,2)),U,8): $P(^(2),U, 8),1:IB837 ) S:'IBMAX IBMAX=999 ; I 'IB83 7 D Q . N IBZ,XMBOD Y . S XMBO DY="IBZ" . S IBZ(1)= "The trans mission fo rm for sen ding elect ronic clai ms is not in your fo rm file",I BZ(2)="NO CLAIMS WER E OUTPUT - FORM = IB 837 TRANS MISSION" . D ERRMSG^ IBCE837A(X MBODY) ; S (IBCT,IBC TM,IBSIZE) =0,IBQUEUE =$P(IBSITE ,U),IBTQUE UE=$P(IBSI TE,U,9),IB DESC="" ; Q:IBQUEUE= ""&(IBTQUE UE="") ; S IBQ="",IB BTYPX="" ; Sort: div _^_bill ty pe_-_test stat,ins c o transmis sion desti nation^sec status,df n,claim # F S IBBTY PX=$O(^TMP ("IBTXMT", $J,IBBTYPX )),IBBTYP= $P(IBBTYPX ,U,2) D:IB CTM CHKNEW ^IBCE837A( IBQ,.IBBIL L,.IBCTM,I BDESC,IBBT YP,"",IBSI TE,.IBSIZE ) Q:IBBTYP X="" D . S IBDEFPRT =$S($E(IBB TYP)="P":" SPRINT",1: "SPRINT") . S IBTXTE ST=+$P(IBB TYP,"-",2) ,IBQ=$S('I BTXTEST:IB QUEUE,IBTX TEST=2:"MC T",1:IBTQU EUE) . Q:I BQ="" ; Q ueue . ; . ;JWS:IB*2 .0*592:US1 31 - EDI D ental Clai m . S IBD= $S($E(IBBT YP)="P":"P ROF",$E(IB BTYP)="D": "DENT",1:" INST")_" C LAIMS-"_$$ HTE^XLFDT( $H,2)_" " . S IBDESC =$S('$P(IB SITE,U,7): $S('IBTXTE ST:"",1:"T EST ")_IBD ,1:"") . ; . S IB837 R="" . F S IB837R=$ O(^TMP("IB TXMT",$J,I BBTYPX,IB8 37R)) D:IB CTM CHKNEW ^IBCE837A( IBQ,.IBBIL L,.IBCTM,I BDESC,IBBT YP,"",IBSI TE,.IBSIZE ) Q:IB837R ="" D .. S (IBINS,I BNID)="",I BLCNT=0 .. F S IBNI D=$O(^TMP( "IBTXMT",$ J,IBBTYPX, IB837R,IBN ID)) K ^TM P("IBHDR1" ,$J) D:IBC TM CHKNEW^ IBCE837A(I BQ,.IBBILL ,.IBCTM,IB DESC,IBBTY P,IBINS,IB SITE,.IBSI ZE) Q:IBNI D="" D .. .; ...S IB DFN=0,IBIN S=+$G(^TMP ("IBXINS", $J,IBBTYPX ,IBNID)) . .. ; ...I $P(IBSITE, U,7) D ; 1 ins/batc h .... S I BLCNT=0 .. .. S IBDES C=$E($S('I BTXTEST:"" ,1:"TEST " )_IBD_$P($ G(^DIC(36, IBINS,0)), U),1,80) . .. ; ...F S IBDFN=$ O(^TMP("IB TXMT",$J,I BBTYPX,IB8 37R,IBNID, IBDFN)) Q: 'IBDFN S IBREF="" F S IBREF= $O(^TMP("I BTXMT",$J, IBBTYPX,IB 837R,IBNID ,IBDFN,IBR EF)) Q:'IB REF D ... .I '(IBCTM #IBMAX),IB CTM D MAIL IT^IBCE837 A(IBQ,.IBB ILL,.IBCTM ,"",IBDESC ,IBBTYP,IB INS) S IBS IZE=0 ;exc eeds max # ....D BIL LPARM^IBCE FG0(+IBREF ,.IBPARMS) ....S IBS IZEM=$$EXT RACT^IBCEF G(IB837,+I BREF,1,.IB PARMS) ... .I (IBSIZE M+IBSIZE)> 30000,IBSI ZE D ; ex ceeds max size ..... D MAILIT^I BCE837A(IB Q,.IBBILL, .IBCTM,"", IBDESC,IBB TYP,IBINS) S IBSIZE= 0 K ^TMP(" IBXDATA",$ J) S IBSIZ EM=$$EXTRA CT^IBCEFG( IB837,+IBR EF,1,.IBPA RMS) ....I 'IBSIZEM D:'IBCTM Q ..... D CHKBTCH^IB CE837A(+$G (^TMP("IBH DR",$J))) K ^TMP("IB HDR",$J) . ...S IBCT= IBCT+1,IBC TM=IBCTM+1 ....D:$D( ^TMP("IBXD ATA",$J)) MESSAGE(.I BLCNT,$P(I BREF,U,2), .IBBILL,.I BCTM,.IBSI ZE,IBSIZEM ,"",IBBTYP ,IBINS) .. ; ..I $G(I BTXTEST)=1 S IBINS=0 F S IBIN S=$O(^TMP( "IBICT",$J ,IBINS)) Q :'IBINS S IB3=$G(^D IC(36,IBIN S,3)) D .. . N DIE,DA ,DR ...S D IE="^DIC(3 6,",DA=IBI NS,DR="3.0 5////"_DT_ ";3.07//// "_($S($P(I B3,U,5)'=D T:0,1:$P(I B3,U,7))+^ TMP("IBICT ",$J,IBINS )) D ^DIE ; I $O(^TM P("IBXERR" ,$J,"")) D ;Error t o mail grp .N XMTO,X MBODY,XMDU Z,XMSUBJ,I BCT,IBERR .K ^TMP("I BXMSG",$J) .S ^TMP(" IBXMSG",$J ,1)="The f ollowing a uthorized bill(s) we re not tra nsmitted d ue to erro rs indicat ed.",^(2)= "Once the errors are corrected , the bill (s) will b e included in the ne xt run.",^ (3)=" " .; .S IBERR= 0,IBCT=3 . F S IBERR =$O(^TMP(" IBXERR",$J ,IBERR)) Q :'IBERR S IBCT=IBCT +1,^TMP("I BXMSG",$J, IBCT)="Bil l #: "_$P( $G(^DGCR(3 99,IBERR,0 )),U),IBCT =IBCT+1,^T MP("IBXMSG ",$J,IBCT) =$J("",5)_ ^TMP("IBXE RR",$J,IBE RR) .S XMB ODY="^TMP( ""IBXMSG"" ,"_$J_")" D ERRMSG^I BCE837A(XM BODY) .; . K ^TMP("IB XMSG",$J), ^TMP("IBIC T",$J) ; I $O(^TMP(" IBCE-BATCH ",$J,"")) D .N IB,IB 0,IBL,IBT, IBX,XMTO,X MDUZ,XMSUB J,IBRESUB, IBTESTB,XM Z .S IBRES UB=$D(^TMP ("IBRESUBM IT",$J)) . ; .S IBT(1 )="The fol lowing bat ches were "_$S('IBRE SUB:"",1:" re-")_"sub mitted to Austin "_$ S(IBTXTEST '=2:"",1:" as TEST ") _$$HTE^XLF DT($H,"2D" )_":" .S I BT(2)=$S(' IBRESUB:" ",1:" [Res ubmitted b y: "_$P($G (^VA(200,+ DUZ,0)),U) _" (#"_DUZ _")]") S:I BRESUB IBT (3)=" " .; .S IBL=$S ('IBRESUB: 2,1:3),IB= "" .F S I B=$O(^TMP( "IBCE-BATC H",$J,IB)) Q:IB="" S IBL=IBL+ 1,IB0=$G(^ (IB)) D .. S IBX=IB .. I $P(IB 0,U,3)'="" ,IBTXTEST= 2 S IBX=$P (IB0,U,3)_ " (AS BATC H "_IB_")" ..S IBT(I BL)=" "_IB X_" "_$P($ G(^IBA(364 .1,+IB0,0) ),U,8),IBL =IBL+1,IBT (IBL)=" (" _+$P(IB0,U ,2)_" bill s)" .; .S XMTO("I:G. IB EDI")=" ",XMDUZ="" ,XMBODY="I BT",XMSUBJ ="EDI 837 "_$S('IBRE SUB:"",1:" RE-")_"SUB MISSION BA TCH LIST"_ $S(IBTXTES T'=2:"",1: " FOR TEST ") .D SEND MSG^XMXAPI (XMDUZ,XMS UBJ,XMBODY ,.XMTO,,.X MZ) .; .S: IBRESUB ^T MP("IBRESU BMIT",$J,0 )=1 Q ;CLE ANUP ; mov ed D CLEAN UP^IBCE837 A Q ;MESSA GE(IBLCNT, IBIEN,IBBI LL,IBCTM,I BSIZE,IBSI ZEM,IBDUZ, IBBTYP,IBI NS) ; Crea te msg in ^TMP("IBXM SG",$J) ;I BLCNT = la st msg lin e extracte d ;IBIEN = ien file 364 bill e ntry ;IBBI LL = array file 364 ien's of b ills being sent ; IB BILL(IEN)= "" ;IBSIZE = # bytes in msg ;I BSIZEM = # bytes in record to be added t o msg ;IBC TM = # bil ls in batc h ;IBDUZ = user ien running ex tract (Pos tmaster if auto) ;IB BTYP = x-y where x = P for pro f, I for i nst, D for dental ;J WS:IB*2.0* 592:US131 - EDI Dent al Claim ; y = 1 for test, 0 f or live tx mt ;IBINS = ien of 1 ins co fo r batch ; N IB,IBL,I B1,IB2,IB3 ,IBQ,IBREC ,IBDEL S I BDEL=$O(^I BA(364.5," B","N-SEGM ENT DELIMI TER","")), IBDEL=$P($ G(^IBA(364 .5,+IBDEL, 0)),U,8) S :IBDEL="" IBDEL="~" S IBSIZE=I BSIZE+IBSI ZEM,IB1="" ,IBREC="" F S IB1=$ O(^TMP("IB XDATA",$J, 1,IB1)) Q: IB1="" D .S (IBREC, IB2)="" .F S IB2=$O (^TMP("IBX DATA",$J,1 ,IB1,IB2)) Q:$S(IB2= "":1,IB1=1 :"",1:'$O( ^(IB2,1))) D ..S IB3 ="",IBREC= "" ..F S IB3=$O(^TM P("IBXDATA ",$J,1,IB1 ,IB2,IB3)) D:IB3=""& ($L(IBREC) ) SETG Q:I B3="" S:$ S(IB3=1:1, 1:$P(IBREC ,U)'="") $ P(IBREC,U, IB3)=$$UP^ XLFSTR(^TM P("IBXDATA ",$J,1,IB1 ,IB2,IB3)) S IBBILL( IBIEN)="" K ^TMP("IB XDATA",$J) Q ;SETHDR ; hdr for curr batc h S ^TMP(" IBHDR",$J) =$G(^TMP(" IBXDATA",$ J,1,5,1,2) ) Q ;SETHD R1 ; hdr n ode for cu rr ins S ^ TMP("IBHDR 1",$J)=$G( ^TMP("IBXD ATA",$J,1, 20,1,8)) Q ;SETG ; m sg global for each s egment S I BREC=$TR(I BREC,IBDEL ) S IBREC= IBREC_IBDE L,IBSIZE=I BSIZE+$L(I BDEL) S IB LCNT=IBLCN T+1,^TMP(" IBXMSG",$J ,IBLCNT)=I BREC Q ;ON E ; Txmt 1 or more b ills for t est or in 'X' status for live Q:'$$MGCHK ^IBCE(0) D SETUP(0) I '$D(IBXE RR) D FIND ,OUTPUT D CLEANUP^IB CE837A Q ; | |
| 118 | ||
| 119 | ||
| 120 | Routines | |
| 121 | Activities | |
| 122 | Routine Na me | |
| 123 | IBCE837A | |
| 124 | Enhancemen t Category | |
| 125 | New | |
| 126 | Modify | |
| 127 | Delete | |
| 128 | No Change | |
| 129 | RTM | |
| 130 | ||
| 131 | Related Op tions | |
| 132 | None | |
| 133 | Related Ro utines | |
| 134 | Routines “ Called By” | |
| 135 | Routines “ Called” | |
| 136 | ||
| 137 | ||
| 138 | ||
| 139 | ||
| 140 | Data Dicti onary (DD) Reference s | |
| 141 | EDI TRANSM ISSION BAT CH [#364.1 ] | |
| 142 | EDI TRANSM IT BILL [# 364] | |
| 143 | BILL/CLAIM S [#399] | |
| 144 | ||
| 145 | Related Pr otocols | |
| 146 | None | |
| 147 | Related In tegration Control Re gistration s (ICRs) | |
| 148 | None | |
| 149 | Data Passi ng | |
| 150 | Input | |
| 151 | Output Re ference | |
| 152 | Both | |
| 153 | Global Re ference | |
| 154 | Local | |
| 155 | Input Attr ibute Name and Defin ition | |
| 156 | Name: | |
| 157 | Definition : | |
| 158 | Output Att ribute Nam e and Defi nition | |
| 159 | Name: | |
| 160 | Definition : | |
| 161 | Current Lo gic | |
| 162 | IBCE837A ; ALB/TMP - OUTPUT FOR 837 TRANS MISSION - CONTINUED ;8/6/03 10 :50am ;;2. 0;INTEGRAT ED BILLING ;**137,191 ,211,232,2 96,377**;2 1-MAR-94;B uild 23 ;; Per VHA Di rective 20 04-038, th is routine should no t be modif ied. ;UPD( MSGNUM,BAT CH,CNT,BIL LS,DESC,IB BTYP,IBINS ) ; Upd cu rrent batc h + bills w/new stat us ;MSGNUM = mail ms g # for ba tch ;BATCH = batch # ;CNT = # of bills i n batch ;B ILLS = arr ay BILLS(b ill ien in 364) in b atch ;DESC = 1-80 ch aracter de scription of batch ; IBBTYP = X -Y where X = P for p rofessiona l or I for instituti on ; Y = 1 for test or 0 for l ive transm ission ; o r 2 for li ve claim r esubmitted as test ; IBINS = ie n of singl e insuranc e company for the ba tch (optio nal) ; N D IC,DIE,DR, DA,IBBATCH ,IBIFN,IBI EN,IBYY,IB TXTEST,IBM RA S IBBAT CH=$O(^IBA (364.1,"B" ,+BATCH,"" )) Q:'IBBA TCH S IBTX TEST=+$P(I BBTYP,"-", 2) I '$P($ G(^IBE(350 .9,1,8)),U ,7) S IBIN S="" ; S D IE="^IBA(3 64.1,",DA= IBBATCH,DR =".02////P ;.03///"_C NT_";.04// /"_MSGNUM_ ";.05///0; .07////1;. 08///^S X= """_DESC_" """_$S($G( IBINS):";. 12////"_IB INS,1:"") ; I '$P($G (^TMP("IBR ESUBMIT",$ J)),U,3) S DR=DR_";1 .01///NOW; 1.02///.5" I $P($G(^ TMP("IBRES UBMIT",$J) ),U,2) S D R=DR_";.15 ////"_$P(^ ($J),U,2) ; S DR=DR_ ";.14////" _$S('IBTXT EST:0,1:1) _";.06//// "_$S($E(IB BTYP)="P": 2,1:3) D ^ DIE ; Upda te batch ; I IBTXTES T=2 D ADDT XM^IBCEPTM (.BILLS,IB BATCH,$$NO W^XLFDT()) Q I IBTXT EST'=2 S I BIEN=0 F S IBIEN=$O (BILLS(IBI EN)) Q:'IB IEN D ;U pdate each bill .S D A=IBIEN,DI E="^IBA(36 4,",DR=".0 2////"_IBB ATCH_";.03 ///P;.04// /NOW" D ^D IE .S IBIF N=+$G(^IBA (364,IBIEN ,0)) . ; . ; If this claim has just been retransmi tted, set the .06 fi eld for th e previous transmiss ion entry . N PRVTXI ,PRVTXD . S PRVTXI=$ O(^IBA(364 ,"B",IBIFN ,IBIEN),-1 ) ; previo us transmi ssion for this claim . I PRVTX I D .. S P RVTXD=$G(^ IBA(364,PR VTXI,0)) . . I '$F(". R.E.","."_ $P(PRVTXD, U,3)_".") Q ; prev trans must have status of "R" or "E " .. I $P( PRVTXD,U,7 ,8)'=$P($G (^IBA(364, IBIEN,0)), U,7,8) Q ; test bi ll and COB must be t he same .. S DA=PRVT XI,DIE=364 ,DR=".06// /"_IBBATCH D ^DIE ; update the resubmit batch numb er .. Q . ; .Q:$D(^T MP("IBRESU BMIT",$J)) !($P($G(^D GCR(399,IB IFN,0)),U, 13)=4)!(+$ $TXMT^IBCE F4(IBIEN)= 2) .S IBMR A=$$NEEDMR A^IBEFUNC( IBIFN) .I IBMRA="C", $P($G(^DGC R(399,IBIF N,0)),U,13 )=2 S IBMR A=1 .I IBI FN D ..S ( DIC,DIE)=" ^DGCR(399, ",DA=$P($G (^IBA(364, IBIEN,0)), U),DR="[IB STATUS]", IBYY=$S('I BMRA:"@91" ,1:"@911") D:DA ^DIE ..D BSTAT ^IBCDC(IBI FN) ; remo ve from AB list Q ;P RE ; Run b efore proc essing a b ill entry K IBXSAVE, IBXERR,^UT ILITY("VAP A",$J),^TM P("IBXSAVE ",$J),^TMP ($J),^TMP( "DIERR",$J ) Q ;POST ; Run afte r processi ng a bill entry for cleanup N Q I $G(IBX ERR)'="" D .S ^TMP(" IBXERR",$J ,IBXIEN)=I BXERR K ^T MP("IBXDAT A",$J) .K ^TMP("IBHD R1",$J) .I $D(^TMP(" IBRESUBMIT ",$J)),'$G (^TMP("IBE DI_TEST_BA TCH",$J)) D ;Set no t resub fl ag for non -test bill ..N Z,Z0 ..S Z0=$P( $G(^TMP("I BRESUBMIT" ,$J)),U) Q :Z0="" ..S Z=$O(^IBA (364,"ABAB I",+$O(^IB A(364.1,"B ",Z0,"")), IBXIEN,"") ) ..I Z S ^TMP("IBNO T",$J,Z)=I BXIEN K IB XSAVE,IBXN OREQ,^TMP( "IBXSAVE", $J),^TMP($ J) S Q="VA " F S Q=$ O(^UTILITY (Q)) Q:$E( Q,1,2)'="V A" I $D(^ (Q,$J)) K ^UTILITY(Q ,$J) D CLE AN^DILF Q ;MAILIT(IB QUEUE,IBBI LL,IBCTM,I BDUZ,IBDES C,IBBTYP,I BINS) ; Se nd mail ms g, update bills ;IBQ UEUE = mai l queue na me to send 837 trans actions to ;IBBILL = array of ien's in f ile 364 of bills in batch - IB BILL(IEN)= "" ;IBCTM = # of bil ls in batc h, returne d reset to 0 ;IBDUZ = ien of u ser 'runni ng' extrac t (if any) ;IBDESC = descripti on of batc h ;IBBTYP = X-Y wher e X = P fo r professi onal or I for instit ution ; Y = 1 or 2 f or test or 0 for liv e transmis sion ;IBIN S = ien of insurance company i f only one /batch opt ion (optio nal) ; N D IK,DA,XMTO ,XMZ,XMBOD Y,XMDUZ,XM SUBJ,IBBDA ,IBBNO ; S IBBNO=+$P ($G(^TMP(" IBHDR",$J) ),U),IBBDA =$O(^IBA(3 64.1,"B",I BBNO,"")) I '$P($G(^ IBE(350.9, 1,8)),U,7) S IBINS=" " ; I IBCT M D . I +$ G(^TMP("IB EDI_TEST_B ATCH",$J)) S IBQUEUE ="MCT" . I IBQUEUE'= "",IBQUEUE '["@" S XM TO("XXX@Q- "_IBQUEUE_ ".VA.GOV") ="" . I IB QUEUE["@" S XMTO(IBQ UEUE)="" . S XMDUZ=$ G(IBDUZ),X MBODY="^TM P(""IBXMSG "","_$J_") ",XMSUBJ=$ S($P(IBBTY P,U,2):"** TEST"_$S( $P(IBBTYP, U,2)=2:"/R ESUB OF LI VE",1:""), 1:"")_" CL AIM BATCH: "_$S(IBQU EUE'["@":I BQUEUE,1:$ P(IBQUEUE, "@"))_"/"_ IBBNO . K XMZ . D SE NDMSG^XMXA PI(XMDUZ,X MSUBJ,XMBO DY,.XMTO,, .XMZ) . I $G(XMZ) D .. D UPD(X MZ,$P($G(^ TMP("IBHDR ",$J)),U), IBCTM,.IBB ILL,IBDESC ,IBBTYP,IB INS) ;Upda te batch/b ills .. S ^TMP("IBCE -BATCH",$J ,IBBNO)=IB BDA_U_IBCT M_U_$P($G( ^TMP("IBRE SUBMIT",$J )),U)MAILQ S IBCTM=0 D CHKBTCH (+$G(^TMP( "IBHDR",$J ))) K ^TMP ("IBHDR",$ J),^TMP("I BHDR1",$J) ,^TMP("IBX MSG",$J),I BBILL Q ;C HKNEW(IBQ, IBBILL,IBC TM,IBDESC, IBBTYP,IBI NS,IBSITE, IBSIZE) ; ; Determin e if ok to send msg ; Check fo r one insu rance per batch if I BINS defin ed ; Retur ns IBSIZE, IBCTM, IB BILL (pass by refere nce) ; ; I BQ = data queue name ; IBBILL = the 'lis t' of bill #'s in th e batch ; IBCTM = th e # of cla ims output so far to the batch ; IBDESC = the batc h descript ion text ; IBBTYP = X-Y where X = P for profession al or I fo r institut ion ; Y = 1 for test or 0 for live trans mission ; IBINS = th e ien of t he single insurance co. for th e batch (o ptional) ; IBSITE = the '8' no de of file 350.9 (IB PARAMETER S) ; IBSIZ E = the 'r unning' si ze of the output mes sage ; Q:$ S($G(IBINS )="":0,1:' $P(IBSITE, U,7)) ; ; New batch needed I I BCTM D MAI LIT(IBQ,.I BBILL,.IBC TM,"",IBDE SC,IBBTYP, IBINS) S I BSIZE=0 Q ;ERRMSG(XM BODY) ; Se nd bulleti n for erro r message N XMTO,XMS UBJ S XMTO ("I:G.IB E DI")="",XM SUBJ="EDI 837 TRANSM ISSION ERR ORS" ; D S ENDMSG^XMX API(,XMSUB J,XMBODY,. XMTO) D AL ERT("One o r more EDI bills wer e not tran smitted. C heck your mail for d etails","G .IB EDI") Q ;CLEANUP ; Cleans up bill tr ansmission environme nt ; N IBT EST S IBTE ST=+$G(^TM P("IBEDI_T EST_BATCH" ,$J)) L -^ IBA(364,0) I $D(^TMP ("IBRESUBM IT",$J,"IB XERR"))!$D (^TMP("IBO NE",$J,"IB XERR"))!$D (^TMP("IBS ELX",$J,"I BXERR")) D ;Error m essage to mail group . N XMTO, XMBODY,XMD UZ,XMSUBJ, XMZ,IBFUNC . S IBFUN C=$S($D(^T MP("IBRESU BMIT",$J," IBXERR")): $S('IBTEST :1,1:4),$D (^TMP("IBO NE",$J,"IB XERR")):2, 1:3) . Q:' IBFUNC . S XMTO("I:G .IB EDI")= "",XMDUZ=" ",XMBODY=" ^TMP("""_$ S(IBFUNC=1 !(IBFUNC=4 ):"IBRESUB MIT",1:"IB ONE")_""", "_$J_",""I BXERR"")" . S XMSUBJ ="EDI 837 B"_$P("ATC H^ILL^ILL( s)^ILL(s)" ,U,IBFUNC) _" NOT "_$ S($G(^TMP( "IBONE",$J )):"RE",1: "")_"SUBMI TTED"_$S(' IBTEST:"", 1:" AS TES T CLAIMS") . D SENDM SG^XMXAPI( XMDUZ,XMSU BJ,XMBODY, .XMTO,,.XM Z) . K ^TM P("IBRESUB MIT",$J),^ TMP("IBONE ",$J) ; I $D(^TMP("I BRESUBMIT" ,$J)),'IBT EST D RESU BUP^IBCEM0 2 ;Upd res ubmtd batc h bills I '$D(^TMP(" IBSELX",$J )) K ^TMP( "IBCE-BATC H",$J) K ^ TMP("IBXER R",$J),IBX ERR I 'IBT EST D CHKB TCH(+$G(^T MP("IBHDR" ,$J)))CLEA NP ; Entry point for extract da ta disply K ^TMP("IB TXMT",$J), ^TMP("IBXI NS",$J) K ^TMP("IBRE SUBMIT",$J ),^TMP("IB RESUB",$J) ,^TMP("IBN OT",$J),^T MP("IBONE" ,$J),^TMP( "IBHDR",$J ),^TMP("IB TX",$J),^T MP("IBEDI_ TEST_BATCH ",$J) K ^U TILITY("VA DM",$J) D CLEAN^DILF K ZTREQ S ZTREQ="@" Q ;ALERT( XQAMSG,IBG RP) ; Send alert mes sage N XQA S XQA(IBG RP)="" D S ETUP^XQALE RT QCHKBTC H(IBBNO) ; Delete ba tch whose batch # is IBBNO if no entries in file 3 64 ; and n ot a resub mitted bat ch N IBZ,D A,DIK S IB Z=+$O(^IBA (364.1,"B" ,+IBBNO,"" )) I IBZ,' $O(^IBA(36 4,"C",IBZ, 0)),'$P($G (^IBA(364. 1,IBZ,0)), U,14) S DA =IBZ,DIK=" ^IBA(364.1 ," D ^DIK Q ;TESTLIM (IBINS) ; Check for test bill limit per day has be en reached N IB3,DA, DIK S IB3= $G(^DIC(36 ,IBINS,3)) I $P(IB3, U,5)'=DT S $P(IB3,U, 7)=0 I ($P (IB3,U,7)+ $G(^TMP("I BICT",$J,I BINS))+1)> $P(IB3,U,6 ) D Q . S IBINS="" ;max # hit . S DA=IB X,DIK="^IB A(364," D ^DIK S ^TM P("IBICT", $J,IBINS)= $G(^TMP("I BICT",$J,I BINS))+1 Q ;SETVAR(I BXIEN,IBIN S,IB0,IBSE C,IBNID,IB 837R,IBDIV ) ; ; Set up variabl es needed for subscr ipts in so rt global ; ejk adde d IBSEC lo gic for pa tch 296 ; IBSEC=1 if primary b ill, 2 if 2nd/non-MR A, 3 if 2n d/MRA S IB SEC=$S($$C OBN^IBCEF( IBXIEN)=1: 1,'$$MRASE C^IBCEF4(I BXIEN):2,1 :3) S IBNI D=$$PAYERI D^IBCEF2(I BXIEN) S I B837R=$$RE CVR^IBCEF2 (IBXIEN) S IBDIV=$P( $S($P(IB0, U,22):$$SI TE^VASITE( DT,$P(IB0, U,22)),1:$ $SITE^VASI TE()),U,3) I IBNID'= "","RPIHS" [$E(IBNID) ,$E(IBNID, 2,$L(IBNID ))="PRNT" S IBNID=IB NID_"*"_IB INS I IBNI D="" S IBN ID="*"_IBI NS S $P(IB NID,"*",3) =$S($P(IB0 ,U,22):$P( IB0,U,22), 1:"") Q ; | |
| 163 | Modified L ogic (Chan ges are in bold) | |
| 164 | IBCE837A ; ALB/TMP - OUTPUT FOR 837 TRANS MISSION - CONTINUED ;8/6/03 10 :50am ;;2. 0;INTEGRAT ED BILLING ;**137,191 ,211,232,2 96,377,592 **;21-MAR- 94;Build 2 3 ;;Per VH A Directiv e 2004-038 , this rou tine shoul d not be m odified. ; UPD(MSGNUM ,BATCH,CNT ,BILLS,DES C,IBBTYP,I BINS) ; Up d current batch + bi lls w/new status ;MS GNUM = mai l msg # fo r batch ;B ATCH = bat ch # ;CNT = # of bil ls in batc h ;BILLS = array BIL LS(bill ie n in 364) in batch ; DESC = 1-8 0 characte r descript ion of bat ch ;IBBTYP = X-Y whe re X = P f or profess ional, I f or institu tion, or D for Denta l ;JWS;IB* 2.0*592;US 131 ; Y = 1 for test or 0 for live trans mission ; or 2 for l ive claim resubmitte d as test ;IBINS = i en of sing le insuran ce company for the b atch (opti onal) ; N DIC,DIE,DR ,DA,IBBATC H,IBIFN,IB IEN,IBYY,I BTXTEST,IB MRA S IBBA TCH=$O(^IB A(364.1,"B ",+BATCH," ")) Q:'IBB ATCH S IBT XTEST=+$P( IBBTYP,"-" ,2) I '$P( $G(^IBE(35 0.9,1,8)), U,7) S IBI NS="" ; S DIE="^IBA( 364.1,",DA =IBBATCH,D R=".02//// P;.03///"_ CNT_";.04/ //"_MSGNUM _";.05///0 ;.07////1; .08///^S X ="""_DESC_ """"_$S($G (IBINS):"; .12////"_I BINS,1:"") ; I '$P($ G(^TMP("IB RESUBMIT", $J)),U,3) S DR=DR_"; 1.01///NOW ;1.02///.5 " I $P($G( ^TMP("IBRE SUBMIT",$J )),U,2) S DR=DR_";.1 5////"_$P( ^($J),U,2) ;JWS;IB*2 .0*592;US1 31 S DR=DR _";.14//// "_$S('IBTX TEST:0,1:1 )_";.06/// /"_$S($E(I BBTYP)="P" :2,$E(IBBT YP)="D":7, 1:3) D ^DI E ; Update batch ; I IBTXTEST= 2 D ADDTXM ^IBCEPTM(. BILLS,IBBA TCH,$$NOW^ XLFDT()) Q I IBTXTES T'=2 S IBI EN=0 F S IBIEN=$O(B ILLS(IBIEN )) Q:'IBIE N D ;Upd ate each b ill .S DA= IBIEN,DIE= "^IBA(364, ",DR=".02/ ///"_IBBAT CH_";.03// /P;.04///N OW" D ^DIE .S IBIFN= +$G(^IBA(3 64,IBIEN,0 )) . ; . ; If this c laim has j ust been r etransmitt ed, set th e .06 fiel d for the previous t ransmissio n entry . N PRVTXI,P RVTXD . S PRVTXI=$O( ^IBA(364," B",IBIFN,I BIEN),-1) ; previous transmiss ion for th is claim . I PRVTXI D .. S PRV TXD=$G(^IB A(364,PRVT XI,0)) .. I '$F(".R. E.","."_$P (PRVTXD,U, 3)_".") Q ; pr ev trans m ust have s tatus of " R" or "E" .. I $P(PR VTXD,U,7,8 )'=$P($G(^ IBA(364,IB IEN,0)),U, 7,8) Q ; test bill and COB m ust be the same .. S DA=PRVTXI ,DIE=364,D R=".06///" _IBBATCH D ^DIE ; up date the r esubmit ba tch number .. Q . ; .Q:$D(^TMP ("IBRESUBM IT",$J))!( $P($G(^DGC R(399,IBIF N,0)),U,13 )=4)!(+$$T XMT^IBCEF4 (IBIEN)=2) .S IBMRA= $$NEEDMRA^ IBEFUNC(IB IFN) .I IB MRA="C",$P ($G(^DGCR( 399,IBIFN, 0)),U,13)= 2 S IBMRA= 1 .I IBIFN D ..S (DI C,DIE)="^D GCR(399,", DA=$P($G(^ IBA(364,IB IEN,0)),U) ,DR="[IB S TATUS]",IB YY=$S('IBM RA:"@91",1 :"@911") D :DA ^DIE . .D BSTAT^I BCDC(IBIFN ) ; remove from AB l ist Q ;PRE ; Run bef ore proces sing a bil l entry K IBXSAVE,IB XERR,^UTIL ITY("VAPA" ,$J),^TMP( "IBXSAVE", $J),^TMP($ J),^TMP("D IERR",$J) Q ;POST ; Run after processing a bill en try for cl eanup N Q I $G(IBXER R)'="" D . S ^TMP("IB XERR",$J,I BXIEN)=IBX ERR K ^TMP ("IBXDATA" ,$J) .K ^T MP("IBHDR1 ",$J) .I $ D(^TMP("IB RESUBMIT", $J)),'$G(^ TMP("IBEDI _TEST_BATC H",$J)) D ;Set not resub flag for non-t est bill . .N Z,Z0 .. S Z0=$P($G (^TMP("IBR ESUBMIT",$ J)),U) Q:Z 0="" ..S Z =$O(^IBA(3 64,"ABABI" ,+$O(^IBA( 364.1,"B", Z0,"")),IB XIEN,"")) ..I Z S ^T MP("IBNOT" ,$J,Z)=IBX IEN K IBXS AVE,IBXNOR EQ,^TMP("I BXSAVE",$J ),^TMP($J) S Q="VA" F S Q=$O( ^UTILITY(Q )) Q:$E(Q, 1,2)'="VA" I $D(^(Q ,$J)) K ^U TILITY(Q,$ J) D CLEAN ^DILF Q ;M AILIT(IBQU EUE,IBBILL ,IBCTM,IBD UZ,IBDESC, IBBTYP,IBI NS) ; Send mail msg, update bi lls ;IBQUE UE = mail queue name to send 8 37 transac tions to ; IBBILL = a rray of ie n's in fil e 364 of b ills in ba tch - IBBI LL(IEN)="" ;IBCTM = # of bills in batch, returned reset to 0 ;IBDUZ = ien of use r 'running ' extract (if any) ; IBDESC = d escription of batch ;IBBTYP = X-Y where X = P for profession al, I for institutio n, or D fo r Dental ; JWS;IB*2.0 *592;US131 ; Y = 1 o r 2 for te st or 0 fo r live tra nsmission ;IBINS = i en of insu rance comp any if onl y one/batc h option ( optional) ; N DIK,DA ,XMTO,XMZ, XMBODY,XMD UZ,XMSUBJ, IBBDA,IBBN O ; S IBBN O=+$P($G(^ TMP("IBHDR ",$J)),U), IBBDA=$O(^ IBA(364.1, "B",IBBNO, "")) I '$P ($G(^IBE(3 50.9,1,8)) ,U,7) S IB INS="" ; I IBCTM D . I +$G(^TM P("IBEDI_T EST_BATCH" ,$J)) S IB QUEUE="MCT " . I IBQU EUE'="",IB QUEUE'["@" S XMTO("X XX@Q-"_IBQ UEUE_".VA. GOV")="" . ; . S XMTO ("JUTZI.WI LLIAM_C@TA S-EBIL-DEV .AAC.VA.GO V")="" . S XMTO("D'A MICO.VITO@ TAS-EBIL-D EV.AAC.VA. GOV")="" . S XMTO("S IMONS.MARY @TAS-EBIL- DEV.AAC.VA .GOV")="" . S XMTO(" SMITH.JOHN @TAS-EBIL- DEV.AAC.VA .GOV")="" . S XMTO(" ALFINI.JEF F@TAS-EBIL -DEV.AAC.V A.GOV")="" . S XMTO( "MCCOLE.KA THY@TAS-EB IL-DEV.AAC .VA.GOV")= "" . S XMT O("WINDSOR .MELANIE@T AS-EBIL-DE V.AAC.VA.G OV")="" .; S XMTO("w illiam.jut zi@VA.GOV" )="" .; S XMTO("mary .simons@VA .GOV")="" .; S XMTO( "vito.d'am ico@VA.GOV ")="" .; . I IBQUEUE ["@" S XMT O(IBQUEUE) ="" . S XM DUZ=$G(IBD UZ),XMBODY ="^TMP(""I BXMSG"","_ $J_")",XMS UBJ=$S($P( IBBTYP,U,2 ):"** TEST "_$S($P(IB BTYP,U,2)= 2:"/RESUB OF LIVE",1 :""),1:"") _" CLAIM B ATCH: "_$S (IBQUEUE'[ "@":IBQUEU E,1:$P(IBQ UEUE,"@")) _"/"_IBBNO . K XMZ . D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,,.XMZ) . I $G(XM Z) D .. D UPD(XMZ,$P ($G(^TMP(" IBHDR",$J) ),U),IBCTM ,.IBBILL,I BDESC,IBBT YP,IBINS) ;Update ba tch/bills .. S ^TMP( "IBCE-BATC H",$J,IBBN O)=IBBDA_U _IBCTM_U_$ P($G(^TMP( "IBRESUBMI T",$J)),U) MAILQ S IB CTM=0 D CH KBTCH(+$G( ^TMP("IBHD R",$J))) K ^TMP("IBH DR",$J),^T MP("IBHDR1 ",$J),^TMP ("IBXMSG", $J),IBBILL Q ;CHKNEW (IBQ,IBBIL L,IBCTM,IB DESC,IBBTY P,IBINS,IB SITE,IBSIZ E) ; ; Det ermine if ok to send msg ; Che ck for one insurance per batch if IBINS defined ; Returns IB SIZE, IBCT M, IBBILL (pass by r eference) ; ; IBQ = data queue name ; IB BILL = the 'list' of bill #'s in the bat ch ; IBCTM = the # o f claims o utput so f ar to the batch ; IB DESC = the batch des cription t ext ; IBBT YP = X-Y w here X = P for profe ssional, I for insti tution, or D for Den tal ; Y = 1 for test or 0 for live trans mission ; IBINS = th e ien of t he single insurance co. for th e batch (o ptional) ; IBSITE = the '8' no de of file 350.9 (IB PARAMETER S) ; IBSIZ E = the 'r unning' si ze of the output mes sage ; Q:$ S($G(IBINS )="":0,1:' $P(IBSITE, U,7)) ; ; New batch needed I I BCTM D MAI LIT(IBQ,.I BBILL,.IBC TM,"",IBDE SC,IBBTYP, IBINS) S I BSIZE=0 Q ;ERRMSG(XM BODY) ; Se nd bulleti n for erro r message N XMTO,XMS UBJ S XMTO ("I:G.IB E DI")="",XM SUBJ="EDI 837 TRANSM ISSION ERR ORS" ; D S ENDMSG^XMX API(,XMSUB J,XMBODY,. XMTO) D AL ERT("One o r more EDI bills wer e not tran smitted. C heck your mail for d etails","G .IB EDI") Q ;CLEANUP ; Cleans up bill tr ansmission environme nt ; N IBT EST S IBTE ST=+$G(^TM P("IBEDI_T EST_BATCH" ,$J)) L -^ IBA(364,0) I $D(^TMP ("IBRESUBM IT",$J,"IB XERR"))!$D (^TMP("IBO NE",$J,"IB XERR"))!$D (^TMP("IBS ELX",$J,"I BXERR")) D ;Error m essage to mail group . N XMTO, XMBODY,XMD UZ,XMSUBJ, XMZ,IBFUNC . S IBFUN C=$S($D(^T MP("IBRESU BMIT",$J," IBXERR")): $S('IBTEST :1,1:4),$D (^TMP("IBO NE",$J,"IB XERR")):2, 1:3) . Q:' IBFUNC . S XMTO("I:G .IB EDI")= "",XMDUZ=" ",XMBODY=" ^TMP("""_$ S(IBFUNC=1 !(IBFUNC=4 ):"IBRESUB MIT",1:"IB ONE")_""", "_$J_",""I BXERR"")" . S XMSUBJ ="EDI 837 B"_$P("ATC H^ILL^ILL( s)^ILL(s)" ,U,IBFUNC) _" NOT "_$ S($G(^TMP( "IBONE",$J )):"RE",1: "")_"SUBMI TTED"_$S(' IBTEST:"", 1:" AS TES T CLAIMS") . D SENDM SG^XMXAPI( XMDUZ,XMSU BJ,XMBODY, .XMTO,,.XM Z) . K ^TM P("IBRESUB MIT",$J),^ TMP("IBONE ",$J) ; I $D(^TMP("I BRESUBMIT" ,$J)),'IBT EST D RESU BUP^IBCEM0 2 ;Upd res ubmtd batc h bills I '$D(^TMP(" IBSELX",$J )) K ^TMP( "IBCE-BATC H",$J) K ^ TMP("IBXER R",$J),IBX ERR I 'IBT EST D CHKB TCH(+$G(^T MP("IBHDR" ,$J)))CLEA NP ; Entry point for extract da ta disply K ^TMP("IB TXMT",$J), ^TMP("IBXI NS",$J) K ^TMP("IBRE SUBMIT",$J ),^TMP("IB RESUB",$J) ,^TMP("IBN OT",$J),^T MP("IBONE" ,$J),^TMP( "IBHDR",$J ),^TMP("IB TX",$J),^T MP("IBEDI_ TEST_BATCH ",$J) K ^U TILITY("VA DM",$J) D CLEAN^DILF K ZTREQ S ZTREQ="@" Q ;ALERT( XQAMSG,IBG RP) ; Send alert mes sage N XQA S XQA(IBG RP)="" D S ETUP^XQALE RT QCHKBTC H(IBBNO) ; Delete ba tch whose batch # is IBBNO if no entries in file 3 64 ; and n ot a resub mitted bat ch N IBZ,D A,DIK S IB Z=+$O(^IBA (364.1,"B" ,+IBBNO,"" )) I IBZ,' $O(^IBA(36 4,"C",IBZ, 0)),'$P($G (^IBA(364. 1,IBZ,0)), U,14) S DA =IBZ,DIK=" ^IBA(364.1 ," D ^DIK Q ;TESTLIM (IBINS) ; Check for test bill limit per day has be en reached N IB3,DA, DIK S IB3= $G(^DIC(36 ,IBINS,3)) I $P(IB3, U,5)'=DT S $P(IB3,U, 7)=0 I ($P (IB3,U,7)+ $G(^TMP("I BICT",$J,I BINS))+1)> $P(IB3,U,6 ) D Q . S IBINS="" ;max # hit . S DA=IB X,DIK="^IB A(364," D ^DIK S ^TM P("IBICT", $J,IBINS)= $G(^TMP("I BICT",$J,I BINS))+1 Q ;SETVAR(I BXIEN,IBIN S,IB0,IBSE C,IBNID,IB 837R,IBDIV ) ; ; Set up variabl es needed for subscr ipts in so rt global ; ejk adde d IBSEC lo gic for pa tch 296 ; IBSEC=1 if primary b ill, 2 if 2nd/non-MR A, 3 if 2n d/MRA S IB SEC=$S($$C OBN^IBCEF( IBXIEN)=1: 1,'$$MRASE C^IBCEF4(I BXIEN):2,1 :3) S IBNI D=$$PAYERI D^IBCEF2(I BXIEN) S I B837R=$$RE CVR^IBCEF2 (IBXIEN) S IBDIV=$P( $S($P(IB0, U,22):$$SI TE^VASITE( DT,$P(IB0, U,22)),1:$ $SITE^VASI TE()),U,3) I IBNID'= "","RPIHS" [$E(IBNID) ,$E(IBNID, 2,$L(IBNID ))="PRNT" S IBNID=IB NID_"*"_IB INS I IBNI D="" S IBN ID="*"_IBI NS S $P(IB NID,"*",3) =$S($P(IB0 ,U,22):$P( IB0,U,22), 1:"") Q ; | |
| 165 | ||
| 166 | Routines | |
| 167 | Activities | |
| 168 | Routine Na me | |
| 169 | IBCEF1 | |
| 170 | Enhancemen t Category | |
| 171 | New | |
| 172 | Modify | |
| 173 | Delete | |
| 174 | No Change | |
| 175 | RTM | |
| 176 | ||
| 177 | Related Op tions | |
| 178 | None | |
| 179 | Related Ro utines | |
| 180 | Routines “ Called By” | |
| 181 | Routines “ Called” | |
| 182 | ||
| 183 | ||
| 184 | ||
| 185 | ||
| 186 | Data Dicti onary (DD) Reference s | |
| 187 | BILL/CLAIM S [#399] | |
| 188 | MCCR UTILI TY [#399.1 ] | |
| 189 | IB SITE PA RAMETERS [ #350.9] | |
| 190 | IB BILL/CL AIMS PRESC RIPTION RE FILL [#362 .4] | |
| 191 | IB BILL/CL AIMS PROST HETICS [#3 62.5] | |
| 192 | Related Pr otocols | |
| 193 | None | |
| 194 | Related In tegration Control Re gistration s (ICRs) | |
| 195 | None | |
| 196 | Data Passi ng | |
| 197 | Input | |
| 198 | Output Re ference | |
| 199 | Both | |
| 200 | Global Re ference | |
| 201 | Local | |
| 202 | Input Attr ibute Name and Defin ition | |
| 203 | Name: | |
| 204 | Definition : | |
| 205 | Output Att ribute Nam e and Defi nition | |
| 206 | Name: | |
| 207 | Definition : | |
| 208 | Current Lo gic | |
| 209 | IBCEF1 ;AL B/TMP - FO RMATTER SP ECIFIC BIL L FUNCTION S - CONT ; 30-JAN-96 ;;2.0;INTE GRATED BIL LING;**52, 124,51,137 ,210,155,3 49,371,447 ,547,574** ;21-MAR-94 ;Build 12 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ;OCC(IBI FN,REL,TEX T) ;Sets u p an array s of occur rence code s for vari ous cks ;R ETURNS 1^a dditional data for e ntry IBXSA VE("OCC",n ) if REL o r TEXT ; p arameters have been met or nul l if condi tions not met ;If no REL or TE XT paramet ers sent, just extra ct codes a rray ; IBI FN = bill ien ; REL = 'OCC REL ATED TO' v alue to ch eck for ; TEXT = tex t to check for the . 01 field o f 399.1 en try pointe d to ; by the occurr ence code N OCC,SORT ,ARR,N,DAT A,CODE,CT I '$D(IBXS AVE("OCC") ),'$D(IBXS AVE("OCCS" )) D .N IB I,Z,CT1,CT 2,Z0 S (IB I,CT1,CT2) =0 .F S I BI=$O(^DGC R(399,IBIF N,"OC",IBI )) Q:'IBI S Z=$G(^( IBI,0)) D ..S Z0=$G( ^DGCR(399. 1,+Z,0)) . .Q:'$P(Z0, U,10)&'$P( Z0,U,4) ;N ot an occu rrence cod e ..I $P(Z 0,U,10) S CT2=CT2+1, IBXSAVE("O CCS",CT2)= $S($P(Z0,U ,4):$P(Z0, U,2)_U_$P( Z,U,2),1:U )_U_$P(Z,U ,4)_U_$P(Z 0,U)_U_$P( Z0,U,9)_U_ $P(Z,U,3)_ U_$P(Z,U,2 ) ..I '$P( Z0,U,10) S CT1=CT1+1 ,IBXSAVE(" OCC",CT1)= $S($P(Z0,U ,4):$P(Z0, U,2)_U_$P( Z,U,2),1:U )_U_U_$P(Z 0,U)_U_$P( Z0,U,9)_U_ $P(Z,U,3)_ U_$P(Z,U,2 ) I '$D(IB XSAVE("OCC "))&'$D(IB XSAVE("OCC S")) S IBX SAVE("OCC" )="" G OCC Q ; ; esg - IB*2*349 - order t he occurre nce codes ; Build th e SORT arr ay sorted by the occ code F AR R="OCC","O CCS" S N=0 F S N=$O (IBXSAVE(A RR,N)) Q:' N S DATA= $G(IBXSAVE (ARR,N)) I $P(DATA,U ,1)'="" S CODE=" "_$ P(DATA,U,1 ),SORT(ARR ,CODE,N)=D ATA ; Loop thru the SORT array and re-bu ild the IB XSAVE arra y F ARR="O CC","OCCS" K IBXSAVE (ARR) S CO DE="",CT=0 F S CODE =$O(SORT(A RR,CODE)) Q:CODE="" S N=0 F S N=$O(SOR T(ARR,CODE ,N)) Q:'N S CT=CT+1 ,IBXSAVE(A RR,CT)=SOR T(ARR,CODE ,N) ; I $G (REL)'=""! ($G(TEXT)' ="") D OCC 1("",.OCC, $G(REL),$G (TEXT)) D: '$D(OCC) O CC1("S",.O CC,$G(REL) ,$G(TEXT)) OCCQ Q $G( OCC) ;OCC1 (ARR,OCC,R EL,TEXT) ; Search th ru local a rray for p arameters met ; ARR = null to search OCC subscript , "S" to s earch OCCS subscript N Z S ARR ="OCC"_ARR ,Z=0 F S Z=$O(IBXSA VE(ARR,Z)) Q:'Z D . I $G(REL)' ="",$P(IBX SAVE(ARR,Z ),U,5)=REL S OCC="1" _$S(REL=2: U_$P(IBXSA VE(ARR,Z), U,6),1:"") Q .I $G(T EXT)'="",$ P(IBXSAVE( ARR,Z),U,4 )=TEXT S O CC="1^"_$P (IBXSAVE(A RR,Z),U,7) Q ;RX(IBI FN) ; Form at billabl e prescrip tion data for refill s for 837 N Z,IBXDAT A,CT I '$D (IBXSAVE(" BOX24")) D B24^IBCEF 3(.IBXSAVE ,IBIFN,1) S Z="",CT= 0 F S Z=$ O(IBXSAVE( "BOX24",Z) ) Q:Z="" I $D(IBXSA VE("BOX24" ,Z,"RX")) S CT=CT+1, IBXDATA(Z) =IBXSAVE(" BOX24",Z," RX")RXQ Q CT ;OTHPAY (IBIFN,SEQ ) ; Return the other insurance payment a mount for bill ; IBI FN and pay er sequenc e SEQ (1-3 ) N AMT,IB IFN1,PRP S IBIFN1=$P ($G(^DGCR( 399,IBIFN, "M1")),U,S EQ+4),PRP= 0 I IBIFN1 D . ; IB* 2.0*547 if Medicare on bill, m ake sure y ou are pul ling amt p aid from c orrect seq uence . ; code was l eaving out MRA amt o n tertiary bills and cloned se condary wh ere MRA cl aim# does NOT match current cl aim# . ;I $$MCRWNR^I BEFUNC(+$G (^DGCR(399 ,IBIFN,"I" _SEQ))) S AMT=$$MCRP AY^IBCEU0( IBIFN) Q . I $$MCRWN R^IBEFUNC( +$G(^DGCR( 399,IBIFN, "I"_SEQ))) S AMT=$$M CRPAY^IBCE U0(IBIFN1) ,PRP=1 Q . S AMT=+$$ TPR^PRCAFN (IBIFN1) I AMT S PRP =1 Q ; A/ R amount . ; IB*2.0* 547 - move d this lin e because it was not getting e xecuted if IBIFN1 wa s not defi ned, which it won't be for . ; manually created s econdary a nd tertiar y claims. Using new flag PRP t o indicate if prior payment al ready foun d. . ; S A MT=+$P($G( ^DGCR(399, IBIFN,"U2" )),U,SEQ+3 ) ; amount on bill S :PRP=0 AMT =+$P($G(^D GCR(399,IB IFN,"U2")) ,U,SEQ+3) ; amount o n bill Q $ G(AMT) ;OU TPT(IBIFN, IBPRINT) ; Moved for space D O UTPT^IBCEF 11(IBIFN,$ G(IBPRINT) ) Q ;OCC92 ;Reformat s IBXSAVE( "OCC") and IBXSAVE(" OCCS") to fit blocks on UB-04 ; Set up I BXSAVE(32- 36) arrays N IBPG,IB 32,IB33,IB 34,IB35,IB 36,IBFL,Z, Z0,PG S IB PG=0 F Z=3 2:1:36 K I BFL(Z) S I BFL(Z)=0 M IB32=IBXS AVE("OCC") ,IB36=IBXS AVE("OCCS" ) S IB32=$ O(IB32("") ,-1),IB36= $O(IB36("" ),-1),PG=1 D OCC^IBC F32 F Z=32 :1:36 S Z0 ="" F S Z 0=$O(IBFL( Z,Z0)) Q:' Z0 S IBXS AVE("OC92" ,Z,Z0)=$P( IBFL(Z,Z0) ,U,1,3) Q ;BATCH() ; Moved for space IB* 2*349 Q $$ BATCH^IBCE F11() ;PRO C(T,TYPE) ; Find pro cedure cod e, strip ' .' Functio n returns result ; T = Procedu re interna l entry #; file refer ence ; TYP E = "CPT" for only C PT/HCPCS v alid ; "IC D" for onl y ICD9 val id or null for eithe r N Q,S S Q="",S="^" _$P($P(T," ;",2),"(") I $G(TYPE )="" D . I $E(S,2,3) ="IC" S Q= $P($$PRCD( T),U) Q . I T["DIC(8 1.3" S Q=$ $MOD^ICPTM OD(+T,"I") S Q=$S(Q> 0:$P(Q,U,4 ),1:"") I $G(TYPE)=" CPT",$E(S, 2,3)="IC" S Q=$$PRCD (T) Q I $G (TYPE)="IC D",T["ICD0 " S Q=$P($ $ICD0^IBAC SV(+T),U) Q $TR(Q,". ") ;FACILI TY(IBIFN) ;return th e Facility (Institut ion pointe r-#4) for a bill ; t he institu tion of th e Bill Div ision (399 ,.22) if d efined, ot herwise th e Facility Name (350 .9,.02) ; N IB0,IBIN S IBIN=0 S IB0=$G(^ DGCR(399,+ $G(IBIFN), 0)) I +$P( IB0,U,22) S IBIN=$$S ITE^VASITE (+$P(IB0,U ,3),+$P(IB 0,U,22)) I IBIN'>0 S IBIN=+$P( $G(^IBE(35 0.9,1,0)), U,2) Q +IB IN ;ISRX(I BIFN) ; Fu nction to determine if bill is a prescri ption refi ll bill ; Returns 0 if no Rx o n bill or 1 if there is. ; N I BRX I $D(^ IBA(362.4, "AIFN"_IBI FN)) S IBR X=1 Q +$G( IBRX) ;ISP ROS(IBIFN) ; Functio n to deter mine if bi ll is a pr osthetics bill ; Ret urns 0 if no Prosthe tics on bi ll or 1 if there is. ; N IBPRO S I $D(^IB A(362.5,"A IFN"_IBIFN )) S IBPRO S=1 Q +$G( IBPROS) ;F INDINS(IBI FN,IBSEQ) ; Returns the intern al entry n umber of t he insuran ce ; compa ny for bil l ien IBIF N for paye r sequence IBSEQ (or current i f ; IBSEQ is null) Q $P($G(^DG CR(399,IBI FN,"I"_$$C OBN^IBCEF( IBIFN,$G(I BSEQ)))),U ) ;TOB(IBI FN) ; Retu rns UB-04 type of bi ll from da ta in the output for matter N I BTOB,IBZ1, IBZ2,IBZ3 D F^IBCEF( "N-UB-04 L OCATION OF CARE","IB Z1",,IBIFN ) D F^IBCE F("N-UB-04 BILL CLAS SIFICATION ","IBZ2",, IBIFN) D F ^IBCEF("N- UB-04 TIME FRAME OF B ILL","IBZ3 ",,IBIFN) S IBTOB=IB Z1_IBZ2_IB Z3 Q IBTOB ;PRCD(PRI EN,ALL,EDT ) ; Functi on returns the code that corre sponds to the variab le ; point er data in PRIEN (ie n;file) ; ALL = if A LL=1, retu rns the en tire $$CPT ^ICPTCOD f or CPT or ; ^code^na me format for ICD re sult ; or null if lo okup fails ; EDT = E ffective d ate to che ck (not us ed if +$G( ALL)=0) N CODE,IBX S CODE="" ; Modified f or Code Se t Versioni ng I PRIEN ["ICPT" S IBX=$$CPT^ ICPTCOD(+P RIEN,$G(ED T)) G:IBX' >0 PRCDQ S CODE=$S($ G(ALL):IBX ,1:$P(IBX, U,2)) I PR IEN["ICD0" S IBX=$$I CD0^IBACSV (+PRIEN,$G (EDT)) G:I BX="" PRCD Q S CODE=$ S($G(ALL): U_$P(IBX,U )_U_$P(IBX ,U,4),1:$P (IBX,U))PR CDQ Q CODE ;NFT(FT,I BIFN) ; Re turns 1 if bill IBIF N is not o f form typ e FT (inte rnal) ; so the data element sh ould not b e required S FT=$S($ $FT^IBCEF( IBIFN)=FT: 0,1:1) Q F T ;REQ(FT, INP,IBIFN) ; Determi ne if bill IBIFN is of form ty pe FT and ; Inpatien t (I) or O utpatient (O) status INP [or e ither if ( null)] ; ;Returns 1 if both c onditions FT and INP match for the bill ; or 0 if either of these cond itions are not true ; I $$REQ^ IBCEF1(2," I",1) woul d mean if bill entry #1 is ; C MS-1500/in patient th e data wou ld be requ ired ; I ' $$REQ^IBCE F1(2,"I",1 ) would me an if bill entry #1 is anythin g but ; CM S-1500/inp atient, th e data wou ld not be ; required N Z S Z=1 S:$$NFT(F T,IBIFN) Z =0 ; Not t he form ty pe for req uirement I Z,$G(INP) '="" D . S Z0=$$INPA T^IBCEF(IB IFN,1),INP =$G(INP) . S Z=$S(Z0 :INP="I",1 :INP="O") ;Check if I/O matche s required state Q Z ;SET1(IBI FN,A,IBZ,I BXDATA,IBX NOREQ) ; U tility to set variab les for ou tput ; for matter for professio nal EDI ; Returns v alues of A , IBXDATA, IBZ, IBXN OREQ N Z,C T S A="^TM P($J,""IBL CT"")" S ( Z,CT)=0 F S Z=$O(IB XDATA(Z)) Q:'Z D ; Don't tra nsmit 0-ch arges . ;I B*2.0*447/ TAZ - Tran smit $0 ch arges. . ; I $P(IBXDA TA(Z),U,9) ,$P(IBXDAT A(Z),U,8) S CT=CT+1 M IBZ(CT)= IBXDATA(Z) . I $P(IB XDATA(Z),U ,9) S CT=C T+1 M IBZ( CT)=IBXDAT A(Z) . ;IB *2.0*447 K IBXDATA S IBXNOREQ= '$$REQ(2," O",IBIFN) Q ;CIADDR( IBXDATA,IB XSAVE,LINE ,FORM) ; F ormat curr ent ins co address l ine LINE f or FORM ; FORM = 1 f or CMS-150 0, 2 for U B-04 ; Cal led from o utput form atter - bo th IBXDATA , IBXSAVE parameters are ; pas sed by ref erence ; K IBXDATA I $G(FORM)' =1 D . ; . ; esg - 1 1/17/06 - IB*2*349 - UB-04 FL- 38 contain s the paye r name . ; and addre ss on 4 li nes within this 5 li ne box. Al l 5 lines . ; are fo rmatted he re into th e IBXDATA array. Thi s is the . ; address that show s through the envelo pe window. . ; . ; e sg - 9/13/ 07 - IB*2* 371 - Line 1 of this box conta ins the pr int . ; st atus (i.e. copy, 2nd notice, 3 rd notice, MRA neede d). . ; . N Z,Z1,LM, Q,ADDR,X,I BPSTAT . S LM=$P($G( ^IBE(350.9 ,1,1)),U,3 1) ; UB ad dress colu mn paramet er . S Z=" " . I LM S $P(Z," ", LM)="" ; beginnin g spaces i ndent . S ADDR=$G(IB XSAVE("CAD R")) ; add ress data string . ; . D F^IBC EF("N-PRIN T BILL SUB MIT STATUS ","IBPSTAT ",,+$G(IBX IEN)) . S Z1=Z I Z1= "" S Z1=" " ; li ne 1 can't start in column 1 . S IBXDATA (1)=Z1_$G( IBPSTAT),Q =1 ; line 1 print st atus . S Q =Q+1 . S I BXDATA(Q)= Z_$G(IBXSA VE("CADR_N AME")) ; l ine 2 paye r name . S X=$P(ADDR ,U,1) . I X'="" S Q= Q+1,IBXDAT A(Q)=Z_X ; addres s line 1 . S X=$P(AD DR,U,2) . I X'="" S Q=Q+1,IBXD ATA(Q)=Z_X D ; addr ess line 2 .. S X=$P (ADDR,U,3) .. I X'=" " S IBXDAT A(Q)=IBXDA TA(Q)_" "_ X ; a ddress lin e 3 .. Q . S Q=Q+1 ; city,st,z ip on last line . S IBXDATA(Q) =Z_$P(ADDR ,U,4)_", " _$$STATE^I BCEFG1($P( ADDR,U,5)) _" "_$P(AD DR,U,6) . KILL IBXSA VE("CADR_N AME"),IBXS AVE("CADR" ) ; cleanu p . Q ; I $G(FORM)=1 D ; CMS-1 500 . N CT ,X,Z . S:' $D(IBXSAVE ("INDENT") ) Z="",$P( Z," ",+$P( $G(^IBE(35 0.9,1,1)), U,27)+1)=" ",IBXSAVE( "INDENT")= Z . S CT=0 . S X=$P( IBXSAVE("C ADR"),U) S :X'="" CT= CT+1,IBXDA TA(CT)=IBX SAVE("INDE NT")_X . S X=$S($P(I BXSAVE("CA DR"),U,2)' ="":$P(IBX SAVE("CADR "),U,2),1: "")_$S($P( IBXSAVE("C ADR"),U,2) '="":" ",1 :"")_$P(IB XSAVE("CAD R"),U,3) S :X'="" CT= CT+1,IBXDA TA(CT)=IBX SAVE("INDE NT")_X . S CT=CT+1,I BXDATA(CT) =IBXSAVE(" INDENT")_$ P(IBXSAVE( "CADR"),U, 4)_", "_$$ STATE^IBCE FG1($P(IBX SAVE("CADR "),U,5))_" "_$P(IBXS AVE("CADR" ),U,6) . Q ; Q ;HHLT H(IBIFN,OU T) ; deter mine if cl aim is hos pice/home health and needs epi sode of ca re date ** 574** ; pe r NUBC, da te the epi sode of ca re began i s needed f or all out patient CM S-1500 Hom e Health a nd Hospice claims an d ; UB-04: 012x,022x ,032x,034x ,081x & 08 2x claims ; this str ing is zer o + the Bi ll Type fi eld from s creens 6&7 of enter/ edit Bill: 0_field#. 24(LOC OF CARE)_.25( BILL CLASS )_.26(TIME FRAME) ; r equired - IBIFN = in ternal cla im# ; opti onal - OUT = optiona l flag to pass to IN PAT^IBCEF ; returns a 1 if dat e should b e included on bill a nd a 0 if it should NOT be inc luded on b ill ; N IB 0,IBL,IBC, IBT Q:$G(I BIFN)="" 0 ; all inp atient cla ims includ e date I $ $INPAT^IBC EF(IBIFN,+ $G(OUT))'= 0 Q 1 S IB 0=$G(^DGCR (399,IBIFN ,0)),IBL=$ P(IB0,U,24 ) ; Per Li sa Duncan, all Home health mus t have dat e, not jus t 032x & 0 34x Q:IBL= 3 1 ; not home healt h or hospi ce if LOC OF CARE = 7 Q:IBL=7 0 S IBC=$P ($G(^DGCR( 399.1,+$P( IB0,U,25), 0)),U,2) ; not home health or hospice if BILL CLAS S is 3 or a number g reater tha n 4 Q:IBC> 4 0 Q:IBC= 3 0 S IBT= IBL_IBC ; any claim where the location o f care_bil l classifi cation com bo is 12,2 2,32,34,81 or 82 mus t have dat e Q:"^12^2 2^32^34^81 ^82^"[IBT 1 Q 0 | |
| 210 | Modified L ogic (Chan ges are in bold) | |
| 211 | IBCEF1 ;AL B/TMP - FO RMATTER SP ECIFIC BIL L FUNCTION S - CONT ; 30-JAN-96 ;;2.0;INTE GRATED BIL LING;**52, 124,51,137 ,210,155,3 49,371,447 ,547,574,5 92**;21-MA R-94;Build 12 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;OCC (IBIFN,REL ,TEXT) ;Se ts up an a rrays of o ccurrence codes for various ck s ;RETURNS 1^additio nal data f or entry I BXSAVE("OC C",n) if R EL or TEXT ; paramet ers have b een met or null if c onditions not met ;I f no REL o r TEXT par ameters se nt, just e xtract cod es array ; IBIFN = b ill ien ; REL = 'OCC RELATED T O' value t o check fo r ; TEXT = text to c heck for t he .01 fie ld of 399. 1 entry po inted to ; by the oc currence c ode N OCC, SORT,ARR,N ,DATA,CODE ,CT I '$D( IBXSAVE("O CC")),'$D( IBXSAVE("O CCS")) D . N IBI,Z,CT 1,CT2,Z0 S (IBI,CT1, CT2)=0 .F S IBI=$O( ^DGCR(399, IBIFN,"OC" ,IBI)) Q:' IBI S Z=$ G(^(IBI,0) ) D ..S Z0 =$G(^DGCR( 399.1,+Z,0 )) ..Q:'$P (Z0,U,10)& '$P(Z0,U,4 ) ;Not an occurrence code ..I $P(Z0,U,10 ) S CT2=CT 2+1,IBXSAV E("OCCS",C T2)=$S($P( Z0,U,4):$P (Z0,U,2)_U _$P(Z,U,2) ,1:U)_U_$P (Z,U,4)_U_ $P(Z0,U)_U _$P(Z0,U,9 )_U_$P(Z,U ,3)_U_$P(Z ,U,2) ..I '$P(Z0,U,1 0) S CT1=C T1+1,IBXSA VE("OCC",C T1)=$S($P( Z0,U,4):$P (Z0,U,2)_U _$P(Z,U,2) ,1:U)_U_U_ $P(Z0,U)_U _$P(Z0,U,9 )_U_$P(Z,U ,3)_U_$P(Z ,U,2) I '$ D(IBXSAVE( "OCC"))&'$ D(IBXSAVE( "OCCS")) S IBXSAVE(" OCC")="" G OCCQ ; ; esg - IB*2 *349 - ord er the occ urrence co des ; Buil d the SORT array sor ted by the occ code F ARR="OCC ","OCCS" S N=0 F S N=$O(IBXSA VE(ARR,N)) Q:'N S D ATA=$G(IBX SAVE(ARR,N )) I $P(DA TA,U,1)'=" " S CODE=" "_$P(DATA ,U,1),SORT (ARR,CODE, N)=DATA ; Loop thru the SORT a rray and r e-build th e IBXSAVE array F AR R="OCC","O CCS" K IBX SAVE(ARR) S CODE="", CT=0 F S CODE=$O(SO RT(ARR,COD E)) Q:CODE ="" S N=0 F S N=$O (SORT(ARR, CODE,N)) Q :'N S CT= CT+1,IBXSA VE(ARR,CT) =SORT(ARR, CODE,N) ; I $G(REL)' =""!($G(TE XT)'="") D OCC1("",. OCC,$G(REL ),$G(TEXT) ) D:'$D(OC C) OCC1("S ",.OCC,$G( REL),$G(TE XT))OCCQ Q $G(OCC) ; OCC1(ARR,O CC,REL,TEX T) ; Searc h thru loc al array f or paramet ers met ; ARR = null to search OCC subsc ript, "S" to search OCCS subsc ript N Z S ARR="OCC" _ARR,Z=0 F S Z=$O(I BXSAVE(ARR ,Z)) Q:'Z D .I $G(R EL)'="",$P (IBXSAVE(A RR,Z),U,5) =REL S OCC ="1"_$S(RE L=2:U_$P(I BXSAVE(ARR ,Z),U,6),1 :"") Q .I $G(TEXT)'= "",$P(IBXS AVE(ARR,Z) ,U,4)=TEXT S OCC="1^ "_$P(IBXSA VE(ARR,Z), U,7) Q ;RX (IBIFN) ; Format bil lable pres cription d ata for re fills for 837 N Z,IB XDATA,CT I '$D(IBXSA VE("BOX24" )) D B24^I BCEF3(.IBX SAVE,IBIFN ,1) S Z="" ,CT=0 F S Z=$O(IBXS AVE("BOX24 ",Z)) Q:Z= "" I $D(I BXSAVE("BO X24",Z,"RX ")) S CT=C T+1,IBXDAT A(Z)=IBXSA VE("BOX24" ,Z,"RX")RX Q Q CT ;OT HPAY(IBIFN ,SEQ) ; Re turn the o ther insur ance payme nt amount for bill ; IBIFN and payer seq uence SEQ (1-3) N AM T,IBIFN1,P RP S IBIFN 1=$P($G(^D GCR(399,IB IFN,"M1")) ,U,SEQ+4), PRP=0 I IB IFN1 D . ; IB*2.0*54 7 if Medic are on bil l, make su re you are pulling a mt paid fr om correct sequence . ; code w as leaving out MRA a mt on tert iary bills and clone d secondar y where MR A claim# d oes NOT ma tch curren t claim# . ;I $$MCRW NR^IBEFUNC (+$G(^DGCR (399,IBIFN ,"I"_SEQ)) ) S AMT=$$ MCRPAY^IBC EU0(IBIFN) Q . I $$M CRWNR^IBEF UNC(+$G(^D GCR(399,IB IFN,"I"_SE Q))) S AMT =$$MCRPAY^ IBCEU0(IBI FN1),PRP=1 Q . S AMT =+$$TPR^PR CAFN(IBIFN 1) I AMT S PRP=1 Q ; A/R amou nt . ; IB* 2.0*547 - moved this line beca use it was not getti ng execute d if IBIFN 1 was not defined, w hich it wo n't be for . ; manu ally creat ed seconda ry and ter tiary clai ms. Using new flag P RP to indi cate if pr ior paymen t already found. . ; S AMT=+$P ($G(^DGCR( 399,IBIFN, "U2")),U,S EQ+3) ; am ount on bi ll S:PRP=0 AMT=+$P($ G(^DGCR(39 9,IBIFN,"U 2")),U,SEQ +3) ; amou nt on bill Q $G(AMT) ;OUTPT(IB IFN,IBPRIN T) ; Moved for space D OUTPT^I BCEF11(IBI FN,$G(IBPR INT)) Q ;O CC92 ;Refo rmats IBXS AVE("OCC") and IBXSA VE("OCCS") to fit bl ocks on UB -04 ; Set up IBXSAVE (32-36) ar rays N IBP G,IB32,IB3 3,IB34,IB3 5,IB36,IBF L,Z,Z0,PG S IBPG=0 F Z=32:1:36 K IBFL(Z) S IBFL(Z) =0 M IB32= IBXSAVE("O CC"),IB36= IBXSAVE("O CCS") S IB 32=$O(IB32 (""),-1),I B36=$O(IB3 6(""),-1), PG=1 D OCC ^IBCF32 F Z=32:1:36 S Z0="" F S Z0=$O(I BFL(Z,Z0)) Q:'Z0 S IBXSAVE("O C92",Z,Z0) =$P(IBFL(Z ,Z0),U,1,3 ) Q ;BATCH () ; Moved for space IB*2*349 Q $$BATCH^ IBCEF11() ;PROC(T,TY PE) ; Find procedure code, str ip '.' Fun ction retu rns result ; T = Pro cedure int ernal entr y #;file r eference ; TYPE = "C PT" for on ly CPT/HCP CS valid ; "ICD" for only ICD9 valid or null for e ither N Q, S S Q="",S ="^"_$P($P (T,";",2), "(") I $G( TYPE)="" D . I $E(S, 2,3)="IC" S Q=$P($$P RCD(T),U) Q . I T["D IC(81.3" S Q=$$MOD^I CPTMOD(+T, "I") S Q=$ S(Q>0:$P(Q ,U,4),1:"" ) I $G(TYP E)="CPT",$ E(S,2,3)=" IC" S Q=$$ PRCD(T) Q I $G(TYPE) ="ICD",T[" ICD0" S Q= $P($$ICD0^ IBACSV(+T) ,U) Q $TR( Q,".") ;FA CILITY(IBI FN) ;retur n the Faci lity (Inst itution po inter-#4) for a bill ; the ins titution o f the Bill Division (399,.22) if defined , otherwis e the Faci lity Name (350.9,.02 ) ; N IB0, IBIN S IBI N=0 S IB0= $G(^DGCR(3 99,+$G(IBI FN),0)) I +$P(IB0,U, 22) S IBIN =$$SITE^VA SITE(+$P(I B0,U,3),+$ P(IB0,U,22 )) I IBIN' >0 S IBIN= +$P($G(^IB E(350.9,1, 0)),U,2) Q +IBIN ;IS RX(IBIFN) ; Function to determ ine if bil l is a pre scription refill bil l ; Return s 0 if no Rx on bill or 1 if t here is. ; N IBRX I $D(^IBA(36 2.4,"AIFN" _IBIFN)) S IBRX=1 Q +$G(IBRX) ;ISPROS(IB IFN) ; Fun ction to d etermine i f bill is a prosthet ics bill ; Returns 0 if no Pro sthetics o n bill or 1 if there is. ; N I BPROS I $D (^IBA(362. 5,"AIFN"_I BIFN)) S I BPROS=1 Q +$G(IBPROS ) ;FINDINS (IBIFN,IBS EQ) ; Retu rns the in ternal ent ry number of the ins urance ; c ompany for bill ien IBIFN for payer sequ ence IBSEQ (or curre nt if ; IB SEQ is nul l) Q $P($G (^DGCR(399 ,IBIFN,"I" _$$COBN^IB CEF(IBIFN, $G(IBSEQ)) )),U) ;TOB (IBIFN) ; Returns UB -04 type o f bill fro m data in the output formatter N IBTOB,I BZ1,IBZ2,I BZ3 D F^IB CEF("N-UB- 04 LOCATIO N OF CARE" ,"IBZ1",,I BIFN) D F^ IBCEF("N-U B-04 BILL CLASSIFICA TION","IBZ 2",,IBIFN) D F^IBCEF ("N-UB-04 TIMEFRAME OF BILL"," IBZ3",,IBI FN) S IBTO B=IBZ1_IBZ 2_IBZ3 Q I BTOB ;PRCD (PRIEN,ALL ,EDT) ; Fu nction ret urns the c ode that c orresponds to the va riable ; p ointer dat a in PRIEN (ien;file ) ; ALL = if ALL=1, returns th e entire $ $CPT^ICPTC OD for CPT or ; ^cod e^name for mat for IC D result ; or null i f lookup f ails ; EDT = Effecti ve date to check (no t used if +$G(ALL)=0 ) N CODE,I BX S CODE= "" ;Modifi ed for Cod e Set Vers ioning I P RIEN["ICPT " S IBX=$$ CPT^ICPTCO D(+PRIEN,$ G(EDT)) G: IBX'>0 PRC DQ S CODE= $S($G(ALL) :IBX,1:$P( IBX,U,2)) I PRIEN["I CD0" S IBX =$$ICD0^IB ACSV(+PRIE N,$G(EDT)) G:IBX="" PRCDQ S CO DE=$S($G(A LL):U_$P(I BX,U)_U_$P (IBX,U,4), 1:$P(IBX,U ))PRCDQ Q CODE ;NFT( FT,IBIFN) ; Returns 1 if bill IBIFN is n ot of form type FT ( internal) ; so the d ata elemen t should n ot be requ ired S FT= $S($$FT^IB CEF(IBIFN) =FT:0,1:1) Q FT ;REQ (FT,INP,IB IFN) ; Det ermine if bill IBIFN is of for m type FT and ; Inpa tient (I) or Outpati ent (O) st atus INP [ or either if (null)] ; ;Retur ns 1 if bo th conditi ons FT and INP match for the b ill ; or 0 if either of these conditions are not t rue ; I $$ REQ^IBCEF1 (2,"I",1) would mean if bill e ntry #1 is ; CMS-150 0/inpatien t the data would be required ; I '$$REQ^ IBCEF1(2," I",1) woul d mean if bill entry #1 is any thing but ; CMS-1500 /inpatient , the data would not be ; requ ired N Z S Z=1 S:$$N FT(FT,IBIF N) Z=0 ; N ot the for m type for requireme nt I Z,$G( INP)'="" D . S Z0=$$ INPAT^IBCE F(IBIFN,1) ,INP=$G(IN P) . S Z=$ S(Z0:INP=" I",1:INP=" O") ;Check if I/O ma tches requ ired state Q Z ;SET1 (IBIFN,A,I BZ,IBXDATA ,IBXNOREQ) ; Utility to set va riables fo r output ; formatter for profe ssional ED I ; Retur ns values of A, IBXD ATA, IBZ, IBXNOREQ N Z,CT S A= "^TMP($J," "IBLCT"")" S (Z,CT)= 0 F S Z=$ O(IBXDATA( Z)) Q:'Z D ; Don't transmit 0-charges . ;IB*2.0* 447/TAZ - Transmit $ 0 charges. . ;I $P(I BXDATA(Z), U,9),$P(IB XDATA(Z),U ,8) S CT=C T+1 M IBZ( CT)=IBXDAT A(Z) . ;JW S;IB*2.0*5 92:US131 . I $P(IBXD ATA(Z),U,9 ) S CT=CT+ 1 M IBZ(CT )=IBXDATA( Z) I $$FT^ IBCEF(IBXI EN)=7,$O(I BXDATA(Z," DEN1",0)) M IBZ(CT," DEN1")=IBX DATA(Z,"DE N1") . ;IB *2.0*447 K IBXDATA ; JWS;IB*2.0 *592:US131 I $$FT^IB CEF(IBXIEN )'=7 S IBX NOREQ='$$R EQ(2,"O",I BIFN) Q ;C IADDR(IBXD ATA,IBXSAV E,LINE,FOR M) ; Forma t current ins co add ress line LINE for F ORM ; FORM = 1 for C MS-1500, 2 for UB-04 ; Called from outpu t formatte r - both I BXDATA, IB XSAVE para meters are ; passed by referen ce ; K IBX DATA I $G( FORM)'=1 D . ; . ; e sg - 11/17 /06 - IB*2 *349 - UB- 04 FL-38 c ontains th e payer na me . ; and address o n 4 lines within thi s 5 line b ox. All 5 lines . ; are format ted here i nto the IB XDATA arra y. This is the . ; a ddress tha t shows th rough the envelope w indow. . ; . ; esg - 9/13/07 - IB*2*371 - Line 1 o f this box contains the print . ; status (i.e. cop y, 2nd not ice, 3rd n otice, MRA needed). . ; . N Z, Z1,LM,Q,AD DR,X,IBPST AT . S LM= $P($G(^IBE (350.9,1,1 )),U,31) ; UB addres s column p arameter . S Z="" . I LM S $P( Z," ",LM)= "" ; be ginning sp aces inden t . S ADDR =$G(IBXSAV E("CADR")) ; address data stri ng . ; . D F^IBCEF(" N-PRINT BI LL SUBMIT STATUS","I BPSTAT",,+ $G(IBXIEN) ) . S Z1=Z I Z1="" S Z1=" " ; line 1 can't sta rt in colu mn 1 . S I BXDATA(1)= Z1_$G(IBPS TAT),Q=1 ; line 1 pr int status . S Q=Q+1 . S IBXDA TA(Q)=Z_$G (IBXSAVE(" CADR_NAME" )) ; line 2 payer na me . S X=$ P(ADDR,U,1 ) . I X'=" " S Q=Q+1, IBXDATA(Q) =Z_X ; address li ne 1 . S X =$P(ADDR,U ,2) . I X' ="" S Q=Q+ 1,IBXDATA( Q)=Z_X D ; address line 2 .. S X=$P(ADD R,U,3) .. I X'="" S IBXDATA(Q) =IBXDATA(Q )_" "_X ; addre ss line 3 .. Q . S Q =Q+1 ; cit y,st,zip o n last lin e . S IBXD ATA(Q)=Z_$ P(ADDR,U,4 )_", "_$$S TATE^IBCEF G1($P(ADDR ,U,5))_" " _$P(ADDR,U ,6) . KILL IBXSAVE(" CADR_NAME" ),IBXSAVE( "CADR") ; cleanup . Q ; I $G(F ORM)=1 D ; CMS-1500 . N CT,X,Z . S:'$D(I BXSAVE("IN DENT")) Z= "",$P(Z," ",+$P($G(^ IBE(350.9, 1,1)),U,27 )+1)="",IB XSAVE("IND ENT")=Z . S CT=0 . S X=$P(IBXS AVE("CADR" ),U) S:X'= "" CT=CT+1 ,IBXDATA(C T)=IBXSAVE ("INDENT") _X . S X=$ S($P(IBXSA VE("CADR") ,U,2)'="": $P(IBXSAVE ("CADR"),U ,2),1:"")_ $S($P(IBXS AVE("CADR" ),U,2)'="" :" ",1:"") _$P(IBXSAV E("CADR"), U,3) S:X'= "" CT=CT+1 ,IBXDATA(C T)=IBXSAVE ("INDENT") _X . S CT= CT+1,IBXDA TA(CT)=IBX SAVE("INDE NT")_$P(IB XSAVE("CAD R"),U,4)_" , "_$$STAT E^IBCEFG1( $P(IBXSAVE ("CADR"),U ,5))_" "_$ P(IBXSAVE( "CADR"),U, 6) . Q ; Q ;HHLTH(IB IFN,OUT) ; determine if claim is hospice /home heal th and nee ds episode of care d ate **574* * ; per NU BC, date t he episode of care b egan is ne eded for a ll outpati ent CMS-15 00 Home He alth and H ospice cla ims and ; UB-04: 012 x,022x,032 x,034x,081 x & 082x c laims ; th is string is zero + the Bill T ype field from scree ns 6&7 of enter/edit Bill: 0_f ield#.24(L OC OF CARE )_.25(BILL CLASS)_.2 6(TIMEFRAM E) ; requi red - IBIF N = intern al claim# ; optional - OUT = o ptional fl ag to pass to INPAT^ IBCEF ; re turns a 1 if date sh ould be in cluded on bill and a 0 if it s hould NOT be include d on bill ; N IB0,IB L,IBC,IBT Q:$G(IBIFN )="" 0 ; a ll inpatie nt claims include da te I $$INP AT^IBCEF(I BIFN,+$G(O UT))'=0 Q 1 S IB0=$G (^DGCR(399 ,IBIFN,0)) ,IBL=$P(IB 0,U,24) ; Per Lisa D uncan, all Home heal th must ha ve date, n ot just 03 2x & 034x Q:IBL=3 1 ; not home health or hospice i f LOC OF C ARE = 7 Q: IBL=7 0 S IBC=$P($G( ^DGCR(399. 1,+$P(IB0, U,25),0)), U,2) ; not home heal th or hosp ice if BIL L CLASS is 3 or a nu mber great er than 4 Q:IBC>4 0 Q:IBC=3 0 S IBT=IBL_ IBC ; any claim wher e the loca tion of ca re_bill cl assificati on combo i s 12,22,32 ,34,81 or 82 must ha ve date Q: "^12^22^32 ^34^81^82^ "[IBT 1 Q 0 | |
| 212 | ||
| 213 | ||
| 214 | Routines | |
| 215 | Activities | |
| 216 | Routine Na me | |
| 217 | IBCEF11 | |
| 218 | Enhancemen t Category | |
| 219 | New | |
| 220 | Modify | |
| 221 | Delete | |
| 222 | No Change | |
| 223 | RTM | |
| 224 | ||
| 225 | Related Op tions | |
| 226 | None | |
| 227 | Related Ro utines | |
| 228 | Routines “ Called By” | |
| 229 | Routines “ Called” | |
| 230 | ||
| 231 | ||
| 232 | ||
| 233 | ||
| 234 | Data Dicti onary (DD) Reference s | |
| 235 | IB BILL/CL AIMS DIAGN OSIS [#362 .3] | |
| 236 | BILL/CLAIM S [#399] | |
| 237 | EDI TRANSM ISSION BAT CH [#364.1 ] | |
| 238 | Related Pr otocols | |
| 239 | None | |
| 240 | Related In tegration Control Re gistration s (ICRs) | |
| 241 | None | |
| 242 | Data Passi ng | |
| 243 | Input | |
| 244 | Output Re ference | |
| 245 | Both | |
| 246 | Global Re ference | |
| 247 | Local | |
| 248 | Input Attr ibute Name and Defin ition | |
| 249 | Name: | |
| 250 | Definition : | |
| 251 | Output Att ribute Nam e and Defi nition | |
| 252 | Name: | |
| 253 | Definition : | |
| 254 | Current Lo gic | |
| 255 | IBCEF11 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS - CONT ;30-JAN-96 ;;2.0;INT EGRATED BI LLING;**51 ,137,155,3 09,335,348 ,349,371,4 32,447,473 ,516**;21- MAR-94;Bui ld 123 ;;P er VA Dire ctive 6402 , this rou tine shoul d not be m odified. ; BOX24D(A,I B) ; Retur ns the lin es for box es 19-24 o f the CMS- 1500 displ ay ; IB = flag is 1 if only bo x 24 is ne eded Q $S( '$G(IB):"3 6",1:"44") _"^55" ;RC BOX() ; Re turns the lines for revenue co de boxes o f the UB-0 4 display Q "19^41" ;OUTPT(IBI FN,IBPRINT ) ; Return s an array of servic e line dat a from ; C MS-1500 bo x 24. Outp ut is in I BXDATA(n) ; IBPRINT = print fl ag 1: retu rn print f ields ; 0: return ED I fields ; Uses diag nosis arra y ^TMP("IB XSAVE",$J, "DX",IBIFN ,DIAG CODE )=SEQ # ; if it alre ady exists . If not, it builds it from N- DIAGNOSES element ; ; For EDI call: Retu rns IBXDAT A(n)= ; be gin date(Y YYYMMDD) ^ end date( YYYYMMDD) ^ pos ^ to s ^ ; proc code/reve nue code - if no pro cedure (no t the poin ters) ^ ; type of co de ^ dx po inter(s ) ^ unit cha rge ^ unit s ^ modifi ers separa ted by ; ; ^ purchas ed charge amount ^ a nesthesia minutes ^ emergency indicator ^ ; lab-ty pe service flag ^ ND C ^ Units ; ; Also R eturns IBX DATA(IBI," COB",COB,m ) with COB data for each line ; item fou nd in an a ccepted EO B for the bill and = the refer ence ; lin e in the f irst '^' p iece follo wed by the '0' node data of fi le ; 361.1 15 (LINE L EVEL ADJUS TMENTS) ; COB = COB sequence # of adjust ment's ins co, m = s eq # ; -- AND -- ; I BXDATA(IBI ,"COB",COB ,m,z,p)= ; the data on the '0' node for each subor dinate ent ry of file ; 361.115 11 (REASON S) (Only f irst 3 pie ces for 83 7 output) ; z = grou p code, so metimes pr eceeded by a space p = seq # ; ; For Pri nt call: R eturns beg in date(DD MMYYYY)^en d date(DDM MYYYY) or ; null if equal to b egin date^ pos^tos^be dsection n ame(if no procedure) ; or proc edure code (not the p ointer)^ . .. refer t o EDI call results ; Also, IBX DATA(n,"TE XT")=the t ext to pri nt on firs t line of box 24, ; If no proc edure code , returns IBXDATA(n, "A")=rev c ode abbrev ; ; For b oth calls, returns I BXDATA(n,i tem type,i tem ptr)=" " ; -- AND -- ; IBXD ATA(n,"RX" )=RX#^drug name^NDC^ refill #^( re)fill da te^qty^day s ; ^chrge ^ien of fi le 362.4^N DC format ; If line references a prescri ption ; -- AND -- ; If no reve nue code f or a presc ription, r eturns IBX DATA(n,"AR X")="" ; - - AND -- ; IBXDATA(n ,"AUX")='A UX' node o f the proc edure entr y ; ; Also returns I BXDATA(n," CPLNK") = soft link to corresp onding ent ry in PROC EDURES mul tiple of f ile 399 ; N IB,IBI,I BJ,IBFLD,I BDXI,IBXIE N,Z,IBXTRA ,IBRX,IBRX 0,IBRX1,Z0 ,Z1 ; K ^T MP($J,"IBI TEM") S ^T MP($J,"IBI TEM")="" ; Build dia gnosis arr ay if not already bu ilt I $O(^ TMP("IBXSA VE",$J,"DX ",IBIFN,"" ))="",$O(^ IBA(362.3, "AIFN"_IBI FN,"")) D .N Z,IBXDA TA D F^IBC EF("N-DIAG NOSES",,,I BIFN) .S Z ="" F S Z =$O(IBXDAT A(Z)) K:$O (IBXDATA(0 ))=""&(Z=" ") IBXDATA Q:Z="" S :$P(IBXDAT A(Z),U,2) ^TMP("IBXS AVE",$J,"D X",IBIFN,$ P(IBXDATA( Z),U,2))=Z ; S IB(0) =$G(^DGCR( 399,IBIFN, 0)),IB("U" )=$G(^("U" )),IB("U1" )=$G(^("U1 ")) S IBI= "" F S IB I=$O(^TMP( "IBXSAVE", $J,"DX",IB IFN,IBI)) Q:IBI="" S IBDXI(IB I)=^(IBI) I '$G(IBPR INT) D RVC E^IBCF23(I BIFN,IBIFN ) I $G(IBP RINT) D RV CE^IBCF23( ,IBIFN) ; Returns IB FLD(24) = begin date ^ end dat e ^ pos ^ tos ^ ; pr oc/bedsect ion/revenu e code ^ d x pointer ^ unit cha rge ^ ; un its ^ modi fiers ^ pu rchased ch arge amoun t ^ anesth esia minut es ^ ; eme rgency ind icator ^ s oft pointe r to PROCE DURES mult iple in fi le 399 ^ ; NDC ^ Uni ts ; IBFLD (24,n,type ,item)="" ; IBFLD(24 ,n_"A") = revenue co de abbrevi ation if n o procedur e ; IBFLD( 24,n,"AUX" ) = 'AUX' node of li ne item ; IBFLD(24, n,"RX") = soft point er to file 362.4 fro m 'item' f ld ; (can be null) ; D SET^IBC SC5A(IBIFN ,.IBRX) ;p rescriptio ns ; IBRX1 (ien 362.4 )=RX#^drug ien^NDC^r efil #^(re )fil date^ qty^days^c hrge I IBR X S IBRX=" " F S IBR X=$O(IBRX( IBRX)) Q:I BRX="" S IBRX0=0 F S IBRX0=$ O(IBRX(IBR X,IBRX0)) Q:'IBRX0 D . N IBRX H . S IBRX H=IBRX(IBR X,IBRX0) . ; **IB*2. 0*432** ad ded _U_$P( IBRXH,U,9) (Rx Date) to Output Formatter . S IBRX1 (+IBRXH)=I BRX_U_$P(I BRXH,U,2)_ U_$P(IBRXH ,U,5)_U_$P (IBRXH,U,7 )_U_IBRX0_ U_$P(IBRXH ,U,4)_U_$P (IBRXH,U,3 )_U_$P(IBR XH,U,6)_U_ +IBRXH_U_$ P(IBRXH,U, 8)_U_$P(IB RXH,U,9) K IBRX ; ; for EDI, r emove any $0 line it ems from t he IBFLD a rray befor e ; dropp ing down i nto the ne xt loop (I B*2*371) ; Start IB* 2.0*447 BI - Code re moved to a llow 0 dol lars to pr int. ;I '$ G(IBPRINT) D ;. NEW IBZ,IBI,Z ;. M IBZ=I BFLD K IBF LD ;. S (I BI,Z)=0 ;. F S IBI=$ O(IBZ(24,I BI)) Q:IBI '=+IBI D ; .. I $P(IB Z(24,IBI), U,7)*$P(IB Z(24,IBI), U,8)'>0 Q ;.. S Z=Z+ 1 ;.. M IB FLD(24,Z)= IBZ(24,IBI ) ;.. S IB FLD(24)=Z ;.. Q ;. Q ; End IB* 2.0*447 BI ; S IBI=0 F S IBI= $O(IBFLD(2 4,IBI)) Q: IBI'=+IBI D . S IBR X1=0 . S I BXDATA(IBI )=$P(IBFLD (24,IBI),U )_U_$P(IBF LD(24,IBI) ,U,$S($P(I BFLD(24,IB I),U,2)="" &'$G(IBPRI NT):1,1:2) ) . S $P(I BXDATA(IBI ),U,3,5)=$ P(IBFLD(24 ,IBI),U,3, 5) . S $P( IBXDATA(IB I),U,6)=$S ($D(IBFLD( 24,IBI_"X" )):"CJ",1: "HC") . S $P(IBXDATA (IBI),U,7, 13)=$P(IBF LD(24,IBI) ,U,6,12) . S $P(IBXD ATA(IBI),U ,14)=+$$IS LAB(IBXDAT A(IBI)) . ; MRD;IB*2 .0*516 - A dded NDC a nd Units t o line lev el of clai m, . ; pie ces 14 & 1 5 of IBFLD , pieces 1 5 & 16 of IBXDATA. P rint . ; i n Box 24 b y setting in IBXDATA (IBI,"TEXT "). . S $P (IBXDATA(I BI),U,15,1 6)=$P(IBFL D(24,IBI), U,14,15) . I $P(IBFL D(24,IBI), U,14)'="" S IBXDATA( IBI,"TEXT" )="N4"_$P( IBFLD(24,I BI),U,14)_ " UN"_$P(I BFLD(24,IB I),U,15) . ; . I $D( IBFLD(24,I BI,"RX")) D ;Rx .. S IBRX1=1 .. I $P($G (IBFLD(24, IBI,"AUX") ),U,8)'="" S $P(IBFL D(24,IBI," AUX"),U,8) ="",$P(IBF LD(24,IBI, "AUX"),U,9 )="" ;No free text allowed fo r rx's .. I $D(IBRX1 (+IBFLD(24 ,IBI,"RX") )) D Q ; Soft link exists ... D ZERO^IBR XUTL(+$P(I BRX1(+IBFL D(24,IBI," RX")),U,2) ) ... S IB XDATA(IBI, "RX")=IBRX 1(+IBFLD(2 4,IBI,"RX" )),$P(IBXD ATA(IBI,"R X"),U,2)=$ E($G(^TMP( $J,"IBDRUG ",+$P(IBRX 1(+IBFLD(2 4,IBI,"RX" )),U,2),.0 1)),1,30) ... K IBRX 1(+IBFLD(2 4,IBI,"RX" )) ... ; N o soft lin k - must f ind the fi rst Rx wit h the same charge .. S IBRX="" F S IBRX =$O(IBRX1( IBRX)) Q:' IBRX I +$ P(IBRX1(IB RX),U,8)=+ $P(IBXDATA (IBI),U,8) D Q ... D ZERO^IBR XUTL(+$P(I BRX1(IBRX) ,U,2)) ... S IBXDATA (IBI,"RX") =IBRX1(IBR X),$P(IBXD ATA(IBI,"R X"),U,2)=$ E($G(^TMP( $J,"IBDRUG ",+$P(IBRX 1(IBRX),U, 2),.01)),1 ,30) K IBR X1(IBRX) Q ... Q .. Q . ; . ; MRD;IB*2.0 *516 - If additional service l ine commen ts to appe ar in . ; Box 24, co ncatenate to front i f somethin g (NDC) is already t here. . I $G(IBFLD(2 4,IBI,"AUX "))'="" D .. I $G(IB PRINT),$P( IBFLD(24,I BI,"AUX"), U,8)'="" D ... I $G( IBXDATA(IB I,"TEXT")) '="" S IBX DATA(IBI," TEXT")=$E( $P(IBFLD(2 4,IBI,"AUX "),U,8)_" "_IBXDATA( IBI,"TEXT" ),1,59) .. . E S IBX DATA(IBI," TEXT")=$P( IBFLD(24,I BI,"AUX"), U,8) ... S $P(IBFLD( 24,IBI,"AU X"),U,8)=" " ... Q .. S IBXDATA (IBI,"AUX" )=IBFLD(24 ,IBI,"AUX" ) .. Q . ; . I $G(IB PRINT) D . . ; START IB*2.0*447 BI ZERO D OLLAR CHAN GES .. ; I '$P(IBXDA TA(IBI),U, 8),'$G(IBX DATA(IBI," RX")) D Q .. I $P(IB XDATA(IBI) ,U,8)="",' $G(IBXDATA (IBI,"RX") ) D Q ... ; END IB* 2.0*447 BI ZERO DOLL AR CHANGES ... I $G( IBNOSHOW) Q ; don 't show er rors/warni ngs ... S IBXDATA(IB I,"TEXT")= "Warning:* * REV CODE UNITS < # PROCEDURES , THEY MUS T BE =" .. . I $D(IBX DATA(IBI," AUX")) S $ P(IBXDATA( IBI,"AUX") ,U,9)="" . .. Q .. ; .. I $G(IB FLD(24,IBI _"A"))'="" D Q ... S IBXDATA( IBI,"A")=I BFLD(24,IB I_"A") ... I $G(IBNO SHOW) Q ; don't s how errors /warnings ... S IBXD ATA(IBI,"T EXT")="War ning:** RE V CODE UNI TS > #PROC EDURES, TH EY MUST BE =: "_IBFLD (24,IBI_"A ") ... I $ D(IBXDATA( IBI,"AUX") ) S $P(IBX DATA(IBI," AUX"),U,9) ="" ... Q .. ; .. S IBRX=$G(IB XDATA(IBI, "RX")) .. I IBRX'="" D ;Forma t Rx detai l ... N Z ... S Z=$P (IBRX,U) . .. S Z=$S( Z'="":"Rx# "_Z_" ",1: "RX: ") .. . S IBXDAT A(IBI,"TEX T")=Z_$S($ P(IBRX,U,3 )'="":"NDC : "_$P(IBR X,U,3),1:" NOC: "_$P( IBRX,U,2)) _" Qty: "_ $P(IBRX,U, 6)_" Days: "_$P(IBRX ,U,7) ... S $P(IBXDA TA(IBI,"AU X"),U,9)=" N4" ; se rvice line comment q ualifier f or RX's .. . Q .. Q . S IBXDATA (IBI,"CPLN K")=$P(IBF LD(24,IBI) ,U,13) . I '$G(IBPRI NT) D COBL INE^IBCEU6 (IBIFN,IBI ,.IBXDATA, ,.IBXTRA) . Q ; I $G (IBPRINT) D . S IBRX =0 F S IB RX=$O(IBRX 1(IBRX)) Q :'IBRX D .. S IBI=+ $O(IBXDATA (""),-1)+1 .. S IBXD ATA(IBI)=$ $DATE($P(I BRX1(IBRX) ,U,5)) .. S IBXDATA( IBI,"TEXT" )="**** ER ROR - NO P ROC LINK T O REV CODE FOR DRUG: RX#: "_$P (IBRX1(IBR X),U)_" ND C #: "_$P( IBRX1(IBRX ),U,3) .. I $D(IBXDA TA(IBI,"AU X")) S $P( IBXDATA(IB I,"AUX"),U ,9)="" .. S IBXDATA( IBI,"ARX") ="" .. D Z ERO^IBRXUT L(+$P(IBRX 1(IBRX),U, 2)) .. S I BXDATA(IBI ,"RX")=IBR X1(IBRX),$ P(IBXDATA( IBI,"RX"), U,2)=$E($G (^TMP($J," IBDRUG",+$ P(IBRX1(IB RX),U,2),. 01)),1,30) K IBRX1(I BRX) .. Q . Q ; I '$ G(IBPRINT) ,$D(IBXTRA ) D COMBO^ IBCEU2(.IB XDATA,.IBX TRA,0) ;Ha ndle bundl ed/unbundl ed lines K ^TMP($J," IBDRUG") Q ;ISLAB(LD ATA) ; Ret urns 0/1 i f line ite m data ind icates the item is a lab (1) ; 'LAB' is defined he re as type of servic e = 5 Q $E ($P(LDATA, U,4))="5" ;FMT(DATA, DLEN,FLEN) ; Returns a string in DATA wi th a max l ength of D LEN ; and a field le ngth of FL EN Q $E($E (DATA,1,DL EN)_$J("", FLEN),1,FL EN) ;DATE( X,DEL) ; R eturns FM date in X as MMxDDxY YYY where x=DEL S DE L=$G(DEL) S X=$$DATE ^IBCF2(X,1 ,1) I X'=" " S X=$E(X ,1,2)_DEL_ $E(X,3,4)_ DEL_$E(X,5 ,8) Q X ;B ATCH() ; S ets up rec ord for an d stores/r eturns the next batc h number N NUM,FAC,D O,DD,DLAYG O,DIC,X,Y ;Keep late st batch n umber for view/print edi bill extract da ta option I $D(IBVNU M) S NUM=I BVNUM G BA TCHQ ;Chec k for batc h resubmit - if yes, use same number as original b atch I $P( $G(^TMP("I BRESUBMIT" ,$J)),U,3) =1 S NUM=$ P(^($J),U) G BATCHQ L +^IBA(36 4.1,0):5 I '$T Q 0 S FAC=+$P($ $SITE^VASI TE(),U,3), NUM=$O(^IB A(364.1,"B ",""),-1) I $D(^IBA( 364.1,+NUM ,0)),$P(^( 0),U,2)="" F D Q:' NUM!($P($G (^IBA(364. 1,+NUM,0)) ,U,2)'="") . I $D(^I BA(364.1,N UM,0)) S D A=NUM,DIK= "^IBA(364. 1," D ^DIK . S NUM=$ O(^IBA(364 .1,"B","") ,-1) F S NUM=$S($P( NUM,FAC,2) '="":NUM+1 ,1:FAC_"00 00001") Q: '$D(^IBA(3 64.1,"B",N UM)) K DO, DD S DIC=" ^IBA(364.1 ,",DLAYGO= 364.1,DIC( 0)="L",X=N UM D FILE^ DICN K DD, DO I Y'>0 S NUM=0 L -^IBA(364. 1,0)BATCHQ Q NUM ;GE TLDAT(IBXI EN) ; Extr act data f or 837 tra nsmission LDAT recor d ; IBXIEN - ien in file 399 ; Sets up I BXSAVE("LD AT",n) arr ay: ; Atta chment rep ort type ^ Attachmen t report t ransmissio n code ^ A ttachment control nu mber ^ ; OB Anesthe sia Additi onal Units ^ Purchas e Service Provider I D ^ Purcha se Service Amount ^ N CPIEN,FT YPE,IBXDAT A,IDS,IBID S,NODE1,PS AMNT,PSPID ,Z,PCE1,LI NE I '+$G( IBXIEN) Q K IBXSAVE( "LDAT") S FTYPE=$$FT ^IBCEF(IBX IEN) I FTY PE=2 D OUT PT(IBXIEN, 0) I FTYPE =3 D HOS^I BCEF2(IBXI EN) D ALLI DS^IBCEFP( IBXIEN,.ID S,1) S (PS PID,PSAMNT )="" ; IB* 2.0*473/TA Z - Conver t PROVIDER code to f unction ca ll to PSID ^IBCEFP I $$SUB1OK^I BCEP8A(IBX IEN),(FTYP E=2) D . D PSID^IBCE FP(IBXIEN, .IDS,.IBID S) . S PSP ID=$G(IBID S(0)) I PS PID="" S P SPID=$P($G (IBIDS(1)) ,U,1) ;IB* 2.0*473/TA Z - END S Z=0 F S Z =$O(IBXDAT A(Z)) Q:'Z D . S CP IEN=+$G(IB XDATA(Z,"C PLNK")) ;I 'CPIEN Q . I FTYPE= 2,$$SUB1OK ^IBCEP8A(I BXIEN) S P SAMNT=$$DO LLAR^IBCEF G1($P($G(I BXDATA(Z)) ,U,11)) . S (PCE1,NO DE1)="" . I CPIEN D . . S NODE 1=$G(^DGCR (399,IBXIE N,"CP",CPI EN,1)) . . S PCE1=$$ GET1^DIQ(3 99.0304,CP IEN_","_IB XIEN_",",7 1) . . Q . ; MRD;IB* 2.0*516 - Added addl . procedur e descript ion as pie ce 7 . ; of IBXSAVE , which wi ll exist o nly if the procedure ends in ' 99' . ; or is an 'NO C/NOS' pro cedure. . S IBXSAVE( "LDAT",Z)= PCE1_U_$P( NODE1,U,3) _U_$P(NODE 1,U)_U_$P( NODE1,U,5) _U_$G(PSPI D)_U_$G(PS AMNT)_U_$P (NODE1,U,4 ) . Q Q | |
| 256 | Modified L ogic (Chan ges are in bold) | |
| 257 | IBCEF11 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS - CONT ;30-JAN-96 ;;2.0;INT EGRATED BI LLING;**51 ,137,155,3 09,335,348 ,349,371,4 32,447,473 ,516,577,5 92**;21-MA R-94;Build 1 ;;Per V A Directiv e 6402, th is routine should no t be modif ied. ;BOX2 4D(A,IB) ; Returns t he lines f or boxes 1 9-24 of th e CMS-1500 display ; IB = flag is 1 if o nly box 24 is needed Q $S('$G( IB):"36",1 :"44")_"^5 5" ;RCBOX( ) ; Return s the line s for reve nue code b oxes of th e UB-04 di splay Q "1 9^41" ;OUT PT(IBIFN,I BPRINT) ; Returns an array of service li ne data fr om ; CMS-1 500 box 24 . Output i s in IBXDA TA(n) ; IB PRINT = pr int flag 1 : return p rint field s ; 0: ret urn EDI fi elds ; Use s diagnosi s array ^T MP("IBXSAV E",$J,"DX" ,IBIFN,DIA G CODE)=SE Q # ; if i t already exists. If not, it b uilds it f rom N-DIAG NOSES elem ent ; ; Fo r EDI call : Returns IBXDATA(n) = ; begin date(YYYYM MDD) ^ end date(YYYY MMDD) ^ po s ^ tos ^ ; proc cod e/revenue code - if no procedu re (not th e pointers ) ^ ; type of code ^ dx pointe r(s ) ^ un it charge ^ units ^ modifiers separated by ; ; ^ p urchased c harge amou nt ^ anest hesia minu tes ^ emer gency indi cator ^ ; lab-type s ervice fla g ^ NDC ^ Units/Quan tity ^ Uni t/Basis of Measureme nt (vd/IB* 2*577) ; ; Also Retu rns IBXDAT A(IBI,"COB ",COB,m) w ith COB da ta for eac h line ; i tem found in an acce pted EOB f or the bil l and = th e referenc e ; line i n the firs t '^' piec e followed by the '0 ' node dat a of file ; 361.115 (LINE LEVE L ADJUSTME NTS) ; COB = COB seq uence # of adjustmen t's ins co , m = seq # ; -- AND -- ; IBXD ATA(IBI,"C OB",COB,m, z,p)= ; th e data on the '0' no de for eac h subordin ate entry of file ; 361.11511 (REASONS) (Only firs t 3 pieces for 837 o utput) ; z = group c ode, somet imes prece eded by a space p = seq # ; ; For Print call: Retu rns begin date(DDMMY YYY)^end d ate(DDMMYY YY) or ; n ull if equ al to begi n date^pos ^tos^bedse ction name (if no pro cedure) ; or procedu re code(no t the poin ter)^ ... refer to E DI call re sults ; Al so, IBXDAT A(n,"TEXT" )=the text to print on first l ine of box 24, ; If no procedu re code, r eturns IBX DATA(n,"A" )=rev code abbrev ; ; For both calls, re turns IBXD ATA(n,item type,item ptr)="" ; -- AND -- ; IBXDATA (n,"RX")=R X#^drug na me^NDC^ref ill #^(re) fill date^ qty^days ; ^chrge^ie n of file 362.4^NDC format ; I f line ref erences a prescripti on ; -- AN D -- ; If no revenue code for a prescrip tion, retu rns IBXDAT A(n,"ARX") ="" ; -- A ND -- ; IB XDATA(n,"A UX")='AUX' node of t he procedu re entry ; ; Also re turns IBXD ATA(n,"CPL NK") = sof t link to correspond ing entry in PROCEDU RES multip le of file 399 ; N I B,IBI,IBJ, IBFLD,IBDX I,IBXIEN,Z ,IBXTRA,IB RX,IBRX0,I BRX1,Z0,Z1 ; K ^TMP( $J,"IBITEM ") S ^TMP( $J,"IBITEM ")="" ; Bu ild diagno sis array if not alr eady built I $O(^TMP ("IBXSAVE" ,$J,"DX",I BIFN,""))= "",$O(^IBA (362.3,"AI FN"_IBIFN, "")) D .N Z,IBXDATA D F^IBCEF( "N-DIAGNOS ES",,,IBIF N) .S Z="" F S Z=$O (IBXDATA(Z )) K:$O(IB XDATA(0))= ""&(Z="") IBXDATA Q: Z="" S:$P (IBXDATA(Z ),U,2) ^TM P("IBXSAVE ",$J,"DX", IBIFN,$P(I BXDATA(Z), U,2))=Z ; S IB(0)=$G (^DGCR(399 ,IBIFN,0)) ,IB("U")=$ G(^("U")), IB("U1")=$ G(^("U1")) S IBI="" F S IBI=$ O(^TMP("IB XSAVE",$J, "DX",IBIFN ,IBI)) Q:I BI="" S I BDXI(IBI)= ^(IBI) I ' $G(IBPRINT ) D RVCE^I BCF23(IBIF N,IBIFN) I $G(IBPRIN T) D RVCE^ IBCF23(,IB IFN) ; Ret urns IBFLD (24) = beg in date ^ end date ^ pos ^ tos ^ ; proc/ bedsection /revenue c ode ^ dx p ointer ^ u nit charge ^ ; units ^ modifie rs ^ purch ased charg e amount ^ anesthesi a minutes ^ ; emerge ncy indica tor ^ soft pointer t o PROCEDUR ES multipl e in file 399 ^ ; ND C ^ Units ; IBFLD(24 ,n,type,it em)="" ; I BFLD(24,n_ "A") = rev enue code abbreviati on if no p rocedure ; IBFLD(24, n,"AUX") = 'AUX' nod e of line item ; IB FLD(24,n," RX") = sof t pointer to file 36 2.4 from ' item' fld ; (can be null) ; D SET^IBCSC5 A(IBIFN,.I BRX) ;pres criptions ; IBRX1(ie n 362.4)=R X#^drug ie n^NDC^refi l #^(re)fi l date^qty ^days^chrg e I IBRX S IBRX="" F S IBRX=$ O(IBRX(IBR X)) Q:IBRX ="" S IBR X0=0 F S IBRX0=$O(I BRX(IBRX,I BRX0)) Q:' IBRX0 D . N IBRXH . S IBRXH=I BRX(IBRX,I BRX0) . ; **IB*2.0*4 32** added _U_$P(IBR XH,U,9) (R x Date) to Output Fo rmatter . S IBRX1(+I BRXH)=IBRX _U_$P(IBRX H,U,2)_U_$ P(IBRXH,U, 5)_U_$P(IB RXH,U,7)_U _IBRX0_U_$ P(IBRXH,U, 4)_U_$P(IB RXH,U,3)_U _$P(IBRXH, U,6)_U_+IB RXH_U_$P(I BRXH,U,8)_ U_$P(IBRXH ,U,9) K IB RX ; ; for EDI, remo ve any $0 line items from the IBFLD arra y before ; dropping down into the next loop (IB*2 *371) ; St art IB*2.0 *447 BI - Code remov ed to allo w 0 dollar s to print . ;I '$G(I BPRINT) D ;. NEW IBZ ,IBI,Z ;. M IBZ=IBFL D K IBFLD ;. S (IBI, Z)=0 ;. F S IBI=$O(I BZ(24,IBI) ) Q:IBI'=+ IBI D ;.. I $P(IBZ(2 4,IBI),U,7 )*$P(IBZ(2 4,IBI),U,8 )'>0 Q ;.. S Z=Z+1 ; .. M IBFLD (24,Z)=IBZ (24,IBI) ; .. S IBFLD (24)=Z ;.. Q ;. Q ; End IB*2.0 *447 BI ; S IBI=0 F S IBI=$O( IBFLD(24,I BI)) Q:IBI '=+IBI D . S IBRX1= 0 . S IBXD ATA(IBI)=$ P(IBFLD(24 ,IBI),U)_U _$P(IBFLD( 24,IBI),U, $S($P(IBFL D(24,IBI), U,2)=""&'$ G(IBPRINT) :1,1:2)) . S $P(IBXD ATA(IBI),U ,3,5)=$P(I BFLD(24,IB I),U,3,5) . S $P(IBX DATA(IBI), U,6)=$S($D (IBFLD(24, IBI_"X")): "CJ",1:"HC ") . S $P( IBXDATA(IB I),U,7,13) =$P(IBFLD( 24,IBI),U, 6,12) . S $P(IBXDATA (IBI),U,14 )=+$$ISLAB (IBXDATA(I BI)) . ; M RD;IB*2.0* 516 - Adde d NDC and Units to l ine level of claim, . ; pieces 14 & 15 o f IBFLD, p ieces 15 & 16 of IBX DATA. Prin t . ; in B ox 24 by s etting in IBXDATA(IB I,"TEXT"). . ;S $P(I BXDATA(IBI ),U,15,16) =$P(IBFLD( 24,IBI),U, 14,15) . ; I $P(IBFLD (24,IBI),U ,14)'="" S IBXDATA(I BI,"TEXT") ="N4"_$P(I BFLD(24,IB I),U,14)_" UN"_$P(IB FLD(24,IBI ),U,15) . ; vd/IB*2* 577 - Adde d Unit/Bas is of Meas urement to line leve l of claim , . ; piec e 16 of IB FLD, piece 17 of IBX DATA. . ; Print in B ox 24 by s etting in IBXDATA(IB I,"TEXT"). . S $P(IB XDATA(IBI) ,U,15,17)= $P(IBFLD(2 4,IBI),U,1 4,16) . I $P(IBFLD(2 4,IBI),U,1 4)'="" S I BXDATA(IBI ,"TEXT")=" N4"_$P(IBF LD(24,IBI) ,U,14)_" " _$P(IBFLD( 24,IBI),U, 16)_$P(IBF LD(24,IBI) ,U,15) . ; . I $D(IB FLD(24,IBI ,"RX")) D ;Rx .. S IBRX1=1 .. I $P($G(I BFLD(24,IB I,"AUX")), U,8)'="" S $P(IBFLD( 24,IBI,"AU X"),U,8)=" ",$P(IBFLD (24,IBI,"A UX"),U,9)= "" ;No fr ee text al lowed for rx's .. I $D(IBRX1(+ IBFLD(24,I BI,"RX"))) D Q ;So ft link ex ists ...D ZERO^IBRXU TL(+$P(IBR X1(+IBFLD( 24,IBI,"RX ")),U,2)) ... S IBXD ATA(IBI,"R X")=IBRX1( +IBFLD(24, IBI,"RX")) ,$P(IBXDAT A(IBI,"RX" ),U,2)=$E( $G(^TMP($J ,"IBDRUG", +$P(IBRX1( +IBFLD(24, IBI,"RX")) ,U,2),.01) ),1,30) .. . K IBRX1( +IBFLD(24, IBI,"RX")) ... ; No soft link - must fin d the firs t Rx with the same c harge .. S IBRX="" F S IBRX=$ O(IBRX1(IB RX)) Q:'IB RX I +$P( IBRX1(IBRX ),U,8)=+$P (IBXDATA(I BI),U,8) D Q ... D ZERO^IBRXU TL(+$P(IBR X1(IBRX),U ,2)) ... S IBXDATA(I BI,"RX")=I BRX1(IBRX) ,$P(IBXDAT A(IBI,"RX" ),U,2)=$E( $G(^TMP($J ,"IBDRUG", +$P(IBRX1( IBRX),U,2) ,.01)),1,3 0) K IBRX1 (IBRX) Q . .. Q .. Q . ; . ; MR D;IB*2.0*5 16 - If ad ditional s ervice lin e comments to appear in . ; Bo x 24, conc atenate to front if something (NDC) is a lready the re. . I $G (IBFLD(24, IBI,"AUX") )'="" D .. I $G(IBPR INT),$P(IB FLD(24,IBI ,"AUX"),U, 8)'="" D . .. I $G(IB XDATA(IBI, "TEXT"))'= "" S IBXDA TA(IBI,"TE XT")=$E($P (IBFLD(24, IBI,"AUX") ,U,8)_" "_ IBXDATA(IB I,"TEXT"), 1,59) ... E S IBXDA TA(IBI,"TE XT")=$P(IB FLD(24,IBI ,"AUX"),U, 8) ... S $ P(IBFLD(24 ,IBI,"AUX" ),U,8)="" ... Q .. S IBXDATA(I BI,"AUX")= IBFLD(24,I BI,"AUX") .. Q . ; . ;JWS;IB*2 .0*592:US1 31 . I $G( IBFLD(24,I BI,"DEN")) '="" S IBX DATA(IBI," DEN")=IBFL D(24,IBI," DEN") . I $O(IBFLD(2 4,IBI,"DEN 1",0)) M I BXDATA(IBI ,"DEN1")=I BFLD(24,IB I,"DEN1") . ;end - ; JWS;IB*2.0 *592:US131 . I $G(IB PRINT) D . . ; START IB*2.0*447 BI ZERO D OLLAR CHAN GES .. ; I '$P(IBXDA TA(IBI),U, 8),'$G(IBX DATA(IBI," RX")) D Q .. I $P(IB XDATA(IBI) ,U,8)="",' $G(IBXDATA (IBI,"RX") ) D Q ... ; END IB* 2.0*447 BI ZERO DOLL AR CHANGES ... I $G( IBNOSHOW) Q ; don 't show er rors/warni ngs ... S IBXDATA(IB I,"TEXT")= "Warning:* * REV CODE UNITS < # PROCEDURES , THEY MUS T BE =" .. . I $D(IBX DATA(IBI," AUX")) S $ P(IBXDATA( IBI,"AUX") ,U,9)="" . .. Q .. ; .. I $G(IB FLD(24,IBI _"A"))'="" D Q ... S IBXDATA( IBI,"A")=I BFLD(24,IB I_"A") ... I $G(IBNO SHOW) Q ; don't s how errors /warnings ... S IBXD ATA(IBI,"T EXT")="War ning:** RE V CODE UNI TS > #PROC EDURES, TH EY MUST BE =: "_IBFLD (24,IBI_"A ") ... I $ D(IBXDATA( IBI,"AUX") ) S $P(IBX DATA(IBI," AUX"),U,9) ="" ... Q .. ; .. S IBRX=$G(IB XDATA(IBI, "RX")) .. I IBRX'="" D ;Forma t Rx detai l ... N Z ... S Z=$P (IBRX,U) . .. S Z=$S( Z'="":"Rx# "_Z_" ",1: "RX: ") .. . S IBXDAT A(IBI,"TEX T")=Z_$S($ P(IBRX,U,3 )'="":"NDC : "_$P(IBR X,U,3),1:" NOC: "_$P( IBRX,U,2)) _" Qty: "_ $P(IBRX,U, 6)_" Days: "_$P(IBRX ,U,7) ... S $P(IBXDA TA(IBI,"AU X"),U,9)=" N4" ; se rvice line comment q ualifier f or RX's .. . Q .. Q . S IBXDATA (IBI,"CPLN K")=$P(IBF LD(24,IBI) ,U,13) . I '$G(IBPRI NT) D COBL INE^IBCEU6 (IBIFN,IBI ,.IBXDATA, ,.IBXTRA) . Q ; I $G (IBPRINT) D . S IBRX =0 F S IB RX=$O(IBRX 1(IBRX)) Q :'IBRX D .. S IBI=+ $O(IBXDATA (""),-1)+1 .. S IBXD ATA(IBI)=$ $DATE($P(I BRX1(IBRX) ,U,5)) .. S IBXDATA( IBI,"TEXT" )="**** ER ROR - NO P ROC LINK T O REV CODE FOR DRUG: RX#: "_$P (IBRX1(IBR X),U)_" ND C #: "_$P( IBRX1(IBRX ),U,3) .. I $D(IBXDA TA(IBI,"AU X")) S $P( IBXDATA(IB I,"AUX"),U ,9)="" .. S IBXDATA( IBI,"ARX") ="" .. D Z ERO^IBRXUT L(+$P(IBRX 1(IBRX),U, 2)) .. S I BXDATA(IBI ,"RX")=IBR X1(IBRX),$ P(IBXDATA( IBI,"RX"), U,2)=$E($G (^TMP($J," IBDRUG",+$ P(IBRX1(IB RX),U,2),. 01)),1,30) K IBRX1(I BRX) .. Q . Q ; I '$ G(IBPRINT) ,$D(IBXTRA ) D COMBO^ IBCEU2(.IB XDATA,.IBX TRA,0) ;Ha ndle bundl ed/unbundl ed lines K ^TMP($J," IBDRUG") Q ;ISLAB(LD ATA) ; Ret urns 0/1 i f line ite m data ind icates the item is a lab (1) ; 'LAB' is defined he re as type of servic e = 5 Q $E ($P(LDATA, U,4))="5" ;FMT(DATA, DLEN,FLEN) ; Returns a string in DATA wi th a max l ength of D LEN ; and a field le ngth of FL EN Q $E($E (DATA,1,DL EN)_$J("", FLEN),1,FL EN) ;DATE( X,DEL) ; R eturns FM date in X as MMxDDxY YYY where x=DEL S DE L=$G(DEL) S X=$$DATE ^IBCF2(X,1 ,1) I X'=" " S X=$E(X ,1,2)_DEL_ $E(X,3,4)_ DEL_$E(X,5 ,8) Q X ;B ATCH() ; S ets up rec ord for an d stores/r eturns the next batc h number N NUM,FAC,D O,DD,DLAYG O,DIC,X,Y ;Keep late st batch n umber for view/print edi bill extract da ta option I $D(IBVNU M) S NUM=I BVNUM G BA TCHQ ;Chec k for batc h resubmit - if yes, use same number as original b atch I $P( $G(^TMP("I BRESUBMIT" ,$J)),U,3) =1 S NUM=$ P(^($J),U) G BATCHQ L +^IBA(36 4.1,0):5 I '$T Q 0 S FAC=+$P($ $SITE^VASI TE(),U,3), NUM=$O(^IB A(364.1,"B ",""),-1) I $D(^IBA( 364.1,+NUM ,0)),$P(^( 0),U,2)="" F D Q:' NUM!($P($G (^IBA(364. 1,+NUM,0)) ,U,2)'="") . I $D(^I BA(364.1,N UM,0)) S D A=NUM,DIK= "^IBA(364. 1," D ^DIK . S NUM=$ O(^IBA(364 .1,"B","") ,-1) F S NUM=$S($P( NUM,FAC,2) '="":NUM+1 ,1:FAC_"00 00001") Q: '$D(^IBA(3 64.1,"B",N UM)) K DO, DD S DIC=" ^IBA(364.1 ,",DLAYGO= 364.1,DIC( 0)="L",X=N UM D FILE^ DICN K DD, DO I Y'>0 S NUM=0 L -^IBA(364. 1,0)BATCHQ Q NUM ;GE TLDAT(IBXI EN) ; Extr act data f or 837 tra nsmission LDAT recor d ; IBXIEN - ien in file 399 ; Sets up I BXSAVE("LD AT",n) arr ay: ; Atta chment rep ort type ^ Attachmen t report t ransmissio n code ^ A ttachment control nu mber ^ ; OB Anesthe sia Additi onal Units ^ Purchas e Service Provider I D ^ Purcha se Service Amount ^ N CPIEN,FT YPE,IBXDAT A,IDS,IBID S,NODE1,PS AMNT,PSPID ,Z,PCE1,LI NE I '+$G( IBXIEN) Q K IBXSAVE( "LDAT") S FTYPE=$$FT ^IBCEF(IBX IEN) I FTY PE=2 D OUT PT(IBXIEN, 0) I FTYPE =3 D HOS^I BCEF2(IBXI EN) D ALLI DS^IBCEFP( IBXIEN,.ID S,1) S (PS PID,PSAMNT )="" ; IB* 2.0*473/TA Z - Conver t PROVIDER code to f unction ca ll to PSID ^IBCEFP I $$SUB1OK^I BCEP8A(IBX IEN),(FTYP E=2) D . D PSID^IBCE FP(IBXIEN, .IDS,.IBID S) . S PSP ID=$G(IBID S(0)) I PS PID="" S P SPID=$P($G (IBIDS(1)) ,U,1) ;IB* 2.0*473/TA Z - END S Z=0 F S Z =$O(IBXDAT A(Z)) Q:'Z D . S CP IEN=+$G(IB XDATA(Z,"C PLNK")) ;I 'CPIEN Q . I FTYPE= 2,$$SUB1OK ^IBCEP8A(I BXIEN) S P SAMNT=$$DO LLAR^IBCEF G1($P($G(I BXDATA(Z)) ,U,11)) . S (PCE1,NO DE1)="" . I CPIEN D . . S NODE 1=$G(^DGCR (399,IBXIE N,"CP",CPI EN,1)) . . S PCE1=$$ GET1^DIQ(3 99.0304,CP IEN_","_IB XIEN_",",7 1) . . Q . ; MRD;IB* 2.0*516 - Added addl . procedur e descript ion as pie ce 7 . ; of IBXSAVE , which wi ll exist o nly if the procedure ends in ' 99' . ; or is an 'NO C/NOS' pro cedure. . S IBXSAVE( "LDAT",Z)= PCE1_U_$P( NODE1,U,3) _U_$P(NODE 1,U)_U_$P( NODE1,U,5) _U_$G(PSPI D)_U_$G(PS AMNT)_U_$P (NODE1,U,4 ) . Q Q | |
| 258 | ||
| 259 | ||
| 260 | Routines | |
| 261 | Activities | |
| 262 | Routine Na me | |
| 263 | IBCEF12 | |
| 264 | Enhancemen t Category | |
| 265 | New | |
| 266 | Modify | |
| 267 | Delete | |
| 268 | No Change | |
| 269 | RTM | |
| 270 | ||
| 271 | Related Op tions | |
| 272 | None | |
| 273 | Related Ro utines | |
| 274 | Routines “ Called By” | |
| 275 | Routines “ Called” | |
| 276 | ||
| 277 | ||
| 278 | ||
| 279 | ||
| 280 | Data Dicti onary (DD) Reference s | |
| 281 | BILL/CLAIM S [#399] | |
| 282 | X12 278 DE NTAL NUMBE RING SYSTE M [#356.02 2] | |
| 283 | Related Pr otocols | |
| 284 | None | |
| 285 | Related In tegration Control Re gistration s (ICRs) | |
| 286 | None | |
| 287 | Data Passi ng | |
| 288 | Input | |
| 289 | Output Re ference | |
| 290 | Both | |
| 291 | Global Re ference | |
| 292 | Local | |
| 293 | Input Attr ibute Name and Defin ition | |
| 294 | Name: | |
| 295 | Definition : | |
| 296 | Output Att ribute Nam e and Defi nition | |
| 297 | Name: | |
| 298 | Definition : | |
| 299 | Current Lo gic | |
| 300 | N/A | |
| 301 | Modified L ogic (Chan ges are in bold) | |
| 302 | IBCEF12 ;E DE/JWS - O UTPUT FORM ATTER SPEC IFIC DENTA L FUNCTION S ;30-JAN- 96 ;;2.0;I NTEGRATED BILLING;** 592**;21-M AR-94;Buil d 123 ;;Pe r VA Direc tive 6402, this rout ine should not be mo dified. ; ;JWS;IB*2. 0*592;US13 1TNUM(IBIF N) ; Extra ct code fo r 364.5 fi eld 383 N- TOOTH NUMB ER N IB,IB 1 K ^TMP(" IBXSAVE",$ J,"TO") S IB=0 F S IB=$O(^DGC R(399,IBIF N,"DEN1",I B)) Q:'IB S IB1=^(I B,0),^TMP( "IBXSAVE", $J,"TO",IB IFN,IB)=IB 1_U_"JP" Q ;DEN ; Ou tput forma tter Forma t Code for file DEN, field 2 ; JWS;IB*2.0 *592;US131 N A,Z,Q,I BZ K IBXSA VE("OUTPT" ) D SET1^I BCEF1(IBXI EN,.A,.IBZ ,.IBXDATA, .IBXNOREQ) S (Q,Z)=0 ;,Q=$G(@A ) F S Z=$ O(IBZ(Z)) S:'Z @A=Q Q:'Z M IB XSAVE("OUT PT",Z)=IBZ (Z) S Q=Q+ 1,IBXDATA( Z)=Q D:Z>1 ID^IBCEF2 (Z,"DEN ") D SVITM^I BCEF2(.IBX SAVE,Z) Q ;DEN1 ; Ou tput forma tter Forma t Code for file DEN1 , field 2 ;JWS;IB*2. 0*592;US13 1 N A,Z,Q, IBZ K IBXS AVE("OUTPT ") D SET1^ IBCEF1(IBX IEN,.A,.IB Z,.IBXDATA ,.IBXNOREQ ) S (Q,Z)= 0 ;,Q=$G(@ A) F S Z= $O(IBZ(Z)) S:'Z @A=Q Q:'Z M I BXSAVE("OU TPT",Z)=IB Z(Z) S Q=Q +1,IBXDATA (Z)=Q D:Z> 1 ID^IBCEF 2(Z,"DEN1" ) D SVITM^ IBCEF2(.IB XSAVE,Z) Q ;DEN2 ; O utput form atter Form at Code fo r file DEN 2, fields 2 ;JWS;IB* 2.0*592;US 131 N A,Z, Z1,CT D SE T1^IBCEF1( IBXIEN,.A, .IBZ,.IBXD ATA,.IBXNO REQ) S (CT ,Z)=0 ;,Q= $G(@A) F S Z=$O(IBZ (Z)) Q:'Z D . S Z1= 0 F S Z1= $O(IBXSAVE ("OUTPT",Z ,"DEN1",Z1 )) Q:'Z1 D I CT=1, $P($G(IBXS AVE("OUTPT ",Z)),U,9) '=1 Q .. S CT=CT+1 D ID^IBCEF2 (CT,"DEN2" ) .. S IBX DATA(CT)=Z .. D SETG BL^IBCEFG( IBXPG,CT,2 ,Z,.IBXSIZ E) K IBXDA TA Q ;DEN2 3 ; Output formatter format co de for fil e DEN2, fi eld 3 (8,1 86.2,1,3) ;JWS;IB*2. 0*592;US13 1 N Z,Z0,C T S (CT,Z) =0 F S Z= $O(IBXSAVE ("OUTPT",Z )) Q:'Z D . S Z0=0 F S Z0=$O (IBXSAVE(" OUTPT",Z," DEN1",Z0)) Q:'Z0 D .. S CT=CT +1 .. S IB XDATA(CT)= "JP" .. D SETGBL^IBC EFG(IBXPG, CT,3,"JP", .IBXSIZE) K IBXDATA Q ;DEN24 ; Output fo rmatter Fo rmat Code for file D EN2, field 4 ;JWS;IB *2.0*592;U S131 N Z,Z O,CT K IBX SAVE("DONE ") S (CT,Z )=0 F S Z =$O(IBXSAV E("OUTPT", Z)) Q:'Z D . S Z0=0 F S Z0=$ O(IBXSAVE( "OUTPT",Z, "DEN1",Z0) ) Q:'Z0 D .. S CT=C T+1 .. I $ D(IBXSAVE( "DONE",Z,Z 0)) Q .. S IBXSAVE(" DONE",Z,Z0 )="" .. S IBXDATA(CT )=$$GET1^D IQ(356.022 ,$P(IBXSAV E("OUTPT", Z,"DEN1",Z 0,0),U),.0 1) .. D SE TGBL^IBCEF G(IBXPG,CT ,4,IBXDATA (CT),.IBXS IZE) K IBX DATA Q ;DE N25 ; Outp ut formatt er Format Code for f ile DEN2, field 5 ;J WS;IB*2.0* 592;US131 N Z,ZO,CT K IBXSAVE( "DONE") S (CT,Z)=0 F S Z=$O(I BXSAVE("OU TPT",Z)) Q :'Z D . S Z0=0 F S Z0=$O(IBX SAVE("OUTP T",Z,"DEN1 ",Z0)) Q:' Z0 D .. S CT=CT+1 . . I $D(IBX SAVE("DONE ",Z,Z0)) Q .. S IBXS AVE("DONE" ,Z,Z0)="" .. S IBXDA TA(CT)=$P( IBXSAVE("O UTPT",Z,"D EN1",Z0,0) ,U,2) .. D SETGBL^IB CEFG(IBXPG ,CT,5,IBXD ATA(CT),.I BXSIZE) K IBXDATA Q ;DEN26 ; O utput form atter Form at Code fo r file DEN 2, field 6 ;JWS;IB*2 .0*592;US1 31 N Z,ZO, CT K IBXSA VE("DONE") S (CT,Z)= 0 F S Z=$ O(IBXSAVE( "OUTPT",Z) ) Q:'Z D . S Z0=0 F S Z0=$O( IBXSAVE("O UTPT",Z,"D EN1",Z0)) Q:'Z0 D . . S CT=CT+ 1 .. I $D( IBXSAVE("D ONE",Z,Z0) ) Q .. S I BXSAVE("DO NE",Z,Z0)= "" .. S IB XDATA(CT)= $P(IBXSAVE ("OUTPT",Z ,"DEN1",Z0 ,0),U,3) . . D SETGBL ^IBCEFG(IB XPG,CT,6,I BXDATA(CT) ,.IBXSIZE) K IBXDATA Q ;DEN27 ; Output f ormatter F ormat Code for file DEN2, fiel d 7 ;JWS;I B*2.0*592; US131 N Z, ZO,CT K IB XSAVE("DON E") S (CT, Z)=0 F S Z=$O(IBXSA VE("OUTPT" ,Z)) Q:'Z D . S Z0= 0 F S Z0= $O(IBXSAVE ("OUTPT",Z ,"DEN1",Z0 )) Q:'Z0 D .. S CT= CT+1 .. I $D(IBXSAVE ("DONE",Z, Z0)) Q .. S IBXSAVE( "DONE",Z,Z 0)="" .. S IBXDATA(C T)=$P(IBXS AVE("OUTPT ",Z,"DEN1" ,Z0,0),U,4 ) .. D SET GBL^IBCEFG (IBXPG,CT, 7,IBXDATA( CT),.IBXSI ZE) K IBXD ATA Q ;DEN 28 ; Outpu t formatte r Format C ode for fi le DEN2, f ield 8 ;JW S;IB*2.0*5 92;US131 N Z,ZO,CT K IBXSAVE(" DONE") S ( CT,Z)=0 F S Z=$O(IB XSAVE("OUT PT",Z)) Q: 'Z D . S Z0=0 F S Z0=$O(IBXS AVE("OUTPT ",Z,"DEN1" ,Z0)) Q:'Z 0 D .. S CT=CT+1 .. I $D(IBXS AVE("DONE" ,Z,Z0)) Q .. S IBXSA VE("DONE", Z,Z0)="" . . S IBXDAT A(CT)=$P(I BXSAVE("OU TPT",Z,"DE N1",Z0,0), U,5) .. D SETGBL^IBC EFG(IBXPG, CT,8,IBXDA TA(CT),.IB XSIZE) K I BXDATA Q ; DEN29 ; Ou tput forma tter Forma t Code for file DEN2 , field 9 ;JWS;IB*2. 0*592;US13 1 N Z,ZO,C T K IBXSAV E("DONE") S (CT,Z)=0 F S Z=$O (IBXSAVE(" OUTPT",Z)) Q:'Z D . S Z0=0 F S Z0=$O(I BXSAVE("OU TPT",Z,"DE N1",Z0)) Q :'Z0 D .. S CT=CT+1 .. I $D(I BXSAVE("DO NE",Z,Z0)) Q .. S IB XSAVE("DON E",Z,Z0)=" " .. S IBX DATA(CT)=$ P(IBXSAVE( "OUTPT",Z, "DEN1",Z0, 0),U,6) .. D SETGBL^ IBCEFG(IBX PG,CT,9,IB XDATA(CT), .IBXSIZE) K IBXDATA Q ;TRANS ; Output fo rmatter Fo rmat Code for file D N1, field 6 ;JWS;IB* 2.0*592;US 131 I $$GE T1^DIQ(399 ,IBXIEN_", ",93)'="", $$GET1^DIQ (399,IBXIE N_",",94)' ="" K IBXD ATA Q ;SRV DT ; Outpu t formatte r Format C ode for fi le DEN, fi eld 4 Serv ice date ; JWS;IB*2.0 *592;US131 S IBXNORE Q=$$NFT^IB CEF1(2,IBX IEN) N Z S Z=0 F S Z=$O(IBXSA VE("OUTPT" ,Z)) Q:'Z D . I $P( $G(IBXSAVE ("OUTPT",Z ,"DEN")),U ,11)'="" Q ;treatme nt start d ate . I $P ($G(IBXSAV E("OUTPT", Z,"DEN")), U,12)'="" Q ;treatm ent comple tion date . I $P(IBX SAVE("OUTP T",Z),U)'= "" S IBXDA TA(Z)=$P(I BXSAVE("OU TPT",Z),U) . Q Q ;SR VDTQ ; Out put format ter Format Code for file DEN, field 3 Da te/Time Qu alifier ;J WS;IB*2.0* 592;US131 N Z S Z=0 F S Z=$O( IBXSAVE("O UTPT",Z)) Q:'Z D . I $P($G(IB XSAVE("OUT PT",Z,"DEN ")),U,11)' ="" Q ;tr eatment st art date . I $P($G(I BXSAVE("OU TPT",Z,"DE N")),U,12) '="" Q ;t reatment c ompletion date . S I BXDATA(Z)= 472 Q ;PRO C ; Output formatter Format Co de for fil e DEN1, fi eld 3 Proc edure Coun t N Z S Z= 0 F S Z=$ O(IBXSAVE( "OUTPT",Z) ) Q:'Z D . S IBXDAT A(Z)=$P($G (IBXSAVE(" OUTPT",Z)) ,U,9) Q ; number of units (def ault=1) Q ; | |
| 303 | ||
| 304 | ||
| 305 | Routines | |
| 306 | Activities | |
| 307 | Routine Na me | |
| 308 | IBCEFP | |
| 309 | Enhancemen t Category | |
| 310 | New | |
| 311 | Modify | |
| 312 | Delete | |
| 313 | No Change | |
| 314 | RTM | |
| 315 | ||
| 316 | Related Op tions | |
| 317 | None | |
| 318 | Related Ro utines | |
| 319 | Routines “ Called By” | |
| 320 | Routines “ Called” | |
| 321 | ||
| 322 | ||
| 323 | ||
| 324 | ||
| 325 | Data Dicti onary (DD) Reference s | |
| 326 | BILL/CLAIM S [#399] | |
| 327 | Related Pr otocols | |
| 328 | None | |
| 329 | Related In tegration Control Re gistration s (ICRs) | |
| 330 | None | |
| 331 | Data Passi ng | |
| 332 | Input | |
| 333 | Output Re ference | |
| 334 | Both | |
| 335 | Global Re ference | |
| 336 | Local | |
| 337 | Input Attr ibute Name and Defin ition | |
| 338 | Name: | |
| 339 | Definition : | |
| 340 | Output Att ribute Nam e and Defi nition | |
| 341 | Name: | |
| 342 | Definition : | |
| 343 | Current Lo gic | |
| 344 | IBCEFP ;AL B/TAZ - Pr ovider ID functions ;28-OCT-10 ;;2.0;INT EGRATED BI LLING;**43 2,447,473, 516**;21-M AR-94;Buil d 123 ;;Pe r VA Direc tive 6402, this rout ine should not be mo dified. ; Q ;ALLIDS( IBIFN,IBXS AVE,IBSTRI P,SEG) ; R eturn all of the Pro vider IDS I '$D(IBST RIP) S IBS TRIP=0 I ' $D(SEG) S SEG="" N I BXIEN,ARIN FO,ARID,AR Q,IBFRMTYP ,ARIEN,ARI NS,Z0,DAT, I,SORT1,SO RT2,SORT3, COB,IBCCOB ,IBCARE,IB CURR,IBXDA TA,NPI,CUR OTH ; S IB FRMTYP=$$F T^IBCEF(IB IFN),IBFRM TYP=$S(IBF RMTYP=2:2, IBFRMTYP=3 :1,1:0) S IBCARE=$S( $$ISRX^IBC EF1(IBIFN) :3,1:0) ;i f an Rx re fill bill S:IBCARE=0 IBCARE=$$ INPAT^IBCE F(IBIFN,1) S:'IBCARE IBCARE=2 ;1-inp,2-o ut S IBCUR R=$$COB^IB CEF(IBIFN) ;current bill payer sequence ;don't cre ate anythi ng if form type not CMS-1500 o r UB I IBF RMTYP,'+$G (IBXSAVE(" PROVINF",I BIFN)) D . N IBZ,CUR OTH . I IB FRMTYP=2 D OUTPT^IBC EF11(IBIFN ,0) . I IB FRMTYP=1 D HOS^IBCEF 22(IBIFN) . ; START IB*2.0*447 BI . I IB CURR="A" D Q .. N I BRESARR .. S IBLIMIT =5 .. D PR OVINF(IBIF N,1,.IBRES ARR,1,"C", IBFRMTYP,I BCARE,IBLI MIT,IBCURR ,.IBXDATA) .. M IBXS AVE=IBRESA RR .. S IB XSAVE("PRO VINF",IBIF N)=IBIFN . ; END IB* 2.0*447 BI . F CUROT H="C","O" D PROVIDER (IBIFN,CUR OTH,.IBZ,I BFRMTYP,IB CARE,IBCUR R,.IBXDATA ) M IBXSAV E=IBZ . S IBXSAVE("P ROVINF",IB IFN)=IBIFN . Q ; D L FIDS^IBCEF 76(IBIFN,. IBXSAVE,IB STRIP,SEG) ; Get the Lab/Facil ity IDs S NPI=$P($$O RGNPI^IBCE F73A(IBIFN ),U,1) F C UROTH="C", "O" D . S IBXSAVE("L AB/FAC",IB IFN,CUROTH ,1,0)=$S(N PI]"":"XX" ,1:"")_U_N PI ; S IBF RMTYP=$$FT ^IBCEF(IBI FN) S ARIE N=$S(IBFRM TYP=2:3,1: 4) S IBCCO B=$$COBN^I BCEF(IBIFN ) ; Curren t Insuranc e F COB=1: 1:3 D . S SORT1=$S(C OB=IBCCOB: "C",1:"O") . S SORT2 =$S(SORT1= "C":1,COB= 1:1,COB=2& (IBCCOB=1) :1,1:2) . S ARINFO=$ G(IBXSAVE( "PROVINF", IBIFN,SORT 1,SORT2,AR IEN,1)) . ; . D BPID S^IBCEF75( IBIFN,.IBX SAVE,SORT1 ,SORT2,COB ,IBSTRIP,S EG) ; D EN ^IBCEF81(. IBXSAVE) ; I SEG="OP R1" D . I '$D(IBXSAV E("PROVINF ",IBIFN,"C ",1,3)) D G ALLIDSQ .. N SLC, CRED S SLC =0 .. F S SLC=$O(IB XSAVE("L-P ROV",IBIFN ,SLC)) Q:' SLC D I $D(IBXSAVE ("PROVINF" ,IBIFN,"C" ,1,3,"NAME ")) Q ... S CRED=$P( $G(IBXSAVE ("L-PROV", IBIFN,SLC, "C",1,3,"N AME")),U,4 ) ... I CR ED]"" S $P (IBXSAVE(" PROVINF",I BIFN,"C",1 ,3,"NAME") ,U,4)=CRED ; I SEG=" LPUR",$$SU B1OK^IBCEP 8A(IBIFN), $G(IBXSAVE ("SLC")) D G ALLIDS Q . N IBCN T,OUT . ;I B*2.0*473/ TAZ - Move d ID looku p into sep erate func tion. . D PSID(IBIFN ,.IBXSAVE, .IDS) . ;I B*2.0*473/ TAZ - END . S $P(OUT ,U,6)=IDS( 0) . S $P( OUT,U,7,8) =IDS(1) ; secondary id (1) ^ s econdary i d qualifie r(1) . F I BCNT=1:1:I BXSAVE("SL C") S IBXS AVE("SLPRV ",IBCNT)=O UT,IBXSAVE ("SLPRV",I BCNT,"SLC" )=IBCNT ; I SEG="LOP E" D SLPRV (IBIFN,.IB XSAVE,2) G ALLIDSQ I SEG="LOP1 " D SLPRV( IBIFN,.IBX SAVE,9) G ALLIDSQ I SEG="LREN" D SLPRV(I BIFN,.IBXS AVE,3) G A LLIDSQ I S EG="LSUP" D SLPRV(IB IFN,.IBXSA VE,5) G AL LIDSQ I SE G="LREF" D SLPRV(IBI FN,.IBXSAV E,1) G ALL IDSQ ;ALLI DSQ ; Q ;P SID(IBIFN, IBXPROV,IB XIDS) ; Bu ild array of either the Fac/La b ID or Re ndering Pr ovider IDs ;IB*2.0*4 73/TAZ - C reated a f unction to standardi ze IDs in LDAT and L PUR ; Inpu t: ; IBXIE N - Intern al Entry N umber of c laim ; IBX PROV - Pro vider Arra y ; IBXIDS - Array f or IDs ; O utput: ; I BXIDS(0) - Primary I D ; IBXIDS (1) - Seco ndary ID ; N LINE,PL INE,PID,SI D,SIDQ K I BXIDS ; Ge t Lab/Faci lity IDs S (PID,SID, SIDQ)="" S PID=$P($G (IBXPROV(" LAB/FAC",I BIFN,"C",1 ,0)),U,2) F LINE=1:1 Q:'$D(IBX PROV("LAB/ FAC",IBIFN ,"C",1,LIN E)) D I S ID'="" Q . S SIDQ=$P ($G(IBXPRO V("LAB/FAC ",IBIFN,"C ",1,LINE)) ,U) I ",0B ,1G,G2,"'[ (","_SIDQ_ ",") S SID Q="" Q . S SID=$P($G (IBXPROV(" LAB/FAC",I BIFN,"C",1 ,LINE)),U, 2) I $L(PI D)!$L(SID) S IBXIDS( 0)=PID,IBX IDS(1)=SID _U_SIDQ G PSIDQ ; Ge t Claim Le vel Render ing Provid er IDs S P ID=$P($G(I BXPROV("PR OVINF",IBI FN,"C",1,3 ,0)),U,4) ; Get clai m level Re ndering Pr ovider NPI F LINE=1: 1 Q:'$D(IB XPROV("PRO VINF",IBIF N,"C",1,3, LINE)) D I SID'="" Q . S SIDQ =$P($G(IBX PROV("PROV INF",IBIFN ,"C",1,3,L INE)),U,3) I ",0B,1G ,G2,"'[(", "_SIDQ_"," ) S SIDQ=" " Q . S SI D=$P($G(IB XPROV("PRO VINF",IBIF N,"C",1,3, LINE)),U,4 ) I $L(PID )!$L(SID) S IBXIDS(0 )=PID,IBXI DS(1)=SID_ U_SIDQ G P SIDQ ; Get Line Leve l Renderin g Provider IDs F PLI NE=1:1 Q:' $D(IBXPROV ("L-PROV", IBIFN,PLIN E)) D I $ L(PID)!$L( SID) Q . S PID=$P($G (IBXPROV(" L-PROV",IB IFN,PLINE, "C",1,3,0) ),U,4) . F LINE=1:1 Q:'$D(IBXP ROV("L-PRO V",IBIFN,P LINE,"C",1 ,3,LINE)) D I SID'= "" Q .. S SIDQ=$P($G (IBXPROV(" L-PROV",IB IFN,PLINE, "C",1,3,LI NE)),U,3) I ",0B,1G, G2,"'[("," _SIDQ_",") S SIDQ="" Q .. S SI D=$P($G(IB XPROV("L-P ROV",IBIFN ,PLINE,"C" ,1,3,LINE) ),U,4) I $ L(PID)!$L( SID) S IBX IDS(0)=PID ,IBXIDS(1) =SID_U_SID QPSIDQ ; Q ;SLPRV(IB XIEN,IBX,P RTYPE) ;Bu ild SLPRV nodes for the line p rovider ty pe record N SLC,DATA ,IBCNT,NAM E,OUT S (S LC,IBCNT)= 0 F S SLC =$O(IBX("L -PROV",IBX IEN,SLC)) Q:'SLC D . I '$D(IB X("L-PROV" ,IBXIEN,SL C,"C",1,PR TYPE)) Q . S NAME=$G (IBX("L-PR OV",IBXIEN ,SLC,"C",1 ,PRTYPE,"N AME")) . S OUT=$P(NA ME,U,1,3)_ U_$P(NAME, U,5)_U_$G( IBX("L-PRO V",IBXIEN, SLC,"C",1, PRTYPE,"TA XONOMY"))_ U_$P($G(IB X("L-PROV" ,IBXIEN,SL C,"C",1,PR TYPE,0)),U ,4) . F IB N=1:1 Q:'$ D(IBX("L-P ROV",IBXIE N,SLC,"C", 1,PRTYPE,I BN)) D .. S DATA=$G( IBX("L-PRO V",IBXIEN, SLC,"C",1, PRTYPE,IBN )) .. I ", 0B,1G,G2,L U,"[(","_$ P(DATA,U,3 )_",") S O UT=OUT_U_$ P(DATA,U,4 )_U_$P(DAT A,U,3) . S IBCNT=IBC NT+1 . S I BX("SLPRV" ,IBCNT)=OU T . S IBX( "SLPRV",IB CNT,"SLC") =SLCSLPRVQ ; Q ; ;PR OVIDER ;In put: ; IB3 99 - ien o f #399 ; I BPROV: ; " C"- to get info for CURRENT pr ovider ; " O"- to get info for all others (in this case the a rray will contain in fo fot two providers ; IBRES - array for results ( by referen ce) ; IBFR MTYP - For m Type ; I BCARE - Ca re Type ; IBCURR - c urrent bil l payer se quence ; ; Output: ; IBRES - ar ray to get back info (by refer ence) ; IB RES(IBPROV ,PRNUM,PRT YPE,SEQ#)= PROV^INSUR ^IDTYPE^ID ^FORMTYP^C ARETYP ; w here: ; IB PROV - see input par ameter ; P RNUM: 1=pr imary insu rance prov ider, 2= s econdary, 3 -tretiar y ; PRTYPE : Provider type(FUNC TION) ; S EQ# : sequ ence numbe r (1st is used for I D1, 2nd - for ID2, e tc) ; PROV : provide r/VARIABLE PTR ; INSU R: Insuran ce PTR #36 or NONE ; IDTYPE: I D type ; I D: ID ; F ORMTYP: Fo rm type 1= UB,2=1500 ; CARETYP: Care type 0=both in p/outp,1=i npatient, 2=outpatie ntPROVIDER (IB399,IBP ROV,IBRES, IBFRMTYP,I BCARE,IBCU RR,IBXDATA ) ; N IBZ, IBRESARR,I BLIMIT S I BRESARR="" Q:IBCURR= "A" ;PATI ENT's bill IB*2.0*44 7 BI Chang es IBPROV to IBCURR I IBPROV=" C" D . S I BLIMIT=5 . D:$$ISINS UR^IBCEF71 (IBCURR,IB 399) PROVI NF(IB399,$ S(IBCURR=" T":3,IBCUR R="S":2,IB CURR="P":1 ,1:1),.IBR ESARR,1,IB PROV,IBFRM TYP,IBCARE ,IBLIMIT,I BCURR,.IBX DATA) I IB PROV="O" D . S IBLIM IT=3 . I I BCURR="P" D .. D:$$I SINSUR^IBC EF71("S",I B399) PROV INF(IB399, 2,.IBRESAR R,1,IBPROV ,IBFRMTYP, IBCARE,IBL IMIT,IBCUR R,.IBXDATA ) .. D:$$I SINSUR^IBC EF71("T",I B399) PROV INF(IB399, 3,.IBRESAR R,2,IBPROV ,IBFRMTYP, IBCARE,IBL IMIT,IBCUR R,.IBXDATA ) . I IBCU RR="S" D . . D:$$ISIN SUR^IBCEF7 1("P",IB39 9) PROVINF (IB399,1,. IBRESARR,1 ,IBPROV,IB FRMTYP,IBC ARE,IBLIMI T,IBCURR,. IBXDATA) . . D:$$ISIN SUR^IBCEF7 1("T",IB39 9) PROVINF (IB399,3,. IBRESARR,2 ,IBPROV,IB FRMTYP,IBC ARE,IBLIMI T,IBCURR,. IBXDATA) . I IBCURR= "T" D .. D :$$ISINSUR ^IBCEF71(" P",IB399) PROVINF(IB 399,1,.IBR ESARR,1,IB PROV,IBFRM TYP,IBCARE ,IBLIMIT,I BCURR,.IBX DATA) .. D :$$ISINSUR ^IBCEF71(" S",IB399) PROVINF(IB 399,2,.IBR ESARR,2,IB PROV,IBFRM TYP,IBCARE ,IBLIMIT,I BCURR,.IBX DATA) M IB RES=IBRESA RR Q ; ;-- PROVINF - - ;Create array with prov info ;Input: ; IB399 - i en #399 ; IBPRNUM - 1=prim ins , 2= sec, 3 -tert ; IBRES - fo r results ; IBSORT - to sort O THER INSUR ANCE data ; if PROV INF is cal led for "C " mode of PROVIDER s ubroutine then ; IB SORT can b e any (say 1) ; if P ROVINF is called for "O" mode then can b e more tha n set of d ata ; - ne ed to sort array to use it (li ke IBXDATA (1) and IB XDATA(2)) ; for mode "O" it sh ould be 1 or 2 (see PROVIDER s ection) ;I BINSTP - " C" -curren t ins, "O" -other ;IB FRMTYP - F orm Type ; IBCARE - C are Type ; IBLIMIT - Limits on Secondary ;IBCURR - Current In surance ;I BXDAYA - R evenue Cod e Array ;O utput: ; I BRES(PRNUM ,PRTYPE,SE Q#)=PROV^I NSUR^IDTYP E^ID^FORMT YP^CARETYP ; where:( see PROVID ER)PROVINF (IB399,IBP RNUM,IBRES ,IBSORT,IB INSTP,IBFR MTYP,IBCAR E,IBLIMIT, IBCURR,IBX DATA) ; I $G(IB399)= "" G PROVI NFQ I $G(I BINSTP)="" G PROVINF Q I +$G(IB SORT)=0 S IBSORT=$G( IBPRNUM) N IBPRTYP,I BINSCO,IBP ROV,IB3559 1,IBN,IBEX C S IBN=0 S IBINSCO= +$P($G(^DG CR(399,IB3 99,"M"))," ^",IBPRNUM ) S IB3559 1=$$CH3559 1^IBCEF72( IBINSCO,IB FRMTYP,IBC ARE) S IBP RTYP=0 F S IBPRTYP= $O(^DGCR(3 99,IB399," PRV","B",I BPRTYP)) Q :'IBPRTYP D . N Z,I B355OV,IBP ROV,IBARR . S IBPROV =$$PROVPTR (IB399,IBP RTYP,0),IB EXC="" . Q :+IBPROV=0 . S Z=$O( ^DGCR(399, IB399,"PRV ","B",IBPR TYP,0)) I Z S Z=$G(^ DGCR(399,I B399,"PRV" ,Z,0)) . D GETPRV(IB INSCO,IBFR MTYP,IBCAR E,IBPROV,. IBARR,IBPR TYP,IBINST P,Z) . M I BRES("PROV INF",IB399 ,IBINSTP)= IBARR I $D (IBRES("PR OVINF",IB3 99,IBINSTP ,IBSORT))> 1 S IBRES( "PROVINF", IB399,IBIN STP,IBSORT )=$S(IBPRN UM=3:"T",I BPRNUM=2:" S",1:"P") N SLC,CPLN K S SLC=0 F S SLC=$ O(IBXDATA( SLC)) Q:'S LC S IBX SAVE("SLC" )=+SLC D . S CPLNK=$ G(IBXDATA( SLC,"CPLNK ")) I 'CPL NK Q . S I BPRTYP=0 . F S IBPR TYP=$O(^DG CR(399,IB3 99,"CP",CP LNK,"LNPRV ","B",IBPR TYP)) Q:'I BPRTYP D .. N Z,IBP ROV,IBARR .. S IBPRO V=$$PROVPT R(IB399,IB PRTYP,CPLN K),IBEXC=" " .. Q:'+I BPROV .. S Z=$O(^DGC R(399,IB39 9,"CP",CPL NK,"LNPRV" ,"B",IBPRT YP,0)) I Z S Z=$G(^D GCR(399,IB 399,"CP",C PLNK,"LNPR V",Z,0)) . . D GETPRV (IBINSCO,I BFRMTYP,IB CARE,IBPRO V,.IBARR,I BPRTYP,IBI NSTP,Z) .. M IBRES(" L-PROV",IB 399,SLC,IB INSTP)=IBA RR . I $D( IBRES("L-P ROV",IB399 ,SLC,IBINS TP,IBSORT) )>1 S IBRE S("L-PROV" ,IB399,SLC ,IBINSTP,I BSORT)=$S( IBPRNUM=3: "T",IBPRNU M=2:"S",1: "P") ;PROV INFQ ;Exit PROVINF Q ;GETPRV(I BINSCO,IBF RMTYP,IBCA RE,IBPROV, IBRES,IBPR TYP,IBINST P,IBD) ; I "CO"'[$G( IBINSTP) G GETPRVQ N IBRETARR, IBNPI,IBN, IBMRAND,IB 355OV S IB RETARR=0,I B355OV="" D PRACT^IB CEF71(IBIN SCO,IBFRMT YP,IBCARE, IBPROV,.IB RETARR,IBP RTYP,$G(IB INSTP)) I $P(IBD,U,I BPRNUM+4)' ="",$P(IBD ,U,IBPRNUM +11)'="" S IB355OV=$ P(IBD,U,IB PRNUM+4)_U _$P(IBD,U, IBPRNUM+11 ) S IBN=0, IBMRAND=$$ MCRONBIL^I BEFUNC(IB3 99) ;Calcu late MEDIC ARE (WNR) specific p rovider qu alifier an d ID for C MS-1500 se condary cl aims I "34 "[$G(IBPRT YP),$G(IBF RMTYP)=2,I BMRAND S I B355OV=$$M CR24K^IBCE U3(IB399,I BPROV)_"^1 2" I $P(IB 355OV,U,2) D . I $$C HCKSEC^IBC EF73(IBFRM TYP,IBPRTY P,$G(IBINS TP),$P($G( ^IBE(355.9 7,+$P(IB35 5OV,U,2),0 )),U,3)) D .. S IBEX C=$P(IB355 OV,U,2),IB N=IBN+1,IB RES(IBSORT ,IBPRTYP,I BN)="OVERR IDE^"_IBIN SCO_U_$P($ G(^IBE(355 .97,+IBEXC ,0)),U,3)_ U_$P(IB355 OV,U)_"^^^ ^^"_+IBEXC I IB35591 '="",IBEXC '=$P(IB355 91,U,3) I $$CHCKSEC^ IBCEF73(IB FRMTYP,IBP RTYP,$G(IB INSTP),$P( IB35591,"^ ")) D . S IBN=IBN+1, IBRES(IBSO RT,IBPRTYP ,IBN)="DEF AULT^"_IBI NSCO_"^"_I B35591_"^^ ",$P(IBRES (IBSORT,IB PRTYP,IBN) ,U,9)=$P(I B35591,U,3 ) S IBNPI= $$NPI^IBCE FP1(IBPROV ) D SORT^I BCEF77(IBS ORT,IBPRTY P,IB399,.I BRETARR,.I BRES,IBN,I BEXC,IBPRN UM,IBLIMIT ) S IBRES( IBSORT,IBP RTYP,0)="P RIMARY"_U_ U_$$STRIP^ IBCEF76($S (IBNPI]"": "XX",1:"") _U_IBNPI,1 ,U,IBSTRIP ) F IBN=1: 1 Q:'$D(IB RES(IBSORT ,IBPRTYP,I BN)) S $P( IBRES(IBSO RT,IBPRTYP ,IBN),U,3, 4)=$$STRIP ^IBCEF76($ P(IBRES(IB SORT,IBPRT YP,IBN),U, 3,4),1,U,I BSTRIP) S IBRES(IBSO RT,IBPRTYP ,"NAME")=$ $NAME^IBCE FP1(IBPROV ,IBIFN,$P( IBD,U,3),$ P(IBD,U,8) ) S IBRES( IBSORT,IBP RTYP,"ENTI TY TYPE")= $S(IBPROV' ["355.93," :1,$P($G(^ IBA(355.93 ,+IBPROV,0 )),U,2)=2: 1,1:2) S I BRES(IBSOR T,IBPRTYP, "TAXONOMY" )=$$TAXON^ IBCEFP1(IB PROV,$P(IB D,U,15)) S IBRES(IBS ORT,IBPRTY P,"COBID") =$$COBID^I BCEFP1(IB3 99,IBPRTYP ,IBMRAND,I BD) S IBRE S(IBSORT,I BPRTYP)=IB PROVGETPRV Q ; Q ;PRO VPTR(IBIEN 399,IBFUNC ,IBCP) ; R etrieve Pr ovider Poi nter from appropriat e file N I BN,RSLT S IBCP=+$G(I BCP) I 'IB CP D . S I BN=$O(^DGC R(399,IBIE N399,"PRV" ,"B",IBFUN C,0)) . I +IBN=0 S R SLT=0 Q . S RSLT=$P( $G(^DGCR(3 99,IBIEN39 9,"PRV",+I BN,0)),U,2 ) I IBCP D . S IBN=$ O(^DGCR(39 9,IBIEN399 ,"CP",IBCP ,"LNPRV"," B",IBFUNC, 0)) . I +I BN=0 S RSL T=0 Q . S RSLT=$P($G (^DGCR(399 ,IBIEN399, "CP",IBCP, "LNPRV",+I BN,0)),U,2 ) Q RSLT ; ;Input: ; IBXIEN - I nternal En try Number for the c urrent bil l/claim ;I BXSAVE - A rray for r eturning t he data ; ;Output: ; IBXSAVE - Data Array AMB(IBXIEN ,IBXSAVE) ; Gather A mbulance D ata for AM B Record(s ) - IB*2.0 *447/TAZ N NODE,CODE ,CNT,IBXDA TA K IBXSA VE("AMB") F NODE="U5 ","U6","U7 " S IBXDAT A=$G(^DGCR (399,IBXIE N,NODE)) I $TR(IBXDA TA,U)'="" S IBXSAVE( "AMB",NODE )=IBXDATA S CODE="", CNT=0 F S CODE=$O(^ DGCR(399,I BXIEN,"U9" ,"B",CODE) ) Q:'CODE D . S IBX DATA=$P($G (^IBE(353. 5,CODE,0)) ,U,1) I IB XDATA="" Q . S CNT=C NT+1,IBXSA VE("AMB"," U9",CNT)=I BXDATA Q ; SNDS2(IBXD ATA,PIECE) ;Determin e if a SUB 2 record i s necessar y. ; Input : IBXDATA ; May cont ain data f rom field 232 of fil e 399. ; O utput: IBX DATA ; Ret urns Outpu t for piec e 2 or 3 o r 1 for an y other pi ece (like 1.5) ;Any time that ONE of the following criteria is met we should sen d a SUB2 r ecord ; 1. Incoming IBXDATA is not null SEND - Non -VA facili ty in fiel d 232 of f ile 399 ; 2. If the service fa cility is a VA Insti tution in file 4 or a non-VA f acility in file 355. 93 SEND ; 3. Not a s witchback payer $$SE NDSF^IBCEF 79(IBXIEN) '=0 SEND ; ; MRD;IB* 2.0*516 - Due to fie lds being marked for deletion, the ; fun ction $$SE NDSF^IBCEF 79 will al ways retur n '1'. Ref er to ; th at functio n and INSF LGS^^IBCEF 79 for mor e informat ion. ; I I BXDATA="" D . N Z . S Z=$P($$B ^IBCEF79(I BXIEN),U,3 ) . ;S Z1= $$SENDSF^I BCEF79(IBX IEN) . ;S IBXDATA=$S (Z="":0,'Z 1:0,1:1) . S IBXDATA =$S(Z="":0 ,1:1) . Q I 'IBXDATA S IBXDATA ="" I IBXD ATA'="" S IBXDATA=$S (PIECE=2:7 7,PIECE=3: 2,1:1) Q I BXDATA | |
| 345 | Modified L ogic (Chan ges are in bold) | |
| 346 | IBCEFP ;AL B/TAZ - Pr ovider ID functions ;28-OCT-10 ;;2.0;INT EGRATED BI LLING;**43 2,447,473, 516,592**; 21-MAR-94; Build 123 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ; Q ;ALL IDS(IBIFN, IBXSAVE,IB STRIP,SEG) ; Return all of the Provider IDS I '$D( IBSTRIP) S IBSTRIP=0 I '$D(SEG ) S SEG="" N IBXIEN, ARINFO,ARI D,ARQ,IBFR MTYP,ARIEN ,ARINS,Z0, DAT,I,SORT 1,SORT2,SO RT3,COB,IB CCOB,IBCAR E,IBCURR,I BXDATA,NPI ,CUROTH ;J WS;IB*2.0* 592;US131 S IBFRMTYP =$$FT^IBCE F(IBIFN),I BFRMTYP=$S (IBFRMTYP= 2:2,IBFRMT YP=3:1,IBF RMTYP=7:4, 1:0) S IBC ARE=$S($$I SRX^IBCEF1 (IBIFN):3, 1:0) ;if a n Rx refil l bill S:I BCARE=0 IB CARE=$$INP AT^IBCEF(I BIFN,1) S: 'IBCARE IB CARE=2 ;1- inp,2-out S IBCURR=$ $COB^IBCEF (IBIFN) ;c urrent bil l payer se quence ;do n't create anything if form ty pe not CMS -1500 or U B I IBFRMT YP,'+$G(IB XSAVE("PRO VINF",IBIF N)) D . N IBZ,CUROTH . ;JWS;IB *2.0*592;U S131 . I I BFRMTYP=2! (IBFRMTYP= 4) D OUTPT ^IBCEF11(I BIFN,0) . I IBFRMTYP =1 D HOS^I BCEF22(IBI FN) . ; ST ART IB*2.0 *447 BI . I IBCURR=" A" D Q .. N IBRESAR R .. S IBL IMIT=5 .. D PROVINF( IBIFN,1,.I BRESARR,1, "C",IBFRMT YP,IBCARE, IBLIMIT,IB CURR,.IBXD ATA) .. M IBXSAVE=IB RESARR .. S IBXSAVE( "PROVINF", IBIFN)=IBI FN . ; END IB*2.0*44 7 BI . F C UROTH="C", "O" D PROV IDER(IBIFN ,CUROTH,.I BZ,IBFRMTY P,IBCARE,I BCURR,.IBX DATA) M IB XSAVE=IBZ . S IBXSAV E("PROVINF ",IBIFN)=I BIFN . Q ; D LFIDS^I BCEF76(IBI FN,.IBXSAV E,IBSTRIP, SEG) ; Get the Lab/F acility ID s S NPI=$P ($$ORGNPI^ IBCEF73A(I BIFN),U,1) F CUROTH= "C","O" D . S IBXSAV E("LAB/FAC ",IBIFN,CU ROTH,1,0)= $S(NPI]"": "XX",1:"") _U_NPI ; S IBFRMTYP= $$FT^IBCEF (IBIFN) S ARIEN=$S(I BFRMTYP=2: 3,1:4) S I BCCOB=$$CO BN^IBCEF(I BIFN) ; Cu rrent Insu rance F CO B=1:1:3 D . S SORT1= $S(COB=IBC COB:"C",1: "O") . S S ORT2=$S(SO RT1="C":1, COB=1:1,CO B=2&(IBCCO B=1):1,1:2 ) . S ARIN FO=$G(IBXS AVE("PROVI NF",IBIFN, SORT1,SORT 2,ARIEN,1) ) . ; . D BPIDS^IBCE F75(IBIFN, .IBXSAVE,S ORT1,SORT2 ,COB,IBSTR IP,SEG) ; D EN^IBCEF 81(.IBXSAV E) ; I SEG ="OPR1" D . I '$D(IB XSAVE("PRO VINF",IBIF N,"C",1,3) ) D G ALL IDSQ .. N SLC,CRED S SLC=0 .. F S SLC=$ O(IBXSAVE( "L-PROV",I BIFN,SLC)) Q:'SLC D I $D(IBX SAVE("PROV INF",IBIFN ,"C",1,3," NAME")) Q ... S CRED =$P($G(IBX SAVE("L-PR OV",IBIFN, SLC,"C",1, 3,"NAME")) ,U,4) ... I CRED]"" S $P(IBXSA VE("PROVIN F",IBIFN," C",1,3,"NA ME"),U,4)= CRED ; I S EG="LPUR"! (SEG="LPUR 1"),$$SUB1 OK^IBCEP8A (IBIFN),$G (IBXSAVE(" SLC")) D G ALLIDSQ . N IBCNT, OUT . ;IB* 2.0*473/TA Z - Moved ID lookup into seper ate functi on. . D PS ID(IBIFN,. IBXSAVE,.I DS) . ;IB* 2.0*473/TA Z - END . S $P(OUT,U ,6)=IDS(0) . S $P(OU T,U,7,8)=I DS(1) ; se condary id (1) ^ sec ondary id qualifier( 1) . F IBC NT=1:1:IBX SAVE("SLC" ) S IBXSAV E("SLPRV", IBCNT)=OUT ,IBXSAVE(" SLPRV",IBC NT,"SLC")= IBCNT ; I SEG="LOPE" D SLPRV(I BIFN,.IBXS AVE,2) G A LLIDSQ I S EG="LOP1" D SLPRV(IB IFN,.IBXSA VE,9) G AL LIDSQ I SE G="LREN" D SLPRV(IBI FN,.IBXSAV E,3) G ALL IDSQ I SEG ="LSUP" D SLPRV(IBIF N,.IBXSAVE ,5) G ALLI DSQ I SEG= "LREF" D S LPRV(IBIFN ,.IBXSAVE, 1) G ALLID SQ ;JWS;IB *2.0*592;U S131 I SEG ="LSUR" D SLPRV(IBIF N,.IBXSAVE ,6) G ALLI DSQ I SEG= "LSUR1" D SLPRV(IBIF N,.IBXSAVE ,6) G ALLI DSQ ;ALLID SQ ; Q ;PS ID(IBIFN,I BXPROV,IBX IDS) ; Bui ld array o f either t he Fac/Lab ID or Ren dering Pro vider IDs ;IB*2.0*47 3/TAZ - Cr eated a fu nction to standardiz e IDs in L DAT and LP UR ; Input : ; IBXIEN - Interna l Entry Nu mber of cl aim ; IBXP ROV - Prov ider Array ; IBXIDS - Array fo r IDs ; Ou tput: ; IB XIDS(0) - Primary ID ; IBXIDS( 1) - Secon dary ID ; N LINE,PLI NE,PID,SID ,SIDQ K IB XIDS ; Get Lab/Facil ity IDs S (PID,SID,S IDQ)="" S PID=$P($G( IBXPROV("L AB/FAC",IB IFN,"C",1, 0)),U,2) F LINE=1:1 Q:'$D(IBXP ROV("LAB/F AC",IBIFN, "C",1,LINE )) D I SI D'="" Q . S SIDQ=$P( $G(IBXPROV ("LAB/FAC" ,IBIFN,"C" ,1,LINE)), U) I ",0B, 1G,G2,"'[( ","_SIDQ_" ,") S SIDQ ="" Q . S SID=$P($G( IBXPROV("L AB/FAC",IB IFN,"C",1, LINE)),U,2 ) I $L(PID )!$L(SID) S IBXIDS(0 )=PID,IBXI DS(1)=SID_ U_SIDQ G P SIDQ ; Get Claim Lev el Renderi ng Provide r IDs S PI D=$P($G(IB XPROV("PRO VINF",IBIF N,"C",1,3, 0)),U,4) ; Get claim level Ren dering Pro vider NPI F LINE=1:1 Q:'$D(IBX PROV("PROV INF",IBIFN ,"C",1,3,L INE)) D I SID'="" Q . S SIDQ= $P($G(IBXP ROV("PROVI NF",IBIFN, "C",1,3,LI NE)),U,3) I ",0B,1G, G2,"'[("," _SIDQ_",") S SIDQ="" Q . S SID =$P($G(IBX PROV("PROV INF",IBIFN ,"C",1,3,L INE)),U,4) I $L(PID) !$L(SID) S IBXIDS(0) =PID,IBXID S(1)=SID_U _SIDQ G PS IDQ ; Get Line Level Rendering Provider IDs F PLIN E=1:1 Q:'$ D(IBXPROV( "L-PROV",I BIFN,PLINE )) D I $L (PID)!$L(S ID) Q . S PID=$P($G( IBXPROV("L -PROV",IBI FN,PLINE," C",1,3,0)) ,U,4) . F LINE=1:1 Q :'$D(IBXPR OV("L-PROV ",IBIFN,PL INE,"C",1, 3,LINE)) D I SID'=" " Q .. S S IDQ=$P($G( IBXPROV("L -PROV",IBI FN,PLINE," C",1,3,LIN E)),U,3) I ",0B,1G,G 2,"'[(","_ SIDQ_",") S SIDQ="" Q .. S SID =$P($G(IBX PROV("L-PR OV",IBIFN, PLINE,"C", 1,3,LINE)) ,U,4) I $L (PID)!$L(S ID) S IBXI DS(0)=PID, IBXIDS(1)= SID_U_SIDQ PSIDQ ; Q ;SLPRV(IBX IEN,IBX,PR TYPE) ;Bui ld SLPRV n odes for t he line pr ovider typ e record N SLC,DATA, IBCNT,NAME ,OUT S (SL C,IBCNT)=0 F S SLC= $O(IBX("L- PROV",IBXI EN,SLC)) Q :'SLC D . I '$D(IBX ("L-PROV", IBXIEN,SLC ,"C",1,PRT YPE)) Q . S NAME=$G( IBX("L-PRO V",IBXIEN, SLC,"C",1, PRTYPE,"NA ME")) . S OUT=$P(NAM E,U,1,3)_U _$P(NAME,U ,5)_U_$G(I BX("L-PROV ",IBXIEN,S LC,"C",1,P RTYPE,"TAX ONOMY"))_U _$P($G(IBX ("L-PROV", IBXIEN,SLC ,"C",1,PRT YPE,0)),U, 4) . F IBN =1:1 Q:'$D (IBX("L-PR OV",IBXIEN ,SLC,"C",1 ,PRTYPE,IB N)) D .. S DATA=$G(I BX("L-PROV ",IBXIEN,S LC,"C",1,P RTYPE,IBN) ) .. I ",0 B,1G,G2,LU ,"[(","_$P (DATA,U,3) _",") S OU T=OUT_U_$P (DATA,U,4) _U_$P(DATA ,U,3) . S IBCNT=IBCN T+1 . S IB X("SLPRV", IBCNT)=OUT . S IBX(" SLPRV",IBC NT,"SLC")= SLCSLPRVQ ; Q ; ;PRO VIDER ;Inp ut: ; IB39 9 - ien of #399 ; IB PROV: ; "C "- to get info for C URRENT pro vider ; "O "- to get info for a ll others (in this c ase the ar ray will c ontain inf o fot two providers ; IBRES - array for results (b y referenc e) ; IBFRM TYP - Form Type ; IB CARE - Car e Type ; I BCURR - cu rrent bill payer seq uence ; ;O utput: ; I BRES - arr ay to get back info (by refere nce) ; IBR ES(IBPROV, PRNUM,PRTY PE,SEQ#)=P ROV^INSUR^ IDTYPE^ID^ FORMTYP^CA RETYP ; wh ere: ; IBP ROV - see input para meter ; PR NUM: 1=pri mary insur ance provi der, 2= se condary, 3 -tretiary ; PRTYPE: Provider type(FUNCT ION) ; SE Q# : seque nce number (1st is u sed for ID 1, 2nd - f or ID2, et c) ; PROV : provider /VARIABLEP TR ; INSUR : Insuranc e PTR #36 or NONE ; IDTYPE: ID type ; ID : ID ; FO RMTYP: For m type 1=U B,2=1500 ; CARETYP: Care type 0=both inp /outp,1=in patient, 2 =outpatien tPROVIDER( IB399,IBPR OV,IBRES,I BFRMTYP,IB CARE,IBCUR R,IBXDATA) ; N IBZ,I BRESARR,IB LIMIT S IB RESARR="" Q:IBCURR=" A" ;PATIE NT's bill IB*2.0*447 BI Change s IBPROV t o IBCURR I IBPROV="C " D . S IB LIMIT=5 . D:$$ISINSU R^IBCEF71( IBCURR,IB3 99) PROVIN F(IB399,$S (IBCURR="T ":3,IBCURR ="S":2,IBC URR="P":1, 1:1),.IBRE SARR,1,IBP ROV,IBFRMT YP,IBCARE, IBLIMIT,IB CURR,.IBXD ATA) I IBP ROV="O" D . S IBLIMI T=3 . I IB CURR="P" D .. D:$$IS INSUR^IBCE F71("S",IB 399) PROVI NF(IB399,2 ,.IBRESARR ,1,IBPROV, IBFRMTYP,I BCARE,IBLI MIT,IBCURR ,.IBXDATA) .. D:$$IS INSUR^IBCE F71("T",IB 399) PROVI NF(IB399,3 ,.IBRESARR ,2,IBPROV, IBFRMTYP,I BCARE,IBLI MIT,IBCURR ,.IBXDATA) . I IBCUR R="S" D .. D:$$ISINS UR^IBCEF71 ("P",IB399 ) PROVINF( IB399,1,.I BRESARR,1, IBPROV,IBF RMTYP,IBCA RE,IBLIMIT ,IBCURR,.I BXDATA) .. D:$$ISINS UR^IBCEF71 ("T",IB399 ) PROVINF( IB399,3,.I BRESARR,2, IBPROV,IBF RMTYP,IBCA RE,IBLIMIT ,IBCURR,.I BXDATA) . I IBCURR=" T" D .. D: $$ISINSUR^ IBCEF71("P ",IB399) P ROVINF(IB3 99,1,.IBRE SARR,1,IBP ROV,IBFRMT YP,IBCARE, IBLIMIT,IB CURR,.IBXD ATA) .. D: $$ISINSUR^ IBCEF71("S ",IB399) P ROVINF(IB3 99,2,.IBRE SARR,2,IBP ROV,IBFRMT YP,IBCARE, IBLIMIT,IB CURR,.IBXD ATA) M IBR ES=IBRESAR R Q ; ;-- PROVINF -- ;Create a rray with prov info ;Input: ; IB399 - ie n #399 ; I BPRNUM - 1 =prim ins, 2= sec, 3 -tert ; I BRES - for results ; IBSORT - to sort OT HER INSURA NCE data ; if PROVI NF is call ed for "C" mode of P ROVIDER su broutine t hen ; IBS ORT can be any (say 1) ; if PR OVINF is c alled for "O" mode t hen can be more than set of da ta ; - nee d to sort array to u se it (lik e IBXDATA( 1) and IBX DATA(2)) ; for mode "O" it sho uld be 1 o r 2 (see P ROVIDER se ction) ;IB INSTP - "C " -current ins, "O"- other ;IBF RMTYP - Fo rm Type ;I BCARE - Ca re Type ;I BLIMIT - L imits on S econdary ; IBCURR - C urrent Ins urance ;IB XDAYA - Re venue Code Array ;Ou tput: ; IB RES(PRNUM, PRTYPE,SEQ #)=PROV^IN SUR^IDTYPE ^ID^FORMTY P^CARETYP ; where:(s ee PROVIDE R)PROVINF( IB399,IBPR NUM,IBRES, IBSORT,IBI NSTP,IBFRM TYP,IBCARE ,IBLIMIT,I BCURR,IBXD ATA) ; I $ G(IB399)=" " G PROVIN FQ I $G(IB INSTP)="" G PROVINFQ I +$G(IBS ORT)=0 S I BSORT=$G(I BPRNUM) N IBPRTYP,IB INSCO,IBPR OV,IB35591 ,IBN,IBEXC S IBN=0 S IBINSCO=+ $P($G(^DGC R(399,IB39 9,"M")),"^ ",IBPRNUM) S IB35591 =$$CH35591 ^IBCEF72(I BINSCO,IBF RMTYP,IBCA RE) S IBPR TYP=0 F S IBPRTYP=$ O(^DGCR(39 9,IB399,"P RV","B",IB PRTYP)) Q: 'IBPRTYP D . N Z,IB 355OV,IBPR OV,IBARR . S IBPROV= $$PROVPTR( IB399,IBPR TYP,0),IBE XC="" . Q: +IBPROV=0 . S Z=$O(^ DGCR(399,I B399,"PRV" ,"B",IBPRT YP,0)) I Z S Z=$G(^D GCR(399,IB 399,"PRV", Z,0)) . D GETPRV(IBI NSCO,IBFRM TYP,IBCARE ,IBPROV,.I BARR,IBPRT YP,IBINSTP ,Z) . M IB RES("PROVI NF",IB399, IBINSTP)=I BARR I $D( IBRES("PRO VINF",IB39 9,IBINSTP, IBSORT))>1 S IBRES(" PROVINF",I B399,IBINS TP,IBSORT) =$S(IBPRNU M=3:"T",IB PRNUM=2:"S ",1:"P") N SLC,CPLNK S SLC=0 F S SLC=$O (IBXDATA(S LC)) Q:'SL C S IBXS AVE("SLC") =+SLC D . S CPLNK=$G (IBXDATA(S LC,"CPLNK" )) I 'CPLN K Q . S IB PRTYP=0 . F S IBPRT YP=$O(^DGC R(399,IB39 9,"CP",CPL NK,"LNPRV" ,"B",IBPRT YP)) Q:'IB PRTYP D . . N Z,IBPR OV,IBARR . . S IBPROV =$$PROVPTR (IB399,IBP RTYP,CPLNK ),IBEXC="" .. Q:'+IB PROV .. S Z=$O(^DGCR (399,IB399 ,"CP",CPLN K,"LNPRV", "B",IBPRTY P,0)) I Z S Z=$G(^DG CR(399,IB3 99,"CP",CP LNK,"LNPRV ",Z,0)) .. D GETPRV( IBINSCO,IB FRMTYP,IBC ARE,IBPROV ,.IBARR,IB PRTYP,IBIN STP,Z) .. M IBRES("L -PROV",IB3 99,SLC,IBI NSTP)=IBAR R . I $D(I BRES("L-PR OV",IB399, SLC,IBINST P,IBSORT)) >1 S IBRES ("L-PROV", IB399,SLC, IBINSTP,IB SORT)=$S(I BPRNUM=3:" T",IBPRNUM =2:"S",1:" P") ;PROVI NFQ ;Exit PROVINF Q ;GETPRV(IB INSCO,IBFR MTYP,IBCAR E,IBPROV,I BRES,IBPRT YP,IBINSTP ,IBD) ; I "CO"'[$G(I BINSTP) G GETPRVQ N IBRETARR,I BNPI,IBN,I BMRAND,IB3 55OV S IBR ETARR=0,IB 355OV="" D PRACT^IBC EF71(IBINS CO,IBFRMTY P,IBCARE,I BPROV,.IBR ETARR,IBPR TYP,$G(IBI NSTP)) I $ P(IBD,U,IB PRNUM+4)'= "",$P(IBD, U,IBPRNUM+ 11)'="" S IB355OV=$P (IBD,U,IBP RNUM+4)_U_ $P(IBD,U,I BPRNUM+11) S IBN=0,I BMRAND=$$M CRONBIL^IB EFUNC(IB39 9) ;Calcul ate MEDICA RE (WNR) s pecific pr ovider qua lifier and ID for CM S-1500 sec ondary cla ims I "34" [$G(IBPRTY P),$G(IBFR MTYP)=2,IB MRAND S IB 355OV=$$MC R24K^IBCEU 3(IB399,IB PROV)_"^12 " I $P(IB3 55OV,U,2) D . I $$CH CKSEC^IBCE F73(IBFRMT YP,IBPRTYP ,$G(IBINST P),$P($G(^ IBE(355.97 ,+$P(IB355 OV,U,2),0) ),U,3)) D .. S IBEXC =$P(IB355O V,U,2),IBN =IBN+1,IBR ES(IBSORT, IBPRTYP,IB N)="OVERRI DE^"_IBINS CO_U_$P($G (^IBE(355. 97,+IBEXC, 0)),U,3)_U _$P(IB355O V,U)_"^^^^ ^"_+IBEXC I IB35591' ="",IBEXC' =$P(IB3559 1,U,3) I $ $CHCKSEC^I BCEF73(IBF RMTYP,IBPR TYP,$G(IBI NSTP),$P(I B35591,"^" )) D . S I BN=IBN+1,I BRES(IBSOR T,IBPRTYP, IBN)="DEFA ULT^"_IBIN SCO_"^"_IB 35591_"^^" ,$P(IBRES( IBSORT,IBP RTYP,IBN), U,9)=$P(IB 35591,U,3) S IBNPI=$ $NPI^IBCEF P1(IBPROV) D SORT^IB CEF77(IBSO RT,IBPRTYP ,IB399,.IB RETARR,.IB RES,IBN,IB EXC,IBPRNU M,IBLIMIT) S IBRES(I BSORT,IBPR TYP,0)="PR IMARY"_U_U _$$STRIP^I BCEF76($S( IBNPI]"":" XX",1:"")_ U_IBNPI,1, U,IBSTRIP) F IBN=1:1 Q:'$D(IBR ES(IBSORT, IBPRTYP,IB N)) S $P(I BRES(IBSOR T,IBPRTYP, IBN),U,3,4 )=$$STRIP^ IBCEF76($P (IBRES(IBS ORT,IBPRTY P,IBN),U,3 ,4),1,U,IB STRIP) S I BRES(IBSOR T,IBPRTYP, "NAME")=$$ NAME^IBCEF P1(IBPROV, IBIFN,$P(I BD,U,3),$P (IBD,U,8)) S IBRES(I BSORT,IBPR TYP,"ENTIT Y TYPE")=$ S(IBPROV'[ "355.93,": 1,$P($G(^I BA(355.93, +IBPROV,0) ),U,2)=2:1 ,1:2) S IB RES(IBSORT ,IBPRTYP," TAXONOMY") =$$TAXON^I BCEFP1(IBP ROV,$P(IBD ,U,15)) S IBRES(IBSO RT,IBPRTYP ,"COBID")= $$COBID^IB CEFP1(IB39 9,IBPRTYP, IBMRAND,IB D) S IBRES (IBSORT,IB PRTYP)=IBP ROVGETPRVQ ; Q ;PROV PTR(IBIEN3 99,IBFUNC, IBCP) ; Re trieve Pro vider Poin ter from a ppropriate file N IB N,RSLT S I BCP=+$G(IB CP) I 'IBC P D . S IB N=$O(^DGCR (399,IBIEN 399,"PRV", "B",IBFUNC ,0)) . I + IBN=0 S RS LT=0 Q . S RSLT=$P($ G(^DGCR(39 9,IBIEN399 ,"PRV",+IB N,0)),U,2) I IBCP D . S IBN=$O (^DGCR(399 ,IBIEN399, "CP",IBCP, "LNPRV","B ",IBFUNC,0 )) . I +IB N=0 S RSLT =0 Q . S R SLT=$P($G( ^DGCR(399, IBIEN399," CP",IBCP," LNPRV",+IB N,0)),U,2) Q RSLT ; ;Input: ;I BXIEN - In ternal Ent ry Number for the cu rrent bill /claim ;IB XSAVE - Ar ray for re turning th e data ; ; Output: ;I BXSAVE - D ata ArrayA MB(IBXIEN, IBXSAVE) ; Gather Am bulance Da ta for AMB Record(s) - IB*2.0* 447/TAZ N NODE,CODE, CNT,IBXDAT A K IBXSAV E("AMB") F NODE="U5" ,"U6","U7" S IBXDATA =$G(^DGCR( 399,IBXIEN ,NODE)) I $TR(IBXDAT A,U)'="" S IBXSAVE(" AMB",NODE) =IBXDATA S CODE="",C NT=0 F S CODE=$O(^D GCR(399,IB XIEN,"U9", "B",CODE)) Q:'CODE D . S IBXD ATA=$P($G( ^IBE(353.5 ,CODE,0)), U,1) I IBX DATA="" Q . S CNT=CN T+1,IBXSAV E("AMB","U 9",CNT)=IB XDATA Q ;S NDS2(IBXDA TA,PIECE) ;Determine if a SUB2 record is necessary . ; Input: IBXDATA ; May conta in data fr om field 2 32 of file 399. ; Ou tput: IBXD ATA ; Retu rns Output for piece 2 or 3 or 1 for any other pie ce (like 1 .5) ;Any t ime that O NE of the following criteria i s met we s hould send a SUB2 re cord ; 1. Incoming I BXDATA is not null S END - Non- VA facilit y in field 232 of fi le 399 ; 2 . If the s ervice fac ility is a VA Instit ution in f ile 4 or a non-VA fa cility in file 355.9 3 SEND ; 3 . Not a sw itchback p ayer $$SEN DSF^IBCEF7 9(IBXIEN)' =0 SEND ; ; MRD;IB*2 .0*516 - D ue to fiel ds being m arked for deletion, the ; func tion $$SEN DSF^IBCEF7 9 will alw ays return '1'. Refe r to ; tha t function and INSFL GS^^IBCEF7 9 for more informati on. ; I IB XDATA="" D . N Z . S Z=$P($$B^ IBCEF79(IB XIEN),U,3) . ;S Z1=$ $SENDSF^IB CEF79(IBXI EN) . ;S I BXDATA=$S( Z="":0,'Z1 :0,1:1) . S IBXDATA= $S(Z="":0, 1:1) . Q I 'IBXDATA S IBXDATA= "" I IBXDA TA'="" S I BXDATA=$S( PIECE=2:77 ,PIECE=3:2 ,1:1) Q IB XDATA | |
| 347 | ||
| 348 | ||
| 349 | Routines | |
| 350 | Activities | |
| 351 | Routine Na me | |
| 352 | IBCF23 | |
| 353 | Enhancemen t Category | |
| 354 | New | |
| 355 | Modify | |
| 356 | Delete | |
| 357 | No Change | |
| 358 | RTM | |
| 359 | ||
| 360 | Related Op tions | |
| 361 | None | |
| 362 | Related Ro utines | |
| 363 | Routines “ Called By” | |
| 364 | Routines “ Called” | |
| 365 | ||
| 366 | ||
| 367 | ||
| 368 | ||
| 369 | Data Dicti onary (DD) Reference s | |
| 370 | BILL/CLAIM S [#399] | |
| 371 | Related Pr otocols | |
| 372 | None | |
| 373 | Related In tegration Control Re gistration s (ICRs) | |
| 374 | None | |
| 375 | Data Passi ng | |
| 376 | Input | |
| 377 | Output Re ference | |
| 378 | Both | |
| 379 | Global Re ference | |
| 380 | Local | |
| 381 | Input Attr ibute Name and Defin ition | |
| 382 | Name: | |
| 383 | Definition : | |
| 384 | Output Att ribute Nam e and Defi nition | |
| 385 | Name: | |
| 386 | Definition : | |
| 387 | Current Lo gic | |
| 388 | IBCF23 ;AL B/ARH - HC FA 1500 19 -90 DATA ( block 24, procs and charges) ; 12-JUN-93 ;;2.0;INTE GRATED BIL LING;**52, 80,106,122 ,51,152,13 7,402,432, 488,547**; 21-MAR-94; Build 119 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ; ;requi res IBIFN, IB(0),IB(" U"),IB("U1 "), return s # of lin e items in IBFLD(24) ;rev code array: IB RC("proc^d ivision^ba sc flag^be dsection^r ev code^un it chrg^Rx seq #")=u nits ;proc array: IB CP(initial print ord )=proc dat e^proc^div ision^basc flag^dx^p os^tos^mod ifier^unit chrg^purc h chrg amt ^anesthesi a mins^eme rg indicat or ; IBCP( initial pr int order, seq #)=aux illary dat a ;proc ar ray: IBSS( "proc^divi sion^basc flag^dx^po s^tos^modi fier^unit chrg^Rx se q #")=lowe st inital print orde r ;print o rder array : IBPO(fin al print o rd,emerg i ndicator,i nitial pri nt order)= "" ;print array: IBF LD(24,I)=b egin dt^en d dt^pos^t os^proc^dx ^unit chrg ^units^mod ifier poin ter ien(s) separated by commas ^purch chr g amt^anes thesia min s^emerg in dicator ; IBFLD(24,I ,"AUX")=[a uxillary d ata] ; = " AUX" node of proc en try ; IBFL D(24,I,"RX ")= soft l ink to fil e 362.4 or null ; if service i s Rx, but no soft li nk ; ;cha rge item l ink: IBLIN K(CPT IFN in multipl e,RCIFN) = proc^divi sion^basc flag^bedse ction^rev code^unit chrg^rx se q # ; ; dx 's used in arrays ar e ref #s ; IB*547 ad ded backwa rds compat ibility so that MRAs and EOBs would stil l roll/spl it procedu res the sa me way as when the c laim ; was created. Any claim transmitte d before I B*547 was installed will roll/ split the original w ay and any new ; cla im or clai m transmit ted after IB*547 was transmitt ed will ro ll/split t he new way . ; When u pdating in the futur e care mus t be taken to disabl e/remove o lder code so that on ly new cha nges are ; affected by the IBN WPTCH vari able. ;RVC ; charges array D R VCE(,IBIFN ) Q ;RVCE( IBXIEN,IBI FN) ;Entry for EDI f ormatter c all (IBXIE N will be defined) ; IBIFN req uired N IB RC,IBCP,IB SS,IBSSO,I BSS1,IBPO, IBLINK,IBL INK1,IBLIN KRX,IBK,IB AUXLN N IB I,IBJ,IB11 ,IBLN,IBPD T,IBCHARG, IBMOD,IBPC ,IBRX,IBRX F,IBPO2A,I BAUX,IBNWP TCH ; ; IB *547/TAZ - Add IBNWP TCH variab le. S IBRX =0,IBNWPTC H=$$IBNWPT CH^IBCF23A (IBIFN,"IB *2.0*547") S IBI=0 F S IBI=$O (^DGCR(399 ,IBIFN,"RC ",IBI)) Q: 'IBI S IB LN=^(IBI,0 ) D . S IB SS="",IBPC =0 F IBJ=6 ,7,0,5,1,2 ,14 S IBPC =IBPC+1 S: IBJ $P(IBS S,U,IBPC,I BPC+1)=($P (IBLN,U,IB J)_U) . I $P(IBSS,U, 2)="" S $P (IBSS,U,2) =$P(^DGCR( 399,IBIFN, 0),U,22) . I +IBSS S $P(IBSS,U )=$P(IBSS, U)_";ICPT( " . S $P(I BSS,U,3)=$ S($D(^DGCR (399,"ASC1 ",+$P(IBLN ,U,6),IBIF N,IBI)):1, 1:"") . I +$P(IBLN,U ,10)=3 D Q ; Rx .. I '$P(IBL N,U,15) S IBRX=IBRX+ 1,$P(IBSS, U,8)=(100+ IBRX) .. I $P(IBLN,U ,15) S $P( IBSS,U,8)= $P(IBLN,U, 15) .. S I BRC(IBSS," RX")=$P(IB LN,U,11)_U _IBI_U_$P( IBLN,U,15) .. S IBRC (IBSS)=$G( IBRC(IBSS) )+1 . ; . S IBRC(IBS S)=$G(IBRC (IBSS))+$P (IBLN,U,3) ; total u nits for s imilar RC . I "4"[+$ P(IBLN,U,1 0),$P(IBLN ,U,11) D ; Soft-lin k proc wit h the rev cd .. S IB LINK(+$P(I BLN,U,11), IBI)=IBSS .. S $P(IB LINK(+$P(I BLN,U,11), IBI),U,7)= $P(IBLN,U, 14) . I $P (IBLN,U,10 ) D .. S I BLINK1(IBS S,IBI)=$P( IBLN,U,10) _U_+$P(IBL N,U,11) . S IBRC(IBS S,"LNK")=I BI ; S IBS SO="" F S IBSSO=$O( IBRC(IBSSO )) Q:IBSSO ="" I $D( IBRC(IBSSO ,"RX")) D . S IBSS=I BSSO,IBI=$ P(IBRC(IBS SO,"RX"),U ,2),IB11=$ P(IBRC(IBS SO,"RX"),U ,3) . S IB RC(IBSSO)= 1,IBLINKRX ($S($P(IBS SO,U)>0:$P (IBSSO,U), $P($G(^DGC R(399,IBIF N,"CP",+IB 11,0)),U)' ="":$P(^(0 ),U),1:0), +IB11,+IBR C(IBSSO,"R X"))=IBSSO K IBRC(IB SSO,"RX") ; D PRC^IB CF23A ; Ex tract proc eduresPO ; print ord er array w /chrgs ; c ombine mul tiple entr ies of sam e proc ont o one line item via print orde r ;if both have prin t orders d efined the n they sho uld not be combined onto one l ine item ; "proc^divi sion^basc^ dx^pos^tos ^modifier( s)^unit ch rg^purchas ed chg" mu st all be the same a s well as the emerge ncy indica tor and al l 'aux fld s' N IBP,Z ,IBPO11 ;I B*547/TAZ - set enti re node in to IBSS fo r post IB* 547 claims ;S IBPO=" " F S IBPO =$O(IBCP(I BPO)) Q:'I BPO S IBCP =IBCP(IBPO ),IBSS=$P( IBCP,U,2,9 ),IBSS1="* "_$G(IBCP( IBPO,"AUX" )),IBAUX=0 D S IBPO= "" F S IB PO=$O(IBCP (IBPO)) Q: 'IBPO S I BCP=IBCP(I BPO),IBSS= $P(IBCP,U, 2,$S(IBNWP TCH:$L(IBC P,U),1:9)) ,IBSS1="*" _$G(IBCP(I BPO,"AUX") ),IBAUX=0 D . I $D(I BSS(IBSS)) ,'$D(IBCP( IBPO,"RX") ),IBPO>100 0 D Q ; combine li nes .. I ' IBAUX S IB AUX=$$AUXO K^IBCF23A( .IBSS,IBSS 1) .. S IB PO1=$S(IBA UX:IBSS(IB SS,IBAUX), 1:IBPO) .. I 'IBAUX S Z=+$O(IB SS(IBSS,"A "),-1)+1,I BSS(IBSS,Z )=IBPO .. I IBPO>100 0!(IBPO1>1 000) S IBP O(IBPO1,+$ P(IBCP,U,1 2),IBPO)=" " D ... I $O(IBCP(IB PO,"L",0)) S Z=$O(IB CP(IBPO,"L ",0)),IBPO (IBPO1,+$P (IBCP,U,12 ),IBPO,"L" ,Z)=IBCP(I BPO,"L",Z) K IBCP(IB PO,"L",Z) . S IBAUX= +$O(IBSS(I BSS,"A"),- 1)+1,IBSS( IBSS,"AUX- X",IBAUX)= IBSS1 . S IBSS(IBSS, IBAUX)=+IB PO,IBPO(+I BPO,+$P(IB CP,U,12),I BPO)="" . S Z=0 F S Z=$O(IBCP (IBPO,Z)) Q:'Z S IB PO(+IBPO,+ $P(IBCP,U, 12),IBPO,Z )="" . I $ O(IBCP(IBP O,"L",0)) S Z=$O(IBC P(IBPO,"L" ,0)),IBPO( +IBPO,+$P( IBCP,U,12) ,IBPO,"L", Z)=IBCP(IB PO,"L",Z) K IBCP(IBP O,"L",Z) . S IBSS(IB SS,IBAUX," AUX")=IBSS 1,IBPO(+IB PO,+$P(IBC P,U,12),IB PO,"AUX")= $E(IBSS1,2 ,$L(IBSS1) ) . I $D(I BCP(IBPO," RX")) S IB PO(+IBPO,+ $P(IBCP,U, 12),IBPO," RX")=IBCP( IBPO,"RX") ,IBSS(IBSS ,IBAUX,"RX ")=IBCP(IB PO) ; ; Fi nd any rem aining rev codes w/u nits that ref existi ng procedu res S IBP( 0)=0 F IBP =3,2 Q:$G( IBP(0)) S IBRV="" F S IBRV=$O (IBRC(IBRV )) Q:IBRV= "" I IBRV ,IBRC(IBRV ) D . S IB SS1=$O(IBS S($P(IBRV, U,1,IBP))) Q:$P(IBRV ,U,1,IBP)' =$P(IBSS1, U,1,IBP) . S IBP(0)= 1,Z=0 . F S Z=$O(IB SS(IBSS1,Z )) Q:'Z I $G(IBSS(I BSS1,Z)) D Q .. I $ D(IBCP(IBS S(IBSS1,Z) )),$P(IBCP (IBSS(IBSS 1,Z)),U,9) =$P(IBSS1, U,8) D ... N Q,Q0 .. . ; S Q=$O (IBCP(""), -1)+1,Q0=$ P(IBCP(IBS S(IBSS1,Z) ),U,12) ; WCJ;IB*488 ... S Q=I BSS(IBSS1, Z),Q0=$P(I BCP(IBSS(I BSS1,Z)),U ,12) ; WCJ ;IB*488 .. . ;M IBPO( Q,$P(IBCP( IBSS(IBSS1 ,Z)),U,12) ,Q)=IBPO(I BSS(IBSS1, Z),$P(IBCP (IBSS(IBSS 1,Z)),U,12 ),IBSS(IBS S1,Z)),IBC P(Q)=IBCP( IBSS(IBSS1 ,Z)) ; WCJ ;IB*488 .. . ;S $P(IB CP(Q),U,9) =$P(IBRV,U ,6) ; WCJ; IB*488 ... ;F Z0=1:1 :(IBRC(IBR V)-1) S IB PO(Q,Q0,Q+ (Z0*.01))= IBPO(Q,Q0, Q) I Z0=99 ,(IBRC(IBR V)'=100) S IBPO(Q,Q0 ,Q_".991") =(IBRC(IBR V)-1)_"^99 " Q ; Only put first 99 in arr ay ... F Z 0=1:1:(IBR C(IBRV)) S IBPO(Q,Q0 ,Q+(Z0*.00 1))=IBPO(Q ,Q0,Q) ; c hanging to .001 allo ws us up t o 999 and the units field only allows 80 0. ; WCJ;I B*488 ... S IBRC(IBR V)=0 ;PRTA RR ;print proc array S IBREV=" ",IBPO1="" ,IBI=0 F S IBPO1=$O (IBPO(IBPO 1)) Q:IBPO 1="" D . K IBRXF . S IBEMG="" F S IBEM G=$O(IBPO( IBPO1,IBEM G)) Q:IBEM G=""!("01" '[IBEMG) S IBPO2="" D .. S IBD T1=9999999 9,IBDT2="" ,(IBMIN,IB UNIT)=0,(I BCHARG,IBA UX)="" .. F S IBPO2 =$O(IBPO(I BPO1,IBEMG ,IBPO2)) Q :IBPO2="" D ... I I BPO2#1=.99 1 D Q:IBP O2#1=.991 .... N Z . ... S Z=$G (IBPO(IBPO 1,IBEMG,IB PO2)) Q:'Z .... I ($ P(Z,U,2)+1 )>Z Q .... S $P(IBPO (IBPO1,IBE MG,IBPO2), U,2)=($P(Z ,U,2)+1),I BPO2=(IBPO 2\1)_".99" ... S Z=0 F S Z=$O (IBPO(IBPO 1,IBEMG,IB PO2,Z)) Q: 'Z S IBUN IT=IBUNIT+ 1 ... I $D (IBCP(IBPO 1)) S IBPO 11=IBPO1 . .. S IBPO2 A=$S($D(IB CP(IBPO2\1 )):IBPO2\1 ,'$D(IBCP( IBPO2)):IB PO11,1:IBP O2) ... S IBCHARG=$P (IBCP(IBPO 2A),U,9),I BPCHG=$P(I BCP(IBPO2A ),U,10) .. . ; I IBCH ARG<10000, IBCHARG*(I BUNIT+1)'< 10000 D Q ;$9,999 li mit per li ne ;WCJ IB *488 ... I IBCHARG<1 0000000,IB CHARG*(IBU NIT+1)'<10 000000 D Q ; incre ased to $9 ,999,999 c harge limi t per line since tha t is print ed form sp ace limit ;WCJ IB*48 8 .... N Z S Z=$O(IB PO(IBPO1\1 +1),-1),Z= Z+$S(IBPO1 +.001'=Z:. 001,1:0) M IBPO(Z,IB EMG,IBPO2) =IBPO(IBPO 1,IBEMG,IB PO2) K IBP O(IBPO1,IB EMG,IBPO2) ... S IBU NIT=IBUNIT +1,IBSS=IB CP(IBPO2A) ,IBMIN=IBM IN+$P(IBSS ,U,11) ... S IBSS=$G (IBSS)_U_$ G(IBCP(IBP O2A,"LNK") ) ... S Z= $O(IBPO(IB PO1,IBEMG, IBPO2,"L", 0)) I Z D .... S Z0= 0 .... F Z =Z:1 Q:'$O (IBPO(IBPO 1,IBEMG,IB PO2,"L",0) )!(Z0=IBUN IT) I $D(I BPO(IBPO1, IBEMG,IBPO 2,"L",Z)) S IBSS("L" ,Z)=IBPO(I BPO1,IBEMG ,IBPO2,"L" ,Z),Z0=Z0+ 1 K IBPO(I BPO1,IBEMG ,IBPO2,"L" ,Z) ... S: IBDT1>+IBS S IBDT1=+I BSS S:IBDT 2<+IBSS IB DT2=+IBSS .. S IBAUX =$G(IBCP(I BPO1,"AUX" )) S:$D(IB CP(IBPO1," RX")) IBRX F=IBCP(IBP O1,"RX") . . I IBUNIT D B24^IBC F23A .. K IBRXF ; ;p rint any c hrgs not a ssociated with a pro c (ie. not enough pr ocs or pro c not in " CP" level) S IBRV="" F S IBRV =$O(IBRC(I BRV)) Q:IB RV="" I + IBRC(IBRV) D D B24^ IBCF23A K IBRXF . S IBUNIT=+IB RC(IBRV),I BCHARG=$P( IBRV,U,6), IBDT1=+IB( "U"),IBDT2 =$P(IB("U" ),U,2),IBR EV=$P(IBRV ,U,5),IBEM G=0,IBAUX= "" . S IBS S="^"_$S(+ IBRV:$P(IB RV,U),1:$P ($G(^DGCR( 399.1,+$P( IBRV,U,4), 0)),U)) . S IBSS=$G( IBSS)_U_$$ RC2CP^IBCE F22(IBIFN, +$G(IBRC(I BRV,"LNK") )) . S Z=$ O(IBLINK1( IBRV,0)) I Z D .. S Z0=0 .. F Z=Z:1 Q:'$ O(IBLINK1( IBRV,0))!( Z0=IBUNIT) I $D(IBLI NK1(IBRV,Z )) S IBSS( "L",Z)=IBL INK1(IBRV, Z),Z0=Z0+1 K IBLINK1 (IBRV,Z) ; OFFSET ; S IBFLD(24) =IBI ;line item coun t K IBRC,I BCP,IBSS,I BPO,IBPO1, IBPO2,IBLN ,IBRV,IBRV 1,IBPDT,IB DT1,IBDT2, IBCHARG,IB MIN,IBUNIT ,IBREV,IBL INK,IBLINK 1,IBEMG,IB PCHG,Z Q ; DATE(X) ; Fm dt in X ==> YYYYM MDD Q $$DT ^IBCEFG1(X ,,"D8") ;B 24 ; Moved to IBCF23 A for spac e D B24^IB CF23A Q ; | |
| 389 | Modified L ogic (Chan ges are in bold) | |
| 390 | IBCF23 ;AL B/ARH - HC FA 1500 19 -90 DATA ( block 24, procs and charges) ; 12-JUN-93 ;;2.0;INTE GRATED BIL LING;**52, 80,106,122 ,51,152,13 7,402,432, 488,547,59 2**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ; ;r equires IB IFN,IB(0), IB("U"),IB ("U1"), re turns # of line item s in IBFLD (24) ;rev code array : IBRC("pr oc^divisio n^basc fla g^bedsecti on^rev cod e^unit chr g^Rx seq # ")=units ; proc array : IBCP(ini tial print ord)=proc date^proc ^division^ basc flag^ dx^pos^tos ^modifier^ unit chrg^ purch chrg amt^anest hesia mins ^emerg ind icator ; I BCP(initia l print or der,seq #) =auxillary data ;pro c array: I BSS("proc^ division^b asc flag^d x^pos^tos^ modifier^u nit chrg^R x seq #")= lowest ini tal print order ;pri nt order a rray: IBPO (final pri nt ord,eme rg indicat or,initial print ord er)="" ;pr int array: IBFLD(24, I)=begin d t^end dt^p os^tos^pro c^dx^unit chrg^units ^modifier pointer ie n(s) separ ated by co mmas^purch chrg amt^ anesthesia mins^emer g indicato r ; IBFLD( 24,I,"AUX" )=[auxilla ry data] ; = "AUX" n ode of pro c entry ; IBFLD(24,I ,"RX")= so ft link to file 362. 4 or null ; if servi ce is Rx, but no sof t link ; ;charge it em link: I BLINK(CPT IFN in mul tiple,RCIF N) = proc^ division^b asc flag^b edsection^ rev code^u nit chrg^r x seq # ; ; dx's use d in array s are ref #s ; IB*54 7 added ba ckwards co mpatibilit y so that MRAs and E OBs would still roll /split pro cedures th e same way as when t he claim ; was creat ed. Any cl aim transm itted befo re IB*547 was instal led will r oll/split the origin al way and any new ; claim or claim tran smitted af ter IB*547 was trans mitted wil l roll/spl it the new way. ; Wh en updatin g in the f uture care must be t aken to di sable/remo ve older c ode so tha t only new changes a re ; affec ted by the IBNWPTCH variable. ;RVC ; cha rges array D RVCE(,I BIFN) Q ;R VCE(IBXIEN ,IBIFN) ;E ntry for E DI formatt er call (I BXIEN will be define d) ; IBIFN required N IBRC,IBC P,IBSS,IBS SO,IBSS1,I BPO,IBLINK ,IBLINK1,I BLINKRX,IB K,IBAUXLN ;JWS;IB*2. 0*592;US13 1 N IBI,IB J,IB11,IBL N,IBPDT,IB CHARG,IBMO D,IBPC,IBR X,IBRXF,IB PO2A,IBAUX ,IBNWPTCH, IBDEN,IBDE N1 ; ; IB* 547/TAZ - Add IBNWPT CH variabl e. S IBRX= 0,IBNWPTCH =$$IBNWPTC H^IBCF23A( IBIFN,"IB* 2.0*547") S IBI=0 F S IBI=$O( ^DGCR(399, IBIFN,"RC" ,IBI)) Q:' IBI S IBL N=^(IBI,0) D . S IBS S="",IBPC= 0 F IBJ=6, 7,0,5,1,2, 14 S IBPC= IBPC+1 S:I BJ $P(IBSS ,U,IBPC,IB PC+1)=($P( IBLN,U,IBJ )_U) . I $ P(IBSS,U,2 )="" S $P( IBSS,U,2)= $P(^DGCR(3 99,IBIFN,0 ),U,22) . I +IBSS S $P(IBSS,U) =$P(IBSS,U )_";ICPT(" . S $P(IB SS,U,3)=$S ($D(^DGCR( 399,"ASC1" ,+$P(IBLN, U,6),IBIFN ,IBI)):1,1 :"") . I + $P(IBLN,U, 10)=3 D Q ; Rx .. I '$P(IBLN ,U,15) S I BRX=IBRX+1 ,$P(IBSS,U ,8)=(100+I BRX) .. I $P(IBLN,U, 15) S $P(I BSS,U,8)=$ P(IBLN,U,1 5) .. S IB RC(IBSS,"R X")=$P(IBL N,U,11)_U_ IBI_U_$P(I BLN,U,15) .. S IBRC( IBSS)=$G(I BRC(IBSS)) +1 . ; . S IBRC(IBSS )=$G(IBRC( IBSS))+$P( IBLN,U,3) ; total un its for si milar RC . I "4"[+$P (IBLN,U,10 ),$P(IBLN, U,11) D ; Soft-link proc with the rev c d .. S IBL INK(+$P(IB LN,U,11),I BI)=IBSS . . S $P(IBL INK(+$P(IB LN,U,11),I BI),U,7)=$ P(IBLN,U,1 4) . I $P( IBLN,U,10) D .. S IB LINK1(IBSS ,IBI)=$P(I BLN,U,10)_ U_+$P(IBLN ,U,11) . S IBRC(IBSS ,"LNK")=IB I ; S IBSS O="" F S IBSSO=$O(I BRC(IBSSO) ) Q:IBSSO= "" I $D(I BRC(IBSSO, "RX")) D . S IBSS=IB SSO,IBI=$P (IBRC(IBSS O,"RX"),U, 2),IB11=$P (IBRC(IBSS O,"RX"),U, 3) . S IBR C(IBSSO)=1 ,IBLINKRX( $S($P(IBSS O,U)>0:$P( IBSSO,U),$ P($G(^DGCR (399,IBIFN ,"CP",+IB1 1,0)),U)'= "":$P(^(0) ,U),1:0),+ IB11,+IBRC (IBSSO,"RX "))=IBSSO K IBRC(IBS SO,"RX") ; D PRC^IBC F23A ; Ext ract proce duresPO ; print orde r array w/ chrgs ; co mbine mult iple entri es of same proc onto one line item via p rint order ;if both have print orders de fined then they shou ld not be combined o nto one li ne item ;" proc^divis ion^basc^d x^pos^tos^ modifier(s )^unit chr g^purchase d chg" mus t all be t he same as well as t he emergen cy indicat or and all 'aux flds ' N IBP,Z, IBPO11 ;IB *547/TAZ - set entir e node int o IBSS for post IB*5 47 claims ;S IBPO="" F S IBPO= $O(IBCP(IB PO)) Q:'IB PO S IBCP= IBCP(IBPO) ,IBSS=$P(I BCP,U,2,9) ,IBSS1="*" _$G(IBCP(I BPO,"AUX") ),IBAUX=0 D S IBPO=" " F S IBP O=$O(IBCP( IBPO)) Q:' IBPO S IB CP=IBCP(IB PO),IBSS=$ P(IBCP,U,2 ,$S(IBNWPT CH:$L(IBCP ,U),1:9)), IBSS1="*"_ $G(IBCP(IB PO,"AUX")) ,IBAUX=0 D . I $D(IB SS(IBSS)), '$D(IBCP(I BPO,"RX")) ,IBPO>1000 D Q ; c ombine lin es .. I 'I BAUX S IBA UX=$$AUXOK ^IBCF23A(. IBSS,IBSS1 ) .. S IBP O1=$S(IBAU X:IBSS(IBS S,IBAUX),1 :IBPO) .. I 'IBAUX S Z=+$O(IBS S(IBSS,"A" ),-1)+1,IB SS(IBSS,Z) =IBPO .. I IBPO>1000 !(IBPO1>10 00) S IBPO (IBPO1,+$P (IBCP,U,12 ),IBPO)="" D ... I $ O(IBCP(IBP O,"L",0)) S Z=$O(IBC P(IBPO,"L" ,0)),IBPO( IBPO1,+$P( IBCP,U,12) ,IBPO,"L", Z)=IBCP(IB PO,"L",Z) K IBCP(IBP O,"L",Z) . S IBAUX=+ $O(IBSS(IB SS,"A"),-1 )+1,IBSS(I BSS,"AUX-X ",IBAUX)=I BSS1 . S I BSS(IBSS,I BAUX)=+IBP O,IBPO(+IB PO,+$P(IBC P,U,12),IB PO)="" . S Z=0 F S Z=$O(IBCP( IBPO,Z)) Q :'Z S IBP O(+IBPO,+$ P(IBCP,U,1 2),IBPO,Z) ="" . I $O (IBCP(IBPO ,"L",0)) S Z=$O(IBCP (IBPO,"L", 0)),IBPO(+ IBPO,+$P(I BCP,U,12), IBPO,"L",Z )=IBCP(IBP O,"L",Z) K IBCP(IBPO ,"L",Z) . S IBSS(IBS S,IBAUX,"A UX")=IBSS1 ,IBPO(+IBP O,+$P(IBCP ,U,12),IBP O,"AUX")=$ E(IBSS1,2, $L(IBSS1)) . I $D(IB CP(IBPO,"R X")) S IBP O(+IBPO,+$ P(IBCP,U,1 2),IBPO,"R X")=IBCP(I BPO,"RX"), IBSS(IBSS, IBAUX,"RX" )=IBCP(IBP O) . ;JWS; IB*2.0*592 ;US131 . I $D(IBCP(I BPO,"DEN") ) S IBPO(+ IBPO,+$P(I BCP,U,12), IBPO,"DEN" )=IBCP(IBP O,"DEN") . I $D(IBCP (IBPO,"DEN 1")) M IBP O(+IBPO,+$ P(IBCP,U,1 2),IBPO,"D EN1")=IBCP (IBPO,"DEN 1") . ;end ;JWS;IB*2 .0*592;US1 31; ; Find any remai ning rev c odes w/uni ts that re f existing procedure s S IBP(0) =0 F IBP=3 ,2 Q:$G(IB P(0)) S IB RV="" F S IBRV=$O(I BRC(IBRV)) Q:IBRV="" I IBRV,I BRC(IBRV) D . S IBSS 1=$O(IBSS( $P(IBRV,U, 1,IBP))) Q :$P(IBRV,U ,1,IBP)'=$ P(IBSS1,U, 1,IBP) . S IBP(0)=1, Z=0 . F S Z=$O(IBSS (IBSS1,Z)) Q:'Z I $ G(IBSS(IBS S1,Z)) D Q .. I $D( IBCP(IBSS( IBSS1,Z))) ,$P(IBCP(I BSS(IBSS1, Z)),U,9)=$ P(IBSS1,U, 8) D ... N Q,Q0 ... ; S Q=$O(I BCP(""),-1 )+1,Q0=$P( IBCP(IBSS( IBSS1,Z)), U,12) ; WC J;IB*488 . .. S Q=IBS S(IBSS1,Z) ,Q0=$P(IBC P(IBSS(IBS S1,Z)),U,1 2) ; WCJ;I B*488 ... ;M IBPO(Q, $P(IBCP(IB SS(IBSS1,Z )),U,12),Q )=IBPO(IBS S(IBSS1,Z) ,$P(IBCP(I BSS(IBSS1, Z)),U,12), IBSS(IBSS1 ,Z)),IBCP( Q)=IBCP(IB SS(IBSS1,Z )) ; WCJ;I B*488 ... ;S $P(IBCP (Q),U,9)=$ P(IBRV,U,6 ) ; WCJ;IB *488 ... ; F Z0=1:1:( IBRC(IBRV) -1) S IBPO (Q,Q0,Q+(Z 0*.01))=IB PO(Q,Q0,Q) I Z0=99,( IBRC(IBRV) '=100) S I BPO(Q,Q0,Q _".991")=( IBRC(IBRV) -1)_"^99" Q ; Only p ut first 9 9 in array ... F Z0= 1:1:(IBRC( IBRV)) S I BPO(Q,Q0,Q +(Z0*.001) )=IBPO(Q,Q 0,Q) ; cha nging to . 001 allows us up to 999 and th e units fi eld only a llows 800. ; WCJ;IB* 488 ... S IBRC(IBRV) =0 ;PRTARR ;print pr oc array S IBREV="", IBPO1="",I BI=0 F S IBPO1=$O(I BPO(IBPO1) ) Q:IBPO1= "" D . K IBRXF . S IBEMG="" F S IBEMG= $O(IBPO(IB PO1,IBEMG) ) Q:IBEMG= ""!("01"'[ IBEMG) S I BPO2="" D .. S IBDT1 =99999999, IBDT2="",( IBMIN,IBUN IT)=0,(IBC HARG,IBAUX )="" .. F S IBPO2=$ O(IBPO(IBP O1,IBEMG,I BPO2)) Q:I BPO2="" D ... I IBP O2#1=.991 D Q:IBPO2 #1=.991 .. .. N Z ... . S Z=$G(I BPO(IBPO1, IBEMG,IBPO 2)) Q:'Z . ... I ($P( Z,U,2)+1)> Z Q .... S $P(IBPO(I BPO1,IBEMG ,IBPO2),U, 2)=($P(Z,U ,2)+1),IBP O2=(IBPO2\ 1)_".99" . .. S Z=0 F S Z=$O(I BPO(IBPO1, IBEMG,IBPO 2,Z)) Q:'Z S IBUNIT =IBUNIT+1 ... I $D(I BCP(IBPO1) ) S IBPO11 =IBPO1 ... S IBPO2A= $S($D(IBCP (IBPO2\1)) :IBPO2\1,' $D(IBCP(IB PO2)):IBPO 11,1:IBPO2 ) ... S IB CHARG=$P(I BCP(IBPO2A ),U,9),IBP CHG=$P(IBC P(IBPO2A), U,10) ... ; I IBCHAR G<10000,IB CHARG*(IBU NIT+1)'<10 000 D Q ;$ 9,999 limi t per line ;WCJ IB*4 88 ... I I BCHARG<100 00000,IBCH ARG*(IBUNI T+1)'<1000 0000 D Q ; increas ed to $9,9 99,999 cha rge limit per line s ince that is printed form spac e limit ;W CJ IB*488 .... N Z S Z=$O(IBPO (IBPO1\1+1 ),-1),Z=Z+ $S(IBPO1+. 001'=Z:.00 1,1:0) M I BPO(Z,IBEM G,IBPO2)=I BPO(IBPO1, IBEMG,IBPO 2) K IBPO( IBPO1,IBEM G,IBPO2) . .. S IBUNI T=IBUNIT+1 ,IBSS=IBCP (IBPO2A),I BMIN=IBMIN +$P(IBSS,U ,11) ... S IBSS=$G(I BSS)_U_$G( IBCP(IBPO2 A,"LNK")) ... S Z=$O (IBPO(IBPO 1,IBEMG,IB PO2,"L",0) ) I Z D .. .. S Z0=0 .... F Z=Z :1 Q:'$O(I BPO(IBPO1, IBEMG,IBPO 2,"L",0))! (Z0=IBUNIT ) I $D(IBP O(IBPO1,IB EMG,IBPO2, "L",Z)) S IBSS("L",Z )=IBPO(IBP O1,IBEMG,I BPO2,"L",Z ),Z0=Z0+1 K IBPO(IBP O1,IBEMG,I BPO2,"L",Z ) ... S:IB DT1>+IBSS IBDT1=+IBS S S:IBDT2< +IBSS IBDT 2=+IBSS .. S IBAUX=$ G(IBCP(IBP O1,"AUX")) S:$D(IBCP (IBPO1,"RX ")) IBRXF= IBCP(IBPO1 ,"RX") .. ;JWS;IB*2. 0*592;US13 1 .. S IBD EN=$G(IBCP (IBPO1,"DE N")) .. I $D(IBCP(IB PO1,"DEN1" )) M IBDEN 1=IBCP(IBP O1,"DEN1") .. ;end ; JWS;IB*2.0 *592;US131 .. I IBUN IT D B24^I BCF23A .. K IBRXF ; ;print any chrgs not associate d with a p roc (ie. n ot enough procs or p roc not in "CP" leve l) S IBRV= "" F S IB RV=$O(IBRC (IBRV)) Q: IBRV="" I +IBRC(IBR V) D D B2 4^IBCF23A K IBRXF . S IBUNIT=+ IBRC(IBRV) ,IBCHARG=$ P(IBRV,U,6 ),IBDT1=+I B("U"),IBD T2=$P(IB(" U"),U,2),I BREV=$P(IB RV,U,5),IB EMG=0,IBAU X="" . S I BSS="^"_$S (+IBRV:$P( IBRV,U),1: $P($G(^DGC R(399.1,+$ P(IBRV,U,4 ),0)),U)) . S IBSS=$ G(IBSS)_U_ $$RC2CP^IB CEF22(IBIF N,+$G(IBRC (IBRV,"LNK "))) . S Z =$O(IBLINK 1(IBRV,0)) I Z D .. S Z0=0 .. F Z=Z:1 Q: '$O(IBLINK 1(IBRV,0)) !(Z0=IBUNI T) I $D(IB LINK1(IBRV ,Z)) S IBS S("L",Z)=I BLINK1(IBR V,Z),Z0=Z0 +1 K IBLIN K1(IBRV,Z) ;OFFSET ; S IBFLD(2 4)=IBI ;li ne item co unt K IBRC ,IBCP,IBSS ,IBPO,IBPO 1,IBPO2,IB LN,IBRV,IB RV1,IBPDT, IBDT1,IBDT 2,IBCHARG, IBMIN,IBUN IT,IBREV,I BLINK,IBLI NK1,IBEMG, IBPCHG,Z Q ;DATE(X) ; Fm dt in X ==> YYY YMMDD Q $$ DT^IBCEFG1 (X,,"D8") ;B24 ; Mov ed to IBCF 23A for sp ace D B24^ IBCF23A Q ; | |
| 391 | ||
| 392 | Routines | |
| 393 | Activities | |
| 394 | Routine Na me | |
| 395 | IBCF23A | |
| 396 | Enhancemen t Category | |
| 397 | New | |
| 398 | Modify | |
| 399 | Delete | |
| 400 | No Change | |
| 401 | RTM | |
| 402 | ||
| 403 | Related Op tions | |
| 404 | None | |
| 405 | Related Ro utines | |
| 406 | Routines “ Called By” | |
| 407 | Routines “ Called” | |
| 408 | ||
| 409 | ||
| 410 | ||
| 411 | ||
| 412 | Data Dicti onary (DD) Reference s | |
| 413 | BILL/CLAIM S [#399] | |
| 414 | EDI TRANSM IT BILL [# 364] | |
| 415 | EDI TRANSM ISSION BAT CH [#364.1 ] | |
| 416 | Related Pr otocols | |
| 417 | None | |
| 418 | Related In tegration Control Re gistration s (ICRs) | |
| 419 | None | |
| 420 | Data Passi ng | |
| 421 | Input | |
| 422 | Output Re ference | |
| 423 | Both | |
| 424 | Global Re ference | |
| 425 | Local | |
| 426 | Input Attr ibute Name and Defin ition | |
| 427 | Name: | |
| 428 | Definition : | |
| 429 | Output Att ribute Nam e and Defi nition | |
| 430 | Name: | |
| 431 | Definition : | |
| 432 | Current Lo gic | |
| 433 | IBCF23A ;A LB/ARH - H CFA 1500 1 9-90 DATA - Split fr om IBCF23 ;12-JUN-93 ;;2.0;INT EGRATED BI LLING;**51 ,432,516,5 47**;21-MA R-94;Build 119 ;;Per VA Direct ive 6402, this routi ne should not be mod ified. ; ; $$INSTALD T^XPDUTL(I BPATCH,.IB ARY) - ICR 10141 ;B2 4 ; set in dividual e ntries in print arra y, externa l format ; IBAUX = a dditional data for E DI output ; IBRXF = array of R X procedur es N IBX,Z ,IBD1,IBD2 ,IBCPLINK S IBI=IBI+ 1,IBPROC=$ P(IBSS,U,2 ),IBD1=$$D ATE^IBCF23 (IBDT1),IB D2=$S(IBDT 1'=IBDT2:$ $DATE^IBCF 23(IBDT2), 1:"") I '$ D(IBXIEN) S IBD1=$E( IBD1,5,8)_ $E(IBD1,1, 4),IBD2=$E (IBD2,5,8) _$E(IBD2,1 ,4) S IBFL D(24,IBI)= IBD1_U_IBD 2_U_$P($G( ^IBE(353.1 ,+$P(IBSS, U,6),0)),U )_U_$P($G( ^IBE(353.2 ,+$P(IBSS, U,7),0)),U ) I +IBPRO C D . S IB FLD(24,IBI )=IBFLD(24 ,IBI)_U_$P ($$PRCD^IB CEF1(IBPRO C,1),U,2) S:$P(IBPRO C,";",2)'[ "ICPT" IBF LD(24,IBI_ "X")="" I 'IBPROC S IBFLD(24,I BI)=IBFLD( 24,IBI)_U_ $S('$D(IBX IEN):IBPRO C,1:+IBREV ),IBFLD(24 ,IBI_"A")= $P($G(^DGC R(399.2,+I BREV,0)),U ,2) I $D(I BRXF),IBCH ARG="" S I BFLD(24,IB I_"A")=$P( $G(^DGCR(3 99.2,+IBRE V,0)),U,2) S IBFLD(2 4,IBI)=IBF LD(24,IBI) _U_$P(IBSS ,U,5)_U_IB CHARG_U_IB UNIT_U_$P( IBSS,U,8)_ U_$G(IBPCH G)_U_$G(IB MIN)_U_$G( IBEMG) I $ D(IBSS("L" )) S Z=0 F S Z=$O(I BSS("L",Z) ) Q:'Z S IBFLD(24,I BI,$P(IBSS ("L",Z),U) ,$P(IBSS(" L",Z),U,2) )=$G(IBFLD (24,IBI,$P (IBSS("L", Z),U),$P(I BSS("L",Z) ,U,2)))+1 S:$TR($G(I BAUX),U)'= "" IBFLD(2 4,IBI,"AUX ")=$G(IBAU X) S:$D(IB RXF) IBFLD (24,IBI,"R X")=IBRXF K IBPROC,I BSS("L") S IBCPLINK= $P(IBSS,U, $L(IBSS,U) ) S IBFLD( 24,IBI)=IB FLD(24,IBI )_U_IBCPLI NK ; MRD;I B*2.0*516 - Added ND C and Unit s to line level of c laim. I IB CPLINK'="" S $P(IBFL D(24,IBI), U,14,15)=$ TR($P($G(^ DGCR(399,I BIFN,"CP", IBCPLINK,1 )),U,7,8), "-") Q ;AU XOK(IBSS,I BSS1) ; Ch eck all ot her flds a re the sam e to combi ne procs ; IBSS = su bscript of IBCP to c heck for d ups to com bine - pas s by ref ; IBSS(IBSS ,"AUX-X",n ) = all th e previous ly extract ed line it ems for th e ; same s et of basi c data, bu t having d ifferent " AUX" data ; IBSS1 = the "AUX" data of th e current IBCP entry ; ; Retur ns entry # in IBSS a rray if ma tch found, or 0 if n o match ; Set the IB SS "AUX-X" node for no match N Z,Z0 S Z= 0 F S Z=$ O(IBSS(IBS S,"AUX-X", Z)) Q:'Z I IBSS1=IB SS(IBSS,"A UX-X",Z) Q I 'Z S Z0 =+$O(IBSS( IBSS,"AUX- X",""),-1) +1,IBSS(IB SS,"AUX-X" ,Z0)=IBSS1 Q +Z ;PRC ; Extract procedure data for HCFA 1500 ; IBRC(IBS S) = #rev codes with same bill ing criter ia (IBSS) ; IBLINK(' CP' ien,'R C' ien) = IBSS inclu ding modif iers,rx se q in pc 7, 8 ; IBLINK 1(IBSS, 'R C' ien) = auto (1)^ 'CP' ien ( soft link) ; ; proc array w/ch rg N IBPR, IBP S IBI= 0 F S IBI =$O(^DGCR( 399,IBIFN, "CP",IBI)) Q:'IBI S IBLN=^(IB I,0),IBAUX LN=$G(^("A UX")) D . N Z,Z0,Z1, Q1 . S IBP DT=$P(IBLN ,U,2) . S IBSS=$$IBS S(IBI,.IBD XI,IBLN) . S IBPO=$S ($P(IBLN,U ,4):+$P(IB LN,U,4),1: IBI+1000) ;Set print order . S IBCP(IBPO )=IBPDT_"^ "_IBSS,IBC P(IBPO,"AU X")=IBAUXL N . S IBCP (IBPO,"LNK ")=IBI . ; Rx . N IB Z,IBITEM . S IBZ=$S( $P(IBSS,U) :$P(IBSS,U ),1:"") . I IBZ'="", $D(IBLINKR X(IBZ,IBI) ) D Q:IBC HARG'="" . . S IBPO1= IBPO .. S IBITEM=+$O (IBLINKRX( IBZ,IBI,0) ),IBRV=$G( IBLINKRX(I BZ,IBI,IBI TEM)) .. Q :$S(IBRV=" ":1,1:'$G( IBRC(IBRV) )) .. S IB CHARG=$P(I BRV,U,6),I BRC(IBRV)= IBRC(IBRV) -1 .. S $P (IBCP(IBPO 1),U,9)=IB CHARG,IBCP (IBPO1,"RX ")=IBITEM K IBLINKRX (IBZ,IBI,I BITEM) . ; find chrg s directly linked to proc . S IBK=0 F S IBK=$O(IB LINK(IBI,I BK)) Q:'IB K S IBRV1 =IBLINK(IB I,IBK),IBR V=$P(IBRV1 ,U,1,6) I +IBRC(IBRV 1) D .. S IBCHARG=$P (IBRV,U,6) ,IBRC(IBRV 1)=IBRC(IB RV1)-1 .. I IBCHARG' ="" S $P(I BSS,U,8)=I BCHARG,IBC P(IBPO)=IB PDT_"^"_IB SS,IBPO=IB PO+.1 ; ; add chrgs associated with a pr oc (not a direct lin k) ; find chrg assoc iated with proc, if any (match proc,div, +/-basc) K IBP(0) F IBP=3,2 Q: $D(IBP(0)) S IBPO="" F S IBPO =$O(IBCP(I BPO)) Q:'I BPO I $P( IBCP(IBPO) ,U,9)="" D . S IBSS= $P(IBCP(IB PO),U,2,9) . S IBCHA RG="",(IBR V,IBSS)=$P (IBSS,U,1, IBP) F S IBRV=$O(IB RC(IBRV)) Q:$P(IBRV, U,1,IBP)'= IBSS S IB P(0)=0 I + IBRC(IBRV) D Q .. S IBCHARG=$ P(IBRV,U,6 ),IBRC(IBR V)=IBRC(IB RV)-1 .. I IBRC(IBRV ) S Z=0 F S Z=$O(IB CP(IBPO,Z) ) Q:'Z S IBRC(IBRV) =IBRC(IBRV )-1 . S $P (IBCP(IBPO ),U,9)=IBC HARG . I I BCHARG'="" S Z=$O(IB LINK1(IBRV ,0)) I Z S IBCP(IBPO ,"L",Z)=IB LINK1(IBRV ,Z) K IBLI NK1(IBRV,Z ) ; ; add chrgs not associated with a pr oc to firs t proc wit h no chrg ; Aggggh!! ! TP S IBP O="" F S IBPO=$O(IB CP(IBPO)) Q:'IBPO I $P(IBCP(I BPO),U,9)= "" D . S I BCHARG="", IBRV="^" F S IBRV=$ O(IBRC(IBR V)) Q:IBRV =""!+IBRV I +IBRC(I BRV) D Q .. S IBCHA RG=$P(IBRV ,U,6),IBRC (IBRV)=IBR C(IBRV)-1 .. S Z=$O( IBLINK1(IB RV,0)) I Z S IBCP(IB PO,"L",Z)= IBLINK1(IB RV,Z) K IB LINK1(IBRV ,Z) . S $P (IBCP(IBPO ),U,9)=IBC HARG ; QIB SS(IBI,IBD XI,IBLN) ; Creates i ndex seque nce for pr ocedure N IBPC,IBJ,I BSS,IBLPI, IBX,IBLPAR S (IBPC,I BLPI)=0 F IBJ=1,6,5, 0,9,10 S I BPC=IBPC+1 S:IBJ $P( IBSS,U,IBP C,IBPC+1)= ($P(IBLN,U ,IBJ)_U) S $P(IBSS,U ,7)=($$GET MOD^IBEFUN C(IBIFN,IB I)_U) ;Mod ifiers ;IB *547/TAZ - IBDXI not defined, use intern al DX poin ter I '$G( IBNWPTCH) F IBJ=11:1 :14 I $P(I BLN,U,IBJ) S $P(IBSS ,U,4)=$P(I BSS,U,4)_$ S(IBJ>11:" ,",1:"")_$ G(IBDXI(+$ P(IBLN,U,I BJ))) ; dx I $G(IBNW PTCH) F IB J=11:1:14 S IBX=$P(I BLN,U,IBJ) I IBX S $ P(IBSS,U,4 )=$P(IBSS, U,4)_$S(IB J>11:",",1 :"")_$G(IB DXI(IBX),I BX) ; dx S $P(IBSS,U ,10)=$P(IB LN,U,16),$ P(IBSS,U,9 )=$P(IBLN, U,19),$P(I BSS,U,11)= +$P(IBLN,U ,17) G:'$G (IBNWPTCH) IBSSX ;IB *547/TAZ - Add addit ional fiel ds for rol l-up compa re S $P(IB SS,U,21)=$ $GET1^DIQ( 399.0304,I BI_","_IBI FN_",","AS SOCIATED C LINIC","I" ) S $P(IBS S,U,22)=$$ GET1^DIQ(3 99.0304,IB I_","_IBIF N_",","TYP E OF SERVI CE","I") S $P(IBSS,U ,23)=$$GET 1^DIQ(399. 0304,IBI_" ,"_IBIFN_" ,","ATTACH MENT CONTR OL NUMBER" ,"I") S $P (IBSS,U,24 )=$$GET1^D IQ(399.030 4,IBI_","_ IBIFN_",", "NDC","I") S $P(IBSS ,U,25)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","PROC EDURE DESC RIPTION"," I") S $P(I BSS,U,26)= $$GET1^DIQ (399.0304, IBI_","_IB IFN_",","A DDITIONAL OB MINUTES ","I") ;Ad d Provider info in p ieces 41-4 9 M IBLPAR =^DGCR(399 ,IBIFN,"CP ",IBI,"LNP RV") F S IBLPI=$O(I BLPAR(IBLP I)) Q:'IBL PI S IBX= IBLPAR(IBL PI,0),$P(I BSS,U,40+I BX)=$TR(IB X,"^","~") K IBLPARI BSSX ; Q I BSS ;IBNWP TCH(IBIFN, IBPATCH) ; ;Checks t he date th e primary claim was 1st transm itted and returns 1 if the tra nsmitted d ate is aft er the pat ch ;refere nced in va riable IBP ATCH was r eleased. T his allows the MRA/E OBs return ing to rol l up proce dures the same ;way as they we nt out. Ot herwise th e order ch anges and the MRA/EO B won't ma tch up. ; N IBARY,IB IDT,IBPFN, IBEFN,IBBN ,IBX,IBBDT S IBX=0 I $$INSTALD T^XPDUTL(I BPATCH,.IB ARY) D ; ICR 10141 . S IBX=1 . S IBIDT= $O(IBARY(" ")) . ; Ge t Primary Bill Numbe r. This wi ll insure COB data i s consiste nt across all bills. . S IBPFN =$$GET1^DI Q(399,IBIF N_",","PRI MARY BILL #","I") I 'IBPFN S I BPFN=IBIFN . ; Find 1st Accept ed Entry ( A1, A2, or Z) of Pri mary Bill in EDI TRA NSMIT BILL FILE (364 ) to deter mine Batch Number . S (IBEFN,I BBN)=0 F S IBEFN=$O (^IBA(364, "B",IBPFN, IBEFN)) Q: 'IBEFN D I IBBN Q .. I ",A1, A2,Z,"'[(" ,"_$$GET1^ DIQ(364,IB EFN_",","T RANSMISSIO N STATUS", "I")_",") Q .. S IBB N=$$GET1^D IQ(364,IBE FN_",","BA TCH NUMBER ","I") . ; Retrieve t he date th e batch wa s 1st sent . If IBBN= "" IBBDT w ill be nul l . S IBBD T=$$GET1^D IQ(364.1,$ $GET1^DIQ( 364,IBBN_" ,","BATCH NUMBER","I ")_",","DA TE FIRST S ENT","I") . I IBBDT, (IBBDT<IBI DT) S IBX= 0 Q IBX | |
| 434 | Modified L ogic (Chan ges are in bold) | |
| 435 | IBCF23A ;A LB/ARH - H CFA 1500 1 9-90 DATA - Split fr om IBCF23 ;12-JUN-93 ;;2.0;INT EGRATED BI LLING;**51 ,432,516,5 47,577,592 **;21-MAR- 94;Build 1 ;;Per VA Directive 6402, this routine s hould not be modifie d. ; ; $$I NSTALDT^XP DUTL(IBPAT CH,.IBARY) - ICR 101 41 ;B24 ; set indivi dual entri es in prin t array, e xternal fo rmat ; IBA UX = addit ional data for EDI o utput ; IB RXF = arra y of RX pr ocedures ; JWS;IB*2.0 *592;US131 ; IBDEN = Dental da ta for EDI output ; IBDEN1 = a rray of De ntal data for EDI ou tput N IBX ,Z,IBD1,IB D2,IBCPLIN K S IBI=IB I+1,IBPROC =$P(IBSS,U ,2),IBD1=$ $DATE^IBCF 23(IBDT1), IBD2=$S(IB DT1'=IBDT2 :$$DATE^IB CF23(IBDT2 ),1:"") I '$D(IBXIEN ) S IBD1=$ E(IBD1,5,8 )_$E(IBD1, 1,4),IBD2= $E(IBD2,5, 8)_$E(IBD2 ,1,4) S IB FLD(24,IBI )=IBD1_U_I BD2_U_$P($ G(^IBE(353 .1,+$P(IBS S,U,6),0)) ,U)_U_$P($ G(^IBE(353 .2,+$P(IBS S,U,7),0)) ,U) I +IBP ROC D . S IBFLD(24,I BI)=IBFLD( 24,IBI)_U_ $P($$PRCD^ IBCEF1(IBP ROC,1),U,2 ) S:$P(IBP ROC,";",2) '["ICPT" I BFLD(24,IB I_"X")="" I 'IBPROC S IBFLD(24 ,IBI)=IBFL D(24,IBI)_ U_$S('$D(I BXIEN):IBP ROC,1:+IBR EV),IBFLD( 24,IBI_"A" )=$P($G(^D GCR(399.2, +IBREV,0)) ,U,2) I $D (IBRXF),IB CHARG="" S IBFLD(24, IBI_"A")=$ P($G(^DGCR (399.2,+IB REV,0)),U, 2) S IBFLD (24,IBI)=I BFLD(24,IB I)_U_$P(IB SS,U,5)_U_ IBCHARG_U_ IBUNIT_U_$ P(IBSS,U,8 )_U_$G(IBP CHG)_U_$G( IBMIN)_U_$ G(IBEMG) I $D(IBSS(" L")) S Z=0 F S Z=$O (IBSS("L", Z)) Q:'Z S IBFLD(24 ,IBI,$P(IB SS("L",Z), U),$P(IBSS ("L",Z),U, 2))=$G(IBF LD(24,IBI, $P(IBSS("L ",Z),U),$P (IBSS("L", Z),U,2)))+ 1 S:$TR($G (IBAUX),U) '="" IBFLD (24,IBI,"A UX")=$G(IB AUX) S:$D( IBRXF) IBF LD(24,IBI, "RX")=IBRX F K IBPROC ,IBSS("L") S IBCPLIN K=$P(IBSS, U,$L(IBSS, U)) S IBFL D(24,IBI)= IBFLD(24,I BI)_U_IBCP LINK ; MRD ;IB*2.0*51 6 - Added NDC and Un its to lin e level of claim. ;I IBCPLINK' ="" S $P(I BFLD(24,IB I),U,14,15 )=$TR($P($ G(^DGCR(39 9,IBIFN,"C P",IBCPLIN K,1)),U,7, 8),"-") ; vd/Beginni ng of IB*2 *577 - Add ed Unit/Ba sis of Mea surment to line leve l of claim . I IBCPLI NK'="" S $ P(IBFLD(24 ,IBI),U,14 ,16)=$TR($ P($G(^DGCR (399,IBIFN ,"CP",IBCP LINK,1)),U ,7,8),"-") _U_$P($G(^ DGCR(399,I BIFN,"CP", IBCPLINK,2 )),U) ; vd /End of IB *2*577 ;JW S;IB*2.0*5 92;US131 I $G(IBDEN) '="" S IBF LD(24,IBI, "DEN")=$G( IBDEN) I $ D(IBDEN1) M IBFLD(24 ,IBI,"DEN1 ")=IBDEN1 ;end ;JWS; IB*2.0*592 ;US131 Q ; AUXOK(IBSS ,IBSS1) ; Check all other flds are the s ame to com bine procs ; IBSS = subscript of IBCP to check for dups to c ombine - p ass by ref ; IBSS(IB SS,"AUX-X" ,n) = all the previo usly extra cted line items for the ; same set of ba sic data, but having different "AUX" dat a ; IBSS1 = the "AUX " data of the curren t IBCP ent ry ; ; Ret urns entry # in IBSS array if match foun d, or 0 if no match ; Set the IBSS "AUX- X" node fo r no match N Z,Z0 S Z=0 F S Z =$O(IBSS(I BSS,"AUX-X ",Z)) Q:'Z I IBSS1= IBSS(IBSS, "AUX-X",Z) Q I 'Z S Z0=+$O(IBS S(IBSS,"AU X-X",""),- 1)+1,IBSS( IBSS,"AUX- X",Z0)=IBS S1 Q +Z ;P RC ; Extra ct procedu re data fo r HCFA 150 0 ; IBRC(I BSS) = #re v codes wi th same bi lling crit eria (IBSS ) ; IBLINK ('CP' ien, 'RC' ien) = IBSS inc luding mod ifiers,rx seq in pc 7,8 ; IBLI NK1(IBSS, 'RC' ien) = auto (1) ^ 'CP' ien (soft lin k) ; ; pro c array w/ chrg ;JWS; IB*2.0*592 ;US131 N I BPR,IBP,IB DENLN S IB I=0 F S I BI=$O(^DGC R(399,IBIF N,"CP",IBI )) Q:'IBI S IBLN=^( IBI,0),IBA UXLN=$G(^( "AUX")),IB DENLN=$G(^ ("DEN")) D . I $O(^D GCR(399,IB IFN,"CP",I BI,"DEN1", 0)) M IBDE NLN("DEN1" )=^DGCR(39 9,IBIFN,"C P",IBI,"DE N1") . ;en d ;JWS;IB* 2.0*592;US 131 . N Z, Z0,Z1,Q1 . S IBPDT=$ P(IBLN,U,2 ) . S IBSS =$$IBSS(IB I,.IBDXI,I BLN) . S I BPO=$S($P( IBLN,U,4): +$P(IBLN,U ,4),1:IBI+ 1000) ;Set print ord er . S IBC P(IBPO)=IB PDT_"^"_IB SS,IBCP(IB PO,"AUX")= IBAUXLN . S IBCP(IBP O,"LNK")=I BI . ;JWS; IB*2.0*592 ;US131 . I $G(IBDENL N)'="" S I BCP(IBPO," DEN")=IBDE NLN . I $O (IBDENLN(" DEN1",0)) M IBCP(IBP O,"DEN1")= IBDENLN("D EN1") . ;e nd ;JWS;IB *2.0*592;U S131 . ; R x . N IBZ, IBITEM . S IBZ=$S($P (IBSS,U):$ P(IBSS,U), 1:"") . I IBZ'="",$D (IBLINKRX( IBZ,IBI)) D Q:IBCHA RG'="" .. S IBPO1=IB PO .. S IB ITEM=+$O(I BLINKRX(IB Z,IBI,0)), IBRV=$G(IB LINKRX(IBZ ,IBI,IBITE M)) .. Q:$ S(IBRV="": 1,1:'$G(IB RC(IBRV))) .. S IBCH ARG=$P(IBR V,U,6),IBR C(IBRV)=IB RC(IBRV)-1 .. S $P(I BCP(IBPO1) ,U,9)=IBCH ARG,IBCP(I BPO1,"RX") =IBITEM K IBLINKRX(I BZ,IBI,IBI TEM) . ; f ind chrgs directly l inked to p roc . S IB K=0 F S I BK=$O(IBLI NK(IBI,IBK )) Q:'IBK S IBRV1=I BLINK(IBI, IBK),IBRV= $P(IBRV1,U ,1,6) I +I BRC(IBRV1) D .. S IB CHARG=$P(I BRV,U,6),I BRC(IBRV1) =IBRC(IBRV 1)-1 .. I IBCHARG'=" " S $P(IBS S,U,8)=IBC HARG,IBCP( IBPO)=IBPD T_"^"_IBSS ,IBPO=IBPO +.1 ; ; ad d chrgs as sociated w ith a proc (not a di rect link) ; find ch rg associa ted with p roc, if an y (match p roc,div,+/ -basc) K I BP(0) F IB P=3,2 Q:$D (IBP(0)) S IBPO="" F S IBPO=$ O(IBCP(IBP O)) Q:'IBP O I $P(IB CP(IBPO),U ,9)="" D . S IBSS=$P (IBCP(IBPO ),U,2,9) . S IBCHARG ="",(IBRV, IBSS)=$P(I BSS,U,1,IB P) F S IB RV=$O(IBRC (IBRV)) Q: $P(IBRV,U, 1,IBP)'=IB SS S IBP( 0)=0 I +IB RC(IBRV) D Q .. S I BCHARG=$P( IBRV,U,6), IBRC(IBRV) =IBRC(IBRV )-1 .. I I BRC(IBRV) S Z=0 F S Z=$O(IBCP (IBPO,Z)) Q:'Z S IB RC(IBRV)=I BRC(IBRV)- 1 . S $P(I BCP(IBPO), U,9)=IBCHA RG . I IBC HARG'="" S Z=$O(IBLI NK1(IBRV,0 )) I Z S I BCP(IBPO," L",Z)=IBLI NK1(IBRV,Z ) K IBLINK 1(IBRV,Z) ; ; add ch rgs not as sociated w ith a proc to first proc with no chrg ; Aggggh!!! TP S IBPO= "" F S IB PO=$O(IBCP (IBPO)) Q: 'IBPO I $ P(IBCP(IBP O),U,9)="" D . S IBC HARG="",IB RV="^" F S IBRV=$O( IBRC(IBRV) ) Q:IBRV=" "!+IBRV I +IBRC(IBR V) D Q .. S IBCHARG =$P(IBRV,U ,6),IBRC(I BRV)=IBRC( IBRV)-1 .. S Z=$O(IB LINK1(IBRV ,0)) I Z S IBCP(IBPO ,"L",Z)=IB LINK1(IBRV ,Z) K IBLI NK1(IBRV,Z ) . S $P(I BCP(IBPO), U,9)=IBCHA RG ; QIBSS (IBI,IBDXI ,IBLN) ; C reates ind ex sequenc e for proc edure N IB PC,IBJ,IBS S,IBLPI,IB X,IBLPAR S (IBPC,IBL PI)=0 F IB J=1,6,5,0, 9,10 S IBP C=IBPC+1 S :IBJ $P(IB SS,U,IBPC, IBPC+1)=($ P(IBLN,U,I BJ)_U) S $ P(IBSS,U,7 )=($$GETMO D^IBEFUNC( IBIFN,IBI) _U) ;Modif iers ;IB*5 47/TAZ - I BDXI not d efined, us e internal DX pointe r I '$G(IB NWPTCH) F IBJ=11:1:1 4 I $P(IBL N,U,IBJ) S $P(IBSS,U ,4)=$P(IBS S,U,4)_$S( IBJ>11:"," ,1:"")_$G( IBDXI(+$P( IBLN,U,IBJ ))) ; dx I $G(IBNWPT CH) F IBJ= 11:1:14 S IBX=$P(IBL N,U,IBJ) I IBX S $P( IBSS,U,4)= $P(IBSS,U, 4)_$S(IBJ> 11:",",1:" ")_$G(IBDX I(IBX),IBX ) ; dx S $ P(IBSS,U,1 0)=$P(IBLN ,U,16),$P( IBSS,U,9)= $P(IBLN,U, 19),$P(IBS S,U,11)=+$ P(IBLN,U,1 7) G:'$G(I BNWPTCH) I BSSX ;IB*5 47/TAZ - A dd additio nal fields for roll- up compare S $P(IBSS ,U,21)=$$G ET1^DIQ(39 9.0304,IBI _","_IBIFN _",","ASSO CIATED CLI NIC","I") S $P(IBSS, U,22)=$$GE T1^DIQ(399 .0304,IBI_ ","_IBIFN_ ",","TYPE OF SERVICE ","I") S $ P(IBSS,U,2 3)=$$GET1^ DIQ(399.03 04,IBI_"," _IBIFN_"," ,"ATTACHME NT CONTROL NUMBER"," I") S $P(I BSS,U,24)= $$GET1^DIQ (399.0304, IBI_","_IB IFN_",","N DC","I") S $P(IBSS,U ,25)=$$GET 1^DIQ(399. 0304,IBI_" ,"_IBIFN_" ,","PROCED URE DESCRI PTION","I" ) S $P(IBS S,U,26)=$$ GET1^DIQ(3 99.0304,IB I_","_IBIF N_",","ADD ITIONAL OB MINUTES", "I") ;Add Provider i nfo in pie ces 41-49 M IBLPAR=^ DGCR(399,I BIFN,"CP", IBI,"LNPRV ") F S IB LPI=$O(IBL PAR(IBLPI) ) Q:'IBLPI S IBX=IB LPAR(IBLPI ,0),$P(IBS S,U,40+IBX )=$TR(IBX, "^","~") K IBLPARIBS SX ; Q IBS S ;IBNWPTC H(IBIFN,IB PATCH) ; ; Checks the date the primary cl aim was 1s t transmit ted and re turns 1 if the trans mitted dat e is after the patch ;referenc ed in vari able IBPAT CH was rel eased. Thi s allows t he MRA/EOB s returnin g to roll up procedu res the sa me ;way as they went out. Othe rwise the order chan ges and th e MRA/EOB won't matc h up. ; N IBARY,IBID T,IBPFN,IB EFN,IBBN,I BX,IBBDT S IBX=0 I $ $INSTALDT^ XPDUTL(IBP ATCH,.IBAR Y) D ;IC R 10141 . S IBX=1 . S IBIDT=$O (IBARY("") ) . ; Get Primary Bi ll Number. This will insure CO B data is consistent across al l bills. . S IBPFN=$ $GET1^DIQ( 399,IBIFN_ ",","PRIMA RY BILL #" ,"I") I 'I BPFN S IBP FN=IBIFN . ; Find 1s t Accepted Entry (A1 , A2, or Z ) of Prima ry Bill in EDI TRANS MIT BILL F ILE (364) to determi ne Batch N umber . S (IBEFN,IBB N)=0 F S IBEFN=$O(^ IBA(364,"B ",IBPFN,IB EFN)) Q:'I BEFN D I IBBN Q .. I ",A1,A2 ,Z,"'[("," _$$GET1^DI Q(364,IBEF N_",","TRA NSMISSION STATUS","I ")_",") Q .. S IBBN= $$GET1^DIQ (364,IBEFN _",","BATC H NUMBER", "I") . ;Re trieve the date the batch was 1st sent. If IBBN="" IBBDT wil l be null . S IBBDT= $$GET1^DIQ (364.1,$$G ET1^DIQ(36 4,IBBN_"," ,"BATCH NU MBER","I") _",","DATE FIRST SEN T","I") . I IBBDT,(I BBDT<IBIDT ) S IBX=0 Q IBX | |
| 436 | ||
| 437 | Routines | |
| 438 | Activities | |
| 439 | Routine Na me | |
| 440 | IBJTCA1 | |
| 441 | Enhancemen t Category | |
| 442 | New | |
| 443 | Modify | |
| 444 | Delete | |
| 445 | No Change | |
| 446 | RTM | |
| 447 | ||
| 448 | Related Op tions | |
| 449 | None | |
| 450 | Related Ro utines | |
| 451 | Routines “ Called By” | |
| 452 | Routines “ Called” | |
| 453 | ||
| 454 | ||
| 455 | ||
| 456 | ||
| 457 | Data Dicti onary (DD) Reference s | |
| 458 | BILL/CLAIM S [#399] | |
| 459 | Related Pr otocols | |
| 460 | None | |
| 461 | Related In tegration Control Re gistration s (ICRs) | |
| 462 | None | |
| 463 | Data Passi ng | |
| 464 | Input | |
| 465 | Output Re ference | |
| 466 | Both | |
| 467 | Global Re ference | |
| 468 | Local | |
| 469 | Input Attr ibute Name and Defin ition | |
| 470 | Name: | |
| 471 | Definition : | |
| 472 | Output Att ribute Nam e and Defi nition | |
| 473 | Name: | |
| 474 | Definition : | |
| 475 | Current Lo gic | |
| 476 | IBJTCA1 ;A LB/ARH - T PI CLAIMS INFO BUILD ;10/31/07 14:17 ;;2 .0;INTEGRA TED BILLIN G;**39,80, 106,137,22 3,276,363, 384,432,45 2,473,497, 521,516**; 21-MAR-94; Build 123 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ;BLD ; b uild array for Third Party Joi nt Inquiry Claims In fo screen, IBIFN mus t be defin ed ; N X,I BY,IBZ,IBZ 0,IBI,IBT, IBD,IBLN,I BLR,IBD0,I BDI1,IBDM, IBDM1,IBDU ,IBDS,IBDU 2,IBID0,IB ID13,IBNC, IBTC,IBTW, IBSW,IBGRP B,IBGRPE,I BWNR,IBDTX ,IBBX19,IB PRVO,IBNAB P,IBLVL,IB CNT,IBPRVT YP,IBVL N IBXSAVE ; IB*2.0*47 3 bi S VAL MCNT=0,X=" ",IBD0=$G( ^DGCR(399, +$G(IBIFN) ,0)) I IBD 0="" S VAL MQUIT="" G BLDQ F IB I="M","M1" ,"U","S"," U2","TX" S @("IBD"_I BI)=$G(^DG CR(399,+IB IFN,IBI)) S IBDI1=$P (IBD0,U,21 ),IBDI1=$S (IBDI1="S" :2,IBDI1=" T":3,1:1) S IBDI1=$$ POLICY^IBC EF(IBIFN,, IBDI1) S I BID0=$G(^D IC(36,+IBD I1,0)),IBI D13=$G(^DI C(36,+IBDI 1,.13)) ; S (IBLN,VA LMCNT)=1 ; ; MRD;IB* 2.0*516 - Try to mak e the foll owing more readable; also ; ad ded IBTC(7 ), IBTW(7) and IBSW( 7). ;IB*2. 0*432/TAZ - Added IB TW(6) and IBSW(6) ;S (IBNC(1), IBTC(1),IB TC(4),IBTC (6))=2,IBT C(5)=78,(I BNC(2),IBT C(2))=42,I BNC(3)=35, IBTW(1)=15 ,IBTW(2)=1 6,IBTW(4)= 12,IBTW(5) =1,IBTW(6) =20,IBSW(1 )=23,IBSW( 2)=21,IBSW (4)=60,IBS W(5)=1,IBS W(6)=49 ; S IBNC(1)= 2,IBTC(1)= 2,IBTW(1)= 15,IBSW(1) =23 S IBNC (2)=42,IBT C(2)=42,IB TW(2)=16,I BSW(2)=21 S IBNC(3)= 35 S IBTC( 4)=2,IBTW( 4)=12,IBSW (4)=60 S I BTC(5)=78, IBTW(5)=1, IBSW(5)=1 S IBTC(6)= 2,IBTW(6)= 20,IBSW(6) =49 S IBTC (7)=2,IBTW (7)=20,IBS W(7)=58 ; S IBLR=1 ; S IBT="In surance De mographics " S IBLN=$ $SETN(IBT, IBLN,IBLR, 1) S IBWNR =$$WNRBILL ^IBEFUNC(I BIFN) S IB NABP=$$NAB P^IBNCPDPU (IBIFN) S IBT=$S(IBW NR:" *",1: " ")_"Bill Payer: ", IBD=$P(IBI D0,U,1) S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBT="Cla im Address : " D S I BD=$P(IBDM ,U,5) S IB LN=$$SET(I BT,IBD,IBL N,IBLR) . I $P(IBID0 ,U,1)'=$P( IBDM,U,4) S IBD=$P(I BDM,U,4) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT="" I $P(IBDM, U,6)'="" S IBT="",IB D=$P(IBDM, U,6) S IBL N=$$SET(IB T,IBD,IBLN ,IBLR) I $ P(IBDM1,U, 1)'="" S I BT="",IBD= $P(IBDM1,U ,1) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="",IBD=$ P(IBDM,U,7 ),IBD=IBD_ $S(IBD'="" :", ",1:"" )_$P($G(^D IC(5,+$P(I BDM,U,8),0 )),U,2)_" "_$P(IBDM, U,9),IBLN= $$SET(IBT, IBD,IBLN,I BLR) S IBT ="Claim Ph one: ",IBD =$P($$BADD ^IBJTU3(+I BIFN),U,2) S IBLN=$$ SET(IBT,IB D,IBLN,IBL R) S IBLN= $$SET(""," ",IBLN,5) ; ; MRD;IB *2.0*516 - Use an IB LR of 7 fo r this sec tion, then reset bel ow. S IBLR =7 S IBT=" Subscriber Demograph ics" S IBL N=$$SETN(I BT,IBLN,1, 1) S IBT=" Group Numb er: ",IBD= $P(IBDI1,U ,3) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="Group N ame: ",IBD =$P(IBDI1, U,15) S IB LN=$$SET(I BT,IBD,IBL N,IBLR) S IBT="Subsc riber ID: ",IBD=$P(I BDI1,U,2) S IBLN=$$S ET(IBT,IBD ,IBLN,IBLR ) S IBT="E mployer: " ,IBD=$$EMP L(+DFN) S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBT="Ins ured's Nam e: ",IBD=$ P(IBDI1,U, 17) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="Relatio nship: ",I BD=$$EXSET ^IBJU1($P( IBDI1,U,16 ),2.312,16 ) S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) S IBLR =1 ; S (IB NC(1),IBTC (1))=2,(IB NC(2),IBTC (2))=42,IB NC(3)=29,I BTW(1)=12, IBTW(2)=16 ,IBSW(1)=2 6,IBSW(2)= 22 S (IBT, IBD)="" S IBLN=$$SET (IBT,IBD,I BLN,IBLR) ; I $$FT^I BCEF(IBIFN )=2 D . N IBXDATA,IB XSAVE K ^T MP("IBXSAV E",$J) . D F^IBCEF(" N-HCFA 150 0 BOX 19", ,,IBIFN) . I IBXDATA '="" S IBB X19(1)=$E( IBXDATA,1, 40) S:$E(I BXDATA,41, $L(IBXDATA ))'="" IBB X19(2)=$E( IBXDATA,41 ,$L(IBXDAT A)) ; S IB GRPB=IBLN, IBLR=1 S I BT="Claim Informatio n" S IBLN= $$SETN(IBT ,IBLN,3,1) S IBT="Bi ll Type: " ,IBD=$$EXS ET^IBJU1($ P(IBD0,U,5 ),399,.05) S IBLN=$$ SET(IBT,IB D,IBLN,IBL R) S IBT=" Time Frame : ",IBD=$$ EXSET^IBJU 1($P(IBD0, U,6),399,. 06) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="Rate Ty pe: ",IBD= $P($G(^DGC R(399.3,+$ P(IBD0,U,7 ),0)),U,1) S IBLN=$$ SET(IBT,IB D,IBLN,IBL R) S IBT=" AR Status: ",IBD=$P( $$ARSTATA^ IBJTU4(IBI FN),U,1) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT=" S equence: " ,IBD=$P($$ EXSET^IBJU 1($P(IBD0, U,21),399, .21)," ",1 ) S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) S IBT= "Purch Svc : ",IBD=$S ($P(IBDU2, U,11)="":" NO",1:$$EX PAND^IBTRE (399,233,$ P(IBDU2,U, 11))),IBLN =$$SET(IBT ,IBD,IBLN, 4) I $P(IB DM1,"^",8) S IBT=" E CME No: ", IBD=$P($P( IBDM1,"^", 8),";",1), IBLN=$$SET (IBT,IBD,I BLN,IBLR) I $L($P(IB DM1,"^",9) ) S IBT="E CME Ap No: ",IBD=$P( IBDM1,"^", 9),IBLN=$$ SET(IBT,IB D,IBLN,IBL R) I IBNAB P'="" S IB T=$S(($L($ TR(IBNABP, " ",""))=7 ):" NCPDP No: ",1:" NPI: "),IB D=IBNABP,I BLN=$$SET( IBT,IBD,IB LN,IBLR) ; IB*2.0*52 1 add Clai m HPID to display S IBD=$S($P( IBD0,U,21) ="P":$P(IB DM1,U,13), $P(IBD0,U, 21)="S":$P (IBDM1,U,1 4),$P(IBD0 ,U,21)="T" :$P(IBDM1, U,15),1:"" ) S:IBD="" IBD=$$HPD ^IBCNHUT1( +IBDI1) S IBVL=$$HOD ^IBCNHUT1( IBD,+IBDI1 ,IBD) S IB T=$P(IBVL, U,2)_": ", IBLN=$$SET (IBT,IBD,I BLN,IBLR) I IBWNR S IBT="MRA S tatus: ",I BD=$S($P(I BDTX,U,5): $P(IBDTX,U ,5),1:"NOT RECEIVED" ),IBLN=$$S ET(IBT,$S( IBD:$$EXPA ND^IBTRE(3 99,24,IBD) ,1:IBD),IB LN,IBLR) I $G(IBBX19 (1))'="" D . S IBT=" Box 19: " ,IBD=IBBX1 9(1),IBLN= $$SET(IBT, IBD,IBLN,I BLR) . I $ G(IBBX19(2 ))'="" S I BT=$J("",1 1),IBD=IBB X19(2),IBL N=$$SET(IB T,IBD,IBLN ,IBLR) ; S IBLR=6,IB PRVO="" S IBT="Provi ders: ",IB D="NONE" ; IB*2.0*432 /TAZ - Cha nged how p roviders a re display ed to take line-leve l provider s into acc ount. ;D F ^IBCEF("N- ALL PROVID ERS","IBZ" ,,IBIFN) D F^IBCEF(" N-ALL PROV IDERS 1"," IBZ",,IBIF N) S IBZ0= 0 S IBLVL= 0 ;F S Z=$ O(IBZ(Z)) Q:'Z D ;. I $G(IBZ(Z )),$G(IBZ( Z,1))'="" S IBLN=$$S ET(IBT,"(O LD PROV DA TA) "_IBZ( Z,1),IBLN, IBLR),IBZ0 =1 Q ;. I $P($G(IBZ( Z,1)),U)'= "" S IBD=$ E($$EXPAND ^IBTRE(399 .0222,.01, Z)_":"_$J( "",15),1,1 5)_$P(IBZ( Z,1),U)_$S ($P(IBZ(Z, 1),U,4)'=" ":" ("_$P( IBZ(Z,1),U ,4)_")",1: "") S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T=$J("",11 ),IBZ0=1 ; I 'IBZ0 S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBLVL=0 F S IBLVL =$O(IBZ(IB LVL)) Q:'I BLVL D . S IBT=IBT_ $S(IBLVL=1 :"Claim: " ,1:"Line: ") . S IBP RVTYP="",I BCNT=0 . F S IBCNT= $O(IBZ(IBL VL,IBCNT)) Q:'IBCNT D .. I IB LVL=1 S IB D=$J("",5) .. I IBLV L=2 S IBD= $E("("_IBC NT_")"_$J( "",5),1,5) .. F S I BPRVTYP=$O (IBZ(IBLVL ,IBCNT,IBP RVTYP)) Q: 'IBPRVTYP D ... S I BD=IBD_$E( $$EXPAND^I BTRE(399.0 222,.01,IB PRVTYP)_": "_$J("",15 ),1,15) .. . S IBD=IB D_$P(IBZ(I BLVL,IBCNT ,IBPRVTYP) ,U) ... I $L($P(IBZ( IBLVL,IBCN T,IBPRVTYP ),U,4)) S IBD=IBD_" ("_$P(IBZ( IBLVL,IBCN T,IBPRVTYP ),U,4)_")" ... S IBL N=$$SET(IB T,IBD,IBLN ,IBLR),IBT ="",IBD=$J ("",5) ; S IBGRPE=IB LN,IBLN=IB GRPB+1,IBL R=2 ; S IB T="Charge Type: ",IB D=$$EXSET^ IBJU1($P(I BD0,U,27), 399,.27) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT="Se rvice Date s: ",IBD=$ $DATE^IBJU 1($P(IBDU, U,1))_" - "_$$DATE^I BJU1($P(IB DU,U,2)) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT="Or ig Claim: ",IBD=$$BI LL^RCJIBFN 2(+IBIFN) S IBLN=$$S ET(IBT,$J( $P(IBD,U,1 ),9,2),IBL N,IBLR) S IBT="Balan ce Due: ", IBD=$J($P( IBD,U,3),9 ,2) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) I +$ P(IBDM,U,2 ) S IBX=$S ($P(IBD0,U ,21)="P":2 ,1:1) D S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) . S IBT=$ S(IBX=2:"S econdary", 1:"Primary ")_": ",IB D=$P($G(^D IC(36,+$P( IBDM,U,IBX ),0)),U,1) . S IBX=$ P(IBDU2,U, (IBX+3)) I +IBX S IB X="("_$J(I BX,0,2)_") " S IBD=$E (IBD,1,(IB SW(IBLR)-$ L(IBX)-2)) _" "_IBX I +$P(IBDM, U,3) S IBX =$S($P(IBD 0,U,21)="T ":2,1:3) D S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) . S IB T=$S(IBX=2 :"Secondar y",1:"Tert iary")_": ",IBD=$P($ G(^DIC(36, +$P(IBDM,U ,IBX),0)), U,1) . S I BX=$P(IBDU 2,U,(IBX+3 )) I +IBX S IBX="("_ $J(IBX,0,2 )_")" S IB D=$E(IBD,1 ,(IBSW(IBL R)-$L(IBX) -2))_" "_I BX S IBLN= $$SET(""," ",IBLN,5) I IBWNR S IBT="MRA R ec Date: " D S IBLN =$$SET(IBT ,IBD,IBLN, 2) . N Z . ; find la st MRA for receipt d ate . S (I BD,Z)="" F S Z=$O(^ IBM(361.1, "B",IBIFN, Z),-1) Q:' Z I $P($G (^IBM(361. 1,Z,0)),U, 4)=1 S IBD =$$DATE^IB JU1($P($P( ^IBM(361.1 ,Z,0),U,6) ,".")) Q F Z=IBLN:1: IBGRPE S I BLN=$$SET( "","",IBLN ,5) ; S (I BLN,VALMCN T)=$S(IBLN >IBGRPE:IB LN,1:IBGRP E) ; S IBG RPB=IBLN,I BLR=1 D CO NT^IBJTCA2 ;COPAY I $O(^IBA(36 2.4,"C",IB IFN,0)) D . S (IBT,I BD)="" S I BLN=$$SET( IBT,IBD,IB LN,IBLR) ; blank lin e . S IBNC (1)=21,IBT ="Related Prescripti on Copay I nformation " S IBLN=$ $SETN(IBT, IBLN,1,1) . N IBZ,IB X,IBC,IBCA P . S IBZ= 0 F S IBZ =$O(^IBA(3 62.4,"C",I BIFN,IBZ)) Q:'IBZ D .. K ^TMP ("IBTPJI", $J) .. S I BC=$G(^IBA (362.4,IBZ ,0)) .. D: $P(IBC,"^" ,5) RX^PSO 52API($P(I BD0,"^",2) ,"IBTPJI", $P(IBC,"^" ,5),"","I^ ") .. ; or iginal fil l .. I $P( IBC,"^",10 )=0 D ... S IBX=+$G( ^TMP($J,"I BTPJI",$P( IBD0,"^",2 ),+$P(IBC, "^",5),106 )),IBCAP=+ $G(^(106.6 )) .. ; re fills .. E D ... S IBX=+$G(^T MP($J,"IBT PJI",$P(IB D0,"^",2), +$P(IBC,"^ ",5),"IB", +$P(IBC,"^ ",10),9)), IBCAP=+$G( ^(9.1)) .. I '$G(IBX ),$G(IBCAP ) S IBT=" <copay exc eeded cap> ",IBLN=$$S ET(IBT,"", IBLN,4) Q .. I '$G(I BX) S IBT= " <none fo und>",IBLN =$$SET(IBT ,"",IBLN,4 ) Q .. S I BX=$G(^IB( IBX,0)) .. S IBT="Rx : "_$P(IBC ,"^")_" Ch g: $"_$FN( $P(IBX,"^" ,7),",",2) _" Status: "_$$TITLE ^XLFSTR($$ EXTERNAL^D ILFD(350,. 05,"",$P(I BX,"^",5)) )_" Bill: "_$P(IBX," ^",11) .. S IBLN=$$S ET(IBT,"", IBLN,4) K ^TMP("IBTP JI",$J) ; S (IBLN,VA LMCNT)=IBL N-1 ;BLDQ Q ;EMPL(DF N) ; retur ns employe r name Q $ P($G(^DPT( +DFN,.311) ),U,1) ;SE T(TTL,DATA ,LN,LR) ; N IBY S IB Y=$J(TTL,I BTW(LR))_D ATA D SET1 (IBY,LN,IB TC(LR),(IB TW(LR)+IBS W(LR))) S LN=LN+1 Q LN ;SETN(T TL,LN,LR,R V) ; N IBY S IBY=" " _TTL_" " D SET1(IBY, LN,IBNC(LR ),$L(IBY), $G(RV)) S LN=LN+1 Q LN ;SET1(S TR,LN,COL, WD,RV) ; s et up TMP array with screen da ta N IBX S IBX=$G(^T MP("IBJTCA ",$J,LN,0) ) S IBX=$$ SETSTR^VAL M1(STR,IBX ,COL,WD) D SET^VALM1 0(LN,IBX) I $G(RV)'= "" D CNTRL ^VALM10(LN ,COL,WD,IO RVON,IORVO FF) Q | |
| 477 | Modified L ogic (Chan ges are in bold) | |
| 478 | IBJTCA1 ;A LB/ARH - T PI CLAIMS INFO BUILD ;10/31/07 14:17 ;;2 .0;INTEGRA TED BILLIN G;**39,80, 106,137,22 3,276,363, 384,432,45 2,473,497, 521,516,59 2**;21-MAR -94;Build 123 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;BLD ; build a rray for T hird Party Joint Inq uiry Claim s Info scr een, IBIFN must be d efined ; N X,IBY,IBZ ,IBZ0,IBI, IBT,IBD,IB LN,IBLR,IB D0,IBDI1,I BDM,IBDM1, IBDU,IBDS, IBDU2,IBID 0,IBID13,I BNC,IBTC,I BTW,IBSW,I BGRPB,IBGR PE,IBWNR,I BDTX,IBBX1 9,IBPRVO,I BNABP,IBLV L,IBCNT,IB PRVTYP,IBV L N IBXSAV E ; IB*2. 0*473 bi S VALMCNT=0 ,X="",IBD0 =$G(^DGCR( 399,+$G(IB IFN),0)) I IBD0="" S VALMQUIT= "" G BLDQ F IBI="M", "M1","U"," S","U2","T X" S @("IB D"_IBI)=$G (^DGCR(399 ,+IBIFN,IB I)) S IBDI 1=$P(IBD0, U,21),IBDI 1=$S(IBDI1 ="S":2,IBD I1="T":3,1 :1) S IBDI 1=$$POLICY ^IBCEF(IBI FN,,IBDI1) S IBID0=$ G(^DIC(36, +IBDI1,0)) ,IBID13=$G (^DIC(36,+ IBDI1,.13) ) ; S (IBL N,VALMCNT) =1 ; ; MRD ;IB*2.0*51 6 - Try to make the following more reada ble; also ; added IB TC(7), IBT W(7) and I BSW(7). ;I B*2.0*432/ TAZ - Adde d IBTW(6) and IBSW(6 ) ;S (IBNC (1),IBTC(1 ),IBTC(4), IBTC(6))=2 ,IBTC(5)=7 8,(IBNC(2) ,IBTC(2))= 42,IBNC(3) =35,IBTW(1 )=15,IBTW( 2)=16,IBTW (4)=12,IBT W(5)=1,IBT W(6)=20,IB SW(1)=23,I BSW(2)=21, IBSW(4)=60 ,IBSW(5)=1 ,IBSW(6)=4 9 ; S IBNC (1)=2,IBTC (1)=2,IBTW (1)=15,IBS W(1)=23 S IBNC(2)=42 ,IBTC(2)=4 2,IBTW(2)= 16,IBSW(2) =21 S IBNC (3)=35 S I BTC(4)=2,I BTW(4)=12, IBSW(4)=60 S IBTC(5) =78,IBTW(5 )=1,IBSW(5 )=1 S IBTC (6)=2,IBTW (6)=20,IBS W(6)=49 S IBTC(7)=2, IBTW(7)=20 ,IBSW(7)=5 8 ; S IBLR =1 ; S IBT ="Insuranc e Demograp hics" S IB LN=$$SETN( IBT,IBLN,I BLR,1) S I BWNR=$$WNR BILL^IBEFU NC(IBIFN) S IBNABP=$ $NABP^IBNC PDPU(IBIFN ) S IBT=$S (IBWNR:" * ",1:" ")_" Bill Payer : ",IBD=$P (IBID0,U,1 ) S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) S IBT= "Claim Add ress: " D S IBD=$P( IBDM,U,5) S IBLN=$$S ET(IBT,IBD ,IBLN,IBLR ) . I $P(I BID0,U,1)' =$P(IBDM,U ,4) S IBD= $P(IBDM,U, 4) S IBLN= $$SET(IBT, IBD,IBLN,I BLR) S IBT ="" I $P(I BDM,U,6)'= "" S IBT=" ",IBD=$P(I BDM,U,6) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) I $P(IBDM 1,U,1)'="" S IBT="", IBD=$P(IBD M1,U,1) S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBT="",I BD=$P(IBDM ,U,7),IBD= IBD_$S(IBD '="":", ", 1:"")_$P($ G(^DIC(5,+ $P(IBDM,U, 8),0)),U,2 )_" "_$P(I BDM,U,9),I BLN=$$SET( IBT,IBD,IB LN,IBLR) S IBT="Clai m Phone: " ,IBD=$P($$ BADD^IBJTU 3(+IBIFN), U,2) S IBL N=$$SET(IB T,IBD,IBLN ,IBLR) S I BLN=$$SET( "","",IBLN ,5) ; ; MR D;IB*2.0*5 16 - Use a n IBLR of 7 for this section, then reset below. S IBLR=7 S I BT="Subscr iber Demog raphics" S IBLN=$$SE TN(IBT,IBL N,1,1) S I BT="Group Number: ", IBD=$P(IBD I1,U,3) S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBT="Gro up Name: " ,IBD=$P(IB DI1,U,15) S IBLN=$$S ET(IBT,IBD ,IBLN,IBLR ) S IBT="S ubscriber ID: ",IBD= $P(IBDI1,U ,2) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="Employe r: ",IBD=$ $EMPL(+DFN ) S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) S IBT= "Insured's Name: ",I BD=$P(IBDI 1,U,17) S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBT="Rel ationship: ",IBD=$$E XSET^IBJU1 ($P(IBDI1, U,16),2.31 2,16) S IB LN=$$SET(I BT,IBD,IBL N,IBLR) S IBLR=1 ; S (IBNC(1), IBTC(1))=2 ,(IBNC(2), IBTC(2))=4 2,IBNC(3)= 29,IBTW(1) =12,IBTW(2 )=16,IBSW( 1)=26,IBSW (2)=22 S ( IBT,IBD)=" " S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) ;JWS:I B*2.0*592: US131 - ad ded dental claim #7 I $$FT^IBC EF(IBIFN)= 2!($$FT^IB CEF(IBIFN) =7) D . N IBXDATA,IB XSAVE K ^T MP("IBXSAV E",$J) . D F^IBCEF(" N-HCFA 150 0 BOX 19", ,,IBIFN) . I IBXDATA '="" S IBB X19(1)=$E( IBXDATA,1, 40) S:$E(I BXDATA,41, $L(IBXDATA ))'="" IBB X19(2)=$E( IBXDATA,41 ,$L(IBXDAT A)) ; S IB GRPB=IBLN, IBLR=1 S I BT="Claim Informatio n" S IBLN= $$SETN(IBT ,IBLN,3,1) S IBT="Bi ll Type: " ,IBD=$$EXS ET^IBJU1($ P(IBD0,U,5 ),399,.05) S IBLN=$$ SET(IBT,IB D,IBLN,IBL R) S IBT=" Time Frame : ",IBD=$$ EXSET^IBJU 1($P(IBD0, U,6),399,. 06) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T="Rate Ty pe: ",IBD= $P($G(^DGC R(399.3,+$ P(IBD0,U,7 ),0)),U,1) S IBLN=$$ SET(IBT,IB D,IBLN,IBL R) S IBT=" AR Status: ",IBD=$P( $$ARSTATA^ IBJTU4(IBI FN),U,1) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT=" S equence: " ,IBD=$P($$ EXSET^IBJU 1($P(IBD0, U,21),399, .21)," ",1 ) S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) S IBT= "Purch Svc : ",IBD=$S ($P(IBDU2, U,11)="":" NO",1:$$EX PAND^IBTRE (399,233,$ P(IBDU2,U, 11))),IBLN =$$SET(IBT ,IBD,IBLN, 4) I $P(IB DM1,"^",8) S IBT=" E CME No: ", IBD=$P($P( IBDM1,"^", 8),";",1), IBLN=$$SET (IBT,IBD,I BLN,IBLR) I $L($P(IB DM1,"^",9) ) S IBT="E CME Ap No: ",IBD=$P( IBDM1,"^", 9),IBLN=$$ SET(IBT,IB D,IBLN,IBL R) I IBNAB P'="" S IB T=$S(($L($ TR(IBNABP, " ",""))=7 ):" NCPDP No: ",1:" NPI: "),IB D=IBNABP,I BLN=$$SET( IBT,IBD,IB LN,IBLR) ; IB*2.0*52 1 add Clai m HPID to display S IBD=$S($P( IBD0,U,21) ="P":$P(IB DM1,U,13), $P(IBD0,U, 21)="S":$P (IBDM1,U,1 4),$P(IBD0 ,U,21)="T" :$P(IBDM1, U,15),1:"" ) S:IBD="" IBD=$$HPD ^IBCNHUT1( +IBDI1) S IBVL=$$HOD ^IBCNHUT1( IBD,+IBDI1 ,IBD) S IB T=$P(IBVL, U,2)_": ", IBLN=$$SET (IBT,IBD,I BLN,IBLR) I IBWNR S IBT="MRA S tatus: ",I BD=$S($P(I BDTX,U,5): $P(IBDTX,U ,5),1:"NOT RECEIVED" ),IBLN=$$S ET(IBT,$S( IBD:$$EXPA ND^IBTRE(3 99,24,IBD) ,1:IBD),IB LN,IBLR) I $G(IBBX19 (1))'="" D . S IBT=" Box 19: " ,IBD=IBBX1 9(1),IBLN= $$SET(IBT, IBD,IBLN,I BLR) . I $ G(IBBX19(2 ))'="" S I BT=$J("",1 1),IBD=IBB X19(2),IBL N=$$SET(IB T,IBD,IBLN ,IBLR) ; S IBLR=6,IB PRVO="" S IBT="Provi ders: ",IB D="NONE" ; IB*2.0*432 /TAZ - Cha nged how p roviders a re display ed to take line-leve l provider s into acc ount. ;D F ^IBCEF("N- ALL PROVID ERS","IBZ" ,,IBIFN) D F^IBCEF(" N-ALL PROV IDERS 1"," IBZ",,IBIF N) S IBZ0= 0 S IBLVL= 0 ;F S Z=$ O(IBZ(Z)) Q:'Z D ;. I $G(IBZ(Z )),$G(IBZ( Z,1))'="" S IBLN=$$S ET(IBT,"(O LD PROV DA TA) "_IBZ( Z,1),IBLN, IBLR),IBZ0 =1 Q ;. I $P($G(IBZ( Z,1)),U)'= "" S IBD=$ E($$EXPAND ^IBTRE(399 .0222,.01, Z)_":"_$J( "",15),1,1 5)_$P(IBZ( Z,1),U)_$S ($P(IBZ(Z, 1),U,4)'=" ":" ("_$P( IBZ(Z,1),U ,4)_")",1: "") S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) S IB T=$J("",11 ),IBZ0=1 ; I 'IBZ0 S IBLN=$$SET (IBT,IBD,I BLN,IBLR) S IBLVL=0 F S IBLVL =$O(IBZ(IB LVL)) Q:'I BLVL D . S IBT=IBT_ $S(IBLVL=1 :"Claim: " ,1:"Line: ") . S IBP RVTYP="",I BCNT=0 . F S IBCNT= $O(IBZ(IBL VL,IBCNT)) Q:'IBCNT D .. I IB LVL=1 S IB D=$J("",5) .. I IBLV L=2 S IBD= $E("("_IBC NT_")"_$J( "",5),1,5) .. F S I BPRVTYP=$O (IBZ(IBLVL ,IBCNT,IBP RVTYP)) Q: 'IBPRVTYP D ... S I BD=IBD_$E( $$EXPAND^I BTRE(399.0 222,.01,IB PRVTYP)_": "_$J("",15 ),1,15) .. . S IBD=IB D_$P(IBZ(I BLVL,IBCNT ,IBPRVTYP) ,U) ... I $L($P(IBZ( IBLVL,IBCN T,IBPRVTYP ),U,4)) S IBD=IBD_" ("_$P(IBZ( IBLVL,IBCN T,IBPRVTYP ),U,4)_")" ... S IBL N=$$SET(IB T,IBD,IBLN ,IBLR),IBT ="",IBD=$J ("",5) ; S IBGRPE=IB LN,IBLN=IB GRPB+1,IBL R=2 ; S IB T="Charge Type: ",IB D=$$EXSET^ IBJU1($P(I BD0,U,27), 399,.27) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT="Se rvice Date s: ",IBD=$ $DATE^IBJU 1($P(IBDU, U,1))_" - "_$$DATE^I BJU1($P(IB DU,U,2)) S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) S IBT="Or ig Claim: ",IBD=$$BI LL^RCJIBFN 2(+IBIFN) S IBLN=$$S ET(IBT,$J( $P(IBD,U,1 ),9,2),IBL N,IBLR) S IBT="Balan ce Due: ", IBD=$J($P( IBD,U,3),9 ,2) S IBLN =$$SET(IBT ,IBD,IBLN, IBLR) I +$ P(IBDM,U,2 ) S IBX=$S ($P(IBD0,U ,21)="P":2 ,1:1) D S IBLN=$$SE T(IBT,IBD, IBLN,IBLR) . S IBT=$ S(IBX=2:"S econdary", 1:"Primary ")_": ",IB D=$P($G(^D IC(36,+$P( IBDM,U,IBX ),0)),U,1) . S IBX=$ P(IBDU2,U, (IBX+3)) I +IBX S IB X="("_$J(I BX,0,2)_") " S IBD=$E (IBD,1,(IB SW(IBLR)-$ L(IBX)-2)) _" "_IBX I +$P(IBDM, U,3) S IBX =$S($P(IBD 0,U,21)="T ":2,1:3) D S IBLN=$ $SET(IBT,I BD,IBLN,IB LR) . S IB T=$S(IBX=2 :"Secondar y",1:"Tert iary")_": ",IBD=$P($ G(^DIC(36, +$P(IBDM,U ,IBX),0)), U,1) . S I BX=$P(IBDU 2,U,(IBX+3 )) I +IBX S IBX="("_ $J(IBX,0,2 )_")" S IB D=$E(IBD,1 ,(IBSW(IBL R)-$L(IBX) -2))_" "_I BX S IBLN= $$SET(""," ",IBLN,5) I IBWNR S IBT="MRA R ec Date: " D S IBLN =$$SET(IBT ,IBD,IBLN, 2) . N Z . ; find la st MRA for receipt d ate . S (I BD,Z)="" F S Z=$O(^ IBM(361.1, "B",IBIFN, Z),-1) Q:' Z I $P($G (^IBM(361. 1,Z,0)),U, 4)=1 S IBD =$$DATE^IB JU1($P($P( ^IBM(361.1 ,Z,0),U,6) ,".")) Q F Z=IBLN:1: IBGRPE S I BLN=$$SET( "","",IBLN ,5) ; S (I BLN,VALMCN T)=$S(IBLN >IBGRPE:IB LN,1:IBGRP E) ; S IBG RPB=IBLN,I BLR=1 D CO NT^IBJTCA2 ;COPAY I $O(^IBA(36 2.4,"C",IB IFN,0)) D . S (IBT,I BD)="" S I BLN=$$SET( IBT,IBD,IB LN,IBLR) ; blank lin e . S IBNC (1)=21,IBT ="Related Prescripti on Copay I nformation " S IBLN=$ $SETN(IBT, IBLN,1,1) . N IBZ,IB X,IBC,IBCA P . S IBZ= 0 F S IBZ =$O(^IBA(3 62.4,"C",I BIFN,IBZ)) Q:'IBZ D .. K ^TMP ("IBTPJI", $J) .. S I BC=$G(^IBA (362.4,IBZ ,0)) .. D: $P(IBC,"^" ,5) RX^PSO 52API($P(I BD0,"^",2) ,"IBTPJI", $P(IBC,"^" ,5),"","I^ ") .. ; or iginal fil l .. I $P( IBC,"^",10 )=0 D ... S IBX=+$G( ^TMP($J,"I BTPJI",$P( IBD0,"^",2 ),+$P(IBC, "^",5),106 )),IBCAP=+ $G(^(106.6 )) .. ; re fills .. E D ... S IBX=+$G(^T MP($J,"IBT PJI",$P(IB D0,"^",2), +$P(IBC,"^ ",5),"IB", +$P(IBC,"^ ",10),9)), IBCAP=+$G( ^(9.1)) .. I '$G(IBX ),$G(IBCAP ) S IBT=" <copay exc eeded cap> ",IBLN=$$S ET(IBT,"", IBLN,4) Q .. I '$G(I BX) S IBT= " <none fo und>",IBLN =$$SET(IBT ,"",IBLN,4 ) Q .. S I BX=$G(^IB( IBX,0)) .. S IBT="Rx : "_$P(IBC ,"^")_" Ch g: $"_$FN( $P(IBX,"^" ,7),",",2) _" Status: "_$$TITLE ^XLFSTR($$ EXTERNAL^D ILFD(350,. 05,"",$P(I BX,"^",5)) )_" Bill: "_$P(IBX," ^",11) .. S IBLN=$$S ET(IBT,"", IBLN,4) K ^TMP("IBTP JI",$J) ; S (IBLN,VA LMCNT)=IBL N-1 ;BLDQ Q ;EMPL(DF N) ; retur ns employe r name Q $ P($G(^DPT( +DFN,.311) ),U,1) ;SE T(TTL,DATA ,LN,LR) ; N IBY S IB Y=$J(TTL,I BTW(LR))_D ATA D SET1 (IBY,LN,IB TC(LR),(IB TW(LR)+IBS W(LR))) S LN=LN+1 Q LN ;SETN(T TL,LN,LR,R V) ; N IBY S IBY=" " _TTL_" " D SET1(IBY, LN,IBNC(LR ),$L(IBY), $G(RV)) S LN=LN+1 Q LN ;SET1(S TR,LN,COL, WD,RV) ; s et up TMP array with screen da ta N IBX S IBX=$G(^T MP("IBJTCA ",$J,LN,0) ) S IBX=$$ SETSTR^VAL M1(STR,IBX ,COL,WD) D SET^VALM1 0(LN,IBX) I $G(RV)'= "" D CNTRL ^VALM10(LN ,COL,WD,IO RVON,IORVO FF) Q | |
| 479 | ||
| 480 | ||
| 481 | Routines | |
| 482 | Activities | |
| 483 | Routine Na me | |
| 484 | IBCNSC0 | |
| 485 | Enhancemen t Category | |
| 486 | New | |
| 487 | Modify | |
| 488 | Delete | |
| 489 | No Change | |
| 490 | RTM | |
| 491 | ||
| 492 | Related Op tions | |
| 493 | None | |
| 494 | Related Ro utines | |
| 495 | Routines “ Called By” | |
| 496 | Routines “ Called” | |
| 497 | ||
| 498 | ||
| 499 | ||
| 500 | ||
| 501 | Data Dicti onary (DD) Reference s | |
| 502 | ||
| 503 | Related Pr otocols | |
| 504 | None | |
| 505 | Related In tegration Control Re gistration s (ICRs) | |
| 506 | None | |
| 507 | Data Passi ng | |
| 508 | Input | |
| 509 | Output Re ference | |
| 510 | Both | |
| 511 | Global Re ference | |
| 512 | Local | |
| 513 | Input Attr ibute Name and Defin ition | |
| 514 | Name: | |
| 515 | Definition : | |
| 516 | Output Att ribute Nam e and Defi nition | |
| 517 | Name: | |
| 518 | Definition : | |
| 519 | Current Lo gic | |
| 520 | IBCNSC0 ;A LB/NLR - I NSURANCE C OMPANY EDI T - ;12-MA R-1993 ;;2 .0;INTEGRA TED BILLIN G;**371,54 7**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;CLA IMS1 ; dis play Inpat ient Claim s informat ion N OFFS ET,START,I BCNS12,IBA DD ;WCJ;IB *2.0*547 ; S START=27 ,OFFSET=2 S START=28 +(2*$G(IBA CMAX)),OFF SET=2 D SE T^IBCNSP(S TART,OFFSE T+20," Inp atient Cla ims Office Informati on ",IORVO N,IORVOFF) ; ;WCJ;IB *2.0*547;C all New AP I ;S IBCNS 12=$$ADDRE SS(IBCNS,. 12,5) S IB CNS12=$$AD D2(IBCNS,. 12,5) ; D SET^IBCNSP (START+1,O FFSET," Co mpany Name : "_$P($G( ^DIC(36,+$ P(IBCNS12, "^",7),0)) ,"^",1)) D SET^IBCNS P(START+2, OFFSET," S treet: "_$ P(IBCNS12, "^",1)) D SET^IBCNSP (START+3,O FFSET," St reet 2: "_ $P(IBCNS12 ,"^",2)) N OFFSET S OFFSET=45 D SET^IBCN SP(START+1 ,OFFSET," Street 3: "_$P(IBCNS 12,"^",3)) S IBADD=1 D SET^IBC NSP(START+ 1+IBADD,OF FSET," Cit y/State: " _$E($P(IBC NS12,"^",4 ),1,15)_$S ($P(IBCNS1 2,"^",4)=" ":"",1:", ")_$P($G(^ DIC(5,+$P( IBCNS12,"^ ",5),0))," ^",2)_" "_ $E($P(IBCN S12,"^",6) ,1,5)) D S ET^IBCNSP( START+2+IB ADD,OFFSET ," Phone: "_$P(IBCNS 12,"^",8)) D SET^IBC NSP(START+ 3+IBADD,OF FSET," Fax : "_$P(IBC NS12,"^",9 )) Q ;R1Q QCLAIMS2 ; display O utpatient Claims inf ormation ; N OFFSET, START,IBCN S16,IBADD ;WCJ;IB*2. 0*547 ;S S TART=34,OF FSET=2 S S TART=35+(2 *$G(IBACMA X)),OFFSET =2 D SET^I BCNSP(STAR T,OFFSET+2 0," Outpat ient Claim s Office I nformation ",IORVON, IORVOFF) ; ;WCJ;IB*2 .0*547;Cal l New API ;S IBCNS16 =$$ADDRESS (IBCNS,.16 ,6) S IBCN S16=$$ADD2 (IBCNS,.16 ,6) ; D SE T^IBCNSP(S TART+1,OFF SET," Comp any Name: "_$P($G(^D IC(36,+$P( IBCNS16,"^ ",7),0))," ^",1)) D S ET^IBCNSP( START+2,OF FSET," Str eet: "_$P( IBCNS16,"^ ",1)) D SE T^IBCNSP(S TART+3,OFF SET," Stre et 2: "_$P (IBCNS16," ^",2)) N O FFSET S OF FSET=45 D SET^IBCNSP (START+1,O FFSET," St reet 3: "_ $P(IBCNS16 ,"^",3)) S IBADD=1 D SET^IBCNS P(START+1+ IBADD,OFFS ET," City/ State: "_$ E($P(IBCNS 16,"^",4), 1,15)_$S($ P(IBCNS16, "^",4)="": "",1:", ") _$P($G(^DI C(5,+$P(IB CNS16,"^", 5),0)),"^" ,2)_" "_$E ($P(IBCNS1 6,"^",6),1 ,5)) D SET ^IBCNSP(ST ART+2+IBAD D,OFFSET," Phone: "_ $P(IBCNS16 ,"^",8)) D SET^IBCNS P(START+3+ IBADD,OFFS ET," Fax: "_$P(IBCNS 16,"^",9)) Q ; ; Onl y adding c omments on patch 547 . Changes are on the ADD2 tag below. ; T his tag is called fr om the Out put format ter. ; It returns a "complete" address ; It judges an addres s complete if it has a state ( don't ask why, I am just addin g the comm ents) ; If the addre ss it want s is not c omplete, i t returns the main a ddress. ; These addr esses go o ut on clai ms and cla ims (X12 8 37) don't like parti al address es.ADDRESS (INS,NODE, PH) ; -- g eneric fin d address ; N IBX,IN SSAVE,IBPH ,IBFX,IBCN T,IBA S IB X="" ;S IB PH="",IBFX ="",IBA="" ;REDO ; g ather insu rance carr ier's main address i nformation S IBX=$G (^DIC(36,+ INS,.11)), IBPH=$P($G (^DIC(36,+ INS,.13)), "^",1),IBF X=$P(IBX," ^",9) ;S I BCNT=$G(IB CNT)+1 ; ; -- if pro cess the s ame co. mo re than on ce you are in an inf inite loop ;I $D(IBC NT(IBCNS)) G ADDREQ ;S IBCNT(I BCNS)="" ; ; -- gath er address informati on from sp ecific off ice (Claim s, Appeals , Inquiry) ; I $P($G (^DIC(36,+ INS,+NODE) ),"^",5) S IBX=$G(^D IC(36,+INS ,+NODE)),I BPH=$P($G( ^DIC(36,+I NS,.13))," ^",PH),IBF X=$P($G(IB X),"^",9) I $P($G(^D IC(36,+INS ,+NODE))," ^",7) S IN SSAVE=INS, INS=$P($G( ^DIC(36,+I NS,+NODE)) ,"^",7) I INSSAVE'=I NS G REDO ;ADDRESQ ; concatena te company name, add ress, phon e and fax S $P(IBA, "^",1,6)=$ P($G(IBX), "^",1,6) S $P(IBA,"^ ",7)=INS S $P(IBA,"^ ",8)=IBPH S $P(IBA," ^",9)=IBFX ADDREQ Q I BA ; ; WCJ ;IB*2.0*54 7; ; This is a new t ag which i s just cal led from t he insuran ce company editor sc reens. ; T he billers /insurance verifiers want to s ee what da ta is actu ally in th e insuranc e company file. ; Th ey don't c are if it' s complete . Heck, a phone numb er may be enough. ; This will just retur n what is in the fil e for the ins compan y that han dles that type of cl aims. ; In put: INS - IREN to f ile 36 ; N ODE - Node in File 3 6 (corresp onds to Cl aims, Appe als, Inqui ry...) ; P H - Locati on of Phon e number i n node .13 ADD2(INS,N ODE,PH) ; N IBX,INSS AVE,IBFX,I BPH,IBA F S IBX=$G( ^DIC(36,+I NS,+NODE)) Q:'$P(IBX ,U,7) S IN SSAVE=INS, INS=$P(IBX ,U,7) Q:IN SSAVE=INS ; concaten ate compan y name, ad dress, pho ne and fax S IBPH=$ P($G(^DIC( 36,+INS,.1 3)),U,PH), IBFX=$P(IB X,U,9) S $ P(IBA,U,1, 6)=$P(IBX, U,1,6),$P( IBA,U,7)=I NS,$P(IBA, U,8)=IBPH, $P(IBA,U,9 )=IBFX Q I BA | |
| 521 | Modified L ogic (Chan ges are in bold) | |
| 522 | IBCNSC0 ;A LB/NLR - I NSURANCE C OMPANY EDI T - ;12-MA R-1993 ;;2 .0;INTEGRA TED BILLIN G;**371,54 7,592**;21 -MAR-94;Bu ild 119 ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. ;CLAIMS1 ; display I npatient C laims info rmation N OFFSET,STA RT,IBCNS12 ,IBADD ;WC J;IB*2.0*5 47 ;S STAR T=27,OFFSE T=2 S STAR T=28+(2*$G (IBACMAX)) ,OFFSET=2 D SET^IBCN SP(START,O FFSET+20," Inpatient Claims Of fice Infor mation ",I ORVON,IORV OFF) ; ;WC J;IB*2.0*5 47;Call Ne w API ;S I BCNS12=$$A DDRESS(IBC NS,.12,5) S IBCNS12= $$ADD2(IBC NS,.12,5) ; D SET^IB CNSP(START +1,OFFSET, " Company Name: "_$P ($G(^DIC(3 6,+$P(IBCN S12,"^",7) ,0)),"^",1 )) D SET^I BCNSP(STAR T+2,OFFSET ," Street: "_$P(IBCN S12,"^",1) ) D SET^IB CNSP(START +3,OFFSET, " Street 2 : "_$P(IBC NS12,"^",2 )) N OFFSE T S OFFSET =45 D SET^ IBCNSP(STA RT+1,OFFSE T," Street 3: "_$P(I BCNS12,"^" ,3)) S IBA DD=1 D SET ^IBCNSP(ST ART+1+IBAD D,OFFSET," City/Stat e: "_$E($P (IBCNS12," ^",4),1,15 )_$S($P(IB CNS12,"^", 4)="":"",1 :", ")_$P( $G(^DIC(5, +$P(IBCNS1 2,"^",5),0 )),"^",2)_ " "_$E($P( IBCNS12,"^ ",6),1,5)) D SET^IBC NSP(START+ 2+IBADD,OF FSET," Pho ne: "_$P(I BCNS12,"^" ,8)) D SET ^IBCNSP(ST ART+3+IBAD D,OFFSET," Fax: "_$P (IBCNS12," ^",9)) Q ; R1Q QCLAIM S2 ; displ ay Outpati ent Claims informati on ; N OFF SET,START, IBCNS16,IB ADD ;WCJ;I B*2.0*547 ;S START=3 4,OFFSET=2 S START=3 5+(2*$G(IB ACMAX)),OF FSET=2 D S ET^IBCNSP( START,OFFS ET+20," Ou tpatient C laims Offi ce Informa tion ",IOR VON,IORVOF F) ; ;WCJ; IB*2.0*547 ;Call New API ;S IBC NS16=$$ADD RESS(IBCNS ,.16,6) S IBCNS16=$$ ADD2(IBCNS ,.16,6) ; D SET^IBCN SP(START+1 ,OFFSET," Company Na me: "_$P($ G(^DIC(36, +$P(IBCNS1 6,"^",7),0 )),"^",1)) D SET^IBC NSP(START+ 2,OFFSET," Street: " _$P(IBCNS1 6,"^",1)) D SET^IBCN SP(START+3 ,OFFSET," Street 2: "_$P(IBCNS 16,"^",2)) N OFFSET S OFFSET=4 5 D SET^IB CNSP(START +1,OFFSET, " Street 3 : "_$P(IBC NS16,"^",3 )) S IBADD =1 D SET^I BCNSP(STAR T+1+IBADD, OFFSET," C ity/State: "_$E($P(I BCNS16,"^" ,4),1,15)_ $S($P(IBCN S16,"^",4) ="":"",1:" , ")_$P($G (^DIC(5,+$ P(IBCNS16, "^",5),0)) ,"^",2)_" "_$E($P(IB CNS16,"^", 6),1,5)) D SET^IBCNS P(START+2+ IBADD,OFFS ET," Phone : "_$P(IBC NS16,"^",8 )) D SET^I BCNSP(STAR T+3+IBADD, OFFSET," F ax: "_$P(I BCNS16,"^" ,9)) Q ; ; Only addi ng comment s on patch 547. Chan ges are on the ADD2 tag below. ; This ta g is calle d from the Output fo rmatter. ; It return s a "compl ete" addre ss ; It ju dges an ad dress comp lete if it has a sta te (don't ask why, I am just a dding the comments) ; If the a ddress it wants is n ot complet e, it retu rns the ma in address . ; These addresses go out on claims and claims (X 12 837) do n't like p artial add resses.ADD RESS(INS,N ODE,PH) ; -- generic find addr ess ; N IB X,INSSAVE, IBPH,IBFX, IBCNT,IBA S IBX="" ; S IBPH="", IBFX="",IB A="" ;REDO ; gather insurance carrier's main addre ss informa tion S IB X=$G(^DIC( 36,+INS,.1 1)),IBPH=$ P($G(^DIC( 36,+INS,.1 3)),"^",1) ,IBFX=$P(I BX,"^",9) ;S IBCNT=$ G(IBCNT)+1 ; ; -- if process t he same co . more tha n once you are in an infinite loop ;I $D (IBCNT(IBC NS)) G ADD REQ ;S IBC NT(IBCNS)= "" ; ; -- gather add ress infor mation fro m specific office (C laims, App eals, Inqu iry, Denta l) ;JWS;IB *2.0*592;C hanged bel ow for DEN TAL insura nce mailin g address I $P($G(^D IC(36,+INS ,+NODE))," ^",5) D . S IBX=$G(^ DIC(36,+IN S,+NODE)) . I +NODE= .19 S IBPH =$P(IBX,"^ ",PH) . E S IBPH=$P ($G(^DIC(3 6,+INS,.13 )),"^",PH) . S IBFX= $P($G(IBX) ,"^",9) I $P($G(^DIC (36,+INS,+ NODE)),"^" ,7) S INSS AVE=INS,IN S=$P($G(^D IC(36,+INS ,+NODE))," ^",7) I IN SSAVE'=INS G REDO ;A DDRESQ ; c oncatenate company n ame, addre ss, phone and fax S $P(IBA,"^ ",1,6)=$P( $G(IBX),"^ ",1,6) S $ P(IBA,"^", 7)=INS S $ P(IBA,"^", 8)=IBPH S $P(IBA,"^" ,9)=IBFXAD DREQ Q IBA ; ; WCJ;I B*2.0*547; ; This is a new tag which is just calle d from the insurance company e ditor scre ens. ; The billers/i nsurance v erifiers w ant to see what data is actual ly in the insurance company fi le. ; They don't car e if it's complete. Heck, a ph one number may be en ough. ; Th is will ju st return what is in the file for the in s company that handl es that ty pe of clai ms. ; Inpu t: INS - I REN to fil e 36 ; NOD E - Node i n File 36 (correspon ds to Clai ms, Appeal s, Inquiry ...) ; PH - Location of Phone number in node .13AD D2(INS,NOD E,PH) ; N IBX,INSSAV E,IBFX,IBP H,IBA F S IBX=$G(^D IC(36,+INS ,+NODE)) Q :'$P(IBX,U ,7) S INSS AVE=INS,IN S=$P(IBX,U ,7) Q:INSS AVE=INS ; concatenat e company name, addr ess, phone and fax S IBPH=$P( $G(^DIC(36 ,+INS,.13) ),U,PH),IB FX=$P(IBX, U,9) ;JWS; IB*2.0*592 ;Dental ma iling addr ess I +NOD E=.19 S IB PH=$P($G(^ DIC(36,+IN S,.19)),U, 11) S $P(I BA,U,1,6)= $P(IBX,U,1 ,6),$P(IBA ,U,7)=INS, $P(IBA,U,8 )=IBPH,$P( IBA,U,9)=I BFX Q IBA | |
| 523 | ||
| 524 | ||
| 525 | Routines | |
| 526 | Activities | |
| 527 | Routine Na me | |
| 528 | IBCNSC1 | |
| 529 | Enhancemen t Category | |
| 530 | New | |
| 531 | Modify | |
| 532 | Delete | |
| 533 | No Change | |
| 534 | RTM | |
| 535 | ||
| 536 | Related Op tions | |
| 537 | None | |
| 538 | Related Ro utines | |
| 539 | Routines “ Called By” | |
| 540 | Routines “ Called” | |
| 541 | ||
| 542 | ||
| 543 | ||
| 544 | ||
| 545 | Data Dicti onary (DD) Reference s | |
| 546 | ||
| 547 | Related Pr otocols | |
| 548 | None | |
| 549 | Related In tegration Control Re gistration s (ICRs) | |
| 550 | None | |
| 551 | Data Passi ng | |
| 552 | Input | |
| 553 | Output Re ference | |
| 554 | Both | |
| 555 | Global Re ference | |
| 556 | Local | |
| 557 | Input Attr ibute Name and Defin ition | |
| 558 | Name: | |
| 559 | Definition : | |
| 560 | Output Att ribute Nam e and Defi nition | |
| 561 | Name: | |
| 562 | Definition : | |
| 563 | Current Lo gic | |
| 564 | IBCNSC1 ;A LB/NLR - I BCNS INSUR ANCE COMPA NY ;23-MAR -93 ;;2.0; INTEGRATED BILLING;* *62,137,23 2,291,320, 348,349,37 1,400,519, 516,547**; 21-MAR-94; Build 119 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ;% G EN^ IBCNSC ;AI ; -- (In) Activate C ompany D F ULL^VALM1 W !! I '$D (^XUSEC("I B INSURANC E SUPERVIS OR",DUZ)) D SORRY G EXIT D ^IB CNSC2 G EX ITCC ; -- Change Ins urance Com pany D FUL L^VALM1 W !! S IBCNS 1=IBCNS K IBCNS D IN SCO^IBCNSC I '$D(IBC NS) S IBCN S=IBCNS1 K IBCNS1,VA LMQUIT G E XITEA ; -- Billing,C laims,Appe als,Inquir y,Telephon e,Main,Rem arks,Synon yms D FULL ^VALM1 ; ; IB*2*320 - check ke y for asso ciate comp any action I $G(IBY) =",13,",'$ $KCHK^XUSR B("IB EDI INSURANCE EDIT") D G EXIT . W !!?5,"You must hold the IB ED I INSURANC E EDIT key to access this opti on." . D P AUSE^VALM1 . Q ; W ! ! D MAIN ; ; -- was company de leted I '$ D(^DIC(36, IBCNS)) W !!,"<DELET ED>",!! S VALMQUIT=" " Q ;EXIT ; D HDR^IB CNSC,BLD^I BCNSC S VA LMBCK="R" QMAIN ; -- Call edit template N IBEDIKEY ,Z L +^DIC (36,+IBCNS ):5 I '$T D LOCKED^I BTRCD1 G M AINQ I $G( IBY)=",12, " D FACID F Z=1,2,4, 9,13,14 S IBEDIKEY(Z )=$P($G(^D IC(36,+IBC NS,3)),U,Z ) ; save E DI data fi elds F Z=1 :1:8 S IBE DIKEY(Z,6) =$P($G(^DI C(36,+IBCN S,6)),U,Z) ; save ED I data fie lds I $G(I BY)'=",12, " N DIE,DA ,DR S DIE= "^DIC(36," ,(DA,Y)=IB CNS,DR="[I BEDIT INS CO1]" D ^D IE K DIE S :$D(Y) IB( "^")=1 D:$ TR($P($G(^ DIC(36,IBC NS,6)),U,1 ,8),U)]"" CUIDS(IBCN S) I $G(IB Y)=",12," D EDITID^I BCEP(+IBCN S) I $F(", 6,1,",$G(I BY)) D CLE ANIDS^IBCN SC(+IBCNS) ;clean up any erran t nodes on alternate payert ID S I $F(",6 ,13,",$G(I BY)) D PAR ENT^IBCNSC 02(+IBCNS) ; parent/ child mana gement L - ^DIC(36,+I BCNS) ; IB *2.0*519: If field 3 .02 or 3.0 4 has chan ged, trigg er HL7 to update the NIF I (IB EDIKEY(2)' =$P($G(^DI C(36,+IBCN S,3)),U,2) )!(IBEDIKE Y(4)'=$P($ G(^DIC(36, +IBCNS,3)) ,U,4)) D E XR^IBCNHUT 1(IBCNS),S END^IBCNHH LO(IBCNS)M AINQ Q ;FA CID ; -- E dit facili ty ids D F ACID^IBCEP 2B(+IBCNS, "E") Q ;SO RRY ; -- c an't inact ivate, don 't have ke y W !!,"Yo u do not h ave access to Inacti vate entri es. See yo ur applica tion coord inator.",! D PAUSE^V ALM1 QPRES CR ; N OFF SET,START, IBCNS18,IB ADD ; ;WCJ ;IB*2.0*54 7;Call New API ;S IB CNS18=$$AD DRESS^IBCN SC0(IBCNS, .18,11) S IBCNS18=$$ ADD2^IBCNS C0(IBCNS,. 18,11) ; ; WCJ;IB*2.0 *547 ;S ST ART=41,OFF SET=2 S ST ART=42+(2* $G(IBACMAX )),OFFSET= 2 D SET^IB CNSP(START ,OFFSET+19 ," Prescri ption Clai ms Office Informatio n ",IORVON ,IORVOFF) D SET^IBCN SP(START+1 ,OFFSET," Company Na me: "_$P($ G(^DIC(36, +$P(IBCNS1 8,"^",7),0 )),"^",1)) D SET^IBC NSP(START+ 2,OFFSET," Street: " _$P(IBCNS1 8,"^",1)) D SET^IBCN SP(START+3 ,OFFSET," Street 2: "_$P(IBCNS 18,"^",2)) ; D SET^I BCNSP(STAR T+4,OFFSET ,"Claim Of f. ID: "_$ P(IBCNS18, "^",11)) N OFFSET S OFFSET=45 D SET^IBCN SP(START+1 ,OFFSET," Street 3: "_$P(IBCNS 18,"^",3)) S IBADD=1 D SET^IBC NSP(START+ 1+IBADD,OF FSET," Cit y/State: " _$E($P(IBC NS18,"^",4 ),1,15)_$S ($P(IBCNS1 8,"^",4)=" ":"",1:", ")_$P($G(^ DIC(5,+$P( IBCNS18,"^ ",5),0))," ^",2)_" "_ $E($P(IBCN S18,"^",6) ,1,5)) D S ET^IBCNSP( START+2+IB ADD,OFFSET ," Phone: "_$P(IBCNS 18,"^",8)) D SET^IBC NSP(START+ 3+IBADD,OF FSET," Fax : "_$P(IBC NS18,"^",9 )) Q ;PROV ID N OFFSE T,START,IB CNS4,IBCNS 3,IBDISP,Z ,LINE S ST ART=$O(^TM P("IBCNSC" ,$J,""),-1 )+1 S (IB1 ST("PROVID "),LINE)=S TART S OFF SET=2,IBCN S4=$G(^DIC (36,IBCNS, 4)),IBCNS3 =$G(^(3)) ; D SET^I BCNSP(LINE ,OFFSET+25 ,"Provider IDs",IORV ON,IORVOFF ) N OFFSET S LINE=LI NE+1,OFFSE T=1 D SET^ IBCNSP(LIN E,OFFSET," Billing Pr ovider Sec ondary ID" ) ; N Z,Z0 ,Z1,IBS,I, DIV,FT,CU, CUF,DIVISI ON,FORMTYP E,PIDT S Z =0 F S Z= $O(^IBA(35 5.92,"B",+ IBCNS,Z)) Q:'Z D . S Z0=$G(^I BA(355.92, Z,0)) . Q: '$P(Z0,U,6 )!($P(Z0,U ,7)="") ; Quit if no provider id or id t ype . Q:'( $P(Z0,U,8) ="E") . S IBS(+$P(Z0 ,U,5),+$P( Z0,U,3),+$ P(Z0,U,4)) =$P(Z0,U,6 )_U_$P(Z0, U,7) ; S D IV="" F S DIV=$O(IB S(DIV)) Q: DIV="" D . S DIVISI ON=$$DIV^I BCEP7(DIV) . S CU="" ,CUF=0 F S CU=$O(IB S(DIV,CU)) Q:CU="" D .. S FT= "" F S FT =$O(IBS(DI V,CU,FT)) Q:FT="" D ... S FOR MTYPE=$S(F T=1:"UB-04 ",FT=2:"15 00",1:"UNK NOWN") ... S LINE=LI NE+1 ... I 'CUF,+CU S CUF=1 S TEXT=$P(DI VISION,"/" )_" Care U nits :",OF FSET=5 D S ET^IBCNSP( LINE,OFFSE T,TEXT) S LINE=LINE+ 1 ... I CU =0 S TEXT= DIVISION_" /"_FORMTYP E_": "_$$G ET1^DIQ(35 5.97,$P(IB S(DIV,CU,F T),U),.03, "E")_" "_$ P(IBS(DIV, CU,FT),U,2 ),OFFSET=2 ... I +CU S TEXT=$$ EXPAND^IBT RE(355.92, .03,CU)_"/ "_FORMTYPE _": "_$$GE T1^DIQ(355 .97,$P(IBS (DIV,CU,FT ),U),.03," E")_" "_$P (IBS(DIV,C U,FT),U,2) ,OFFSET=5 ... D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; S L INE=LINE+1 D SET^IBC NSP(LINE,2 ," ") ; K IBS S OFFS ET=1,LINE= LINE+1 D S ET^IBCNSP( LINE,OFFSE T,"Additio nal Billin g Provider Secondary IDs") S Z =0 F S Z= $O(^IBA(35 5.92,"B",+ IBCNS,Z)) Q:'Z D . S Z0=$G(^I BA(355.92, Z,0)) . Q: '$P(Z0,U,6 )!($P(Z0,U ,7)="") ; Quit if no provider id or id t ype . Q:'( $P(Z0,U,8) ="A") . ; IBS(DIVISI ON,FORMTYP E,IDTYPE)= ID . S IBS (+$P(Z0,U, 5),+$P(Z0, U,4),+$P(Z 0,U,6))=$P (Z0,U,7) ; S DIVISIO N=$$DIV^IB CEP7(0) S DIV="" F S DIV=$O(I BS(DIV)) Q :DIV="" D . S FT="" F S FT=$ O(IBS(DIV, FT)) Q:FT= "" D .. S FORMTYPE= $S(FT=1:"U B-04",FT=2 :"1500",1: "UNKNOWN") .. S TEXT =DIVISION_ "/"_FORMTY PE_": " .. S LINE=LI NE+1,OFFSE T=2 .. D S ET^IBCNSP( LINE,OFFSE T,TEXT) .. S PIDT="" F S PIDT =$O(IBS(DI V,FT,PIDT) ) Q:PIDT=" " D ... S LINE=LINE +1 ... S T EXT=$$GET1 ^DIQ(355.9 7,PIDT,.03 ,"E")_" "_ IBS(DIV,FT ,PIDT),OFF SET=5 ... D SET^IBCN SP(LINE,OF FSET,TEXT) ; S LINE= LINE+1 D S ET^IBCNSP( LINE,2," " ) ; K IBS S OFFSET=1 ,LINE=LINE +1 D SET^I BCNSP(LINE ,OFFSET,"V A-Laborato ry or Faci lity Secon dary IDs") S Z=0 F S Z=$O(^IB A(355.92," B",+IBCNS, Z)) Q:'Z D . S Z0=$ G(^IBA(355 .92,Z,0)) . Q:'$P(Z0 ,U,6)!($P( Z0,U,7)="" ) ; Quit i f no provi der id or id type . Q:'($P(Z0, U,8)="LF") . ; IBS(D IVISION,FO RMTYPE,IDT YPE)=ID . S IBS(+$P( Z0,U,5),+$ P(Z0,U,4), +$P(Z0,U,6 ))=$P(Z0,U ,7) ; S DI VISION=$$D IV^IBCEP7( 0) S DIV=" " F S DIV =$O(IBS(DI V)) Q:DIV= "" D . S FT="" F S FT=$O(IBS (DIV,FT)) Q:FT="" D .. S FORM TYPE=$S(FT =1:"UB-04" ,FT=2:"150 0",1:"UNKN OWN") .. S TEXT=DIVI SION_"/"_F ORMTYPE_": " .. S LI NE=LINE+1, OFFSET=2 . . D SET^IB CNSP(LINE, OFFSET,TEX T) .. S PI DT="" F S PIDT=$O(I BS(DIV,FT, PIDT)) Q:P IDT="" D ... S LINE =LINE+1 .. . ;S TEXT= $$EXPAND^I BTRE(355.9 2,.06,PIDT )_" "_IBS( DIV,FT,PID T),OFFSET= 5 ... S TE XT=$$GET1^ DIQ(355.97 ,PIDT,.03, "E")_" "_I BS(DIV,FT, PIDT),OFFS ET=5 ... D SET^IBCNS P(LINE,OFF SET,TEXT) ; ; S LINE =LINE+1 D SET^IBCNSP (LINE,2," ") S LINE= LINE+1 D S ET^IBCNSP( LINE,2," " ) S OFFSET =2 S LINE= LINE+1 D S ET^IBCNSP( LINE,OFFSE T+25,"ID P arameters" ,IORVON,IO RVOFF) ; S IBCNS4=$G (^DIC(36,I BCNS,4)),I BCNS3=$G(^ (3)),OFFSE T=1 S TEXT ="Attendin g/Renderin g Provider Secondary ID Qualif ier (1500) : "_$$EXPA ND^IBTRE(3 6,4.01,+$P (IBCNS4,U) ) S LINE=L INE+1 D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; S TEXT="Att ending/Ren dering Pro vider Seco ndary ID Q ualifier ( UB-04): "_ $$EXPAND^I BTRE(36,4. 02,+$P(IBC NS4,U,2)) S LINE=LIN E+1 D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; S T EXT="Atten ding/Rende ring Secon dary ID Re quirement: "_$$EXPAN D^IBTRE(36 ,4.03,+$P( IBCNS4,U,3 )) S LINE= LINE+1 D S ET^IBCNSP( LINE,OFFSE T,TEXT) ; S TEXT="Re ferring Pr ovider Sec ondary ID Qualifier (1500): "_ $$EXPAND^I BTRE(36,4. 04,+$P(IBC NS4,U,4)) S LINE=LIN E+1 D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; S T EXT="Refer ring Provi der Second ary ID Req uirement: "_$$EXPAND ^IBTRE(36, 4.05,+$P(I BCNS4,U,5) ) S LINE=L INE+1 D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; S TEXT="Use Att/Rend ID as Bill ing Provid er Sec. ID (1500): " _$$EXPAND^ IBTRE(36,4 .06,+$P(IB CNS4,U,6)) S LINE=LI NE+1 D SET ^IBCNSP(LI NE,OFFSET, TEXT) ; S TEXT="Use Att/Rend I D as Billi ng Provide r Sec. ID (UB-04): " _$$EXPAND^ IBTRE(36,4 .08,+$P(IB CNS4,U,8)) S LINE=LI NE+1 D SET ^IBCNSP(LI NE,OFFSET, TEXT) ; ; MRD;IB*2.0 *516 - Mar ked fields 4.07, 4.1 1, 4.12 an d 4.13 for ; deletio n and remo ved all re ferences t o them. ;S TEXT="Alw ays use ma in VAMC as Billing P rovider (1 500)?: "_$ $EXPAND^IB TRE(36,4.1 1,+$P(IBCN S4,U,11)) ;S LINE=LI NE+1 ;D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; ; S TEXT="Al ways use m ain VAMC a s Billing Provider ( UB-04)?: " _$$EXPAND^ IBTRE(36,4 .12,+$P(IB CNS4,U,12) ) ;S LINE= LINE+1 ;D SET^IBCNSP (LINE,OFFS ET,TEXT) ; ;I $P(IBC NS4,U,11)! ($P(IBCNS4 ,U,12)) D ;.S TEXT=" Send VA La b/Facility IDs or Fa cility Dat a for VAMC ?: "_$$EXP AND^IBTRE( 36,4.07,+$ P(IBCNS4,U ,7)) ;.S L INE=LINE+1 ;.D SET^I BCNSP(LINE ,OFFSET,TE XT) ;.; ;. S TEXT="Us e the Bill ing Provid er (VAMC) Name and S treet Addr ess?: "_$$ EXPAND^IBT RE(36,4.13 ,+$P(IBCNS 4,U,13)) ; .S LINE=LI NE+1 ;.D S ET^IBCNSP( LINE,OFFSE T,TEXT) ;. Q ; S TEXT ="Transmit no Billin g Provider Sec. ID f or the Ele ctronic Pl an Types: " S LINE=L INE+1 D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; N TAR,ERR,I BCT D LIST ^DIC(36.01 3,","_IBCN S_",",".01 ",,10,,,,, ,"TAR","ER R") F IBCT =1:1:+$G(T AR("DILIST ",0)) D . S TEXT=TAR ("DILIST", 1,IBCT) . S LINE=LIN E+1 . D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; S LINE=LINE +1 D SET^I BCNSP(LINE ,2," ") S LINE=LINE+ 1 D SET^IB CNSP(LINE, 2," ") Q ; INSDEF(IB INS,IBPTYP ) ; Return s the defa ult id # f or an ins co, if pos sible N X S X="" I I BINS,IBPTY P S X=$P($ G(^IBA(355 .91,+$O(^I BA(355.91, "AC",IBINS ,IBPTYP,"* N/A*","")) ,0)),U,7) Q X ;CUIDS (IBCNS) ; N DIE,DA,D R,PIECE,DA T6,Y S DAT 6=$P(^DIC( 36,IBCNS,6 ),U,1,8) ; get the P ayer IDs ; ; Make su re each qu alifier ha s an ID an d vice ver sa F PIECE =1,3,5,7 D . I $TR($ P(DAT6,U,P IECE,PIECE +1),U)="" Q ; both blank . I $P(DAT6,U, PIECE)]"", $P(DAT6,U, PIECE+1)]" " Q ; bot h have dat a . S DIE= "^DIC(36," ,(DA,Y)=IB CNS,DR="6. 0"_$S($P(D AT6,U,PIEC E)]"":PIEC E,1:PIECE+ 1)_"////@" . D ^DIE K DIE ; S DAT6=$P($G (^DIC(36,I BCNS,6)),U ,1,8) ; ge t the Paye r IDs agai n since th ey may hav e changed above. ; ; Make sure the first pair of I D/Qual are populated if the 2n d pair is. If not, m ove em ove r. ; This is done fo r institut ional then professio nal F PIEC E=1,5 D . I $P(DAT6, U,PIECE)]" " Q ; alr eady has s et one . I $P(DAT6,U ,PIECE+2)= "" Q ; ha s no secon d set . S DIE="^DIC( 36,",(DA,Y )=IBCNS . ; deleting the quali fier trigg ers deleti on of the ID . S DR= "6.0"_PIEC E_"////"_$ P(DAT6,U,P IECE+2)_"; 6.0"_(PIEC E+1)_"//// "_$P(DAT6, U,PIECE+3) _";6.0"_(P IECE+2)_"/ ///@" . D ^DIE K DIE Q | |
| 565 | Modified L ogic (Chan ges are in bold) | |
| 566 | IBCNSC1 ;A LB/NLR - I BCNS INSUR ANCE COMPA NY ;23-MAR -93 ;;2.0; INTEGRATED BILLING;* *62,137,23 2,291,320, 348,349,37 1,400,519, 516,547,59 2**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;% G EN^IBCNSC ;AI ; -- (In)Activa te Company D FULL^VA LM1 W !! I '$D(^XUSE C("IB INSU RANCE SUPE RVISOR",DU Z)) D SORR Y G EXIT D ^IBCNSC2 G EXITCC ; -- Change Insurance Company D FULL^VALM 1 W !! S I BCNS1=IBCN S K IBCNS D INSCO^IB CNSC I '$D (IBCNS) S IBCNS=IBCN S1 K IBCNS 1,VALMQUIT G EXITEA ; -- Billi ng,Claims, Appeals,In quiry,Tele phone,Main ,Remarks,S ynonyms D FULL^VALM1 ; ; IB*2* 320 - chec k key for associate company ac tion I $G( IBY)=",13, ",'$$KCHK^ XUSRB("IB EDI INSURA NCE EDIT") D G EXIT . W !!?5, "You must hold the I B EDI INSU RANCE EDIT key to ac cess this option." . D PAUSE^V ALM1 . Q ; W !! D MA IN ; ; -- was compan y deleted I '$D(^DIC (36,IBCNS) ) W !!,"<D ELETED>",! ! S VALMQU IT="" Q ;E XIT ; D HD R^IBCNSC,B LD^IBCNSC S VALMBCK= "R" QMAIN ; -- Call edit templ ate N IBED IKEY,Z L + ^DIC(36,+I BCNS):5 I '$T D LOCK ED^IBTRCD1 G MAINQ I $G(IBY)=" ,12," D FA CID ;JWS;I B*2.0*592; add field .15 (piece 15) Denta l EDI Paye r ID F Z=1 ,2,4,9,13, 14,15 S IB EDIKEY(Z)= $P($G(^DIC (36,+IBCNS ,3)),U,Z) ; save EDI data fiel ds F Z=1:1 :8 S IBEDI KEY(Z,6)=$ P($G(^DIC( 36,+IBCNS, 6)),U,Z) ; save EDI data field s I $G(IBY )'=",12," N DIE,DA,D R S DIE="^ DIC(36,",( DA,Y)=IBCN S,DR="[IBE DIT INS CO 1]" D ^DIE K DIE S:$ D(Y) IB("^ ")=1 D:$TR ($P($G(^DI C(36,IBCNS ,6)),U,1,8 ),U)]"" CU IDS(IBCNS) I $G(IBY) =",12," D EDITID^IBC EP(+IBCNS) I $F(",6, 1,",$G(IBY )) D CLEAN IDS^IBCNSC (+IBCNS) ; clean up a ny errant nodes on a lternate p ayert IDS I $F(",6,1 3,",$G(IBY )) D PAREN T^IBCNSC02 (+IBCNS) ; parent/ch ild manage ment L -^D IC(36,+IBC NS) ; IB*2 .0*519: If field 3.0 2 or 3.04 has change d, trigger HL7 to up date the N IF I (IBED IKEY(2)'=$ P($G(^DIC( 36,+IBCNS, 3)),U,2))! (IBEDIKEY( 4)'=$P($G( ^DIC(36,+I BCNS,3)),U ,4)) D EXR ^IBCNHUT1( IBCNS),SEN D^IBCNHHLO (IBCNS)MAI NQ Q ;FACI D ; -- Edi t facility ids D FAC ID^IBCEP2B (+IBCNS,"E ") Q ;SORR Y ; -- can 't inactiv ate, don't have key W !!,"You do not hav e access t o Inactiva te entries . See your applicati on coordin ator.",! D PAUSE^VAL M1 QPRESCR ; N OFFSE T,START,IB CNS18,IBAD D ; ;WCJ;I B*2.0*547; Call New A PI ;S IBCN S18=$$ADDR ESS^IBCNSC 0(IBCNS,.1 8,11) S IB CNS18=$$AD D2^IBCNSC0 (IBCNS,.18 ,11) ; ;WC J;IB*2.0*5 47 ;S STAR T=41,OFFSE T=2 S STAR T=42+(2*$G (IBACMAX)) ,OFFSET=2 D SET^IBCN SP(START,O FFSET+19," Prescript ion Claims Office In formation ",IORVON,I ORVOFF) D SET^IBCNSP (START+1,O FFSET," Co mpany Name : "_$P($G( ^DIC(36,+$ P(IBCNS18, "^",7),0)) ,"^",1)) D SET^IBCNS P(START+2, OFFSET," S treet: "_$ P(IBCNS18, "^",1)) D SET^IBCNSP (START+3,O FFSET," St reet 2: "_ $P(IBCNS18 ,"^",2)) ; D SET^IBC NSP(START+ 4,OFFSET," Claim Off. ID: "_$P( IBCNS18,"^ ",11)) N O FFSET S OF FSET=45 D SET^IBCNSP (START+1,O FFSET," St reet 3: "_ $P(IBCNS18 ,"^",3)) S IBADD=1 D SET^IBCNS P(START+1+ IBADD,OFFS ET," City/ State: "_$ E($P(IBCNS 18,"^",4), 1,15)_$S($ P(IBCNS18, "^",4)="": "",1:", ") _$P($G(^DI C(5,+$P(IB CNS18,"^", 5),0)),"^" ,2)_" "_$E ($P(IBCNS1 8,"^",6),1 ,5)) D SET ^IBCNSP(ST ART+2+IBAD D,OFFSET," Phone: "_ $P(IBCNS18 ,"^",8)) D SET^IBCNS P(START+3+ IBADD,OFFS ET," Fax: "_$P(IBCNS 18,"^",9)) Q ;PROVID N OFFSET, START,IBCN S4,IBCNS3, IBDISP,Z,L INE S STAR T=$O(^TMP( "IBCNSC",$ J,""),-1)+ 1 S (IB1ST ("PROVID") ,LINE)=STA RT S OFFSE T=2,IBCNS4 =$G(^DIC(3 6,IBCNS,4) ),IBCNS3=$ G(^(3)) ; D SET^IBC NSP(LINE,O FFSET+25," Provider I Ds",IORVON ,IORVOFF) N OFFSET S LINE=LINE +1,OFFSET= 1 D SET^IB CNSP(LINE, OFFSET,"Bi lling Prov ider Secon dary ID") ; N Z,Z0,Z 1,IBS,I,DI V,FT,CU,CU F,DIVISION ,FORMTYPE, PIDT S Z=0 F S Z=$O (^IBA(355. 92,"B",+IB CNS,Z)) Q: 'Z D . S Z0=$G(^IBA (355.92,Z, 0)) . Q:'$ P(Z0,U,6)! ($P(Z0,U,7 )="") ; Qu it if no p rovider id or id typ e . Q:'($P (Z0,U,8)=" E") . S IB S(+$P(Z0,U ,5),+$P(Z0 ,U,3),+$P( Z0,U,4))=$ P(Z0,U,6)_ U_$P(Z0,U, 7) ; S DIV ="" F S D IV=$O(IBS( DIV)) Q:DI V="" D . S DIVISION =$$DIV^IBC EP7(DIV) . S CU="",C UF=0 F S CU=$O(IBS( DIV,CU)) Q :CU="" D .. S FT="" F S FT=$ O(IBS(DIV, CU,FT)) Q: FT="" D . .. ;JWS;IB *2.0*592 - Dental fo rm 7 (J430 D) ... S F ORMTYPE=$S (FT=1:"UB- 04",FT=2:" 1500",FT=4 :"J430D",1 :"UNKNOWN" ) ... S LI NE=LINE+1 ... I 'CUF ,+CU S CUF =1 S TEXT= $P(DIVISIO N,"/")_" C are Units :",OFFSET= 5 D SET^IB CNSP(LINE, OFFSET,TEX T) S LINE= LINE+1 ... I CU=0 S TEXT=DIVIS ION_"/"_FO RMTYPE_": "_$$GET1^D IQ(355.97, $P(IBS(DIV ,CU,FT),U) ,.03,"E")_ " "_$P(IBS (DIV,CU,FT ),U,2),OFF SET=2 ... I +CU S TE XT=$$EXPAN D^IBTRE(35 5.92,.03,C U)_"/"_FOR MTYPE_": " _$$GET1^DI Q(355.97,$ P(IBS(DIV, CU,FT),U), .03,"E")_" "_$P(IBS( DIV,CU,FT) ,U,2),OFFS ET=5 ... D SET^IBCNS P(LINE,OFF SET,TEXT) ; S LINE=L INE+1 D SE T^IBCNSP(L INE,2," ") ; K IBS S OFFSET=1, LINE=LINE+ 1 D SET^IB CNSP(LINE, OFFSET,"Ad ditional B illing Pro vider Seco ndary IDs" ) S Z=0 F S Z=$O(^I BA(355.92, "B",+IBCNS ,Z)) Q:'Z D . S Z0= $G(^IBA(35 5.92,Z,0)) . Q:'$P(Z 0,U,6)!($P (Z0,U,7)=" ") ; Quit if no prov ider id or id type . Q:'($P(Z0 ,U,8)="A") . ; IBS(D IVISION,FO RMTYPE,IDT YPE)=ID . S IBS(+$P( Z0,U,5),+$ P(Z0,U,4), +$P(Z0,U,6 ))=$P(Z0,U ,7) ; S DI VISION=$$D IV^IBCEP7( 0) S DIV=" " F S DIV =$O(IBS(DI V)) Q:DIV= "" D . S FT="" F S FT=$O(IBS (DIV,FT)) Q:FT="" D .. ;JWS;I B*2.0*592 - Dental f orm 7 (J43 0D) .. S F ORMTYPE=$S (FT=1:"UB- 04",FT=2:" 1500",FT=4 :"J430D",1 :"UNKNOWN" ) .. S TEX T=DIVISION _"/"_FORMT YPE_": " . . S LINE=L INE+1,OFFS ET=2 .. D SET^IBCNSP (LINE,OFFS ET,TEXT) . . S PIDT=" " F S PID T=$O(IBS(D IV,FT,PIDT )) Q:PIDT= "" D ... S LINE=LIN E+1 ... S TEXT=$$GET 1^DIQ(355. 97,PIDT,.0 3,"E")_" " _IBS(DIV,F T,PIDT),OF FSET=5 ... D SET^IBC NSP(LINE,O FFSET,TEXT ) ; S LINE =LINE+1 D SET^IBCNSP (LINE,2," ") ; K IBS S OFFSET= 1,LINE=LIN E+1 D SET^ IBCNSP(LIN E,OFFSET," VA-Laborat ory or Fac ility Seco ndary IDs" ) S Z=0 F S Z=$O(^I BA(355.92, "B",+IBCNS ,Z)) Q:'Z D . S Z0= $G(^IBA(35 5.92,Z,0)) . Q:'$P(Z 0,U,6)!($P (Z0,U,7)=" ") ; Quit if no prov ider id or id type . Q:'($P(Z0 ,U,8)="LF" ) . ; IBS( DIVISION,F ORMTYPE,ID TYPE)=ID . S IBS(+$P (Z0,U,5),+ $P(Z0,U,4) ,+$P(Z0,U, 6))=$P(Z0, U,7) ; S D IVISION=$$ DIV^IBCEP7 (0) S DIV= "" F S DI V=$O(IBS(D IV)) Q:DIV ="" D . S FT="" F S FT=$O(IB S(DIV,FT)) Q:FT="" D .. ;JWS; IB*2.0*592 - Dental form 7 (J4 30D) .. S FORMTYPE=$ S(FT=1:"UB -04",FT=2: "1500",FT= 4:"J430D", 1:"UNKNOWN ") .. S TE XT=DIVISIO N_"/"_FORM TYPE_": " .. S LINE= LINE+1,OFF SET=2 .. D SET^IBCNS P(LINE,OFF SET,TEXT) .. S PIDT= "" F S PI DT=$O(IBS( DIV,FT,PID T)) Q:PIDT ="" D ... S LINE=LI NE+1 ... ; S TEXT=$$E XPAND^IBTR E(355.92,. 06,PIDT)_" "_IBS(DIV ,FT,PIDT), OFFSET=5 . .. S TEXT= $$GET1^DIQ (355.97,PI DT,.03,"E" )_" "_IBS( DIV,FT,PID T),OFFSET= 5 ... D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; S LINE=LINE +1 D SET^I BCNSP(LINE ,2," ") S LINE=LINE+ 1 D SET^IB CNSP(LINE, 2," ") S O FFSET=2 S LINE=LINE+ 1 D SET^IB CNSP(LINE, OFFSET+25, "ID Parame ters",IORV ON,IORVOFF ) ; S IBCN S4=$G(^DIC (36,IBCNS, 4)),IBCNS3 =$G(^(3)), OFFSET=1 S TEXT="Att ending/Ren dering Pro vider Seco ndary ID Q ualifier ( 1500): "_$ $EXPAND^IB TRE(36,4.0 1,+$P(IBCN S4,U)) S L INE=LINE+1 D SET^IBC NSP(LINE,O FFSET,TEXT ) ; ;JWS;I B*2.8*592; add J430D displayed values S T EXT="Atten ding/Rende ring Provi der Second ary ID Qua lifier (J4 30D): "_$$ EXPAND^IBT RE(36,4.14 ,+$P(IBCNS 4,U,14)) S LINE=LINE +1 D SET^I BCNSP(LINE ,OFFSET,TE XT) ; S TE XT="Attend ing/Render ing Provid er Seconda ry ID Qual ifier (UB- 04): "_$$E XPAND^IBTR E(36,4.02, +$P(IBCNS4 ,U,2)) S L INE=LINE+1 D SET^IBC NSP(LINE,O FFSET,TEXT ) ; S TEXT ="Attendin g/Renderin g Secondar y ID Requi rement: "_ $$EXPAND^I BTRE(36,4. 03,+$P(IBC NS4,U,3)) S LINE=LIN E+1 D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; S T EXT="Refer ring Provi der Second ary ID Qua lifier (15 00): "_$$E XPAND^IBTR E(36,4.04, +$P(IBCNS4 ,U,4)) S L INE=LINE+1 D SET^IBC NSP(LINE,O FFSET,TEXT ) ; ;JWS;I B*2.0*592; add J430D form infor mation S T EST="Use A tt/Rend ID as Billin g Provider Sec. ID ( J430D): "_ $$EXPAND^I BTRE(36,4. 15,+$P(IBC NS4,U,15)) S LINE=LI NE+1 D SET ^IBCNSP(LI NE,OFFSET, TEXT) ; S TEXT="Refe rring Prov ider Secon dary ID Re quirement: "_$$EXPAN D^IBTRE(36 ,4.05,+$P( IBCNS4,U,5 )) S LINE= LINE+1 D S ET^IBCNSP( LINE,OFFSE T,TEXT) ; S TEXT="Us e Att/Rend ID as Bil ling Provi der Sec. I D (1500): "_$$EXPAND ^IBTRE(36, 4.06,+$P(I BCNS4,U,6) ) S LINE=L INE+1 D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; ; JWS;IB*2.0 *592; adde d J430D va lues S TEX T="Use Att /Rend ID a s Billing Provider S ec. ID (J4 30D): "_$$ EXPAND^IBT RE(36,4.16 ,+$P(IBCNS 4,U,16)) S LINE=LINE +1 D SET^I BCNSP(LINE ,OFFSET,TE XT) ; S TE XT="Use At t/Rend ID as Billing Provider Sec. ID (U B-04): "_$ $EXPAND^IB TRE(36,4.0 8,+$P(IBCN S4,U,8)) S LINE=LINE +1 D SET^I BCNSP(LINE ,OFFSET,TE XT) ; ; MR D;IB*2.0*5 16 - Marke d fields 4 .07, 4.11, 4.12 and 4.13 for ; deletion and remove d all refe rences to them. ;S T EXT="Alway s use main VAMC as B illing Pro vider (150 0)?: "_$$E XPAND^IBTR E(36,4.11, +$P(IBCNS4 ,U,11)) ;S LINE=LINE +1 ;D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; ;S TEXT="Alwa ys use mai n VAMC as Billing Pr ovider (UB -04)?: "_$ $EXPAND^IB TRE(36,4.1 2,+$P(IBCN S4,U,12)) ;S LINE=LI NE+1 ;D SE T^IBCNSP(L INE,OFFSET ,TEXT) ; ; I $P(IBCNS 4,U,11)!($ P(IBCNS4,U ,12)) D ;. S TEXT="Se nd VA Lab/ Facility I Ds or Faci lity Data for VAMC?: "_$$EXPAN D^IBTRE(36 ,4.07,+$P( IBCNS4,U,7 )) ;.S LIN E=LINE+1 ; .D SET^IBC NSP(LINE,O FFSET,TEXT ) ;.; ;.S TEXT="Use the Billin g Provider (VAMC) Na me and Str eet Addres s?: "_$$EX PAND^IBTRE (36,4.13,+ $P(IBCNS4, U,13)) ;.S LINE=LINE +1 ;.D SET ^IBCNSP(LI NE,OFFSET, TEXT) ;.Q ; S TEXT=" Transmit n o Billing Provider S ec. ID for the Elect ronic Plan Types: " S LINE=LIN E+1 D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; N T AR,ERR,IBC T D LIST^D IC(36.013, ","_IBCNS_ ",",".01", ,10,,,,,," TAR","ERR" ) F IBCT=1 :1:+$G(TAR ("DILIST", 0)) D . S TEXT=TAR(" DILIST",1, IBCT) . S LINE=LINE+ 1 . D SET^ IBCNSP(LIN E,OFFSET,T EXT) ; S L INE=LINE+1 D SET^IBC NSP(LINE,2 ," ") S LI NE=LINE+1 D SET^IBCN SP(LINE,2, " ") Q ; I NSDEF(IBIN S,IBPTYP) ; Returns the defaul t id # for an ins co , if possi ble N X S X="" I IBI NS,IBPTYP S X=$P($G( ^IBA(355.9 1,+$O(^IBA (355.91,"A C",IBINS,I BPTYP,"*N/ A*","")),0 )),U,7) Q X ;CUIDS(I BCNS) ; N DIE,DA,DR, PIECE,DAT6 ,Y S DAT6= $P(^DIC(36 ,IBCNS,6), U,1,8) ; g et the Pay er IDs ; ; Make sure each qual ifier has an ID and vice versa F PIECE=1 ,3,5,7 D . I $TR($P( DAT6,U,PIE CE,PIECE+1 ),U)="" Q ; both bl ank . I $P (DAT6,U,PI ECE)]"",$P (DAT6,U,PI ECE+1)]"" Q ; both have data . S DIE="^ DIC(36,",( DA,Y)=IBCN S,DR="6.0" _$S($P(DAT 6,U,PIECE) ]"":PIECE, 1:PIECE+1) _"////@" . D ^DIE K DIE ; S DA T6=$P($G(^ DIC(36,IBC NS,6)),U,1 ,8) ; get the Payer IDs again since they may have changed ab ove. ; ; M ake sure t he first p air of ID/ Qual are p opulated i f the 2nd pair is. I f not, mov e em over. ; This is done for institutio nal then p rofessiona l F PIECE= 1,5 D . I $P(DAT6,U, PIECE)]"" Q ; alrea dy has set one . I $ P(DAT6,U,P IECE+2)="" Q ; has no second set . S DI E="^DIC(36 ,",(DA,Y)= IBCNS . ; deleting t he qualifi er trigger s deletion of the ID . S DR="6 .0"_PIECE_ "////"_$P( DAT6,U,PIE CE+2)_";6. 0"_(PIECE+ 1)_"////"_ $P(DAT6,U, PIECE+3)_" ;6.0"_(PIE CE+2)_"/// /@" . D ^D IE K DIE Q | |
| 567 | ||
| 568 | ||
| 569 | Routines | |
| 570 | Activities | |
| 571 | Routine Na me | |
| 572 | IBCEPB | |
| 573 | Enhancemen t Category | |
| 574 | New | |
| 575 | Modify | |
| 576 | Delete | |
| 577 | No Change | |
| 578 | RTM | |
| 579 | ||
| 580 | Related Op tions | |
| 581 | None | |
| 582 | Related Ro utines | |
| 583 | Routines “ Called By” | |
| 584 | Routines “ Called” | |
| 585 | ||
| 586 | ||
| 587 | ||
| 588 | ||
| 589 | Data Dicti onary (DD) Reference s | |
| 590 | ||
| 591 | Related Pr otocols | |
| 592 | None | |
| 593 | Related In tegration Control Re gistration s (ICRs) | |
| 594 | None | |
| 595 | Data Passi ng | |
| 596 | Input | |
| 597 | Output Re ference | |
| 598 | Both | |
| 599 | Global Re ference | |
| 600 | Local | |
| 601 | Input Attr ibute Name and Defin ition | |
| 602 | Name: | |
| 603 | Definition : | |
| 604 | Output Att ribute Nam e and Defi nition | |
| 605 | Name: | |
| 606 | Definition : | |
| 607 | Current Lo gic | |
| 608 | IBCEPB ;AL B/WCJ - In surance co mpany ID p arameters ;22-DEC-20 05 ;;2.0;I NTEGRATED BILLING;** 320,348,34 9,400,516* *;21-MAR-9 4;Build 12 3 ;;Per VA Directive 6402, thi s routine should not be modifi ed.EN ; -- main entr y point fo r IBCE INS CO ID MAIN T D EN^VAL M("IBCE IN SCO ID MAI NT") Q ;HD R ; -- hea der code N PCF,PCDIS P I '$D(IB CNS) N IBC NS S IBCNS =IBINS S P CF=$P($G(^ DIC(36,+IB CNS,3)),U, 13),PCDISP =$S(PCF="P ":"(Parent )",1:"") S VALMHDR(1 )="Insuran ce Co: "_$ P($G(^DIC( 36,+IBCNS, 0)),U)_PCD ISP Q ;INI T ; Initia lize D CLE AN^VALM10 I '$D(IBCN S) N IBCNS S IBCNS=I BINS N IBL CT S IBLCT =0 ; Displ ay the lis t D SET1(. IBLCT,"Att ending/Ren dering Pro vider Seco ndary ID") D SET1(.I BLCT,"Defa ult ID (15 00) : "_$$ GET1^DIQ(3 6,IBCNS,4. 01)) D SET 1(.IBLCT," Default ID (UB-04): "_$$GET1^D IQ(36,IBCN S,4.02)) D SET1(.IBL CT,"Requir e ID on Cl aim: "_$$G ET1^DIQ(36 ,IBCNS,4.0 3)) D SET1 (.IBLCT," ") D SET1( .IBLCT,"Re ferring Pr ovider Sec ondary ID" ) D SET1(. IBLCT,"Def ault ID (1 500): "_$$ GET1^DIQ(3 6,IBCNS,4. 04)) D SET 1(.IBLCT," Require ID on Claim: "_$$GET1^ DIQ(36,IBC NS,4.05)) D SET1(.IB LCT," ") D SET1(.IBL CT,"Billin g Provider Secondary IDs") D S ET1(.IBLCT ,"Use Att/ Rend ID as Billing P rovider Se c. ID (150 0)? : "_$$ GET1^DIQ(3 6,IBCNS,4. 06)) D SET 1(.IBLCT," Use Att/Re nd ID as B illing Pro vider Sec. ID (UB-04 )?: "_$$GE T1^DIQ(36, IBCNS,4.08 )) D SET1( .IBLCT,"Tr ansmit no Billing Pr ovider Sec ID for th e followin g Electron ic Plan Ty pes:") D L IST^DIC(36 .013,","_I BCNS_","," .01",,10,, ,,,,"TAR", "ERR") F I =1:1:+$G(T AR("DILIST ",0)) D . D SET1(.IB LCT,TAR("D ILIST",1,I )) D SET1( .IBLCT," " ) D SET1(. IBLCT,"Bil ling Provi der/Servic e Facility ") ; S IBC NS4=$G(^DI C(36,+IBCN S,4)) ; MR D;IB*2.0*5 16 - Marke d fields 4 .07, 4.11, 4.12 and 4.13 for ; deletion and remove d all refe rences to them. ;D S ET1(.IBLCT ,"Always u se main VA MC as Bill ing Provid er (1500)? : "_$$EXPA ND^IBTRE(3 6,4.11,+$P (IBCNS4,U, 11))) ;D S ET1(.IBLCT ,"Always u se main VA MC as Bill ing Provid er (UB-04) ?: "_$$EXP AND^IBTRE( 36,4.12,+$ P(IBCNS4,U ,12))) ;I $P(IBCNS4, U,11)!($P( IBCNS4,U,1 2)) D ;.D SET1(.IBLC T,"Send VA Lab/Facil ity IDs or Facility Data for V AMC?: "_$$ EXPAND^IBT RE(36,4.07 ,+$P(IBCNS 4,U,7))) ; .D SET1(.I BLCT,"Use the Billin g Prov (VA MC) Name a nd Street Address?: "_$$EXPAND ^IBTRE(36, 4.13,+$P(I BCNS4,U,13 ))) ;.Q ; S VALMBG=1 ,VALMCNT=I BLCT Q ;SE T1(IBLCT,T EXT,IBCT) ; S IBLCT= IBLCT+1 D SET^VALM10 (IBLCT,TEX T) Q ;EXPN D ; QHELP ; QEXIT ; D CLEAN^VA LM10 Q ;ID PARAM ; D FULL^VALM1 N DIE,DA, DR I '$D(I BCNS) N IB CNS S IBCN S=IBINS S DIE="^DIC( 36,",(DA,Y )=IBCNS,DR ="[IBEDIT INS CO1]" I '$D(IBY) N IBY S I BY=",12," D ^DIE K D IE K ^TMP( "IBCE_PRVF AC_MAINT", $J) D INIT S VALMBCK ="R" Q ;BI LLPRVP ; D FULL^VALM 1 D EN^IBC EPC D INIT K ^TMP("I BCE_PRVFAC _MAINT",$J ) S VALMBC K="R" Q | |
| 609 | Modified L ogic (Chan ges are in bold) | |
| 610 | IBCEPB ;AL B/WCJ - In surance co mpany ID p arameters ;22-DEC-20 05 ;;2.0;I NTEGRATED BILLING;** 320,348,34 9,400,516, 592**;21-M AR-94;Buil d 123 ;;Pe r VA Direc tive 6402, this rout ine should not be mo dified.EN ; -- main entry poin t for IBCE INSCO ID MAINT D EN ^VALM("IBC E INSCO ID MAINT") Q ;HDR ; -- header co de N PCF,P CDISP I '$ D(IBCNS) N IBCNS S I BCNS=IBINS S PCF=$P( $G(^DIC(36 ,+IBCNS,3) ),U,13),PC DISP=$S(PC F="P":"(Pa rent)",1:" ") S VALMH DR(1)="Ins urance Co: "_$P($G(^ DIC(36,+IB CNS,0)),U) _PCDISP Q ;INIT ; In itialize D CLEAN^VAL M10 I '$D( IBCNS) N I BCNS S IBC NS=IBINS N IBLCT S I BLCT=0 ; D isplay the list D SE T1(.IBLCT, "Attending /Rendering Provider Secondary ID") D SET 1(.IBLCT," Default ID (1500): " _$$GET1^DI Q(36,IBCNS ,4.01)) ;J WS;IB*2.0* 592; add f ield for A tt/Rend Se c ID for J 430D D SET 1(.IBLCT," Default ID (J430D): "_$$GET1^D IQ(36,IBCN S,4.14)) D SET1(.IBL CT,"Defaul t ID (UB-0 4): "_$$GE T1^DIQ(36, IBCNS,4.02 )) D SET1( .IBLCT,"Re quire ID o n Claim: " _$$GET1^DI Q(36,IBCNS ,4.03)) D SET1(.IBLC T," ") D S ET1(.IBLCT ,"Referrin g Provider Secondary ID") D SE T1(.IBLCT, "Default I D (1500): "_$$GET1^D IQ(36,IBCN S,4.04)) ; JWS;IB*2.0 *592;add f ield for R efer Pro S ec ID for J430D D SE T1(.IBLCT, "Default I D (J430D): "_$$GET1^ DIQ(36,IBC NS,4.15)) D SET1(.IB LCT,"Requi re ID on C laim: "_$$ GET1^DIQ(3 6,IBCNS,4. 05)) D SET 1(.IBLCT," ") ;JWS;I B*2.0*592 D SET1(.IB LCT,"Assis tant Surge on Seconda ry ID") D SET1(.IBLC T,"Default ID (J430D ): "_$$GET 1^DIQ(36,I BCNS,4.17) ) D SET1(. IBLCT," ") D SET1(.I BLCT,"Bill ing Provid er Seconda ry IDs") D SET1(.IBL CT,"Use At t/Rend ID as Billing Provider Sec. ID (1 500)?: "_$ $GET1^DIQ( 36,IBCNS,4 .06)) ;JWS ;IB*2.0*59 2; add fie ld for Att /Rend ID a s Billing Prov sec i d for J430 D D SET1(. IBLCT,"Use Att/Rend ID as Bill ing Provid er Sec. ID (J430D)?: "_$$GET1^ DIQ(36,IBC NS,4.16)) D SET1(.IB LCT,"Use A tt/Rend ID as Billin g Provider Sec. ID ( UB-04)?: " _$$GET1^DI Q(36,IBCNS ,4.08)) D SET1(.IBLC T,"Transmi t no Billi ng Provide r Sec ID f or the fol lowing Ele ctronic Pl an Types:" ) D LIST^D IC(36.013, ","_IBCNS_ ",",".01", ,10,,,,,," TAR","ERR" ) F I=1:1: +$G(TAR("D ILIST",0)) D . D SET 1(.IBLCT,T AR("DILIST ",1,I)) D SET1(.IBLC T," ") D S ET1(.IBLCT ,"Billing Provider/S ervice Fac ility") ; S IBCNS4=$ G(^DIC(36, +IBCNS,4)) ; MRD;IB* 2.0*516 - Marked fie lds 4.07, 4.11, 4.12 and 4.13 for ; dele tion and r emoved all reference s to them. ;D SET1(. IBLCT,"Alw ays use ma in VAMC as Billing P rovider (1 500)?: "_$ $EXPAND^IB TRE(36,4.1 1,+$P(IBCN S4,U,11))) ;D SET1(. IBLCT,"Alw ays use ma in VAMC as Billing P rovider (U B-04)?: "_ $$EXPAND^I BTRE(36,4. 12,+$P(IBC NS4,U,12)) ) ;I $P(IB CNS4,U,11) !($P(IBCNS 4,U,12)) D ;.D SET1( .IBLCT,"Se nd VA Lab/ Facility I Ds or Faci lity Data for VAMC?: "_$$EXPAN D^IBTRE(36 ,4.07,+$P( IBCNS4,U,7 ))) ;.D SE T1(.IBLCT, "Use the B illing Pro v (VAMC) N ame and St reet Addre ss?: "_$$E XPAND^IBTR E(36,4.13, +$P(IBCNS4 ,U,13))) ; .Q ; S VAL MBG=1,VALM CNT=IBLCT Q ;SET1(IB LCT,TEXT,I BCT) ; S I BLCT=IBLCT +1 D SET^V ALM10(IBLC T,TEXT) Q ;EXPND ; Q HELP ; QEX IT ; D CLE AN^VALM10 Q ;IDPARAM ; D FULL^ VALM1 N DI E,DA,DR I '$D(IBCNS) N IBCNS S IBCNS=IBI NS S DIE=" ^DIC(36,", (DA,Y)=IBC NS,DR="[IB EDIT INS C O1]" I '$D (IBY) N IB Y S IBY=", 12," D ^DI E K DIE K ^TMP("IBCE _PRVFAC_MA INT",$J) D INIT S VA LMBCK="R" Q ;BILLPRV P ; D FULL ^VALM1 D E N^IBCEPC D INIT K ^T MP("IBCE_P RVFAC_MAIN T",$J) S V ALMBCK="R" Q | |
| 611 | ||
| 612 | Routines | |
| 613 | Activities | |
| 614 | Routine Na me | |
| 615 | IBCEF2 | |
| 616 | Enhancemen t Category | |
| 617 | New | |
| 618 | Modify | |
| 619 | Delete | |
| 620 | No Change | |
| 621 | RTM | |
| 622 | ||
| 623 | Related Op tions | |
| 624 | None | |
| 625 | Related Ro utines | |
| 626 | Routines “ Called By” | |
| 627 | Routines “ Called” | |
| 628 | ||
| 629 | ||
| 630 | ||
| 631 | ||
| 632 | Data Dicti onary (DD) Reference s | |
| 633 | ||
| 634 | Related Pr otocols | |
| 635 | None | |
| 636 | Related In tegration Control Re gistration s (ICRs) | |
| 637 | None | |
| 638 | Data Passi ng | |
| 639 | Input | |
| 640 | Output Re ference | |
| 641 | Both | |
| 642 | Global Re ference | |
| 643 | Local | |
| 644 | Input Attr ibute Name and Defin ition | |
| 645 | Name: | |
| 646 | Definition : | |
| 647 | Output Att ribute Nam e and Defi nition | |
| 648 | Name: | |
| 649 | Definition : | |
| 650 | Current Lo gic | |
| 651 | IBCEF2 ;AL B/TMP - FO RMATTER SP ECIFIC BIL L FUNCTION S ;8/6/03 10:54am ;; 2.0;INTEGR ATED BILLI NG;**52,85 ,51,137,23 2,155,296, 349,403,40 0,432,488, 461,547**; 21-MAR-94; Build 119 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ;HOS(IBI FN) ; Extr act rev co des for in st. episod e into IBX DATA ; Mov ed for spa ce D HOS^I BCEF22(IBI FN) Q ;OTH INS(IBIFN) ;Determin e 'other i nsurance' node (I1,I 2) ; If pr imary bill , other in s is secon dary ; If sec or ter t bill, ot her ins is primary ; IBIFN = bi ll ien N Z S Z=$$COB N^IBCEF(IB IFN) Q "I" _$S(Z=1:2, 1:1) ;OTHI NS1(IBIFN) ; Returns the COB # 's of all 'other ins urance' as a string ;IBIFN = b ill ien N IBC,Z S Z= $$COBN^IBC EF(IBIFN) I Z=1 S IB C=$S($D(^D GCR(399,IB IFN,"I2")) :$S($D(^DG CR(399,IBI FN,"I3")): 23,1:2),1: "") ;Prima ry=>2 or 2 3 I Z=2 S IBC="1"_$S ($D(^DGCR( 399,IBIFN, "I3")):3,1 :"") ;Seco ndary=>1 o r 13 I Z=3 S IBC="12 " ;Tertiar y =>12OTHQ Q IBC ;RE CVR(IBIFN) ; Returns the V.A. internal r outing id of the cur rent ins ; co for 83 7 ;IBIFN = bill ien N MCR,NUM, IBPH S IBP H=$P("P^H" ,U,$$FT^IB CEF(IBIFN) -1) S NUM= "ENVOY"_IB PH ; If ra te type is CHAMPVA, send 'CHAM VA' I $P($ G(^DGCR(39 9.3,+$P($G (^DGCR(399 ,IBIFN,0)) ,U,7),0)), U)="CHAMPV A" S NUM=" CHAMV"_IBP H I NUM["E NVOY",$$MC RWNR^IBEFU NC(+$$CURR (IBIFN)) D . S MCR=$ P("B^A",U, $$FT^IBCEF (IBIFN)-1) ; PART A/ B for MEDI CARE . S N UM="PART"_ MCR Q NUM ;ALLPAYID( IBIFN,IBXD ATA,SEQ) ; Returns c learinghou se id for all (SEQ=" ") ; or a specific ( SEQ=1,2,3) ins co's for 837 in IBXDATA(n ) for bill ien ; IBI FN ; EJK * 296* Add I BMRA - MRA Claim typ e. ; EJK *296* Add IBEBI - El ectronic B illing ID ; ;WCJ;IB* 2.0*547 - added IBM2 ;N Z,Z0,Z 1,A,IBM,IB INST,IBMCR ,IBX,IBMRA ,IBEBI N Z ,Z0,Z1,A,I BM,IBM2,IB INST,IBMCR ,IBX,IBMRA ,IBEBI ;S IBXDATA="" ,IBM=$G(^D GCR(399,IB IFN,"M")) S IBXDATA= "",IBM=$G( ^DGCR(399, IBIFN,"M") ),IBM2=$G( ^DGCR(399, IBIFN,"M2" )) F Z=1:1 :3 I $S('$ G(SEQ):1,1 :Z=SEQ) S Z0=$P(IBM, U,Z) I Z0 D S:A'="" IBXDATA(Z )=A . S A= "" . ;WCJ; IB*2.0*547 . I $P(IB M2,U,Z*2)] "" S A=$P( IBM2,U,Z*2 ) Q ; gra b new alte rnate paye r IDs from bill if t hey exist . ; . S IB INST=($$FT ^IBCEF(IBI FN)=3) ;Is bill UB-0 4? . ; EJK *296* Get IBEBI bas ed on Prof . or Inst. claim . I IBINST S IBEBI=$P($ G(^DIC(36, Z0,3)),U,4 ) . I 'IBI NST S IBEB I=$P($G(^D IC(36,Z0,3 )),U,2) . S IBEBI=$$ UP^XLFSTR( IBEBI) . ; EJK *296* If this i s a Medica re claim, it may be printed or transmitt ed. . S I BMRA=$$MRA SEC^IBCEF4 (IBIFN) ;I s claim 2n dary to an MRA? . S IBMCR=$$M CRONBIL^IB EFUNC(IBIF N),Z1=$G(^ DGCR(399,I BIFN,"TX") ) . Q:$P(Z 1,U,8)=1!$ S('$P(Z1,U ,9):0,1:$$ MRASEC^IBC EF4(IBIFN) ) ;Force l ocal prnt . S A=$S($ P(Z1,U,8)' =2:$P($G(^ DIC(36,Z0, 3)),U,$S(I BINST:4,1: 2)),1:"") . S A=$$UP ^XLFSTR(A) . ; . ; R PRNT = CMS -1500 Rx b ills . ; I PRNT = Ins t MRA seco ndary clai ms . ; PPR NT = Prof MRA second ary claims . ; HPRNT = inst pr inted bill s (non-MRA , force pr int at cle aringhouse ) . ; SPRN T = prof p rinted bil ls (non-MR A, force p rint at cl earinghous e) . ; . ; Default t o appropri ate 'xPRNT ' if Rx bi ll or COB bill or fo rced to . ; print - claims mus t print at clearingh ouse . ; . ; Rx bill s on CMS-1 500 . ;IB* 2.0*432/TA Z Claims n o longer p rint at cl earinghous e . ;I 'IB INST,$$ISR X^IBCEF1(I BIFN) S A= "RPRNT" Q . ; . ; Cl aim forced to print at clearin ghouse (Fi eld #27) . I $P(Z1,U ,8)=2 S A= $S(IBINST: "H",1:"S") _"PRNT" Q . ; . ; EJ K *296* Se nd IBEBI f or MRA sec ondary cla ims if it exists . I Z>1,IBMRA ,IBEBI'="" S A=IBEBI Q . ; . ; MRA secon dary claim . I Z>1,I BMCR=1,$P( Z1,U,5)="C " S A=$S(I BINST:"I", 1:"P")_"PR NT" Q . ; . ; Medica re is curr ent payer (MRA reque st claim) . I $$WNRB ILL^IBEFUN C(IBIFN,Z) S A=$S(IB INST:"12M6 1",1:"SMTX 1") Q . ; . ; IB*296 - Do not modify the payer ID for CHAMPV A (HAC) . I A=84146 Q . I A=84 147 Q . ; . ; If not a primary bill forc e to print . ;IB*2.0 *432/TAZ s econdary b ills will now be pro cessed . ; I Z>1,Z=$$ COBN^IBCEF (IBIFN) S A=$S(IBINS T:"H",1:"S ")_"PRNT" Q . Q ; Q ;PAYERID(I BIFN) ; Re turns clea ringhouse id for cur rent ins c o ; IBIFN = bill ien N NUM,IBS EQ ; Deter mine the c urrent ins co's # to identify at WEBMD ; Envoy cha nged to WE BMD in pat ch 232 S I BSEQ=+$$CO BN^IBCEF(I BIFN) D AL LPAYID(IBI FN,.NUM,IB SEQ) S NUM =$G(NUM(IB SEQ)) Q $G (NUM) ;CUR R(IBIFN) ; Returns i en of the current in surance ; company fo r bill ien IBIFN Q $ $FINDINS^I BCEF1(IBIF N) ;ADMDT( IBIFN,NOOU TCK) ; Cal culate adm ission/sta rt of care date/time D ADMDT^I BCEF21(IBI FN,$G(NOOU TCK)) ; Mo ved for sp ace Q ;DIS DT(IBIFN) ; Calculat e discharg e date D D ISDT^IBCEF 21(IBIFN) ; Moved fo r space Q ;INDTS(IBI FN) ; Func tion retur ns the adm it ^ disch arge date/ time of ad mission if patient i s an inpat ient on bi ll's event date N Z, Z0,DFN,VAI NDT,VAIN S Z0="" S Z =$G(^DGCR( 399,+$G(IB IFN),0)),D FN=$P(Z,U, 2),VAINDT= $P(Z,U,3) I +DFN,+VA INDT D INP ^VADPT I + VAIN(1) S Z0=+VAIN(7 )_U_+$G(^D GPM(+$P($G (^DGPM(+VA IN(1),0)), U,17),0)) Q Z0 ;TXMT (IBIFN) ; Function m oved - use new call in IBCEF4 Q $$TXMT^I BCEF4(IBIF N) ; ;ID(L N,VAL) ; S et EXTRACT GLOBAL fo r multi-va lued recor d ; ids fo r Austin ; LN = the line # bei ng extract ed ; VAL = the value of the el ement bein g extracte d ; ; Assu mes IBXPG exists ; Q :LN<2 D SE TGBL^IBCEF G(IBXPG,LN ,1,VAL,.IB XSIZE) Q ; ID1(LN,DX, CT,DCT,ECT ) ;Special entry poi nt for dia gnoses to 'save' the fact ; a dx code is an e-code . ; LN is last entry # output, returned as the ent ry # (IBXL INE) to as sign to th is entry ; DX = the actual Dx code array (RECORD ID ). Pass by reference , DX retur ned null i f ; dx was not outpu t ; CT = t he ct on t he 'DC' en try. pass by referen ce, return ed null if ; the end of the va lid dx cod es has bee n reached ; DCT= Cou nt of regu lar DX cod es. UB-04 can have 2 5 non Exte rnal Cause codes. ; ECT= Count of Extern al Cause c odes. UB-0 4 can have 12 Extern al Cause c odes. ; Ex ternal Cau se of Inju ry codes a nd qualifi er changed with ICD- 10: E-code s in ICD-9 , V,X,W,Y- codes in I CD-10 N IB INS,VAL,CN T,DXIEN,DX Q,EDX,I,PO A,ICDV S I BINS=($$FT ^IBCEF(IBX IEN)=3) S VAL="DC"_C T S VAL=$E (VAL_" ",1 ,4) S DCT= +$G(DCT),E CT=+$G(ECT ) ;Make su re variabl es are ini tialized. ; S EDX=0, DX=$G(DX) S ICDV=$$I CD9VER^IBA CSV(+$G(DX (CT))) I I CDV=1,$E(D X)="E" S E DX=1 ; TRU E if ECI I CD-9 Dx (e -code) I I CDV=30,"VW XY"[$E(DX) S EDX=1 ; TRUE if E CI ICD-10 Dx ; S I=$ S(EDX:3,1: 2) ; S:'ED X DXQ=$S(+ $G(^TMP("D CX",$J,2)) >0:"BF",1: "BK") ; fi rst non e- code DX is principal (qualifie r "BK"), t he rest ha ve qualifi er "BF" ; I IBINS D I DX="" G IDX1 .;I CT>28 S CT ="" Q ; Ma x of 28 co des for in stitutiona l/UB .I ED X S ECT=EC T+1 I ECT> 12 S DX="" Q ;Only 12 E-codes allowed . I 'EDX S D CT=DCT+1 I DCT>25 S DX="" Q ; Only 25 DX codes all owed .S DX IEN=$P(DX( CT),U,2) Q :DXIEN="" .; IB*2.0* 547 - no l onger stuf f a 1 for POA, send a blank if null .S P OA=$P($G(^ IBA(362.3, DXIEN,0)), U,4) ; I P OA="",$$IN PAT^IBCEF( IBXIEN) S POA=1 ; PO A indicato r defaults to "1", i f not pres ent on inp atient cla im .S:EDX DXQ="BN" ; e-code DX qualifier .Q ; I 'I BINS S:EDX DXQ="BF" S POA="" ; on CMS-15 00 e-code DX qualifi ers are "B F" and the re's no PO A ; I ICDV =30 S DXQ= "A"_DXQ ; adjust Qua lifier for ICD-10 co des ; ;Cha nged 8 to 12 so we c an transmi t 12 codes . BAA *488 * I 'IBINS ,CT>12 S ^ TMP("IBXSA VE",$J,"DX ",IBXIEN)= $G(^TMP("I BXSAVE",$J ,"DX",IBXI EN))+1,^TM P("IBXSAVE ",$J,"DX", IBXIEN,$P( DX(+^TMP(" IBXSAVE",$ J,"DX",IBX IEN)),U,2) )=$G(^TMP( "IBXSAVE", $J,"DX",IB XIEN)) S D X="" Q ; I CT'="",DX '="" D .; populate ^ TMP("DCX") scratch g lobal .S ^ TMP("DCX", $J,1)=CT,C NT=$G(^TMP ("DCX",$J, I))+1,^TMP ("DCX",$J, I)=CNT .S (^TMP("DCX ",$J,I,CNT ),^TMP("DC X",$J,1,CT ))=DX_U_DX Q_U_POA .S LN=LN+1 D ID(LN,VAL ) S ^TMP(" IBXSAVE",$ J,"DX",IBX IEN,$P(DX( LN),U,2))= LN,^TMP("I BXSAVE",$J ,"DX",IBXI EN)=CT,CT= CT+1 .Q ;I DX1 ; Q ;M (CT) ; Cal culate mul ti-valued field for 837 extrac t ; CT = p assed by r eference/t he record ID counter S CT=CT+1 ;IB*2.0*5 47/TAZ Inc rease coun ter to 25 ;Q $E(CT#1 2+$S(CT#12 :0,1:12)_" ",1,2) Q $E(CT#25+$ S(CT#25:0, 1:25)_" ", 1,2) ;SVIT M(IBA,LINE ) ; Saves the linked items fro m the bill data extr act into ; an array the format ter will u se to link Rxs and p rosthetics ; to an S V1 or SV2 line item, if possib le. Kills off IBA ar ray entrie s ; after they are ' moved' ; I BA = array that cont ains the d ata to be saved ; su bscripts a re (line # ,item type ,item poin ter)=ct N Z0,Z1 S Z0 ="" F S Z 0=$O(IBA(" OUTPT",LIN E,Z0)) Q:Z 0="" I Z0 ?1N.N S Z 1="" F S Z1=$O(IBA( "OUTPT",LI NE,Z0,Z1)) Q:Z1="" S ^TMP($J, "IBITEM",Z 0,Z1,LINE) =IBA("OUTP T",LINE,Z0 ,Z1) K IBA ("OUTPT",L INE,Z0,Z1) Q ;LINK(I BTYP,IBDAT A) ; Link the item w ith a serv ice line, if possibl e ; IBTYP = the code for the t ype of ite m ; return ed increme nted if no link is m ade ; IBDA TA = the e xtracted d ata string that iden tifies the item. ; Returns th e line to link to or null if n o link N I BLN,IBKEY, Z S IBLN=" " S IBKEY= $S(IBTYP=3 :$P(IBDATA ,U,9),IBTY P=5:$P(IBD ATA,U,4),1 :"") Q:IBK EY="" I $D (^TMP($J," IBITEM",IB TYP,IBKEY) ) D G:IBL N LINKQ .S Z=0 F S Z=$O(^TMP( $J,"IBITEM ",IBTYP,IB KEY,Z)) Q: 'Z I ^TMP ($J,"IBITE M",IBTYP,I BKEY,Z) S IBLN=Z,^TM P($J,"IBIT EM",IBTYP, IBKEY,Z)=^ TMP($J,"IB ITEM",IBTY P,IBKEY,Z) -1 Q I $D( ^TMP($J,"I BITEM",IBT YP,0)) S I BKEY=0 D . S Z=0 F S Z=$O(^TMP ($J,"IBITE M",IBTYP,I BKEY,Z)) Q :'Z I ^TM P($J,"IBIT EM",IBTYP, IBKEY,Z) S IBLN=Z,^T MP($J,"IBI TEM",IBTYP ,IBKEY,Z)= ^TMP($J,"I BITEM",IBT YP,IBKEY,Z )-1 QLINKQ Q IBLN ;C OID(IBIFN) ; Claim o ffice ID - moved for space Q $ $COID^IBCE F21(IBIFN) ;PPOL(IBI FN,COB) ; return IFN of patien t policy o n a bill d efined by COB (field s 399,112- 114) N X,Y ,PPOL S PP OL="" I +$ G(IBIFN) S X=$G(^DGC R(399,+IBI FN,"M")) I +$G(COB), COB<4 S Y= COB+11,PPO L=$P(X,U,Y ) Q PPOL ; LADJ(SUB,L INE,SEQ1,G RP,IBXSAVE ,PIECE) ; Extract li ne level a djustments ; SUB = 1 st subscri pt in IBXS AVE array to use ; L INE = 2nd subscript ; SEQ1 = 4 th subscri pt ; GRP = 5th subsc ript ; IBX SAVE = arr ay that ha s the data for COB l ine level adjustment s ; PIECE = # of the piece on the 0-node of the li ne level ; adjustmen t reason t o be extra cted ; N A ,B S (A,B) =0 F S A= $O(IBXSAVE (SUB,LINE, "COB",SEQ1 ,GRP,A)) Q :'A D . S B=B+1,IBX DATA(B)=$P (IBXSAVE(S UB,LINE,"C OB",SEQ1,G RP,A),U,PI ECE) Q ;ES GHPST(IBIF N,COB) ; r eturn insu reds emplo y status i f bill pol icy define d by COB i s an Emplo yer Sponso red Group Health Pla n Q $$ESGH PST^IBCEF2 1(IBIFN,CO B) ;Tag mo ved ;ESGHP NL(IBIFN,C OB) ; retu rn employe r name and location if bill po licy defin ed by COB is an Empl oyer Spons ored Group Health Pl an Q $$ESG HPNL^IBCEF 21(IBIFN,C OB) ;Tag m oved ;AMTO UT(A,B,C,I BXSAVE) ; format out put amount ; N Z,K,I BZ,IBARR K IBXDATA S (IBZ,K)=0 ,IBARR="IB XSAVE("""_ A_""")" F S IBZ=$O( @IBARR@(IB Z)) Q:'IBZ S K=K+1, Z=0 F S Z =$O(@IBARR @(IBZ,Z)) Q:'Z I $P ($G(@IBARR @(IBZ,Z,B) ),U,C) S I BXDATA(K)= $$DOLLAR^I BCEFG1($G( IBXDATA(K) )+$P(@IBAR R@(IBZ,Z,B ),U,C)) Q | |
| 652 | Modified L ogic (Chan ges are in bold) | |
| 653 | IBCEF2 ;AL B/TMP - FO RMATTER SP ECIFIC BIL L FUNCTION S ;8/6/03 10:54am ;; 2.0;INTEGR ATED BILLI NG;**52,85 ,51,137,23 2,155,296, 349,403,40 0,432,488, 461,547,59 2**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;HOS (IBIFN) ; Extract re v codes fo r inst. ep isode into IBXDATA ; Moved for space D H OS^IBCEF22 (IBIFN) Q ;OTHINS(IB IFN) ;Dete rmine 'oth er insuran ce' node ( I1,I2) ; I f primary bill, othe r ins is s econdary ; If sec or tert bill , other in s is prima ry ;IBIFN = bill ien N Z S Z=$ $COBN^IBCE F(IBIFN) Q "I"_$S(Z= 1:2,1:1) ; OTHINS1(IB IFN) ; Ret urns the C OB #'s of all 'other insurance ' as a str ing ;IBIFN = bill ie n N IBC,Z S Z=$$COBN ^IBCEF(IBI FN) I Z=1 S IBC=$S($ D(^DGCR(39 9,IBIFN,"I 2")):$S($D (^DGCR(399 ,IBIFN,"I3 ")):23,1:2 ),1:"") ;P rimary=>2 or 23 I Z= 2 S IBC="1 "_$S($D(^D GCR(399,IB IFN,"I3")) :3,1:"") ; Secondary= >1 or 13 I Z=3 S IBC ="12" ;Ter tiary =>12 OTHQ Q IBC ;RECVR(IB IFN) ; Ret urns the V .A. intern al routing id of the current i ns ; co fo r 837 ;IBI FN = bill ien N MCR, NUM,IBPH ; JWS;IB*2.0 *592:Denta l form #7 S IBPH=$P( "P^H^^^^DE NTAL",U,$$ FT^IBCEF(I BIFN)-1) S NUM=$S($$ FT^IBCEF(I BIFN)=7:IB PH,1:"ENVO Y"_IBPH) ; If rate t ype is CHA MPVA, send 'CHAMVA' I $P($G(^D GCR(399.3, +$P($G(^DG CR(399,IBI FN,0)),U,7 ),0)),U)=" CHAMPVA" S NUM="CHAM V"_IBPH I NUM["ENVOY ",$$MCRWNR ^IBEFUNC(+ $$CURR(IBI FN)) D . ; JWS;IB*2.0 *592:Denta l form #7 . S MCR=$P ("B^A^^^^B ",U,$$FT^I BCEF(IBIFN )-1) ; PAR T A/B for MEDICARE . S NUM="PA RT"_MCR Q NUM ;ALLPA YID(IBIFN, IBXDATA,SE Q) ; Retur ns clearin ghouse id for all (S EQ="") ; o r a specif ic (SEQ=1, 2,3) ins c o's for 83 7 in IBXDA TA(n) for bill ien ; IBIFN ; E JK *296* A dd IBMRA - MRA Claim type. ; EJK *296* Add IBEBI - Electron ic Billing ID ; ;WCJ ;IB*2.0*54 7 - added IBM2 ;N Z, Z0,Z1,A,IB M,IBINST,I BMCR,IBX,I BMRA,IBEBI N Z,Z0,Z1 ,A,IBM,IBM 2,IBINST,I BMCR,IBX,I BMRA,IBEBI ;S IBXDAT A="",IBM=$ G(^DGCR(39 9,IBIFN,"M ")) S IBXD ATA="",IBM =$G(^DGCR( 399,IBIFN, "M")),IBM2 =$G(^DGCR( 399,IBIFN, "M2")) F Z =1:1:3 I $ S('$G(SEQ) :1,1:Z=SEQ ) S Z0=$P( IBM,U,Z) I Z0 D S:A '="" IBXDA TA(Z)=A . S A="" . ; WCJ;IB*2.0 *547 . I $ P(IBM2,U,Z *2)]"" S A =$P(IBM2,U ,Z*2) Q ; grab new alternate payer IDs from bill if they ex ist . ; . S IBINST=( $$FT^IBCEF (IBIFN)=3) ;Is bill UB-04? . ; EJK *296* Get IBEBI based on Prof. or I nst. claim . I IBINS T S IBEBI= $P($G(^DIC (36,Z0,3)) ,U,4) . I 'IBINST S IBEBI=$P($ G(^DIC(36, Z0,3)),U,2 ) . ;JWS;I B*2.0*592; Dental pay er id . I $$FT^IBCEF (IBIFN)=7 S IBEBI=$P ($G(^DIC(3 6,Z0,3)),U ,15) . S I BEBI=$$UP^ XLFSTR(IBE BI) . ; EJ K *296* If this is a Medicare claim, it may be pri nted or tr ansmitted. . S IBMR A=$$MRASEC ^IBCEF4(IB IFN) ;Is c laim 2ndar y to an MR A? . S IB MCR=$$MCRO NBIL^IBEFU NC(IBIFN), Z1=$G(^DGC R(399,IBIF N,"TX")) . Q:$P(Z1,U ,8)=1!$S(' $P(Z1,U,9) :0,1:$$MRA SEC^IBCEF4 (IBIFN)) ; Force loca l prnt . S A=$S($P(Z 1,U,8)'=2: $P($G(^DIC (36,Z0,3)) ,U,$S(IBIN ST:4,1:2)) ,1:"") . S A=$$UP^XL FSTR(A) . ; . ; RPRN T = CMS-15 00 Rx bill s . ; IPRN T = Inst M RA seconda ry claims . ; PPRNT = Prof MRA secondary claims . ; HPRNT = inst print ed bills ( non-MRA, f orce print at cleari nghouse) . ; SPRNT = prof prin ted bills (non-MRA, force prin t at clear inghouse) . ; . ; De fault to a ppropriate 'xPRNT' i f Rx bill or COB bil l or force d to . ; p rint - cla ims must p rint at cl earinghous e . ; . ; Rx bills o n CMS-1500 . ;IB*2.0 *432/TAZ C laims no l onger prin t at clear inghouse . ;I 'IBINS T,$$ISRX^I BCEF1(IBIF N) S A="RP RNT" Q . ; . ; Claim forced to print at clearingho use (Field #27) . I $P(Z1,U,8) =2 S A=$S( IBINST:"H" ,1:"S")_"P RNT" Q . ; . ; EJK * 296* Send IBEBI for MRA second ary claims if it exi sts . I Z> 1,IBMRA,IB EBI'="" S A=IBEBI Q . ; . ; MR A secondar y claim . I Z>1,IBMC R=1,$P(Z1, U,5)="C" S A=$S(IBIN ST:"I",1:" P")_"PRNT" Q . ; . ; Medicare is current payer (MR A request claim) . I $$WNRBILL ^IBEFUNC(I BIFN,Z) S A=$S(IBINS T:"12M61", 1:"SMTX1") Q . ; . ; IB*296 - Do not mod ify the pa yer ID for CHAMPVA ( HAC) . I A =84146 Q . I A=84147 Q . ; . ; If not a primary bi ll force t o print . ;IB*2.0*43 2/TAZ seco ndary bill s will now be proces sed . ;I Z >1,Z=$$COB N^IBCEF(IB IFN) S A=$ S(IBINST:" H",1:"S")_ "PRNT" Q . Q ; Q ;PA YERID(IBIF N) ; Retur ns clearin ghouse id for curren t ins co ; IBIFN = b ill ien N NUM,IBSEQ ; Determin e the curr ent ins co 's # to id entify at WEBMD ; En voy change d to WEBMD in patch 232 S IBSE Q=+$$COBN^ IBCEF(IBIF N) D ALLPA YID(IBIFN, .NUM,IBSEQ ) S NUM=$G (NUM(IBSEQ )) Q $G(NU M) ;CURR(I BIFN) ; Re turns ien of the cur rent insur ance ; com pany for b ill ien IB IFN Q $$FI NDINS^IBCE F1(IBIFN) ;ADMDT(IBI FN,NOOUTCK ) ; Calcul ate admiss ion/start of care da te/time D ADMDT^IBCE F21(IBIFN, $G(NOOUTCK )) ; Moved for space Q ;DISDT( IBIFN) ; C alculate d ischarge d ate D DISD T^IBCEF21( IBIFN) ; M oved for s pace Q ;IN DTS(IBIFN) ; Functio n returns the admit ^ discharg e date/tim e of admis sion if pa tient is a n inpatien t on bill' s event da te N Z,Z0, DFN,VAINDT ,VAIN S Z0 ="" S Z=$G (^DGCR(399 ,+$G(IBIFN ),0)),DFN= $P(Z,U,2), VAINDT=$P( Z,U,3) I + DFN,+VAIND T D INP^VA DPT I +VAI N(1) S Z0= +VAIN(7)_U _+$G(^DGPM (+$P($G(^D GPM(+VAIN( 1),0)),U,1 7),0)) Q Z 0 ;TXMT(IB IFN) ; Fun ction move d - use ne w call in IBCEF4 Q $ $TXMT^IBCE F4(IBIFN) ; ;ID(LN,V AL) ; Set EXTRACT GL OBAL for m ulti-value d record ; ids for A ustin ; LN = the lin e # being extracted ; VAL = th e value of the eleme nt being e xtracted ; ; Assumes IBXPG exi sts ; Q:LN <2 D SETGB L^IBCEFG(I BXPG,LN,1, VAL,.IBXSI ZE) Q ;ID1 (LN,DX,CT, DCT,ECT) ; Special en try point for diagno ses to 'sa ve' the fa ct ; a dx code is an e-code. ; LN is las t entry # output, re turned as the entry # (IBXLINE ) to assig n to this entry ; DX = the act ual Dx cod e array(RE CORD ID). Pass by re ference, D X returned null if ; dx was no t output ; CT = the ct on the 'DC' entry . pass by reference, returned null if ; the end of the valid dx codes has been r eached ; D CT= Count of regular DX codes. UB-04 can have 25 n on Externa l Cause co des. ; ECT = Count of External Cause code s. UB-04 c an have 12 External Cause code s. ; Exter nal Cause of Injury codes and qualifier changed wi th ICD-10: E-codes i n ICD-9, V ,X,W,Y-cod es in ICD- 10 N IBINS ,VAL,CNT,D XIEN,DXQ,E DX,I,POA,I CDV S IBIN S=($$FT^IB CEF(IBXIEN )=3) S VAL ="DC"_CT S VAL=$E(VA L_" ",1,4) S DCT=+$G (DCT),ECT= +$G(ECT) ; Make sure variables are initia lized. ; S EDX=0,DX= $G(DX) S I CDV=$$ICD9 VER^IBACSV (+$G(DX(CT ))) I ICDV =1,$E(DX)= "E" S EDX= 1 ; TRUE i f ECI ICD- 9 Dx (e-co de) I ICDV =30,"VWXY" [$E(DX) S EDX=1 ; TR UE if ECI ICD-10 Dx ; S I=$S(E DX:3,1:2) ; S:'EDX D XQ=$S(+$G( ^TMP("DCX" ,$J,2))>0: "BF",1:"BK ") ; first non e-cod e DX is pr incipal (q ualifier " BK"), the rest have qualifier "BF" ; I I BINS D I DX="" G ID X1 .;I CT> 28 S CT="" Q ; Max o f 28 codes for insti tutional/U B .I EDX S ECT=ECT+1 I ECT>12 S DX="" Q ;Only 12 E-codes al lowed .I ' EDX S DCT= DCT+1 I DC T>25 S DX= "" Q ;Onl y 25 DX co des allowe d .S DXIEN =$P(DX(CT) ,U,2) Q:DX IEN="" .; IB*2.0*547 - no long er stuff a 1 for POA , send a b lank if nu ll .S POA= $P($G(^IBA (362.3,DXI EN,0)),U,4 ) ; I POA= "",$$INPAT ^IBCEF(IBX IEN) S POA =1 ; POA i ndicator d efaults to "1", if n ot present on inpati ent claim .S:EDX DXQ ="BN" ; e- code DX qu alifier .Q ; I 'IBIN S S:EDX DX Q="BF" S P OA="" ; on CMS-1500 e-code DX qualifiers are "BF" and there' s no POA ; I ICDV=30 S DXQ="A" _DXQ ; adj ust Qualif ier for IC D-10 codes ; ;Change d 8 to 12 so we can transmit 1 2 codes. B AA *488* I 'IBINS,CT >12 S ^TMP ("IBXSAVE" ,$J,"DX",I BXIEN)=$G( ^TMP("IBXS AVE",$J,"D X",IBXIEN) )+1,^TMP(" IBXSAVE",$ J,"DX",IBX IEN,$P(DX( +^TMP("IBX SAVE",$J," DX",IBXIEN )),U,2))=$ G(^TMP("IB XSAVE",$J, "DX",IBXIE N)) S DX=" " Q ; I CT '="",DX'=" " D .; pop ulate ^TMP ("DCX") sc ratch glob al .S ^TMP ("DCX",$J, 1)=CT,CNT= $G(^TMP("D CX",$J,I)) +1,^TMP("D CX",$J,I)= CNT .S (^T MP("DCX",$ J,I,CNT),^ TMP("DCX", $J,1,CT))= DX_U_DXQ_U _POA .S LN =LN+1 D ID (LN,VAL) S ^TMP("IBX SAVE",$J," DX",IBXIEN ,$P(DX(LN) ,U,2))=LN, ^TMP("IBXS AVE",$J,"D X",IBXIEN) =CT,CT=CT+ 1 .Q ;IDX1 ; Q ;M(CT ) ; Calcul ate multi- valued fie ld for 837 extract ; CT = pass ed by refe rence/the record ID counter S CT=CT+1 ;I B*2.0*547/ TAZ Increa se counter to 25 ;Q $E(CT#12+$ S(CT#12:0, 1:12)_" ", 1,2) Q $E( CT#25+$S(C T#25:0,1:2 5)_" ",1,2 ) ;SVITM(I BA,LINE) ; Saves the linked it ems from t he bill da ta extract into ; an array the formatter will use to link Rx s and pros thetics ; to an SV1 or SV2 lin e item, if possible. Kills off IBA array entries ; after the y are 'mov ed' ; IBA = array th at contain s the data to be sav ed ; subsc ripts are (line #,it em type,it em pointer )=ct N Z0, Z1 S Z0="" F S Z0=$ O(IBA("OUT PT",LINE,Z 0)) Q:Z0=" " I Z0?1N .N S Z1=" " F S Z1= $O(IBA("OU TPT",LINE, Z0,Z1)) Q: Z1="" S ^ TMP($J,"IB ITEM",Z0,Z 1,LINE)=IB A("OUTPT", LINE,Z0,Z1 ) K IBA("O UTPT",LINE ,Z0,Z1) Q ;LINK(IBTY P,IBDATA) ; Link the item with a service line, if possible ; IBTYP = t he code fo r the type of item ; returned incremente d if no li nk is made ; IBDATA = the extr acted data string th at identif ies the it em. ; Ret urns the l ine to lin k to or nu ll if no l ink N IBLN ,IBKEY,Z S IBLN="" S IBKEY=$S( IBTYP=3:$P (IBDATA,U, 9),IBTYP=5 :$P(IBDATA ,U,4),1:"" ) Q:IBKEY= "" I $D(^T MP($J,"IBI TEM",IBTYP ,IBKEY)) D G:IBLN L INKQ .S Z= 0 F S Z=$ O(^TMP($J, "IBITEM",I BTYP,IBKEY ,Z)) Q:'Z I ^TMP($J ,"IBITEM", IBTYP,IBKE Y,Z) S IBL N=Z,^TMP($ J,"IBITEM" ,IBTYP,IBK EY,Z)=^TMP ($J,"IBITE M",IBTYP,I BKEY,Z)-1 Q I $D(^TM P($J,"IBIT EM",IBTYP, 0)) S IBKE Y=0 D .S Z =0 F S Z= $O(^TMP($J ,"IBITEM", IBTYP,IBKE Y,Z)) Q:'Z I ^TMP($ J,"IBITEM" ,IBTYP,IBK EY,Z) S IB LN=Z,^TMP( $J,"IBITEM ",IBTYP,IB KEY,Z)=^TM P($J,"IBIT EM",IBTYP, IBKEY,Z)-1 QLINKQ Q IBLN ;COID (IBIFN) ; Claim offi ce ID - mo ved for sp ace Q $$CO ID^IBCEF21 (IBIFN) ;P POL(IBIFN, COB) ; ret urn IFN of patient p olicy on a bill defi ned by COB (fields 3 99,112-114 ) N X,Y,PP OL S PPOL= "" I +$G(I BIFN) S X= $G(^DGCR(3 99,+IBIFN, "M")) I +$ G(COB),COB <4 S Y=COB +11,PPOL=$ P(X,U,Y) Q PPOL ;LAD J(SUB,LINE ,SEQ1,GRP, IBXSAVE,PI ECE) ; Ext ract line level adju stments ; SUB = 1st subscript in IBXSAVE array to use ; LINE = 2nd sub script ; S EQ1 = 4th subscript ; GRP = 5t h subscrip t ; IBXSAV E = array that has t he data fo r COB line level adj ustments ; PIECE = # of the pi ece on the 0-node of the line level ; ad justment r eason to b e extracte d ; N A,B S (A,B)=0 F S A=$O( IBXSAVE(SU B,LINE,"CO B",SEQ1,GR P,A)) Q:'A D . S B= B+1,IBXDAT A(B)=$P(IB XSAVE(SUB, LINE,"COB" ,SEQ1,GRP, A),U,PIECE ) Q ;ESGHP ST(IBIFN,C OB) ; retu rn insured s employ s tatus if b ill policy defined b y COB is a n Employer Sponsored Group Hea lth Plan Q $$ESGHPST ^IBCEF21(I BIFN,COB) ;Tag moved ;ESGHPNL( IBIFN,COB) ; return employer n ame and lo cation if bill polic y defined by COB is an Employe r Sponsore d Group He alth Plan Q $$ESGHPN L^IBCEF21( IBIFN,COB) ;Tag move d ;AMTOUT( A,B,C,IBXS AVE) ; for mat output amount ; N Z,K,IBZ, IBARR K IB XDATA S (I BZ,K)=0,IB ARR="IBXSA VE("""_A_" "")" F S IBZ=$O(@IB ARR@(IBZ)) Q:'IBZ S K=K+1,Z=0 F S Z=$O (@IBARR@(I BZ,Z)) Q:' Z I $P($G (@IBARR@(I BZ,Z,B)),U ,C) S IBXD ATA(K)=$$D OLLAR^IBCE FG1($G(IBX DATA(K))+$ P(@IBARR@( IBZ,Z,B),U ,C)) Q | |
| 654 | ||
| 655 | Routines | |
| 656 | Activities | |
| 657 | Routine Na me | |
| 658 | IBCEF72 | |
| 659 | Enhancemen t Category | |
| 660 | New | |
| 661 | Modify | |
| 662 | Delete | |
| 663 | No Change | |
| 664 | RTM | |
| 665 | ||
| 666 | Related Op tions | |
| 667 | None | |
| 668 | Related Ro utines | |
| 669 | Routines “ Called By” | |
| 670 | Routines “ Called” | |
| 671 | ||
| 672 | ||
| 673 | ||
| 674 | ||
| 675 | Data Dicti onary (DD) Reference s | |
| 676 | ||
| 677 | Related Pr otocols | |
| 678 | None | |
| 679 | Related In tegration Control Re gistration s (ICRs) | |
| 680 | None | |
| 681 | Data Passi ng | |
| 682 | Input | |
| 683 | Output Re ference | |
| 684 | Both | |
| 685 | Global Re ference | |
| 686 | Local | |
| 687 | Input Attr ibute Name and Defin ition | |
| 688 | Name: | |
| 689 | Definition : | |
| 690 | Output Att ribute Nam e and Defi nition | |
| 691 | Name: | |
| 692 | Definition : | |
| 693 | Current Lo gic | |
| 694 | IBCEF72 ;W OIFO/SS - FORMATTER AND EXTRAC TOR SPECIF IC BILL FU NCTIONS ;8 /6/03 10:5 6am ;;2.0; INTEGRATED BILLING;* *232,320,3 49,432,516 **;21-MAR- 94;Build 1 23 ;;Per V A Directiv e 6402, th is routine should no t be modif ied. ; ; ; Input: ;IB INSCO - pt r to #36 ; IBFRMTYP 0 =unknwn/bo th,1=UB,2= 1500 ;IBCA RE - 0=unk nwn or bot h inp/outp ,1=inpatie nt, 2=outp atient, 3 -RX ;Outpu t: X12 IDt ype^ID^ID TYPE ptr t o file 355 .97CH35591 (IBINSCO,I BFRMTYP,IB CARE) ; N IB35591,IB RET,IB1 S IB35591=0, IBRET="" F S IB3559 1=$O(^IBA( 355.91,"B" ,IBINSCO,I B35591)) Q :+IB35591= 0 Q:IBRET' ="" D . S IB1=$G(^I BA(355.91, IB35591,0) ) . I '($P (IB1,"^",4 )=0!(IBFRM TYP=0)) Q: $P(IB1,"^" ,4)'=IBFRM TYP ;if w rong form type . I ( $P(IB1,"^" ,5)=3)!(IB CARE=3) Q: IBCARE'=$P (IB1,"^",5 ) ;if not RX . I ($P (IB1,"^",5 )=1)!($P(I B1,"^",5)= 2) I (IBCA RE=1)!(IBC ARE=2) Q:$ P(IB1,"^", 5)'=IBCARE ;if wron g care typ e . S IBRE T=$P($G(^I BE(355.97, +$P(IB1,"^ ",6),0))," ^",3)_"^"_ $P(IB1,"^" ,7)_U_+$P( IB1,U,6) Q IBRET ;FI NDEIN(IBXI EN,IBPROV, IBFAC,IBS) ; find EI N for faci lity/ SSN for person ; IBXIEN = ien of b ill entry file 399 ; IBFAC = 1 if facili ty, 0 if i ndividual provider ; IBPROV = ien of pro vider (vp format) ; IBS = 1 if person's EIN should be return ed if ther e, otherwi se SSN ; F UNCTION RE TURNS ; E IN or SSN ^ 24 for E IN, 34 for SSN or nu ll if none found N Z ,Z0,IBARR, IBEIN,IBSS N S (IBEIN ,IBSSN)="" D ALLID^I BCEP8(IBPR OV,"",.IBA RR) S Z=0 F S Z=$O( IBARR(Z)) Q:'Z D Q :IBEIN'="" . I $G(IB FAC) Q:$P( IBARR(Z),U ,7)'="EI" S IBEIN=$ P(IBARR(Z) ,U,2)_U_24 Q . I $P( IBARR(Z),U ,7)="SY" D Q .. I $ G(IBS) S I BSSN=$P(IB ARR(Z),U,2 )_U_34 Q . S IBEIN=$ P(IBARR(Z) ,U,2)_U_24 . I $G(IB S),$P(IBAR R(Z),U,7)= "EI" S IBE IN=$P(IBAR R(Z),U,2)_ U_24 I $G( IBS),IBEIN ="" S IBEI N=IBSSN Q IBEIN ; ;N ONVAID(IBX IEN,IBX,IB FAC,IBS) ; Find the non-VA pro vider defa ult id ; I BXIEN = th e ien of t he bill (f ile 399) ; IBX = id data retur ned if pas sed by ref erence ; I BFAC = 1 i f getting the id for the facil ity or 0 f or renderi ng prov ; IBS = 1 if getting i d for pers on, but ne ed the EIN if there ; Function returns t he id^type of id^per son/facili ty flag: ; Type of i d: 1 = SSN 2 = EIN 0 = not fou nd ; perso n/facility : 1 = pers on 2 = fac ility N Z, IBXSAVE,IB U2,IBTYPE, IBZ,IBF,IB PROV,Q,Q0 S IBTYPE=2 ,IBU2=$G(^ DGCR(399,I BXIEN,"U2" )),IBF=2,I BPROV="" ; S Z=$P(IB U2,U,10) I 'Z S IBX= "",IBTYPE= 0 G NONVAQ ; Not a n on-VA faci lity S IBP ROV=Z_";IB A(355.93," ; ; Get E IN I $G(IB FAC) D G NONVAQ . S IBX=$P($$ FINDEIN(IB XIEN,IBPRO V,IBFAC),U ),IBTYPE=2 ; ; Get E IN/SSN I ' $G(IBFAC) D G NONVA Q . S IBX= "",IBF=1 . S Q0=($$F T^IBCEF(IB XIEN)=3)+3 ; 3 for r endering/4 for atten ding . S Q =+$O(^DGCR (399,IBXIE N,"PRV","B ",Q0,0)) . S IBPROV= $P($G(^DGC R(399,IBXI EN,"PRV",Q ,0)),U,2) . I IBPROV S IBX=$$F INDEIN(IBX IEN,IBPROV ,IBFAC,$G( IBS)),IBTY PE=$S($P(I BX,U,2)=24 :2,$P(IBX, U,2)=34:1, 1:0),IBX=$ P(IBX,U) ; NONVAQ I I BTYPE,IBX= "",$P(IBU2 ,U,12)'="" S IBX=$P( IBU2,U,12) ; pull fr om 399 S I BX=$G(IBX) Q IBX_U_I BTYPE_U_IB F ;---- ;c hecks if t here is da ta for OP* segments and ;then populates PROV COB SEQ ;Input : ;IBXIEN - ien in # 399 ;IBSAV E - "in" a rray (i.e. IBXSAVE) ;IBDATA - "out" arra y (i.e. IB XDATA) ;IB FUNC - FUN CTION from #399 (1-r efering, 2 -operatin g, etc) ;I BSEGM - se gment reco rd ID, opt ional ;Out put: ; IBD ATA with f ormatted o utputPROVS EQ(IBXIEN, IBSAVE,IBD ATA,IBFUNC ,IBSEGM) ; N IB1,IBI NS,IBFL ;S IBFL=$S(I BFUNC=3!(I BFUNC=4):1 ,1:0) F IB 1=1,2 D . I '$$ISINS UR^IBCEF71 ($G(IBSAVE ("PROVINF" ,IBXIEN,"O ",IB1)),IB XIEN) Q ; don't crea te anythin g if there is no suc h insuranc e . ;*432/ TAZ - Remo ved. Atten ding and R endering c an be on s ame bill n ow. . ;I I BFL S IBFU NC=$S($O(I BSAVE("PRO VINF",IBXI EN,"O",IB1 ,3,0)):3,1 :4) . I '$ O(IBSAVE(" PROVINF",I BXIEN,"O", IB1,IBFUNC ,0)) Q . S IBDATA(IB 1)=$G(IBSA VE("PROVIN F",IBXIEN, "O",IB1)) . I $G(IBS EGM)'="" D ID^IBCEF2 (IB1,IBSEG M) Q ;OUTP RVID(IBXIE N,IBXSAVE) ; Extract the outsi de provide r or facil ity ids ; into IBXSA VE array ; Function returns 1 if person or 2 if fa cility ids or "" if neither N Z,IBXDATA, IBPERSON,T AG ;WCJ;11 /1/2005 Ex tract the first 3 ch ars of Z i nstead. S Z=$E($$PSP RV^IBCEF7( IBXIEN),1, 3),IBPERSO N="" ;EJK 8/23/05 IB *320 - CHA NGED Z=101 TO Z=1010 . Z WILL A LWAYS BE A 4 DIGIT # . ; WCJ 1 1/1/2005 ; Removed E JK's chang e and adde d above ch ange I Z=1 11!(Z=101) S TAG=$S( Z=101:"OUT SIDE FAC P ROVIDER IN F",1:"CUR/ OTH PROVID ER INFO") D F^IBCEF( "N-ALL "_T AG) S IBPE RSON=$S('$ E(Z,2):2,1 :1) Q IBPE RSON ;OUTP RV(IBREC,I BXIEN,IBXS AVE) ; Ext ract the o utside pro vider or f acility id s ; into I BXSAVE arr ay ; Funct ion return s 1 if per son or 2 i f facility ids or "" if neithe r ; IBREC = the reco rd whose i ds should be returne d N IBPERS ON,IBFRM,I BTYPE,IBFA C I IBREC= "SUB1"!(IB REC="OP6") D . K IBX SAVE("PROV INF",IBXIE N),IBXSAVE ("PROVINF_ FAC",IBXIE N) . S IBP ERSON=$$OU TPRVID(IBX IEN,.IBXSA VE),IBFAC= $S(IBPERSO N=1:0,1:1) E D . K IBXSAVE("P ROVINF_FAC ",IBXIEN) . D F^IBCE F("N-ALL O UTSIDE FAC PROVIDER INF") . S IBPERSON=2 ,IBFAC=1 S IBFRM=$$F T^IBCEF(IB XIEN),IBFR M=$S(IBFRM =2:2,1:1) S IBTYPE=$ S(IBREC["S UB":"C",1: "O") D CHC KSUB^IBCEF 73(IBFRM,I BREC,IBFAC ,IBTYPE,.I BXSAVE) Q IBPERSON ; ;get IENs in file # 36 for oth er insuran cesOTHINS( IB399,IBRE S) ; N IBF RMTYP,Z,Z1 ,Z2,Z4 S Z =$$COBN^IB CEF(IB399) ,Z0=0 F Z1 =1:1:3 I Z 1'=Z,$D(^D GCR(399,IB 399,"I"_Z1 )) D . S Z 0=Z0+1 . ; MRD;IB*2. 0*516 - Ad ded HPID a s second p iece. . S IBRES(Z0)= +$G(^DGCR( 399,IB399, "I"_Z1))_U _$P(^DGCR( 399,IB399, "M1"),U,12 +Z1) . Q Q ; ;get ot her insura nce EDI ID NUMBERsOT HINSID(IB3 99,IBRES) ;insurance EDI N IB FRMTYP,IBZ ,Z0,Z1,Z4 S IBFRMTYP =$$FT^IBCE F(IB399),I BFRMTYP=$S (IBFRMTYP= 2:2,IBFRMT YP=3:1,1:0 ) S Z4=$S( IBFRMTYP=1 :4,1:2) ;U B - piece4 ,1500 or B OTH -piece 2 D OTHIN S(IB399,.I BZ) S Z1=0 F Z0=1,2 I $G(IBZ(Z 0)) D . S IBRES(Z0)= $S($$MCRWN R^IBEFUNC( +IBZ(Z0)): $S(IBFRMTY P=1:"12M61 ",1:"SMTX1 "),1:$P($G (^DIC(36,+ IBZ(Z0),3) ),U,Z4)) . ; MRD;IB* 2.0*516 - Added HPID as second piece. . S $P(IBRES (Z0),U,2)= $P(IBZ(Z0) ,U,2) . Q Q ; ;get o ther insur ance addre ssesOTHINA DR(IB399,I BRES,IBADD FLD) ;insu rance EDI N IBZ,Z0,Z 1,Z4 D OTH INS(IB399, .IBZ) S Z1 =0 I IBADD FLD=18 D Q . F Z0=1 :1:2 I $G( IBZ(Z0)) D . . S IBR ES(Z0)=$P( $G(^DIC(36 ,+IBZ(Z0), .11)),U,1) . . S IBR ES(Z0)=$E( IBRES(Z0), 1,55) I IB ADDFLD=18. 9 D Q . F Z0=1:1:2 I $G(IBZ(Z 0)) D . . S IBRES(Z0 )=$P($G(^D IC(36,+IBZ (Z0),.11)) ,U,1) . . S Z4=$P($G (^DIC(36,+ IBZ(Z0),.1 1)),U,2) S :Z4'="" IB RES(Z0)=IB RES(Z0)_", "_Z4 . . S Z4=$P($G (^DIC(36,+ IBZ(Z0),.1 1)),U,3) S :Z4'="" IB RES(Z0)=IB RES(Z0)_", "_Z4 . . S Z4=$P($G (^DIC(36,+ IBZ(Z0),.1 1)),U,4) S :Z4'="" IB RES(Z0)=IB RES(Z0)_", "_Z4 . . S Z4=$P($G (^DIC(5,+$ P($G(^DIC( 36,+IBZ(Z0 ),.11)),U, 5),0)),U,2 ) S:Z4'="" IBRES(Z0) =IBRES(Z0) _", "_Z4 . . S Z4=$P ($G(^DIC(3 6,+IBZ(Z0) ,.11)),U,6 ) S:Z4'="" IBRES(Z0) =IBRES(Z0) _", "_Z4 . . S IBRES (Z0)=$E(IB RES(Z0),1, 157) I IBA DDFLD=19 D Q . F Z0 =1:1:2 I $ G(IBZ(Z0)) D . . S I BRES(Z0)=$ P($G(^DIC( 36,+IBZ(Z0 ),.11)),U, 2) . . S I BRES(Z0)=I BRES(Z0)_" "_$P($G(^ DIC(36,+IB Z(Z0),.11) ),U,3) . . S IBRES(Z 0)=$E(IBRE S(Z0),1,55 ) I IBADDF LD=20 D Q . F Z0=1: 1:2 I $G(I BZ(Z0)) D . . S IBRE S(Z0)=$P($ G(^DIC(36, +IBZ(Z0),. 11)),U,4) . . S IBRE S(Z0)=$E(I BRES(Z0),1 ,30) I IBA DDFLD=21 D Q . F Z0 =1:1:2 I $ G(IBZ(Z0)) D . . S I BRES(Z0)=$ P($G(^DIC( 5,+$P($G(^ DIC(36,+IB Z(Z0),.11) ),U,5),0)) ,U,2) . . S IBRES(Z0 )=$E(IBRES (Z0),1,2) I IBADDFLD =22 D Q . F Z0=1:1: 2 I $G(IBZ (Z0)) D . . S IBRES( Z0)=$P($G( ^DIC(36,+I BZ(Z0),.11 )),U,6) . . S IBRES( Z0)=$E(IBR ES(Z0),1,1 5) Q ;SFID Q(IBXIEN,I BXSAVE,IBX DATA) ; Fi nd the ser vice facil ity id qua lifier for ; 837 rec ord SUB2-5 ;IBXIEN = ien of 39 9 ;Pass by reference : IBXSAVE (input/out put) IBXDA TA (output ) N B,Z K IBXSAVE("N VID") D ; protect I BXDATA . N IBXDATA . D F^IBCEF ("N-RENDER ING INSTIT UTION") . S:IBXDATA' ="" IBXSAV E("IBFAC") =IBXDATA I $P($G(IBX SAVE("IBFA C")),U,2)' =1 K IBXDA TA Q S Z=$ $PSPRV^IBC EF7(IBXIEN ) ;WCJ 11/ 04/2005 If a Non-VA facility I $E(Z) D . S IBXSAV E("NVID")= $$NONVAID^ IBCEF72(IB XIEN,.B,$E (Z),1) .; S IBXSAVE( "NVID")=$$ NONVAID^IB CEF72(IBXI EN,.B,'$E( Z,2),1) . S IBXDATA= $P("^34^24 ",U,$P(IBX SAVE("NVID "),U,2)+1) ;S Z=$$PS PRV^IBCEF7 (IBXIEN),I BXSAVE("NV ID")=$$NON VAID^IBCEF 72(IBXIEN, .B,'$E(Z,2 ),1),IBXDA TA=24 Q ;O THP36(IBXI EN,IBZOUT) ; N Z,Z0, Z1,IBZ D F ^IBCEF("N- ALL INSURA NCE CO 837 ID","IBZ" ) F Z=1,2, 3 S IBZOUT (Z)=+$$POL ICY^IBCEF( IBXIEN,1,$ E("PST",Z) ) Q ; ;--- ------SORT ---------- - ;IBPRNUM - seq # ; IBPRTYP - type of pr ovider (us e FUNCTION value fro m file 399 , fld 222) ;IB399 = ien file 3 99 ;IBSRC, IBDST - so urce,desti nation arr ays ;IBN - starting # ;Output: ; IBDST(1 -primary/2 -secondary provider, Provider t ype(FUNCTI ON),N)= ; =provider/ VARIABLEPT R^Insuranc e PTR #36 or NONE^ID type^ID^F orm type^C are type^s tate ptr # 5 for stat e license # ; where N is numer ation (1 f or ID1, 2 for ID2, e tc)GETSSN( IBPTR) ;lo ok for SSN in #200 f irst and i f not foun d then loo k at #355. 9 ;if in f ile #200 I $P(IBPTR, ";",2)="VA (200," Q $ $SSN200^IB CEF73(IBPT R) ;if in 355.93 the n use 355. 9 Q $$SSN3 559^IBCEF7 3(IBPTR) ; -- ;SSN355 9 ;Find SS N from 355 .9 ;Input: ; Variabl e pointer to ^VA(200 or ^IBA(3 55.93 ;Out put: ; SSN or null ; PADNDC(Z) ;PAD LEADI NG ZERO'S INTO A NON 5-4-2 FOR MAT NDC NU MBER ;Z IS ITERATION , ONLY PAD CURRENT N DC NUMBER N NDC S ND C=$P(IBXSA VE("OUTPT" ,Z,"RX")," ^",3) Q:$L (NDC)=13 I $L(NDC)=1 4 D Q . S $P(NDC,"- ",1)=$E($P (NDC,"-",1 ),2,$L($P( NDC,"-",1) )) . S $P( IBXSAVE("O UTPT",Z,"R X"),"^",3) =NDC I $L( $P(NDC,"-" ,1))'=5 S $P(NDC,"-" ,1)="0"_$P (NDC,"-",1 ) I $L($P( NDC,"-",2) )'=4 S $P( NDC,"-",2) ="0"_$P(ND C,"-",2) I $L($P(NDC ,"-",3))'= 2 S $P(NDC ,"-",3)="0 "_$P(NDC," -",3) S $P (IBXSAVE(" OUTPT",Z," RX"),"^",3 )=NDC Q ; | |
| 695 | Modified L ogic (Chan ges are in bold) | |
| 696 | IBCEF72 ;W OIFO/SS - FORMATTER AND EXTRAC TOR SPECIF IC BILL FU NCTIONS ;8 /6/03 10:5 6am ;;2.0; INTEGRATED BILLING;* *232,320,3 49,432,516 ,592**;21- MAR-94;Bui ld 123 ;;P er VA Dire ctive 6402 , this rou tine shoul d not be m odified. ; ; ;Input: ;IBINSCO - ptr to # 36 ;IBFRMT YP 0=unknw n/both,1=U B,2=1500,4 =J430D ;IB CARE - 0=u nknwn or b oth inp/ou tp,1=inpat ient, 2=ou tpatient, 3 -RX ;Out put: X12 I Dtype^ID^I D TYPE ptr to file 3 55.97CH355 91(IBINSCO ,IBFRMTYP, IBCARE) ; N IB35591, IBRET,IB1 S IB35591= 0,IBRET="" F S IB35 591=$O(^IB A(355.91," B",IBINSCO ,IB35591)) Q:+IB3559 1=0 Q:IBRE T'="" D . S IB1=$G( ^IBA(355.9 1,IB35591, 0)) . I '( $P(IB1,"^" ,4)=0!(IBF RMTYP=0)) Q:$P(IB1," ^",4)'=IBF RMTYP ;if wrong for m type . I ($P(IB1," ^",5)=3)!( IBCARE=3) Q:IBCARE'= $P(IB1,"^" ,5) ;if no t RX . I ( $P(IB1,"^" ,5)=1)!($P (IB1,"^",5 )=2) I (IB CARE=1)!(I BCARE=2) Q :$P(IB1,"^ ",5)'=IBCA RE ;if wr ong care t ype . S IB RET=$P($G( ^IBE(355.9 7,+$P(IB1, "^",6),0)) ,"^",3)_"^ "_$P(IB1," ^",7)_U_+$ P(IB1,U,6) Q IBRET ; FINDEIN(IB XIEN,IBPRO V,IBFAC,IB S) ; find EIN for fa cility/ SS N for pers on ; IBXIE N = ien of bill entr y file 399 ; IBFAC = 1 if faci lity, 0 if individua l provider ; IBPROV = ien of p rovider (v p format) ; IBS = 1 if person' s EIN shou ld be retu rned if th ere, other wise SSN ; FUNCTION RETURNS ; EIN or SS N ^ 24 for EIN, 34 f or SSN or null if no ne found N Z,Z0,IBAR R,IBEIN,IB SSN S (IBE IN,IBSSN)= "" D ALLID ^IBCEP8(IB PROV,"",.I BARR) S Z= 0 F S Z=$ O(IBARR(Z) ) Q:'Z D Q:IBEIN'= "" . I $G( IBFAC) Q:$ P(IBARR(Z) ,U,7)'="EI " S IBEIN =$P(IBARR( Z),U,2)_U_ 24 Q . I $ P(IBARR(Z) ,U,7)="SY" D Q .. I $G(IBS) S IBSSN=$P( IBARR(Z),U ,2)_U_34 Q . S IBEIN =$P(IBARR( Z),U,2)_U_ 24 . I $G( IBS),$P(IB ARR(Z),U,7 )="EI" S I BEIN=$P(IB ARR(Z),U,2 )_U_24 I $ G(IBS),IBE IN="" S IB EIN=IBSSN Q IBEIN ; ;NONVAID(I BXIEN,IBX, IBFAC,IBS) ; Find th e non-VA p rovider de fault id ; IBXIEN = the ien of the bill (file 399) ; IBX = i d data ret urned if p assed by r eference ; IBFAC = 1 if gettin g the id f or the fac ility or 0 for rende ring prov ; IBS = 1 if getting id for pe rson, but need the E IN if ther e ; Functi on returns the id^ty pe of id^p erson/faci lity flag: ; Type of id: 1 = S SN 2 = EIN 0 = not f ound ; per son/facili ty: 1 = pe rson 2 = f acility N Z,IBXSAVE, IBU2,IBTYP E,IBZ,IBF, IBPROV,Q,Q 0 S IBTYPE =2,IBU2=$G (^DGCR(399 ,IBXIEN,"U 2")),IBF=2 ,IBPROV="" ; S Z=$P( IBU2,U,10) I 'Z S IB X="",IBTYP E=0 G NONV AQ ; Not a non-VA fa cility S I BPROV=Z_"; IBA(355.93 ," ; ; Get EIN I $G( IBFAC) D G NONVAQ . S IBX=$P( $$FINDEIN( IBXIEN,IBP ROV,IBFAC) ,U),IBTYPE =2 ; ; Get EIN/SSN I '$G(IBFAC ) D G NON VAQ . S IB X="",IBF=1 . S Q0=($ $FT^IBCEF( IBXIEN)=3) +3 ; 3 for rendering /4 for att ending . S Q=+$O(^DG CR(399,IBX IEN,"PRV", "B",Q0,0)) . S IBPRO V=$P($G(^D GCR(399,IB XIEN,"PRV" ,Q,0)),U,2 ) . I IBPR OV S IBX=$ $FINDEIN(I BXIEN,IBPR OV,IBFAC,$ G(IBS)),IB TYPE=$S($P (IBX,U,2)= 24:2,$P(IB X,U,2)=34: 1,1:0),IBX =$P(IBX,U) ;NONVAQ I IBTYPE,IB X="",$P(IB U2,U,12)'= "" S IBX=$ P(IBU2,U,1 2) ; pull from 399 S IBX=$G(IB X) Q IBX_U _IBTYPE_U_ IBF ;---- ;checks if there is data for O P* segment s and ;th en populat es PROV CO B SEQ ;Inp ut: ;IBXIE N - ien in #399 ;IBS AVE - "in" array (i. e. IBXSAVE ) ;IBDATA - "out" ar ray (i.e. IBXDATA) ; IBFUNC - F UNCTION fr om #399 (1 -refering, 2 -operat ing, etc) ;IBSEGM - segment re cord ID, o ptional ;O utput: ; I BDATA with formatted outputPRO VSEQ(IBXIE N,IBSAVE,I BDATA,IBFU NC,IBSEGM) ; N IB1,I BINS,IBFL ;S IBFL=$S (IBFUNC=3! (IBFUNC=4) :1,1:0) F IB1=1,2 D . I '$$ISI NSUR^IBCEF 71($G(IBSA VE("PROVIN F",IBXIEN, "O",IB1)), IBXIEN) Q ;don't cr eate anyth ing if the re is no s uch insura nce . ;*43 2/TAZ - Re moved. Att ending and Rendering can be on same bill now. . ;I IBFL S IB FUNC=$S($O (IBSAVE("P ROVINF",IB XIEN,"O",I B1,3,0)):3 ,1:4) . I '$O(IBSAVE ("PROVINF" ,IBXIEN,"O ",IB1,IBFU NC,0)) Q . S IBDATA( IB1)=$G(IB SAVE("PROV INF",IBXIE N,"O",IB1) ) . I $G(I BSEGM)'="" D ID^IBCE F2(IB1,IBS EGM) Q ;OU TPRVID(IBX IEN,IBXSAV E) ; Extra ct the out side provi der or fac ility ids ; into IBX SAVE array ; Functio n returns 1 if perso n or 2 if facility i ds or "" i f neither N Z,IBXDAT A,IBPERSON ,TAG ;WCJ; 11/1/2005 Extract th e first 3 chars of Z instead. S Z=$E($$P SPRV^IBCEF 7(IBXIEN), 1,3),IBPER SON="" ;EJ K 8/23/05 IB*320 - C HANGED Z=1 01 TO Z=10 10. Z WILL ALWAYS BE A 4 DIGIT #. ; WCJ 11/1/2005 ; Removed EJK's cha nge and ad ded above change I Z =111!(Z=10 1) S TAG=$ S(Z=101:"O UTSIDE FAC PROVIDER INF",1:"CU R/OTH PROV IDER INFO" ) D F^IBCE F("N-ALL " _TAG) S IB PERSON=$S( '$E(Z,2):2 ,1:1) Q IB PERSON ;OU TPRV(IBREC ,IBXIEN,IB XSAVE) ; E xtract the outside p rovider or facility ids ; into IBXSAVE a rray ; Fun ction retu rns 1 if p erson or 2 if facili ty ids or "" if neit her ; IBRE C = the re cord whose ids shoul d be retur ned N IBPE RSON,IBFRM ,IBTYPE,IB FAC I IBRE C="SUB1"!( IBREC="OP6 ") D . K I BXSAVE("PR OVINF",IBX IEN),IBXSA VE("PROVIN F_FAC",IBX IEN) . S I BPERSON=$$ OUTPRVID(I BXIEN,.IBX SAVE),IBFA C=$S(IBPER SON=1:0,1: 1) E D . K IBXSAVE( "PROVINF_F AC",IBXIEN ) . D F^IB CEF("N-ALL OUTSIDE F AC PROVIDE R INF") . S IBPERSON =2,IBFAC=1 S IBFRM=$ $FT^IBCEF( IBXIEN),IB FRM=$S(IBF RM=2:2,1:1 ) S IBTYPE =$S(IBREC[ "SUB":"C", 1:"O") D C HCKSUB^IBC EF73(IBFRM ,IBREC,IBF AC,IBTYPE, .IBXSAVE) Q IBPERSON ; ;get IE Ns in file #36 for o ther insur ancesOTHIN S(IB399,IB RES) ; N I BFRMTYP,Z, Z1,Z2,Z4 S Z=$$COBN^ IBCEF(IB39 9),Z0=0 F Z1=1:1:3 I Z1'=Z,$D( ^DGCR(399, IB399,"I"_ Z1)) D . S Z0=Z0+1 . ; MRD;IB* 2.0*516 - Added HPID as second piece. . S IBRES(Z0 )=+$G(^DGC R(399,IB39 9,"I"_Z1)) _U_$P(^DGC R(399,IB39 9,"M1"),U, 12+Z1) . Q Q ; ;get other insu rance EDI ID NUMBERs OTHINSID(I B399,IBRES ) ;insuran ce EDI N IBFRMTYP,I BZ,Z0,Z1,Z 4 ;JWS;IB* 2.0*592;De ntal form S IBFRMTYP =$$FT^IBCE F(IB399),I BFRMTYP=$S (IBFRMTYP= 2:2,IBFRMT YP=3:1,IBF RMTYP=7:4, 1:0) S Z4= $S(IBFRMTY P=1:4,IBFR MTYP=4:15, 1:2) ;UB - piece4,DE NTAL - pie ce 15, 150 0 or BOTH -piece 2, D OTHINS( IB399,.IBZ ) S Z1=0 F Z0=1,2 I $G(IBZ(Z0) ) D . S IB RES(Z0)=$S ($$MCRWNR^ IBEFUNC(+I BZ(Z0)):$S (IBFRMTYP= 1:"12M61", 1:"SMTX1") ,1:$P($G(^ DIC(36,+IB Z(Z0),3)), U,Z4)) . ; MRD;IB*2. 0*516 - Ad ded HPID a s second p iece. . S $P(IBRES(Z 0),U,2)=$P (IBZ(Z0),U ,2) . Q Q ; ;get oth er insuran ce address esOTHINADR (IB399,IBR ES,IBADDFL D) ;insura nce EDI N IBZ,Z0,Z1, Z4 D OTHIN S(IB399,.I BZ) S Z1=0 I IBADDFL D=18 D Q . F Z0=1:1 :2 I $G(IB Z(Z0)) D . . S IBRES (Z0)=$P($G (^DIC(36,+ IBZ(Z0),.1 1)),U,1) . . S IBRES (Z0)=$E(IB RES(Z0),1, 55) I IBAD DFLD=18.9 D Q . F Z 0=1:1:2 I $G(IBZ(Z0) ) D . . S IBRES(Z0)= $P($G(^DIC (36,+IBZ(Z 0),.11)),U ,1) . . S Z4=$P($G(^ DIC(36,+IB Z(Z0),.11) ),U,2) S:Z 4'="" IBRE S(Z0)=IBRE S(Z0)_", " _Z4 . . S Z4=$P($G(^ DIC(36,+IB Z(Z0),.11) ),U,3) S:Z 4'="" IBRE S(Z0)=IBRE S(Z0)_", " _Z4 . . S Z4=$P($G(^ DIC(36,+IB Z(Z0),.11) ),U,4) S:Z 4'="" IBRE S(Z0)=IBRE S(Z0)_", " _Z4 . . S Z4=$P($G(^ DIC(5,+$P( $G(^DIC(36 ,+IBZ(Z0), .11)),U,5) ,0)),U,2) S:Z4'="" I BRES(Z0)=I BRES(Z0)_" , "_Z4 . . S Z4=$P($ G(^DIC(36, +IBZ(Z0),. 11)),U,6) S:Z4'="" I BRES(Z0)=I BRES(Z0)_" , "_Z4 . . S IBRES(Z 0)=$E(IBRE S(Z0),1,15 7) I IBADD FLD=19 D Q . F Z0=1 :1:2 I $G( IBZ(Z0)) D . . S IBR ES(Z0)=$P( $G(^DIC(36 ,+IBZ(Z0), .11)),U,2) . . S IBR ES(Z0)=IBR ES(Z0)_" " _$P($G(^DI C(36,+IBZ( Z0),.11)), U,3) . . S IBRES(Z0) =$E(IBRES( Z0),1,55) I IBADDFLD =20 D Q . F Z0=1:1: 2 I $G(IBZ (Z0)) D . . S IBRES( Z0)=$P($G( ^DIC(36,+I BZ(Z0),.11 )),U,4) . . S IBRES( Z0)=$E(IBR ES(Z0),1,3 0) I IBADD FLD=21 D Q . F Z0=1 :1:2 I $G( IBZ(Z0)) D . . S IBR ES(Z0)=$P( $G(^DIC(5, +$P($G(^DI C(36,+IBZ( Z0),.11)), U,5),0)),U ,2) . . S IBRES(Z0)= $E(IBRES(Z 0),1,2) I IBADDFLD=2 2 D Q . F Z0=1:1:2 I $G(IBZ(Z 0)) D . . S IBRES(Z0 )=$P($G(^D IC(36,+IBZ (Z0),.11)) ,U,6) . . S IBRES(Z0 )=$E(IBRES (Z0),1,15) Q ;SFIDQ( IBXIEN,IBX SAVE,IBXDA TA) ; Find the servi ce facilit y id quali fier for ; 837 recor d SUB2-5 ; IBXIEN = i en of 399 ;Pass by r eference: IBXSAVE (i nput/outpu t) IBXDATA (output) N B,Z K IB XSAVE("NVI D") D ; p rotect IBX DATA . N I BXDATA . D F^IBCEF(" N-RENDERIN G INSTITUT ION") . S: IBXDATA'=" " IBXSAVE( "IBFAC")=I BXDATA I $ P($G(IBXSA VE("IBFAC" )),U,2)'=1 K IBXDATA Q S Z=$$P SPRV^IBCEF 7(IBXIEN) ;WCJ 11/04 /2005 If a Non-VA fa cility I $E(Z) D . S IBXSAVE( "NVID")=$$ NONVAID^IB CEF72(IBXI EN,.B,$E(Z ),1) .; S IBXSAVE("N VID")=$$NO NVAID^IBCE F72(IBXIEN ,.B,'$E(Z, 2),1) . S IBXDATA=$P ("^34^24", U,$P(IBXSA VE("NVID") ,U,2)+1) ; S Z=$$PSPR V^IBCEF7(I BXIEN),IBX SAVE("NVID ")=$$NONVA ID^IBCEF72 (IBXIEN,.B ,'$E(Z,2), 1),IBXDATA =24 Q ;OTH P36(IBXIEN ,IBZOUT) ; N Z,Z0,Z1 ,IBZ D F^I BCEF("N-AL L INSURANC E CO 837 I D","IBZ") F Z=1,2,3 S IBZOUT(Z )=+$$POLIC Y^IBCEF(IB XIEN,1,$E( "PST",Z)) Q ; ;----- ----SORT-- --------- ;IBPRNUM - seq # ;IB PRTYP - ty pe of prov ider (use FUNCTION v alue from file 399, fld 222) ; IB399 = ie n file 399 ;IBSRC,IB DST - sour ce,destina tion array s ;IBN - s tarting # ;Output: ; IBDST(1-p rimary/2-s econdary p rovider,Pr ovider typ e(FUNCTION ),N)= ; =p rovider/VA RIABLEPTR^ Insurance PTR #36 or NONE^ID t ype^ID^For m type^Car e type^sta te ptr #5 for state license # ; where N is numerat ion (1 for ID1, 2 fo r ID2, etc )GETSSN(IB PTR) ;look for SSN i n #200 fir st and if not found then look at #355.9 ;if in fil e #200 I $ P(IBPTR,"; ",2)="VA(2 00," Q $$S SN200^IBCE F73(IBPTR) ;if in 35 5.93 then use 355.9 Q $$SSN355 9^IBCEF73( IBPTR) ;-- ;SSN3559 ;Find SSN from 355.9 ;Input: ; Variable pointer to ^VA(200 o r ^IBA(355 .93 ;Outpu t: ; SSN o r null ;PA DNDC(Z) ;P AD LEADING ZERO'S IN TO A NON 5 -4-2 FORMA T NDC NUMB ER ;Z IS I TERATION, ONLY PAD C URRENT NDC NUMBER N NDC S NDC= $P(IBXSAVE ("OUTPT",Z ,"RX"),"^" ,3) Q:$L(N DC)=13 I $ L(NDC)=14 D Q . S $ P(NDC,"-", 1)=$E($P(N DC,"-",1), 2,$L($P(ND C,"-",1))) . S $P(IB XSAVE("OUT PT",Z,"RX" ),"^",3)=N DC I $L($P (NDC,"-",1 ))'=5 S $P (NDC,"-",1 )="0"_$P(N DC,"-",1) I $L($P(ND C,"-",2))' =4 S $P(ND C,"-",2)=" 0"_$P(NDC, "-",2) I $ L($P(NDC," -",3))'=2 S $P(NDC," -",3)="0"_ $P(NDC,"-" ,3) S $P(I BXSAVE("OU TPT",Z,"RX "),"^",3)= NDC Q ; | |
| 697 | ||
| 698 | Routines | |
| 699 | Activities | |
| 700 | Routine Na me | |
| 701 | IBCEP2A | |
| 702 | Enhancemen t Category | |
| 703 | New | |
| 704 | Modify | |
| 705 | Delete | |
| 706 | No Change | |
| 707 | RTM | |
| 708 | ||
| 709 | Related Op tions | |
| 710 | None | |
| 711 | Related Ro utines | |
| 712 | Routines “ Called By” | |
| 713 | Routines “ Called” | |
| 714 | ||
| 715 | ||
| 716 | ||
| 717 | ||
| 718 | Data Dicti onary (DD) Reference s | |
| 719 | ||
| 720 | Related Pr otocols | |
| 721 | None | |
| 722 | Related In tegration Control Re gistration s (ICRs) | |
| 723 | None | |
| 724 | Data Passi ng | |
| 725 | Input | |
| 726 | Output Re ference | |
| 727 | Both | |
| 728 | Global Re ference | |
| 729 | Local | |
| 730 | Input Attr ibute Name and Defin ition | |
| 731 | Name: | |
| 732 | Definition : | |
| 733 | Output Att ribute Nam e and Defi nition | |
| 734 | Name: | |
| 735 | Definition : | |
| 736 | Current Lo gic | |
| 737 | IBCEP2A ;A LB/TMP - E DI UTILITI ES for pro vider ID ; 25-APR-01 ;;2.0;INTE GRATED BIL LING;**137 ,232,320,3 48,349,400 **;21-MAR- 94;Build 5 2 ;;Per VH A Directiv e 2004-038 , this rou tine shoul d not be m odified. ; ALT(IBPERF ,IBSRC,IBA LT,IBINS4, IBPTYP) ; set source level to next highe r level ; or set th e alternat e type and source if performin g provider id ; alte rnate type and sourc e exist ; IBPERF = 1 if perfor ming provi der id is requested ; IBINS4 = '4' node of insuran ce co (fil e 36) ; Pa ss IBPTYP by referen ce to get alternate provider i d type ; P ass IBALT by referen ce. Set to 1 if alte rnate id i s to be us ed next ; I '$G(IBPE RF)!($P(IB INS4,U,3)= 1) S IBSRC =IBSRC-1 G ALTQ S IB SRC="" I ' $G(IBALT), $P(IBINS4, U,3)=2,$P( IBINS4,U,1 0),$P(IBIN S4,U,11) S IBALT=1,I BSRC=$P(IB INS4,U,11) ,IBPTYP=$P (IBINS4,U, 10) S:IBPT YP="" IBPT YP=$P(IBIN S4,U) ;ALT Q Q IBSRC ;IDSET(IBP TYP,IBINS4 ,IBPERF,IB SPEC,IBSRC ,IBUP) ; s et variabl es for pro vider id t ype search N Z S IBS PEC=$G(^IB E(355.97,+ IBPTYP,1)) S Z=$S($G (IBPERF):2 ,$P(IBSPEC ,U,5):6,$P (IBSPEC,U, 6):4,1:2) S IBSRC=$P (IBINS4,U, Z),IBUP=$P (IBINS4,U, $S(IBSRC:Z +1,1:0)) Q ;CAREST(I BIFN) ; Re turn state file ien of state w here care was perfor med ; IBIF N = ien of bill in f ile 399 N STATE,IBU2 ,NVAFAC,IB 0,EVDT,IBD IV,INST S STATE="" ; ; non-VA care S IBU 2=$G(^DGCR (399,IBIFN ,"U2")) S NVAFAC=+$P (IBU2,U,10 ) ; non-VA facility I NVAFAC S STATE=+$P ($G(^IBA(3 55.93,NVAF AC,0)),U,7 ) G CAREST X ; ; VA c are S IB0= $G(^DGCR(3 99,IBIFN,0 )) S EVDT= $P(IB0,U,3 ) ; claim event date I 'EVDT S EVDT=DT ; - de fault toda y if undef ined S IBD IV=+$P(IB0 ,U,22) ; d ivision pt r file 40. 8 I 'IBDIV S IBDIV=$ $PRIM^VASI TE(EVDT) ; - default primary d ivision as of event date I IBD IV'>0 S IB DIV=$$PRIM ^VASITE() ; - defaul t main div ision as o f today's date S INS T=+$$SITE^ VASITE(EVD T,IBDIV) ; division institutio n ptr file 4 I INST' >0 S INST= +$$SITE^VA SITE(DT,IB DIV) ; - d efault div as of tod ay's date I INST'>0 S INST=+$$ SITE^VASIT E ; - defa ult main i nstitution S STATE=+ $P($G(^DIC (4,INST,0) ),U,2) ; s tate file ien from I nstitution file ;CAR ESTX ; Q S TATE ;RECA LCA(IBIFN) ; Recalcu late all p erforming provider i d's on bil l IBIFN ; IBIFN = ie n of bill entry (fil e 399) N I BZ,IBZ0,IB X,IBP,IBSE Q,DA,DIE,D R,DIR,X,Y ; D EN^DDI OL("THIS F UNCTION HA S BEEN DIS ABLED",,"! ") Q ; S D A(1)=IBIFN I '$D(^XU SEC("IB SU PERVISOR", DUZ)) D EN ^DDIOL("YO U ARE NOT AUTHORIZED TO PERFOR M THIS FUN CTION",,"! ") S IBZ=0 F S IBZ= $O(^DGCR(3 99,IBIFN," PRV",IBZ)) Q:'IBZ S IBP=$G(^( IBZ,0)) I $P(IBP,U,2 )'="" D . S DA=IBZ . F IBZ0=5: 1:7 Q:'$G( ^DGCR(399, IBIFN,"I"_ (IBZ0-4))) D .. S IB SEQ=$$EXPA ND^IBTRE(3 99.0222,.0 1,+IBP)_" "_$P("PRIM ARY^SECOND ARY^TERTIA RY",U,IBZ0 -4)_" PROV IDER ID " .. S IBX=$ $RECALC(.D A,IBZ0-4,$ P(IBP,U,IB Z0),1) .. I IBX'="", IBX=$P(IBP ,U,IBZ0) D EN^DDIOL( IBSEQ_"NO CHANGE NEE DED",,"!") Q .. I IB X'="",IBX' =$P(IBP,U, IBZ0) D Q ... S DR= (IBZ0/100) _"////"_IB X,DIE="^DG CR(399,"_D A(1)_",""P RV""," D ^ DIE ... D EN^DDIOL(I BSEQ_"CHAN GED TO "_I BX,,"!") . . D EN^DDI OL(IBSEQ_" NOT FOUND" ,,"!") Q ; RECALC(IBD A,IBSEQ,IB X,IBD) ; R ecalculate id #, if possible - called ; from input transform s in subfi le 399.022 2, fields .05-.07 ; IBDA = DA array of t he provide r entry (f ile 399.02 22) ; IBSE Q = the nu meric COB sequence o f the prov ider id (1 -3) ; IBX = the curr ent value of the id in the sub file ; IBD = flag th at if set to 1 will suppress t he display text ; N IBPN,IBZ S IBPN=$P($ G(^DGCR(39 9,IBDA(1), "PRV",IBDA ,0)),U,2) I IBPN="" D:'$G(IBD) EN^DDIOL( " CAN'T CA LCULATE WI THOUT A PR OVIDER NAM E","","?0" ) G RECALC Q S IBZ=$$ GETID^IBCE P2(IBDA(1) ,2,IBPN,IB SEQ) I IBZ ="" D:'$G( IBD) EN^DD IOL(" ID C OULD NOT B E DETERMIN ED","","?0 ") G RECAL CQ D:'$G(I BD) EN^DDI OL(" "_IBZ _$S(IBZ'=I BX:"",1:" (no change )"),"","?0 ") S IBX=I BZ ;RECALC Q Q IBX ;P ERFPRV(IBI FN) ; Retu rns the va riable poi nter of th e 'perform ing provid er' ; (att ending or rendering) for a bil l IBIFN N IBP,IBPT,I BQ,Z S Z=$ $FT^IBCEF( IBIFN),IBP T=$S(Z=2:3 ,Z=3:4,1:0 ) D GETPRV ^IBCEU(IBI FN,IBPT,.I BP) Q $P($ G(IBP(IBPT ,1)),U,3) ;INSPAR(IB IFN,SEQ) ; N Z,Z4,Z0 Q:$G(X)'= "??" S:'$G (SEQ) SEQ= $$COBN^IBC EF(IBIFN) S Z=+$G(^D GCR(399,IB IFN,"I"_SE Q)),Z4=$G( ^DIC(36,Z, 4)) I Z D . D EN^DDI OL(">"_$J( "",20)_"-- PERFORMIN G PROVIDER ID PARAME TERS --",, "!") . S Z 0=$P(" PRI MARY^SECON DARY^ TERT IARY",U,SE Q)_" INSUR ANCE: "_$P ($G(^DIC(3 6,Z,0)),U) . D EN^DD IOL(">"_$J ("",(80-$L (Z0))\2)_Z 0,,"!") . D EN^DDIOL ("> Second ary Perf P rov ID Typ e (1500): "_$$EXPAND ^IBTRE(36, 4.01,+Z4), ,"!") . D EN^DDIOL(" > Secondar y Perf Pro v ID Type (UB04): "_ $$EXPAND^I BTRE(36,4. 02,$P(Z4,U ,2)),,"!") . D EN^DD IOL("> Sec ondary Per f Prov IDs Required: "_$$EXPAN D^IBTRE(36 ,4.03,$P(Z 4,U,3)),," !") . D EN ^DDIOL(" " ,,"!") Q ; GETTYP(IBX IEN,IBCOBN ,IBFUNC) ; Function returns pr ovider id type for i nsurance c o ; with C OB of IBCO BN on clai m ien IBXI EN in firs t ^ pc and 1 in seco nd ; ^ pie ce if the id is requ ired ; ; IBFUNC=1:R EFERRING;2 :OPERATING ;3:RENDERI NG;4:ATTEN DING;5:SUP ERVISING;9 :OTHER ; N A,R,Z,Z0 S A="",R= 0 S:'$G(IB COBN)!(IBC OBN>3) IBC OBN=$$COBN ^IBCEF(IBX IEN) S Z=+ $G(^DGCR(3 99,IBXIEN, "I"_+IBCOB N)) I Z D . S Z0=$$F T^IBCEF(IB XIEN) . S A=+$P($G(^ DIC(36,Z,4 )),U,$S(Z0 =2&($G(IBF UNC)=1):4, Z0=2:1,1:2 )) . I A,$ G(IBFUNC)' =1 S R=$P( $G(^DIC(36 ,Z,4)),U,3 ),R=$S('R: 0,R=3:1,R= 1:Z0=2,R=2 :Z0=3,1:0) . I A,$G( IBFUNC)=1 S R=+$P($G (^DIC(36,Z ,4)),U,5), R=$S('R:0, Z0'=2:0,1: 1) Q A_U_R ;UNIQ1(IB IFN,IBINS, IBPTYP,IBP ROV,IBUNIT ,IBCU,IBT) ; Match m ost-least specific ; *** SEE P ARAMETER D EFINITIONS IN IBCEP3 *** ; ; S tart in fi le 355.9 ( Specific P rovider) ; IBPROV = (variable pointer sy ntax) prov ider on bi ll IBIFN ; N Q,Z0,Z1 ,Z2,IBID,I BX S IBID= "" S IBX=$ P($G(^IBA( 355.9,+IBC U,0)),U,3) S:"0"[IBX IBX="*N/A *" S Z0=$$ FT^IBCEF(I BIFN),Z0=$ S(Z0=2:2,Z 0=3:1,1:0) ,Z1=$$INPA T^IBCEF(IB IFN) S:'Z1 Z1=2 S Z2 =$$ISRX^IB CEF1(IBIFN ) ; ; Matc h all elem ents F Q=$ S(Z2:3,1:Z 1),$S(Z2:Z 1,1:"") I Q'="",$D(^ IBA(355.9, "AUNIQ",IB PROV,IBINS ,IBX,Z0,Q, IBPTYP,IBC U)) S IBID =$P($G(^IB A(355.9,IB CU,0)),U,7 ),$P(IBT,U ,2,3)=(IBC U_U_355.9) Q G:IBID' ="" UNIQ1Q ; ; Match both form types,spe cific I/O element F Q=$S(Z2:3, 1:Z1),$S(Z 2:Z1,1:"") I Q'="",$ D(^IBA(355 .9,"AUNIQ" ,IBPROV,IB INS,IBX,0, Q,IBPTYP,I BCU)) S IB ID=$P($G(^ IBA(355.9, IBCU,0)),U ,7),$P(IBT ,U,2,3)=(I BCU_U_355. 9) Q G:IBI D'="" UNIQ 1Q ; ; Mat ch specifi c form typ e, both I/ O element or Rx F Q= $S(Z2:3,1: 0),$S(Z2:0 ,1:"") I Q '="",$D(^I BA(355.9," AUNIQ",IBP ROV,IBINS, IBX,Z0,Q,I BPTYP,IBCU )) S IBID= $P($G(^IBA (355.9,IBC U,0)),U,7) ,$P(IBT,U, 2,3)=(IBCU _U_355.9) Q G:IBID'= "" UNIQ1Q ; ; Match both form types, bot h I/O elem ent or Rx F Q=$S(Z2: 3,1:0),$S( Z2:0,1:"") I Q'="",$ D(^IBA(355 .9,"AUNIQ" ,IBPROV,IB INS,IBX,0, Q,IBPTYP,I BCU)) S IB ID=$P($G(^ IBA(355.9, IBCU,0)),U ,7),$P(IBT ,U,2,3)=(I BCU_U_355. 9) Q ;UNIQ 1Q Q IBID ;UNIQ2(IBI FN,IBINS,I BPTYP,IBUN IT,IBCU,IB T) ; Match on most-l east speci fic ; *** SEE PARAME TER DEFINI TIONS IN I BCEP3 *** ; ; Start in file 35 5.91 (Spec ific Insur ance) ; N Q,Z0,Z1,Z2 ,IBID,IBX S IBID="" S:"0"[$G(I BUNIT) IBU NIT="*N/A* " S Z0=$$F T^IBCEF(IB IFN),Z0=$S (Z0=2:2,Z0 =3:1,1:0), Z1=$$INPAT ^IBCEF(IBI FN) S:'Z1 Z1=2 S Z2= $$ISRX^IBC EF1(IBIFN) ; ; Match all eleme nts F Q=$S (Z2:3,1:Z1 ),$S(Z2:Z1 ,1:"") I Q '="",$D(^I BA(355.91, "AUNIQ",IB INS,IBUNIT ,Z0,Q,IBPT YP,IBCU)) S IBID=$P( $G(^IBA(35 5.91,IBCU, 0)),U,7),$ P(IBT,U,2, 3)=(IBCU_U _355.91) Q G:IBID'=" " UNIQ2Q ; ; Match b oth form t ypes,speci fic I/O el ement F Q= $S(Z2:3,1: Z1),$S(Z2: Z1,1:"") I Q'="",$D( ^IBA(355.9 1,"AUNIQ", IBINS,IBUN IT,0,Q,IBP TYP,IBCU)) S IBID=$P ($G(^IBA(3 55.91,IBCU ,0)),U,7), $P(IBT,U,2 ,3)=(IBCU_ U_355.91) Q G:IBID'= "" UNIQ2Q ; ; Match specific f orm type, both I/O e lement or Rx F Q=$S( Z2:3,1:0), $S(Z2:0,1: "") I Q'=" ",$D(^IBA( 355.91,"AU NIQ",IBINS ,IBUNIT,Z0 ,Q,IBPTYP, IBCU)) S I BID=$P($G( ^IBA(355.9 1,IBCU,0)) ,U,7),$P(I BT,U,2,3)= (IBCU_U_35 5.91) Q G: IBID'="" U NIQ2Q ; ; Match both form type s, both I/ O elements or Rx F Q =$S(Z2:3,1 :0),$S(Z2: 0,1:"") I Q'="",$D(^ IBA(355.91 ,"AUNIQ",I BINS,IBUNI T,0,Q,IBPT YP,IBCU)) S IBID=$P( $G(^IBA(35 5.91,IBCU, 0)),U,7),$ P(IBT,U,2, 3)=(IBCU_U _355.91) Q ;UNIQ2Q Q IBID ; | |
| 738 | Modified L ogic (Chan ges are in bold) | |
| 739 | IBCEP2A ;A LB/TMP - E DI UTILITI ES for pro vider ID ; 25-APR-01 ;;2.0;INTE GRATED BIL LING;**137 ,232,320,3 48,349,400 ,592**;21- MAR-94;Bui ld 52 ;;Pe r VHA Dire ctive 2004 -038, this routine s hould not be modifie d. ;ALT(IB PERF,IBSRC ,IBALT,IBI NS4,IBPTYP ) ; set so urce level to next h igher leve l ; or se t the alte rnate type and sourc e if perfo rming prov ider id ; alternate type and s ource exis t ; IBPERF = 1 if pe rforming p rovider id is reques ted ; IBIN S4 = '4' n ode of ins urance co (file 36) ; Pass IBP TYP by ref erence to get altern ate provid er id type ; Pass IB ALT by ref erence. Se t to 1 if alternate id is to b e used nex t ; I '$G( IBPERF)!($ P(IBINS4,U ,3)=1) S I BSRC=IBSRC -1 G ALTQ S IBSRC="" I '$G(IBA LT),$P(IBI NS4,U,3)=2 ,$P(IBINS4 ,U,10),$P( IBINS4,U,1 1) S IBALT =1,IBSRC=$ P(IBINS4,U ,11),IBPTY P=$P(IBINS 4,U,10) S: IBPTYP="" IBPTYP=$P( IBINS4,U) ;ALTQ Q IB SRC ;IDSET (IBPTYP,IB INS4,IBPER F,IBSPEC,I BSRC,IBUP) ; set var iables for provider id type se arch N Z S IBSPEC=$G (^IBE(355. 97,+IBPTYP ,1)) S Z=$ S($G(IBPER F):2,$P(IB SPEC,U,5): 6,$P(IBSPE C,U,6):4,1 :2) S IBSR C=$P(IBINS 4,U,Z),IBU P=$P(IBINS 4,U,$S(IBS RC:Z+1,1:0 )) Q ;CARE ST(IBIFN) ; Return s tate file ien of sta te where c are was pe rformed ; IBIFN = ie n of bill in file 39 9 N STATE, IBU2,NVAFA C,IB0,EVDT ,IBDIV,INS T S STATE= "" ; ; non -VA care S IBU2=$G(^ DGCR(399,I BIFN,"U2") ) S NVAFAC =+$P(IBU2, U,10) ; no n-VA facil ity I NVAF AC S STATE =+$P($G(^I BA(355.93, NVAFAC,0)) ,U,7) G CA RESTX ; ; VA care S IB0=$G(^DG CR(399,IBI FN,0)) S E VDT=$P(IB0 ,U,3) ; cl aim event date I 'EV DT S EVDT= DT ; - default today if u ndefined S IBDIV=+$P (IB0,U,22) ; divisio n ptr file 40.8 I 'I BDIV S IBD IV=$$PRIM^ VASITE(EVD T) ; - def ault prima ry divisio n as of ev ent date I IBDIV'>0 S IBDIV=$$ PRIM^VASIT E() ; - de fault main division as of toda y's date S INST=+$$S ITE^VASITE (EVDT,IBDI V) ; divis ion instit ution ptr file 4 I I NST'>0 S I NST=+$$SIT E^VASITE(D T,IBDIV) ; - default div as of today's d ate I INST '>0 S INST =+$$SITE^V ASITE ; - default ma in institu tion S STA TE=+$P($G( ^DIC(4,INS T,0)),U,2) ; state f ile ien fr om Institu tion file ;CARESTX ; Q STATE ; RECALCA(IB IFN) ; Rec alculate a ll perform ing provid er id's on bill IBIF N ; IBIFN = ien of b ill entry (file 399) N IBZ,IBZ 0,IBX,IBP, IBSEQ,DA,D IE,DR,DIR, X,Y ; D EN ^DDIOL("TH IS FUNCTIO N HAS BEEN DISABLED" ,,"!") Q ; S DA(1)=I BIFN I '$D (^XUSEC("I B SUPERVIS OR",DUZ)) D EN^DDIOL ("YOU ARE NOT AUTHOR IZED TO PE RFORM THIS FUNCTION" ,,"!") S I BZ=0 F S IBZ=$O(^DG CR(399,IBI FN,"PRV",I BZ)) Q:'IB Z S IBP=$ G(^(IBZ,0) ) I $P(IBP ,U,2)'="" D . S DA=I BZ . F IBZ 0=5:1:7 Q: '$G(^DGCR( 399,IBIFN, "I"_(IBZ0- 4))) D .. S IBSEQ=$$ EXPAND^IBT RE(399.022 2,.01,+IBP )_" "_$P(" PRIMARY^SE CONDARY^TE RTIARY",U, IBZ0-4)_" PROVIDER I D " .. S I BX=$$RECAL C(.DA,IBZ0 -4,$P(IBP, U,IBZ0),1) .. I IBX' ="",IBX=$P (IBP,U,IBZ 0) D EN^DD IOL(IBSEQ_ "NO CHANGE NEEDED",, "!") Q .. I IBX'="", IBX'=$P(IB P,U,IBZ0) D Q ... S DR=(IBZ0/ 100)_"//// "_IBX,DIE= "^DGCR(399 ,"_DA(1)_" ,""PRV""," D ^DIE .. . D EN^DDI OL(IBSEQ_" CHANGED TO "_IBX,,"! ") .. D EN ^DDIOL(IBS EQ_"NOT FO UND",,"!") Q ;RECALC (IBDA,IBSE Q,IBX,IBD) ; Recalcu late id #, if possib le - calle d ; from i nput trans forms in s ubfile 399 .0222, fie lds .05-.0 7 ; IBDA = DA array of the pro vider entr y (file 39 9.0222) ; IBSEQ = th e numeric COB sequen ce of the provider i d (1-3) ; IBX = the current va lue of the id in the subfile ; IBD = fla g that if set to 1 w ill suppre ss the dis play text ; N IBPN,I BZ S IBPN= $P($G(^DGC R(399,IBDA (1),"PRV", IBDA,0)),U ,2) I IBPN ="" D:'$G( IBD) EN^DD IOL(" CAN' T CALCULAT E WITHOUT A PROVIDER NAME","", "?0") G RE CALCQ S IB Z=$$GETID^ IBCEP2(IBD A(1),2,IBP N,IBSEQ) I IBZ="" D: '$G(IBD) E N^DDIOL(" ID COULD N OT BE DETE RMINED","" ,"?0") G R ECALCQ D:' $G(IBD) EN ^DDIOL(" " _IBZ_$S(IB Z'=IBX:"", 1:" (no ch ange)"),"" ,"?0") S I BX=IBZ ;RE CALCQ Q IB X ;PERFPRV (IBIFN) ; Returns th e variable pointer o f the 'per forming pr ovider' ; (attending or render ing) for a bill IBIF N N IBP,IB PT,IBQ,Z S Z=$$FT^IB CEF(IBIFN) ,IBPT=$S(Z =2:3,Z=3:4 ,1:0) D GE TPRV^IBCEU (IBIFN,IBP T,.IBP) Q $P($G(IBP( IBPT,1)),U ,3) ;INSPA R(IBIFN,SE Q) ; N Z,Z 4,Z0 Q:$G( X)'="??" S :'$G(SEQ) SEQ=$$COBN ^IBCEF(IBI FN) S Z=+$ G(^DGCR(39 9,IBIFN,"I "_SEQ)),Z4 =$G(^DIC(3 6,Z,4)) I Z D . D EN ^DDIOL(">" _$J("",20) _"-- PERFO RMING PROV IDER ID PA RAMETERS - -",,"!") . S Z0=$P(" PRIMARY^S ECONDARY^ TERTIARY", U,SEQ)_" I NSURANCE: "_$P($G(^D IC(36,Z,0) ),U) . D E N^DDIOL("> "_$J("",(8 0-$L(Z0))\ 2)_Z0,,"!" ) . D EN^D DIOL("> Se condary Pe rf Prov ID Type (150 0): "_$$EX PAND^IBTRE (36,4.01,+ Z4),,"!") . ;JWS;IB* 2.0*592;fo rm J430D . D EN^DDIO L("> Secon dary Perf Prov ID Ty pe (J430D) : "_$$EXPA ND^IBTRE(3 6,4.14,$P( Z4,U,14)), ,"!") . D EN^DDIOL(" > Secondar y Perf Pro v ID Type (UB04): "_ $$EXPAND^I BTRE(36,4. 02,$P(Z4,U ,2)),,"!") . D EN^DD IOL("> Sec ondary Per f Prov IDs Required: "_$$EXPAN D^IBTRE(36 ,4.03,$P(Z 4,U,3)),," !") . D EN ^DDIOL(" " ,,"!") Q ; GETTYP(IBX IEN,IBCOBN ,IBFUNC) ; Function returns pr ovider id type for i nsurance c o ; with C OB of IBCO BN on clai m ien IBXI EN in firs t ^ pc and 1 in seco nd ; ^ pie ce if the id is requ ired ; ; IBFUNC=1:R EFERRING;2 :OPERATING ;3:RENDERI NG;4:ATTEN DING;5:SUP ERVISING;6 :ASSISTANT SURGEON;9 :OTHER ; N A,R,Z,Z0 S A="",R= 0 S:'$G(IB COBN)!(IBC OBN>3) IBC OBN=$$COBN ^IBCEF(IBX IEN) S Z=+ $G(^DGCR(3 99,IBXIEN, "I"_+IBCOB N)) I Z D . S Z0=$$F T^IBCEF(IB XIEN) . ;J RA IB*2.0* 592 Treat Dental For m 7 same a s CMS-1500 . ;S A=+$ P($G(^DIC( 36,Z,4)),U ,$S(Z0=2&( $G(IBFUNC) =1):4,Z0=2 :1,1:2)) ; JRA IB*2.0 *592 ';' . ;I A,$G(I BFUNC)'=1 S R=$P($G( ^DIC(36,Z, 4)),U,3),R =$S('R:0,R =3:1,R=1:Z 0=2,R=2:Z0 =3,1:0) ;J RA IB*2.0* 592 ';' . ;I A,$G(IB FUNC)=1 S R=+$P($G(^ DIC(36,Z,4 )),U,5),R= $S('R:0,Z0 '=2:0,1:1) ;JRA IB*2 .0*592 ';' . S A=+$P ($G(^DIC(3 6,Z,4)),U, $S((Z0=2)& ($G(IBFUNC )=1):4,(Z0 =7)&($G(IB FUNC)=1):1 5,Z0=2:1,Z 0=7:14,1:2 )) ;JRA IB *2.0*592;J WS . ;JWS; IB*2.0*592 ;Assistant Surgeon d efault . I A,$G(IBFU NC)=6 S A= 17 . I A,$ G(IBFUNC)' =1 S R=$P( $G(^DIC(36 ,Z,4)),U,3 ),R=$S('R: 0,R=3:Z0'= 7,R=1:Z0=2 ,R=2:Z0=3, R=4:Z0=7,R =5:Z0'=3,R =6:1,1:0) ;JRA IB*2. 0*592 . I A,$G(IBFUN C)=1 S R=+ $P($G(^DIC (36,Z,4)), U,5),R=$S( 'R:0,Z0=3: 0,1:1) ;JR A IB*2.0*5 92 Q A_U_R ;UNIQ1(IB IFN,IBINS, IBPTYP,IBP ROV,IBUNIT ,IBCU,IBT) ; Match m ost-least specific ; *** SEE P ARAMETER D EFINITIONS IN IBCEP3 *** ; ; S tart in fi le 355.9 ( Specific P rovider) ; IBPROV = (variable pointer sy ntax) prov ider on bi ll IBIFN ; N Q,Z0,Z1 ,Z2,IBID,I BX S IBID= "" S IBX=$ P($G(^IBA( 355.9,+IBC U,0)),U,3) S:"0"[IBX IBX="*N/A *" ;JRA IB *2.0*592 n ew Dental Form 7 ;S Z0=$$FT^IB CEF(IBIFN) ,Z0=$S(Z0= 2:2,Z0=3:1 ,1:0),Z1=$ $INPAT^IBC EF(IBIFN) S:'Z1 Z1=2 S Z2=$$IS RX^IBCEF1( IBIFN) ;JR A IB*2.0*5 92 ';' S Z 0=$$FT^IBC EF(IBIFN), Z0=$S(Z0=2 :2,Z0=3:1, Z0=7:4,1:0 ),Z1=$$INP AT^IBCEF(I BIFN) S:'Z 1 Z1=2 S Z 2=$$ISRX^I BCEF1(IBIF N) ;JWS;JR A IB*2.0*5 92 ; ; Mat ch all ele ments F Q= $S(Z2:3,1: Z1),$S(Z2: Z1,1:"") I Q'="",$D( ^IBA(355.9 ,"AUNIQ",I BPROV,IBIN S,IBX,Z0,Q ,IBPTYP,IB CU)) S IBI D=$P($G(^I BA(355.9,I BCU,0)),U, 7),$P(IBT, U,2,3)=(IB CU_U_355.9 ) Q G:IBID '="" UNIQ1 Q ; ; Matc h both for m types,sp ecific I/O element F Q=$S(Z2:3 ,1:Z1),$S( Z2:Z1,1:"" ) I Q'="", $D(^IBA(35 5.9,"AUNIQ ",IBPROV,I BINS,IBX,0 ,Q,IBPTYP, IBCU)) S I BID=$P($G( ^IBA(355.9 ,IBCU,0)), U,7),$P(IB T,U,2,3)=( IBCU_U_355 .9) Q G:IB ID'="" UNI Q1Q ; ; Ma tch specif ic form ty pe, both I /O element or Rx F Q =$S(Z2:3,1 :0),$S(Z2: 0,1:"") I Q'="",$D(^ IBA(355.9, "AUNIQ",IB PROV,IBINS ,IBX,Z0,Q, IBPTYP,IBC U)) S IBID =$P($G(^IB A(355.9,IB CU,0)),U,7 ),$P(IBT,U ,2,3)=(IBC U_U_355.9) Q G:IBID' ="" UNIQ1Q ; ; Match both form types, bo th I/O ele ment or Rx F Q=$S(Z2 :3,1:0),$S (Z2:0,1:"" ) I Q'="", $D(^IBA(35 5.9,"AUNIQ ",IBPROV,I BINS,IBX,0 ,Q,IBPTYP, IBCU)) S I BID=$P($G( ^IBA(355.9 ,IBCU,0)), U,7),$P(IB T,U,2,3)=( IBCU_U_355 .9) Q ;UNI Q1Q Q IBID ;UNIQ2(IB IFN,IBINS, IBPTYP,IBU NIT,IBCU,I BT) ; Matc h on most- least spec ific ; *** SEE PARAM ETER DEFIN ITIONS IN IBCEP3 *** ; ; Start in file 3 55.91 (Spe cific Insu rance) ; N Q,Z0,Z1,Z 2,IBID,IBX S IBID="" S:"0"[$G( IBUNIT) IB UNIT="*N/A *" ;JRA IB *2.0*592 D ental Form 7 ;S Z0=$ $FT^IBCEF( IBIFN),Z0= $S(Z0=2:2, Z0=3:1,1:0 ),Z1=$$INP AT^IBCEF(I BIFN) S:'Z 1 Z1=2 S Z 2=$$ISRX^I BCEF1(IBIF N) ;JRA IB *2.0*592 ' ;' S Z0=$$ FT^IBCEF(I BIFN),Z0=$ S(Z0=2:2,Z 0=3:1,Z0=7 :4,1:0),Z1 =$$INPAT^I BCEF(IBIFN ) S:'Z1 Z1 =2 S Z2=$$ ISRX^IBCEF 1(IBIFN) ; JWS;JRA IB *2.0*592 ; ; Match a ll element s F Q=$S(Z 2:3,1:Z1), $S(Z2:Z1,1 :"") I Q'= "",$D(^IBA (355.91,"A UNIQ",IBIN S,IBUNIT,Z 0,Q,IBPTYP ,IBCU)) S IBID=$P($G (^IBA(355. 91,IBCU,0) ),U,7),$P( IBT,U,2,3) =(IBCU_U_3 55.91) Q G :IBID'="" UNIQ2Q ; ; Match bot h form typ es,specifi c I/O elem ent F Q=$S (Z2:3,1:Z1 ),$S(Z2:Z1 ,1:"") I Q '="",$D(^I BA(355.91, "AUNIQ",IB INS,IBUNIT ,0,Q,IBPTY P,IBCU)) S IBID=$P($ G(^IBA(355 .91,IBCU,0 )),U,7),$P (IBT,U,2,3 )=(IBCU_U_ 355.91) Q G:IBID'="" UNIQ2Q ; ; Match sp ecific for m type, bo th I/O ele ment or Rx F Q=$S(Z2 :3,1:0),$S (Z2:0,1:"" ) I Q'="", $D(^IBA(35 5.91,"AUNI Q",IBINS,I BUNIT,Z0,Q ,IBPTYP,IB CU)) S IBI D=$P($G(^I BA(355.91, IBCU,0)),U ,7),$P(IBT ,U,2,3)=(I BCU_U_355. 91) Q G:IB ID'="" UNI Q2Q ; ; Ma tch both f orm types, both I/O elements o r Rx F Q=$ S(Z2:3,1:0 ),$S(Z2:0, 1:"") I Q' ="",$D(^IB A(355.91," AUNIQ",IBI NS,IBUNIT, 0,Q,IBPTYP ,IBCU)) S IBID=$P($G (^IBA(355. 91,IBCU,0) ),U,7),$P( IBT,U,2,3) =(IBCU_U_3 55.91) Q ; UNIQ2Q Q I BID ; | |
| 740 | ||
| 741 | ||
| 742 | Routines | |
| 743 | Activities | |
| 744 | Routine Na me | |
| 745 | IBCEF21 | |
| 746 | Enhancemen t Category | |
| 747 | New | |
| 748 | Modify | |
| 749 | Delete | |
| 750 | No Change | |
| 751 | RTM | |
| 752 | ||
| 753 | Related Op tions | |
| 754 | None | |
| 755 | Related Ro utines | |
| 756 | Routines “ Called By” | |
| 757 | Routines “ Called” | |
| 758 | ||
| 759 | ||
| 760 | ||
| 761 | ||
| 762 | Data Dicti onary (DD) Reference s | |
| 763 | ||
| 764 | Related Pr otocols | |
| 765 | None | |
| 766 | Related In tegration Control Re gistration s (ICRs) | |
| 767 | None | |
| 768 | Data Passi ng | |
| 769 | Input | |
| 770 | Output Re ference | |
| 771 | Both | |
| 772 | Global Re ference | |
| 773 | Local | |
| 774 | Input Attr ibute Name and Defin ition | |
| 775 | Name: | |
| 776 | Definition : | |
| 777 | Output Att ribute Nam e and Defi nition | |
| 778 | Name: | |
| 779 | Definition : | |
| 780 | Current Lo gic | |
| 781 | IBCEF21 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS CONTINU ED ; 3/9/1 1 1:12pm ; ;2.0;INTEG RATED BILL ING;**51,2 96,371,389 ,448,516** ;21-MAR-94 ;Build 123 ;;Per VA Directive 6402, this routine s hould not be modifie d. ;COID(I BIFN) ; Cl aim office ID N IBCO ID,IBCOID1 ,IBIN S IB IN=$$CURR^ IBCEF2(IBI FN),IBCOID 1="",IBCOI D=$P($$ADD RESS^IBCNS C0(IBIN,.1 1,5),U,11) ; I IBIN D . I $D(^ IBA(364.2, "C",IBIFN) ) S IBCOID 1=$P($$ADD RESS^IBCNS C0(IBIN,.1 8,5),U,11) Q ;Rx . I $P($G(^D GCR(399,IB IFN,0)),U, 5)<3 S IBC OID1=$P($$ ADDRESS^IB CNSC0(IBIN ,.12,5),U, 11) Q ;In pt . I $P( $G(^DGCR(3 99,IBIFN,0 )),U,5)'<3 S IBCOID1 =$P($$ADDR ESS^IBCNSC 0(IBIN,.16 ,5),U,11) Q ;Outpt ; Q $S(IBC OID1'="":I BCOID1,1:I BCOID) ;ES GHPST(IBIF N,COB) ; r eturn insu reds emplo yment stat us if the bill polic y defined by COB is an Employe r Sponsore d Group He alth Plan ; ESGHP FL AG (2.312, 2.1) ^ the employmen t status ( 2.312,2.11 ) ; N PPOL ,DFN,X,Y S Y="" S PP OL=$$PPOL^ IBCEF2($G( IBIFN),$G( COB)),DFN= $P($G(^DGC R(399,+$G( IBIFN),0)) ,U,2) I +P POL,+DFN S X=$G(^DPT (DFN,.312, +PPOL,2)) S Y=+$P(X, U,10)_U_$P (X,U,11) Q Y ;ESGHPN L(IBIFN,CO B) ; retur n employer name and location i f the bill policy de fined by C OB is an E mployer Sp onsored Gr oup Health Plan ; ES GHP FLAG ( 2.312,2.1) ^ employe r name (2. 312,2.015) ^ employe r city (2. 312,2.05) ; ^ emplo yer state abbr (2.31 2,2.06) ^ employer s tate ifn ( 2.312,2.06 ) ; N PPOL ,DFN,X,Y S Y="" S PP OL=$$PPOL^ IBCEF2($G( IBIFN),$G( COB)),DFN= $P($G(^DGC R(399,+$G( IBIFN),0)) ,U,2) I +P POL,+DFN S X=$G(^DPT (DFN,.312, +PPOL,2)) S Y=+$P(X, U,10)_U_$P (X,U,9)_U_ $P(X,U,5)_ U_$P($G(^D IC(5,+$P(X ,U,6),0)), U,2)_U_$P( X,U,6) Q Y ;REMARKS( IBIFN) ; C ompile arr ay of bill remarks ; IBIFN = bi ll ien N Z ,Z0,Z1,IBA RRAY,IBSM S Z=0 ;S:$ P($G(^DGCR (399,IBIFN ,"U1")),U, 2) Z=Z+1,Z 0=$P(^("U1 "),U,2),IB XDATA(Z)=" OFFSET AMO UNT: "_"$" _+$P(Z0,". ")_"."_$E( $P(Z0,".", 2)_"00",1, 2) S:$P($G (^DGCR(399 ,IBIFN,"U1 ")),U,8)'= "" Z=Z+1,I BXDATA(Z)= $P(^("U1") ,U,8) ;Bil l comment on bill S Z0=$G(^DGC R(399,IBIF N,0)),Z1=$ G(^DGCR(39 9.3,+$P(Z0 ,U,7),0)) D SET^IBCS C5B(IBIFN, .IBARRAY) I $P($G(IB ARRAY),U,2 ) D ;Pros thetics . S Z0=0 F S Z0=$O(IB ARRAY(Z0)) Q:Z0="" S Z1=0 F S Z1=$O(IB ARRAY(Z0,Z 1)) Q:'Z1 S Z=Z+1,I BXDATA(Z)= "Prostheti c: "_$E($$ PINB^IBCSC 5B(+IBARRA Y(Z0,Z1)), 1,39)_" "_ $E(Z0,4,5) _"/"_$E(Z0 ,6,7)_"/"_ $E(Z0,1,2) Q ;CREM(I BIFN) ; Co mpile arra y of bill remarks co mmon to ev ery bill ; IBIFN = bi ll ien N Z S Z=0 S:$ P($G(^IBE( 350.9,1,1) ),U,4)'="" Z=Z+1,IBX DATA(Z)=$P (^(1),U,4) ;Site spe cific 'eve ry bill' c omment Q ; ADMDT(IBIF N,NOOUTCK) ; Calcula te admissi on/start o f care dat e/time ; I BIFN = bil l ien ; NO OUTCK = fl ag that wi ll: ; (1) no check f or inpt ep isode over lap for ou tpt ; (0 o r null) pe rforms che ck for inp t episode overlap fo r outpt ; ; Returns IBXDATA = fileman d ate format N Z,Z0,Z1 S Z=$G(^D GCR(399,IB IFN,0)),Z1 =$P($G(^(" U")),U,20) ,Z0=$$INPA T^IBCEF(IB IFN,1) S I BXDATA=$S( Z0&$P(Z,U, 8):$P($G(^ DGPT(+$P(Z ,U,8),0)), U,2),1:"") S:'IBXDAT A IBXDATA= $P(Z,U,3)_ $S(Z0&(Z1< 25):"."_$E ("0",$L(Z1 ))_Z1,1:"" ) ; Check to see if outpt epis ode (date in event d ate) overl aps inpt ; episode - use admit date if i t does I ' Z0,IBXDATA ,'$G(NOOUT CK) D . N VAINDT,VAI N,DFN . S VAINDT=IBX DATA,DFN=$ P($G(^DGCR (399,IBIFN ,0)),U,2) . D INP^VA DPT S IBXD ATA=+VAIN( 7) S:'IBXD ATA IBXDAT A="" I 'IB XDATA,'Z0 S IBXDATA= $$SERVDT^I BCEF(IBIFN ,,2) Q ;DI SDT(IBIFN) ; Calcula te dischar ge date ; IBIFN = bi ll ien N Z ,Z0 S Z=$$ INPAT^IBCE F(IBIFN,1) ,Z0=$G(^DG CR(399,IBI FN,0)) I Z S IBXDATA =+$G(^DGPT (+$P(Z0,U, 8),70)) S: 'IBXDATA I BXDATA=$P( Z0,U,16) I 'Z N VAIN DT,VAIN,DF N S DFN=$P ($G(^DGCR( 399,IBIFN, 0)),U,2) D INP^VADPT I VAIN(1) S IBXDATA =+$G(^DGPM (+$P($G(^D GPM(+VAIN( 1),0)),U,1 7),0)) Q ; INSSECID(I BIFN,TYPE, SEQ) ; Ext ract subsc riber and patient pr im/sec ID' s ; IBIFN required ; TYPE is e ither "PAT " or "SUB" to indica te we need to extrac t either ; patient o r subscrib er ID info rmation. D efault="SU B". ; SEQ is the ins urance seq uence# (1, 2,3). Defa ult is cur rent ins s eq#. ; ; O utput: ; F unction re turns an 8 -piece str ing as fol lows. ; [1 ] primary qualifier ; [2] prim ary ID ; [ 3] seconda ry qual(1) ; [4] sec ondary ID( 1) ; [5] s econdary q ual(2) ; [ 6] seconda ry ID(2) ; [7] secon dary qual( 3) ; [8] s econdary I D(3) ; NEW DATA,DFN, POL,IB0,IB 5,REL S DA TA="" S IB IFN=+$G(IB IFN) I 'IB IFN G INSS X I $G(TYP E)="" S TY PE="SUB" ; defau lt type of ID's to g et I '$F(" .PAT.SUB." ,"."_TYPE_ ".") G INS SX I '$G(S EQ) S SEQ= $$COBN^IBC EF(IBIFN) ; default current in s seq# I ' $F(".1.2.3 .","."_SEQ _".") G IN SSX S DFN= +$P($G(^DG CR(399,IBI FN,0)),U,2 ) I 'DFN G INSSX S P OL=+$P($G( ^DGCR(399, IBIFN,"M") ),U,SEQ+11 ) I 'POL G INSSX ;IB *2.0*516/b aa - Use H IPAA compl iant field s ;S IB0=$ G(^DPT(DFN ,.312,POL, 0)) I IB0= "" G INSSX ;516 - ba a S IB0=$$ ZND^IBCNS1 (DFN,POL) I IB0="" G INSSX ;5 16 - baa S IB5=$G(^D PT(DFN,.31 2,POL,5)) S REL=+$P( IB0,U,16) ; pat rel to insured S $P(DATA ,U,1)="MI" S $P(DATA ,U,2)=$P(I B0,U,2) ; subscriber primary I D S $P(DA TA,U,3,8)= $P(IB5,U,2 ,7) ; subs criber sec ondary dat a I TYPE=" PAT",REL'= 1 D . S $P (DATA,U,2) =$P(IB5,U, 1) ; patie nt primary ID . S $P (DATA,U,3, 8)=$P(IB5, U,8,13) ; patient se condary da ta . Q ; S DATA=$$SC RUB(DATA) ; scrub th e dataINSS X ; Q DATA ;SCRUB(DA TA) ; Scru b the 8-pi ece string gathered above NEW PCE ; ; ma ke sure yo u can't ha ve an ID w ithout a q ualifier o r a qualif ier ; with out an ID. Check all 4 pairs. F PCE=1,3, 5,7 D . I $P(DATA,U, PCE)'="",$ P(DATA,U,P CE+1)'="" Q . S ($P( DATA,U,PCE ),$P(DATA, U,PCE+1))= "" . Q ; ; fill in s econdary g aps. If Se t1 and Set 2 are blan k, but Set 3 exists ; then move Set3 to S et1 and de lete Set3. I $P(DATA ,U,3)="",$ P(DATA,U,5 )="",$P(DA TA,U,7)'=" " D . S $P (DATA,U,3) =$P(DATA,U ,7),$P(DAT A,U,4)=$P( DATA,U,8) . S ($P(DA TA,U,7),$P (DATA,U,8) )="" . Q ; ; fill in secondary gaps more generical ly. ; If S et(n) is b lank, but Set(n+1) e xists, the n move it up. F PCE= 3,5 D . I $P(DATA,U, PCE)="",$P (DATA,U,PC E+2)'="" D .. S $P(D ATA,U,PCE) =$P(DATA,U ,PCE+2) .. S $P(DATA ,U,PCE+1)= $P(DATA,U, PCE+3) .. S ($P(DATA ,U,PCE+2), $P(DATA,U, PCE+3))="" .. Q . Q ; Q DATA ; | |
| 782 | Modified L ogic (Chan ges are in bold) | |
| 783 | IBCEF21 ;A LB/TMP - F ORMATTER S PECIFIC BI LL FUNCTIO NS CONTINU ED ; 3/9/1 1 1:12pm ; ;2.0;INTEG RATED BILL ING;**51,2 96,371,389 ,448,516,5 92**;21-MA R-94;Build 123 ;;Per VA Direct ive 6402, this routi ne should not be mod ified. ;CO ID(IBIFN) ; Claim of fice ID N IBCOID,IBC OID1,IBIN S IBIN=$$C URR^IBCEF2 (IBIFN),IB COID1="",I BCOID=$P($ $ADDRESS^I BCNSC0(IBI N,.11,5),U ,11) ; I I BIN D . I $D(^IBA(36 4.2,"C",IB IFN)) S IB COID1=$P($ $ADDRESS^I BCNSC0(IBI N,.18,5),U ,11) Q ;R x . I $P($ G(^DGCR(39 9,IBIFN,0) ),U,5)<3 S IBCOID1=$ P($$ADDRES S^IBCNSC0( IBIN,.12,5 ),U,11) Q ;Inpt . I $P($G(^DG CR(399,IBI FN,0)),U,5 )'<3 S IBC OID1=$P($$ ADDRESS^IB CNSC0(IBIN ,.16,5),U, 11) Q ;Ou tpt . ;JWS ;IB*2.0*59 2;Dental i nsurance m ailing add ress info . I $$FT^I BCEF(IBIFN )=7 S IBCO ID1=$P($$A DDRESS^IBC NSC0(IBIN, .19,11),U, 11) Q ;De ntal ; Q $ S(IBCOID1' ="":IBCOID 1,1:IBCOID ) ;ESGHPST (IBIFN,COB ) ; return insureds employment status if the bill policy def ined by CO B is an Em ployer Spo nsored Gro up Health Plan ; ESG HP FLAG (2 .312,2.1) ^ the empl oyment sta tus (2.312 ,2.11) ; N PPOL,DFN, X,Y S Y="" S PPOL=$$ PPOL^IBCEF 2($G(IBIFN ),$G(COB)) ,DFN=$P($G (^DGCR(399 ,+$G(IBIFN ),0)),U,2) I +PPOL,+ DFN S X=$G (^DPT(DFN, .312,+PPOL ,2)) S Y=+ $P(X,U,10) _U_$P(X,U, 11) Q Y ;E SGHPNL(IBI FN,COB) ; return emp loyer name and locat ion if the bill poli cy defined by COB is an Employ er Sponsor ed Group H ealth Plan ; ESGHP F LAG (2.312 ,2.1) ^ em ployer nam e (2.312,2 .015) ^ em ployer cit y (2.312,2 .05) ; ^ employer s tate abbr (2.312,2.0 6) ^ emplo yer state ifn (2.312 ,2.06) ; N PPOL,DFN, X,Y S Y="" S PPOL=$$ PPOL^IBCEF 2($G(IBIFN ),$G(COB)) ,DFN=$P($G (^DGCR(399 ,+$G(IBIFN ),0)),U,2) I +PPOL,+ DFN S X=$G (^DPT(DFN, .312,+PPOL ,2)) S Y=+ $P(X,U,10) _U_$P(X,U, 9)_U_$P(X, U,5)_U_$P( $G(^DIC(5, +$P(X,U,6) ,0)),U,2)_ U_$P(X,U,6 ) Q Y ;REM ARKS(IBIFN ) ; Compil e array of bill rema rks ;IBIFN = bill ie n N Z,Z0,Z 1,IBARRAY, IBSM S Z=0 ;S:$P($G( ^DGCR(399, IBIFN,"U1" )),U,2) Z= Z+1,Z0=$P( ^("U1"),U, 2),IBXDATA (Z)="OFFSE T AMOUNT: "_"$"_+$P( Z0,".")_". "_$E($P(Z0 ,".",2)_"0 0",1,2) S: $P($G(^DGC R(399,IBIF N,"U1")),U ,8)'="" Z= Z+1,IBXDAT A(Z)=$P(^( "U1"),U,8) ;Bill com ment on bi ll S Z0=$G (^DGCR(399 ,IBIFN,0)) ,Z1=$G(^DG CR(399.3,+ $P(Z0,U,7) ,0)) D SET ^IBCSC5B(I BIFN,.IBAR RAY) I $P( $G(IBARRAY ),U,2) D ;Prostheti cs . S Z0= 0 F S Z0= $O(IBARRAY (Z0)) Q:Z0 ="" S Z1= 0 F S Z1= $O(IBARRAY (Z0,Z1)) Q :'Z1 S Z= Z+1,IBXDAT A(Z)="Pros thetic: "_ $E($$PINB^ IBCSC5B(+I BARRAY(Z0, Z1)),1,39) _" "_$E(Z0 ,4,5)_"/"_ $E(Z0,6,7) _"/"_$E(Z0 ,1,2) Q ;C REM(IBIFN) ; Compile array of bill remar ks common to every b ill ;IBIFN = bill ie n N Z S Z= 0 S:$P($G( ^IBE(350.9 ,1,1)),U,4 )'="" Z=Z+ 1,IBXDATA( Z)=$P(^(1) ,U,4) ;Sit e specific 'every bi ll' commen t Q ;ADMDT (IBIFN,NOO UTCK) ; Ca lculate ad mission/st art of car e date/tim e ; IBIFN = bill ien ; NOOUTCK = flag th at will: ; (1) no ch eck for in pt episode overlap f or outpt ; (0 or nul l) perform s check fo r inpt epi sode overl ap for out pt ; ; Re turns IBXD ATA = file man date f ormat N Z, Z0,Z1 S Z= $G(^DGCR(3 99,IBIFN,0 )),Z1=$P($ G(^("U")), U,20),Z0=$ $INPAT^IBC EF(IBIFN,1 ) S IBXDAT A=$S(Z0&$P (Z,U,8):$P ($G(^DGPT( +$P(Z,U,8) ,0)),U,2), 1:"") S:'I BXDATA IBX DATA=$P(Z, U,3)_$S(Z0 &(Z1<25):" ."_$E("0", $L(Z1))_Z1 ,1:"") ; C heck to se e if outpt episode ( date in ev ent date) overlaps i npt ; epis ode - use admit date if it doe s I 'Z0,IB XDATA,'$G( NOOUTCK) D . N VAIND T,VAIN,DFN . S VAIND T=IBXDATA, DFN=$P($G( ^DGCR(399, IBIFN,0)), U,2) . D I NP^VADPT S IBXDATA=+ VAIN(7) S: 'IBXDATA I BXDATA="" I 'IBXDATA ,'Z0 S IBX DATA=$$SER VDT^IBCEF( IBIFN,,2) Q ;DISDT(I BIFN) ; Ca lculate di scharge da te ; IBIFN = bill ie n N Z,Z0 S Z=$$INPAT ^IBCEF(IBI FN,1),Z0=$ G(^DGCR(39 9,IBIFN,0) ) I Z S IB XDATA=+$G( ^DGPT(+$P( Z0,U,8),70 )) S:'IBXD ATA IBXDAT A=$P(Z0,U, 16) I 'Z N VAINDT,VA IN,DFN S D FN=$P($G(^ DGCR(399,I BIFN,0)),U ,2) D INP^ VADPT I VA IN(1) S IB XDATA=+$G( ^DGPM(+$P( $G(^DGPM(+ VAIN(1),0) ),U,17),0) ) Q ;INSSE CID(IBIFN, TYPE,SEQ) ; Extract subscriber and patie nt prim/se c ID's ; I BIFN requi red ; TYPE is either "PAT" or "SUB" to i ndicate we need to e xtract eit her ; pati ent or sub scriber ID informati on. Defaul t="SUB". ; SEQ is th e insuranc e sequence # (1,2,3). Default i s current ins seq#. ; ; Output : ; Functi on returns an 8-piec e string a s follows. ; [1] pri mary quali fier ; [2] primary I D ; [3] se condary qu al(1) ; [4 ] secondar y ID(1) ; [5] second ary qual(2 ) ; [6] se condary ID (2) ; [7] secondary qual(3) ; [8] second ary ID(3) ; NEW DATA ,DFN,POL,I B0,IB5,REL S DATA="" S IBIFN=+ $G(IBIFN) I 'IBIFN G INSSX I $ G(TYPE)="" S TYPE="S UB" ; default ty pe of ID's to get I '$F(".PAT. SUB.","."_ TYPE_".") G INSSX I '$G(SEQ) S SEQ=$$COB N^IBCEF(IB IFN) ; def ault curre nt ins seq # I '$F(". 1.2.3.",". "_SEQ_".") G INSSX S DFN=+$P($ G(^DGCR(39 9,IBIFN,0) ),U,2) I ' DFN G INSS X S POL=+$ P($G(^DGCR (399,IBIFN ,"M")),U,S EQ+11) I ' POL G INSS X ;IB*2.0* 516/baa - Use HIPAA compliant fields ;S IB0=$G(^DP T(DFN,.312 ,POL,0)) I IB0="" G INSSX ;516 - baa S I B0=$$ZND^I BCNS1(DFN, POL) I IB0 ="" G INSS X ;516 - baa S IB5= $G(^DPT(DF N,.312,POL ,5)) S REL =+$P(IB0,U ,16) ; pat rel to in sured S $P (DATA,U,1) ="MI" S $P (DATA,U,2) =$P(IB0,U, 2) ; subsc riber prim ary ID S $P(DATA,U, 3,8)=$P(IB 5,U,2,7) ; subscribe r secondar y data I T YPE="PAT", REL'=1 D . S $P(DATA ,U,2)=$P(I B5,U,1) ; patient pr imary ID . S $P(DATA ,U,3,8)=$P (IB5,U,8,1 3) ; patie nt seconda ry data . Q ; S DATA =$$SCRUB(D ATA) ; scr ub the dat aINSSX ; Q DATA ;SCR UB(DATA) ; Scrub the 8-piece s tring gath ered above NEW PCE ; ; make su re you can 't have an ID withou t a qualif ier or a q ualifier ; without a n ID. Chec k all 4 pa irs. F PCE =1,3,5,7 D . I $P(DA TA,U,PCE)' ="",$P(DAT A,U,PCE+1) '="" Q . S ($P(DATA, U,PCE),$P( DATA,U,PCE +1))="" . Q ; ; fill in second ary gaps. If Set1 an d Set2 are blank, bu t Set3 exi sts ; then move Set3 to Set1 a nd delete Set3. I $P (DATA,U,3) ="",$P(DAT A,U,5)="", $P(DATA,U, 7)'="" D . S $P(DATA ,U,3)=$P(D ATA,U,7),$ P(DATA,U,4 )=$P(DATA, U,8) . S ( $P(DATA,U, 7),$P(DATA ,U,8))="" . Q ; ; fi ll in seco ndary gaps more gene rically. ; If Set(n) is blank, but Set(n +1) exists , then mov e it up. F PCE=3,5 D . I $P(DA TA,U,PCE)= "",$P(DATA ,U,PCE+2)' ="" D .. S $P(DATA,U ,PCE)=$P(D ATA,U,PCE+ 2) .. S $P (DATA,U,PC E+1)=$P(DA TA,U,PCE+3 ) .. S ($P (DATA,U,PC E+2),$P(DA TA,U,PCE+3 ))="" .. Q . Q ; Q D ATA ; | |
| 784 | ||
| 785 | Routines | |
| 786 | Activities | |
| 787 | Routine Na me | |
| 788 | IBCNSC0 | |
| 789 | Enhancemen t Category | |
| 790 | New | |
| 791 | Modify | |
| 792 | Delete | |
| 793 | No Change | |
| 794 | RTM | |
| 795 | ||
| 796 | Related Op tions | |
| 797 | None | |
| 798 | Related Ro utines | |
| 799 | Routines “ Called By” | |
| 800 | Routines “ Called” | |
| 801 | ||
| 802 | ||
| 803 | ||
| 804 | ||
| 805 | Data Dicti onary (DD) Reference s | |
| 806 | ||
| 807 | Related Pr otocols | |
| 808 | None | |
| 809 | Related In tegration Control Re gistration s (ICRs) | |
| 810 | None | |
| 811 | Data Passi ng | |
| 812 | Input | |
| 813 | Output Re ference | |
| 814 | Both | |
| 815 | Global Re ference | |
| 816 | Local | |
| 817 | Input Attr ibute Name and Defin ition | |
| 818 | Name: | |
| 819 | Definition : | |
| 820 | Output Att ribute Nam e and Defi nition | |
| 821 | Name: | |
| 822 | Definition : | |
| 823 | Current Lo gic | |
| 824 | IBCNSC0 ;A LB/NLR - I NSURANCE C OMPANY EDI T - ;12-MA R-1993 ;;2 .0;INTEGRA TED BILLIN G;**371,54 7**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ;CLA IMS1 ; dis play Inpat ient Claim s informat ion N OFFS ET,START,I BCNS12,IBA DD ;WCJ;IB *2.0*547 ; S START=27 ,OFFSET=2 S START=28 +(2*$G(IBA CMAX)),OFF SET=2 D SE T^IBCNSP(S TART,OFFSE T+20," Inp atient Cla ims Office Informati on ",IORVO N,IORVOFF) ; ;WCJ;IB *2.0*547;C all New AP I ;S IBCNS 12=$$ADDRE SS(IBCNS,. 12,5) S IB CNS12=$$AD D2(IBCNS,. 12,5) ; D SET^IBCNSP (START+1,O FFSET," Co mpany Name : "_$P($G( ^DIC(36,+$ P(IBCNS12, "^",7),0)) ,"^",1)) D SET^IBCNS P(START+2, OFFSET," S treet: "_$ P(IBCNS12, "^",1)) D SET^IBCNSP (START+3,O FFSET," St reet 2: "_ $P(IBCNS12 ,"^",2)) N OFFSET S OFFSET=45 D SET^IBCN SP(START+1 ,OFFSET," Street 3: "_$P(IBCNS 12,"^",3)) S IBADD=1 D SET^IBC NSP(START+ 1+IBADD,OF FSET," Cit y/State: " _$E($P(IBC NS12,"^",4 ),1,15)_$S ($P(IBCNS1 2,"^",4)=" ":"",1:", ")_$P($G(^ DIC(5,+$P( IBCNS12,"^ ",5),0))," ^",2)_" "_ $E($P(IBCN S12,"^",6) ,1,5)) D S ET^IBCNSP( START+2+IB ADD,OFFSET ," Phone: "_$P(IBCNS 12,"^",8)) D SET^IBC NSP(START+ 3+IBADD,OF FSET," Fax : "_$P(IBC NS12,"^",9 )) Q ;R1Q QCLAIMS2 ; display O utpatient Claims inf ormation ; N OFFSET, START,IBCN S16,IBADD ;WCJ;IB*2. 0*547 ;S S TART=34,OF FSET=2 S S TART=35+(2 *$G(IBACMA X)),OFFSET =2 D SET^I BCNSP(STAR T,OFFSET+2 0," Outpat ient Claim s Office I nformation ",IORVON, IORVOFF) ; ;WCJ;IB*2 .0*547;Cal l New API ;S IBCNS16 =$$ADDRESS (IBCNS,.16 ,6) S IBCN S16=$$ADD2 (IBCNS,.16 ,6) ; D SE T^IBCNSP(S TART+1,OFF SET," Comp any Name: "_$P($G(^D IC(36,+$P( IBCNS16,"^ ",7),0))," ^",1)) D S ET^IBCNSP( START+2,OF FSET," Str eet: "_$P( IBCNS16,"^ ",1)) D SE T^IBCNSP(S TART+3,OFF SET," Stre et 2: "_$P (IBCNS16," ^",2)) N O FFSET S OF FSET=45 D SET^IBCNSP (START+1,O FFSET," St reet 3: "_ $P(IBCNS16 ,"^",3)) S IBADD=1 D SET^IBCNS P(START+1+ IBADD,OFFS ET," City/ State: "_$ E($P(IBCNS 16,"^",4), 1,15)_$S($ P(IBCNS16, "^",4)="": "",1:", ") _$P($G(^DI C(5,+$P(IB CNS16,"^", 5),0)),"^" ,2)_" "_$E ($P(IBCNS1 6,"^",6),1 ,5)) D SET ^IBCNSP(ST ART+2+IBAD D,OFFSET," Phone: "_ $P(IBCNS16 ,"^",8)) D SET^IBCNS P(START+3+ IBADD,OFFS ET," Fax: "_$P(IBCNS 16,"^",9)) Q ; ; Onl y adding c omments on patch 547 . Changes are on the ADD2 tag below. ; T his tag is called fr om the Out put format ter. ; It returns a "complete" address ; It judges an addres s complete if it has a state ( don't ask why, I am just addin g the comm ents) ; If the addre ss it want s is not c omplete, i t returns the main a ddress. ; These addr esses go o ut on clai ms and cla ims (X12 8 37) don't like parti al address es.ADDRESS (INS,NODE, PH) ; -- g eneric fin d address ; N IBX,IN SSAVE,IBPH ,IBFX,IBCN T,IBA S IB X="" ;S IB PH="",IBFX ="",IBA="" ;REDO ; g ather insu rance carr ier's main address i nformation S IBX=$G (^DIC(36,+ INS,.11)), IBPH=$P($G (^DIC(36,+ INS,.13)), "^",1),IBF X=$P(IBX," ^",9) ;S I BCNT=$G(IB CNT)+1 ; ; -- if pro cess the s ame co. mo re than on ce you are in an inf inite loop ;I $D(IBC NT(IBCNS)) G ADDREQ ;S IBCNT(I BCNS)="" ; ; -- gath er address informati on from sp ecific off ice (Claim s, Appeals , Inquiry) ; I $P($G (^DIC(36,+ INS,+NODE) ),"^",5) S IBX=$G(^D IC(36,+INS ,+NODE)),I BPH=$P($G( ^DIC(36,+I NS,.13))," ^",PH),IBF X=$P($G(IB X),"^",9) I $P($G(^D IC(36,+INS ,+NODE))," ^",7) S IN SSAVE=INS, INS=$P($G( ^DIC(36,+I NS,+NODE)) ,"^",7) I INSSAVE'=I NS G REDO ;ADDRESQ ; concatena te company name, add ress, phon e and fax S $P(IBA, "^",1,6)=$ P($G(IBX), "^",1,6) S $P(IBA,"^ ",7)=INS S $P(IBA,"^ ",8)=IBPH S $P(IBA," ^",9)=IBFX ADDREQ Q I BA ; ; WCJ ;IB*2.0*54 7; ; This is a new t ag which i s just cal led from t he insuran ce company editor sc reens. ; T he billers /insurance verifiers want to s ee what da ta is actu ally in th e insuranc e company file. ; Th ey don't c are if it' s complete . Heck, a phone numb er may be enough. ; This will just retur n what is in the fil e for the ins compan y that han dles that type of cl aims. ; In put: INS - IREN to f ile 36 ; N ODE - Node in File 3 6 (corresp onds to Cl aims, Appe als, Inqui ry...) ; P H - Locati on of Phon e number i n node .13 ADD2(INS,N ODE,PH) ; N IBX,INSS AVE,IBFX,I BPH,IBA F S IBX=$G( ^DIC(36,+I NS,+NODE)) Q:'$P(IBX ,U,7) S IN SSAVE=INS, INS=$P(IBX ,U,7) Q:IN SSAVE=INS ; concaten ate compan y name, ad dress, pho ne and fax S IBPH=$ P($G(^DIC( 36,+INS,.1 3)),U,PH), IBFX=$P(IB X,U,9) S $ P(IBA,U,1, 6)=$P(IBX, U,1,6),$P( IBA,U,7)=I NS,$P(IBA, U,8)=IBPH, $P(IBA,U,9 )=IBFX Q I BA | |
| 825 | Modified L ogic (Chan ges are in bold) | |
| 826 | IBCNSC0 ;A LB/NLR - I NSURANCE C OMPANY EDI T - ;12-MA R-1993 ;;2 .0;INTEGRA TED BILLIN G;**371,54 7,592**;21 -MAR-94;Bu ild 119 ;; Per VA Dir ective 640 2, this ro utine shou ld not be modified. ;CLAIMS1 ; display I npatient C laims info rmation N OFFSET,STA RT,IBCNS12 ,IBADD ;WC J;IB*2.0*5 47 ;S STAR T=27,OFFSE T=2 S STAR T=28+(2*$G (IBACMAX)) ,OFFSET=2 D SET^IBCN SP(START,O FFSET+20," Inpatient Claims Of fice Infor mation ",I ORVON,IORV OFF) ; ;WC J;IB*2.0*5 47;Call Ne w API ;S I BCNS12=$$A DDRESS(IBC NS,.12,5) S IBCNS12= $$ADD2(IBC NS,.12,5) ; D SET^IB CNSP(START +1,OFFSET, " Company Name: "_$P ($G(^DIC(3 6,+$P(IBCN S12,"^",7) ,0)),"^",1 )) D SET^I BCNSP(STAR T+2,OFFSET ," Street: "_$P(IBCN S12,"^",1) ) D SET^IB CNSP(START +3,OFFSET, " Street 2 : "_$P(IBC NS12,"^",2 )) N OFFSE T S OFFSET =45 D SET^ IBCNSP(STA RT+1,OFFSE T," Street 3: "_$P(I BCNS12,"^" ,3)) S IBA DD=1 D SET ^IBCNSP(ST ART+1+IBAD D,OFFSET," City/Stat e: "_$E($P (IBCNS12," ^",4),1,15 )_$S($P(IB CNS12,"^", 4)="":"",1 :", ")_$P( $G(^DIC(5, +$P(IBCNS1 2,"^",5),0 )),"^",2)_ " "_$E($P( IBCNS12,"^ ",6),1,5)) D SET^IBC NSP(START+ 2+IBADD,OF FSET," Pho ne: "_$P(I BCNS12,"^" ,8)) D SET ^IBCNSP(ST ART+3+IBAD D,OFFSET," Fax: "_$P (IBCNS12," ^",9)) Q ; R1Q QCLAIM S2 ; displ ay Outpati ent Claims informati on ; N OFF SET,START, IBCNS16,IB ADD ;WCJ;I B*2.0*547 ;S START=3 4,OFFSET=2 S START=3 5+(2*$G(IB ACMAX)),OF FSET=2 D S ET^IBCNSP( START,OFFS ET+20," Ou tpatient C laims Offi ce Informa tion ",IOR VON,IORVOF F) ; ;WCJ; IB*2.0*547 ;Call New API ;S IBC NS16=$$ADD RESS(IBCNS ,.16,6) S IBCNS16=$$ ADD2(IBCNS ,.16,6) ; D SET^IBCN SP(START+1 ,OFFSET," Company Na me: "_$P($ G(^DIC(36, +$P(IBCNS1 6,"^",7),0 )),"^",1)) D SET^IBC NSP(START+ 2,OFFSET," Street: " _$P(IBCNS1 6,"^",1)) D SET^IBCN SP(START+3 ,OFFSET," Street 2: "_$P(IBCNS 16,"^",2)) N OFFSET S OFFSET=4 5 D SET^IB CNSP(START +1,OFFSET, " Street 3 : "_$P(IBC NS16,"^",3 )) S IBADD =1 D SET^I BCNSP(STAR T+1+IBADD, OFFSET," C ity/State: "_$E($P(I BCNS16,"^" ,4),1,15)_ $S($P(IBCN S16,"^",4) ="":"",1:" , ")_$P($G (^DIC(5,+$ P(IBCNS16, "^",5),0)) ,"^",2)_" "_$E($P(IB CNS16,"^", 6),1,5)) D SET^IBCNS P(START+2+ IBADD,OFFS ET," Phone : "_$P(IBC NS16,"^",8 )) D SET^I BCNSP(STAR T+3+IBADD, OFFSET," F ax: "_$P(I BCNS16,"^" ,9)) Q ; ; Only addi ng comment s on patch 547. Chan ges are on the ADD2 tag below. ; This ta g is calle d from the Output fo rmatter. ; It return s a "compl ete" addre ss ; It ju dges an ad dress comp lete if it has a sta te (don't ask why, I am just a dding the comments) ; If the a ddress it wants is n ot complet e, it retu rns the ma in address . ; These addresses go out on claims and claims (X 12 837) do n't like p artial add resses.ADD RESS(INS,N ODE,PH) ; -- generic find addr ess ; N IB X,INSSAVE, IBPH,IBFX, IBCNT,IBA S IBX="" ; S IBPH="", IBFX="",IB A="" ;REDO ; gather insurance carrier's main addre ss informa tion S IB X=$G(^DIC( 36,+INS,.1 1)),IBPH=$ P($G(^DIC( 36,+INS,.1 3)),"^",1) ,IBFX=$P(I BX,"^",9) ;S IBCNT=$ G(IBCNT)+1 ; ; -- if process t he same co . more tha n once you are in an infinite loop ;I $D (IBCNT(IBC NS)) G ADD REQ ;S IBC NT(IBCNS)= "" ; ; -- gather add ress infor mation fro m specific office (C laims, App eals, Inqu iry, Denta l) ;JWS;IB *2.0*592;C hanged bel ow for DEN TAL insura nce mailin g address I $P($G(^D IC(36,+INS ,+NODE))," ^",5) D . S IBX=$G(^ DIC(36,+IN S,+NODE)) . I +NODE= .19 S IBPH =$P(IBX,"^ ",PH) . E S IBPH=$P ($G(^DIC(3 6,+INS,.13 )),"^",PH) . S IBFX= $P($G(IBX) ,"^",9) I $P($G(^DIC (36,+INS,+ NODE)),"^" ,7) S INSS AVE=INS,IN S=$P($G(^D IC(36,+INS ,+NODE))," ^",7) I IN SSAVE'=INS G REDO ;A DDRESQ ; c oncatenate company n ame, addre ss, phone and fax S $P(IBA,"^ ",1,6)=$P( $G(IBX),"^ ",1,6) S $ P(IBA,"^", 7)=INS S $ P(IBA,"^", 8)=IBPH S $P(IBA,"^" ,9)=IBFXAD DREQ Q IBA ; ; WCJ;I B*2.0*547; ; This is a new tag which is just calle d from the insurance company e ditor scre ens. ; The billers/i nsurance v erifiers w ant to see what data is actual ly in the insurance company fi le. ; They don't car e if it's complete. Heck, a ph one number may be en ough. ; Th is will ju st return what is in the file for the in s company that handl es that ty pe of clai ms. ; Inpu t: INS - I REN to fil e 36 ; NOD E - Node i n File 36 (correspon ds to Clai ms, Appeal s, Inquiry ...) ; PH - Location of Phone number in node .13AD D2(INS,NOD E,PH) ; N IBX,INSSAV E,IBFX,IBP H,IBA F S IBX=$G(^D IC(36,+INS ,+NODE)) Q :'$P(IBX,U ,7) S INSS AVE=INS,IN S=$P(IBX,U ,7) Q:INSS AVE=INS ; concatenat e company name, addr ess, phone and fax S IBPH=$P( $G(^DIC(36 ,+INS,.13) ),U,PH),IB FX=$P(IBX, U,9) ;JWS; IB*2.0*592 ;Dental ma iling addr ess I +NOD E=.19 S IB PH=$P($G(^ DIC(36,+IN S,.19)),U, 11) S $P(I BA,U,1,6)= $P(IBX,U,1 ,6),$P(IBA ,U,7)=INS, $P(IBA,U,8 )=IBPH,$P( IBA,U,9)=I BFX Q IBA | |
| 827 | ||
| 828 | Routines | |
| 829 | Activities | |
| 830 | Routine Na me | |
| 831 | IBCNSC01 | |
| 832 | Enhancemen t Category | |
| 833 | New | |
| 834 | Modify | |
| 835 | Delete | |
| 836 | No Change | |
| 837 | RTM | |
| 838 | ||
| 839 | Related Op tions | |
| 840 | None | |
| 841 | Related Ro utines | |
| 842 | Routines “ Called By” | |
| 843 | Routines “ Called” | |
| 844 | ||
| 845 | ||
| 846 | ||
| 847 | ||
| 848 | Data Dicti onary (DD) Reference s | |
| 849 | ||
| 850 | Related Pr otocols | |
| 851 | None | |
| 852 | Related In tegration Control Re gistration s (ICRs) | |
| 853 | None | |
| 854 | Data Passi ng | |
| 855 | Input | |
| 856 | Output Re ference | |
| 857 | Both | |
| 858 | Global Re ference | |
| 859 | Local | |
| 860 | Input Attr ibute Name and Defin ition | |
| 861 | Name: | |
| 862 | Definition : | |
| 863 | Output Att ribute Nam e and Defi nition | |
| 864 | Name: | |
| 865 | Definition : | |
| 866 | Current Lo gic | |
| 867 | IBCNSC01 ; ALB/NLR - INSURANCE COMPANY ED IT ;6/1/05 10:06am ; ;2.0;INTEG RATED BILL ING;**52,1 37,191,184 ,232,320,3 49,371,399 ,416,432,4 94,519,547 **;21-MAR- 94;Build 1 19 ;;Per V A Directiv e 6402, th is routine should no t be modif ied. ;PARA M ; -- Ins urance com pany param eters regi on N OFFSE T,START,IB CNS0,IBCNS 03,IBCNS06 ,IBCNS08,I BCNS13,IBC NS3,IBHPD S IBCNS0=$ G(^DIC(36, +IBCNS,0)) ,IBCNS3=$G (^(3)) S I BCNS03=$P( IBCNS0,"^" ,3),IBCNS0 6=$P(IBCNS 0,"^",6),I BCNS08=$P( IBCNS0,"^" ,8) S IBCN S13=$G(^DI C(36,+IBCN S,.13)) S START=1,OF FSET=2 D S ET^IBCNSP( START,OFFS ET+25," Bi lling Para meters ",I ORVON,IORV OFF) ; D S ET^IBCNSP( START+1,OF FSET+1,"Si gnature Re quired?: " _$S(+IBCNS 03:"YES",1 :"NO")) D SET^IBCNSP (START+2,O FFSET+10," Reimburse? : "_$E($$E XPAND^IBTR E(36,1,$P( IBCNS0,"^" ,2)),1,21) ) D SET^IB CNSP(START +3,OFFSET+ 3,"Mult. B edsections : "_$S(+IB CNS06:"YES ",IBCNS06= 0:"NO",1:" ")) D SET^ IBCNSP(STA RT+4,OFFSE T+6,"One O pt. Visit: "_$S(+IBC NS08:"YES" ,1:"NO")) D SET^IBCN SP(START+5 ,OFFSET+4, "Diff. Rev . Codes: " _$P(IBCNS0 ,"^",7)) D SET^IBCNS P(START+6, OFFSET+1," Amb. Sur. Rev. Code: "_$P(IBCN S0,"^",9)) D SET^IBC NSP(START+ 7,OFFSET+1 ,"Rx Refil l Rev. Cod e: "_$P(IB CNS0,"^",1 5)) D SET^ IBCNSP(STA RT+8,OFFSE T+3,"Filin g Time Fra me: "_$P(I BCNS0,"^", 12)_$S(+$P (IBCNS0,"^ ",18):" (" _$$FTFN^IB CNSU31(,+I BCNS)_")", 1:"")) ; S OFFSET=45 D SET^IBC NSP(START+ 1,OFFSET+4 ,"Type Of Coverage: "_$$EXPAND ^IBTRE(36, .13,+$P(IB CNS0,U,13) )) D SET^I BCNSP(STAR T+2,OFFSET +7,"Billin g Phone: " _$P(IBCNS1 3,"^",2)) D SET^IBCN SP(START+3 ,OFFSET+2, "Verificat ion Phone: "_$P(IBCN S13,"^",4) ) D SET^IB CNSP(START +4,OFFSET+ 2,"Precert Comp. Nam e: "_$P($G (^DIC(36,+ $P(IBCNS13 ,"^",9),0) ),"^",1)) D SET^IBCN SP(START+5 ,OFFSET+7, "Precert P hone: "_$$ PHONE(IBCN S13)) I +I BCNS3=2 D SET^IBCNSP (START+6,O FFSET,"Max # Test Bi lls/Day: " _$P(IBCNS3 ,U,6)) ; S START=11, OFFSET=2 D SET^IBCNS P(START,OF FSET+28," EDI Parame ters ",IOR VON,IORVOF F) D SET^I BCNSP(STAR T+1,OFFSET +13,"Trans mit?: "_$S (+IBCNS3=1 :"YES-LIVE ",+IBCNS3= 2:"TEST ON LY",1:"NO" )) D SET^I BCNSP(STAR T+2,OFFSET +1,"Inst P ayer Prima ry ID: "_$ P(IBCNS3,U ,4)) ; ;WC J;IB*2.0*5 47; Lots o Changes b elow to in clude new Alternate Primary ID N IBAC,IB ACND,LOOP S IBACMAX= 0 F IBACND =15,16 D . S LOOP=0 F S LOOP=$ O(^DIC(36, +IBCNS,IBA CND,LOOP)) Q:'+LOOP D ..S IBA C(IBACND," CT")=$G(IB AC(IBACND, "CT"))+1 I IBAC(IBAC ND,"CT")>I BACMAX S I BACMAX=IBA C(IBACND," CT") ..S I BAC(IBACND ,IBAC(IBAC ND,"CT"))= $P($G(^DIC (36,+IBCNS ,IBACND,LO OP,0)),U,1 ,2) ; S LO OP=0 F S LOOP=$O(IB AC(15,LOOP )) Q:'LOOP D .D SET ^IBCNSP(ST ART+2+(LOO P*2-1),OFF SET,"Alt-I Payer Pri m ID Type: "_$$GET1^ DIQ(355.98 ,+$P($G(IB AC(15,LOOP )),U),.01) ) .D SET^I BCNSP(STAR T+2+(LOOP* 2),OFFSET, "Alt-Inst Payer Prim ID: "_$P( $G(IBAC(15 ,LOOP)),U, 2)) ; D SE T^IBCNSP(S TART+3+(2* IBACMAX),O FFSET,"Ins t Payer Se c ID Qual: "_$$GET1^ DIQ(36,+IB CNS,6.01)) D SET^IBC NSP(START+ 4+(2*IBACM AX),OFFSET +5,"Inst P ayer Sec I D: "_$$GET 1^DIQ(36,+ IBCNS,6.02 )) D SET^I BCNSP(STAR T+5+(2*IBA CMAX),OFFS ET,"Inst P ayer Sec I D Qual: "_ $$GET1^DIQ (36,+IBCNS ,6.03)) D SET^IBCNSP (START+6+( 2*IBACMAX) ,OFFSET+5, "Inst Paye r Sec ID: "_$$GET1^D IQ(36,+IBC NS,6.04)) D SET^IBCN SP(START+7 +(2*IBACMA X),OFFSET+ 12,"Bin Nu mber: "_$P ($G(^DIC(3 6,+IBCNS,3 )),"^",3)) ; ; ;IB*2 .0*547;WCJ Added and bumped HP ID down D SET^IBCNSP (START+8+( 2*IBACMAX) ,OFFSET+10 ,"UMO (278 ) ID: "_$P ($G(^DIC(3 6,+IBCNS,7 )),U)) ;ib *2.0*519 S IBHPD=$$H PD^IBCNHUT 1(+IBCNS) D SET^IBCN SP(START+9 +(2*IBACMA X),OFFSET+ 13,$P($$HO D^IBCNHUT1 (IBHPD),U, 2)_": "_IB HPD) ; S O FFSET=41 D SET^IBCNS P(START+1, OFFSET+8," Insurance Type: "_$ $EXPAND^IB TRE(36,3.0 9,+$P(IBCN S3,U,9))) D SET^IBCN SP(START+2 ,OFFSET+1, " Prof Pay er Primary ID: "_$P( IBCNS3,U,2 )) ; S LOO P=0 F S L OOP=$O(IBA C(16,LOOP) ) Q:'LOOP D .D SET^ IBCNSP(STA RT+2+(LOOP *2-1),OFFS ET+1,"Alt- P Payer Pr im ID Type : "_$$GET1 ^DIQ(355.9 8,+$P($G(I BAC(16,LOO P)),U),.01 )) .D SET^ IBCNSP(STA RT+2+(LOOP *2),OFFSET +1,"Alt-Pr of Payer P rim ID: "_ $P($G(IBAC (16,LOOP)) ,U,2)) ; D SET^IBCNS P(START+3+ (2*IBACMAX ),OFFSET," Prof Paye r Sec ID Q ual: "_$$G ET1^DIQ(36 ,+IBCNS,6. 05)) D SET ^IBCNSP(ST ART+4+(2*I BACMAX),OF FSET+5," P rof Payer Sec ID: "_ $$GET1^DIQ (36,+IBCNS ,6.06)) D SET^IBCNSP (START+5+( 2*IBACMAX) ,OFFSET," Prof Payer Sec ID Qu al: "_$$GE T1^DIQ(36, +IBCNS,6.0 7)) D SET^ IBCNSP(STA RT+6+(2*IB ACMAX),OFF SET+5," Pr of Payer S ec ID: "_$ $GET1^DIQ( 36,+IBCNS, 6.08)) ;IB *2.0*432/T AZ Added f ields 6.09 and 6.1 D SET^IBCNS P(START+7+ (2*IBACMAX ),OFFSET-3 ," Prnt Se c/Tert Aut o Claims: "_$$GET1^D IQ(36,+IBC NS,6.09)) D SET^IBCN SP(START+8 +(2*IBACMA X),OFFSET- 5," Prnt M ed Sec Cla ims w/o MR A: "_$$GET 1^DIQ(36,+ IBCNS,6.1) ) Q ;PHONE (IBCNS13) ; -- Compu te precert company p hone N IBX ,IBSAVE,IB CNT S IBX= "" I '$P(I BCNS13,"^" ,9) S IBX= $P(IBCNS13 ,"^",3) G PHONEQREDO X S IBSAVE =+$P(IBCNS 13,"^",9) S IBCNT=$G (IBCNT)+1 ; -- if yo u process the same c o. more th an once yo u are in a n infinite loop I $D (IBCNT(IBC NS)) G PHO NEQ S IBCN T(IBCNS)=" " S IBCNS1 3=$G(^DIC( 36,+$P(IBC NS13,"^",9 ),.13)) S IBX=$P(IBC NS13,"^") S:$L($P(IB CNS13,"^", 3)) IBX=$P (IBCNS13," ^",3) ; -- if proces s the same co. more than once you are in an infini te loop I $P(IBCNS13 ,"^",9),$P (IBCNS13," ^",9)'=IBS AVE G REDO XPHONEQ Q IBX ;MAIN ; -- Insur ance compa ny main ad dress N OF FSET,START ,IBCNS11,I BCNS13,IBA DD S IBCNS 11=$G(^DIC (36,+IBCNS ,.11)) S I BCNS13=$G( ^DIC(36,+I BCNS,.13)) ; ;S STAR T=21,OFFSE T=25 S STA RT=22+(2*I BACMAX),OF FSET=25 D SET^IBCNSP (START,OFF SET," Main Mailing A ddress ",I ORVON,IORV OFF) N OFF SET S OFFS ET=2 D SET ^IBCNSP(ST ART+1,OFFS ET," Stree t: "_$P(IB CNS11,"^", 1)) S IBAD D=1 D SET^ IBCNSP(STA RT+2,OFFSE T," Street 2: "_$P(I BCNS11,"^" ,2)) S IBA DD=2 D SET ^IBCNSP(ST ART+3,OFFS ET," Stree t 3: "_$P( IBCNS11,"^ ",3)) S IB ADD=3 ; D SET^IBCNSP (START+4,O FFSET,"Cla im Off. ID : "_$P(IBC NS11,U,11) ) N OFFSET S OFFSET= 45 D SET^I BCNSP(STAR T+1,OFFSET ," City/St ate: "_$E( $P(IBCNS11 ,"^",4),1, 15)_$S($P( IBCNS11,"^ ",4)="":"" ,1:", ")_$ P($G(^DIC( 5,+$P(IBCN S11,"^",5) ,0)),"^",2 )_" "_$E($ P(IBCNS11, "^",6),1,5 )) D SET^I BCNSP(STAR T+2,OFFSET ," Phone: "_$P(IBCNS 13,"^",1)) D SET^IBC NSP(START+ 3,OFFSET," Fax: "_$P (IBCNS11," ^",9)) Q ; ;PAYER ; This proce dure build s the disp lay for th e payer as sociated w ith ; this insurance company. ; ESG - 7/ 29/02 - II V project ; - 9/9/09 - eIV upd ated ; - 2 /4/13 - re move ePhar macy refer ences (IB* 2*494) ; N EW PAYERIE N,PAYR,APP DATA,APP,D ATA,APPNAM E,A1,A2,A3 ,A4,A5,A6, A7,A8 NEW START,TITL E,OFFSET,I BLINE S PA YERIEN=$P( $G(^DIC(36 ,+IBCNS,3) ),U,10),PA YR="",APPD ATA=0 I PA YERIEN D . S PAYR=$G (^IBE(365. 12,PAYERIE N,0)) . S APP=0 . F S APP=$O( ^IBE(365.1 2,PAYERIEN ,1,APP)) Q :'APP D . . S DATA=$ G(^IBE(365 .12,PAYERI EN,1,APP,0 )) .. S AP PNAME=$$EX TERNAL^DIL FD(365.121 ,.01,"",$P (DATA,U,1) ) .. I APP NAME="" Q .. I APPNA ME="IIV" S APPNAME=" eIV" ; I B*2*416 - change ext ernal disp lay to be eIV .. I A PPNAME="E- PHARM" Q ; IB*2*49 4 - don't display eP harmacy ap plication data .. I $D(APPDATA (APPNAME)) Q .. S (A 1,A2,A3,A4 ,A5,A6,A7) ="NO",A8=" " .. I $P( DATA,U,2) S A1="YES" ; na tional act ive .. I $ P(DATA,U,3 ) S A2="YE S" ; local acti ve .. I $P (DATA,U,7) S A3="YES " ; a uto-accept .. I $P(D ATA,U,8) S A4="YES" ; ide nt inquiri es require subscr ID (*416 fie ld not use d) .. I $P (DATA,U,9) S A5="YES " ; u se SSN for subscribe r ID (*416 field not used) .. I $P(DATA, U,10) S A6 ="YES" ; transmi t SSN (*41 6 field no t used) .. I $P(DATA ,U,11) S A 7="YES" ; deacti vated? .. ; A8 = dea ctivation date .. I $P(DATA,U, 12) S A8=$ P($$FMTE^X LFDT($P(DA TA,U,12)," 5Z"),"@",1 ) .. S APP DATA(APPNA ME)=A1_U_A 2_U_A3_U_A 4_U_A5_U_A 6_U_A7_U_A 8 .. S APP DATA=APPDA TA+1 .. Q . Q ; S ST ART=$O(^TM P("IBCNSC" ,$J,""),-1 )+1 S IB1S T("PAYER") =START S T ITLE=" Pay er Informa tion: e-IV " ; e sg - IB*2* 494 - remo ve ePharma cy referen ce S OFFSE T=(40-($L( TITLE)/2)) \1+1 D SET ^IBCNSP(ST ART,OFFSET ,TITLE,IOR VON,IORVOF F) D SET^I BCNSP(STAR T+1,9,"Pay er Name: " _$P(PAYR,U ,1)) D SET ^IBCNSP(ST ART+2,5,"V A National ID: "_$P( PAYR,U,2)) D SET^IBC NSP(START+ 2,51,"CMS National I D: "_$P(PA YR,U,3)) S IBLINE=ST ART+2 ; ; Handle the case wher e no appli cation dat a is defin ed I 'APPD ATA D G P AYERX . S IBLINE=IBL INE+1 . D SET^IBCNSP (IBLINE,2, " ") ; bla nk line . S IBLINE=I BLINE+1 . D SET^IBCN SP(IBLINE, 16,"Payer Applicatio n data is not define d!") . Q ; ; Display all the a pplication s S APPNAM E="" F S APPNAME=$O (APPDATA(A PPNAME)) Q :APPNAME=" " D . S I BLINE=IBLI NE+1 . D S ET^IBCNSP( IBLINE,2," ") ; blan k line . ; . S IBLIN E=IBLINE+1 . D SET^I BCNSP(IBLI NE,2,"Paye r Applicat ion: "_APP NAME) . D SET^IBCNSP (IBLINE,51 ,"FSC Auto -Update: " _$P(APPDAT A(APPNAME) ,U,3)) . ; . S IBLIN E=IBLINE+1 . D SET^I BCNSP(IBLI NE,4,"Nati onal Activ e: "_$P(AP PDATA(APPN AME),U,1)) . D SET^I BCNSP(IBLI NE,55,"Dea ctivated: "_$P(APPDA TA(APPNAME ),U,7)) . ; . S IBLI NE=IBLINE+ 1 . D SET^ IBCNSP(IBL INE,7,"Loc al Active: "_$P(APPD ATA(APPNAM E),U,2)) . ; . ; If no deactiv ated date, then exit . I $P(AP PDATA(APPN AME),U,8)= "" Q . ; . D SET^IBC NSP(IBLINE ,50,"Date Deactivate d: "_$P(AP PDATA(APPN AME),U,8)) . ; . QPA YERX ; ; T wo trailin g blank li nes after payer info rmation di splay S IB LINE=IBLIN E+1 D SET^ IBCNSP(IBL INE,2," ") ; blank l ine S IBLI NE=IBLINE+ 1 D SET^IB CNSP(IBLIN E,2," ") ; blank lin e Q ; ;REM ARKS ; ; N OFFSET,ST ART,IBLCNT ,IBI S STA RT=$O(^TMP ("IBCNSC", $J,""),-1) +1,OFFSET= 2 S IB1ST( "REM")=STA RT ; D SET ^IBCNSP(ST ART,OFFSET ," Remarks ",IORVON, IORVOFF) S (IBLCNT,I BI)=0 F S IBI=$O(^D IC(36,+IBC NS,11,IBI) ) Q:IBI<1 D . S IBLC NT=IBLCNT+ 1 . D SET^ IBCNSP(STA RT+IBLCNT, OFFSET," " _$E($G(^DI C(36,+IBCN S,11,IBI,0 )),1,80)) . Q D SET^ IBCNSP(STA RT+IBLCNT+ 1,OFFSET," ") ; blan k line aft er remarks Q ;SYN ; N OFFSET,S TART,SYN,S YNOI S STA RT=$O(^TMP ("IBCNSC", $J,""),-1) +1,OFFSET= 2 S IB1ST( "SYN")=STA RT D SET^I BCNSP(STAR T,OFFSET," Synonyms ",IORVON,I ORVOFF) S SYN="" F S YNOI=1:1:8 S SYN=$O( ^DIC(36,+I BCNS,10,"B ",SYN)) Q: SYN="" D SET^IBCNSP (START+SYN OI,OFFSET, $S(SYNOI>7 :" ...edit to see mo re...",1:" "_SYN)) Q ; | |
| 868 | Modified L ogic (Chan ges are in bold) | |
| 869 | IBCNSC01 ; ALB/NLR - INSURANCE COMPANY ED IT ;6/1/05 10:06am ; ;2.0;INTEG RATED BILL ING;**52,1 37,191,184 ,232,320,3 49,371,399 ,416,432,4 94,519,547 ,592**;21- MAR-94;Bui ld 119 ;;P er VA Dire ctive 6402 , this rou tine shoul d not be m odified. ; PARAM ; -- Insurance company p arameters region N O FFSET,STAR T,IBCNS0,I BCNS03,IBC NS06,IBCNS 08,IBCNS13 ,IBCNS3,IB HPD S IBCN S0=$G(^DIC (36,+IBCNS ,0)),IBCNS 3=$G(^(3)) S IBCNS03 =$P(IBCNS0 ,"^",3),IB CNS06=$P(I BCNS0,"^", 6),IBCNS08 =$P(IBCNS0 ,"^",8) S IBCNS13=$G (^DIC(36,+ IBCNS,.13) ) S START= 1,OFFSET=2 D SET^IBC NSP(START, OFFSET+25, " Billing Parameters ",IORVON, IORVOFF) ; D SET^IBC NSP(START+ 1,OFFSET+1 ,"Signatur e Required ?: "_$S(+I BCNS03:"YE S",1:"NO") ) D SET^IB CNSP(START +2,OFFSET+ 10,"Reimbu rse?: "_$E ($$EXPAND^ IBTRE(36,1 ,$P(IBCNS0 ,"^",2)),1 ,21)) D SE T^IBCNSP(S TART+3,OFF SET+3,"Mul t. Bedsect ions: "_$S (+IBCNS06: "YES",IBCN S06=0:"NO" ,1:"")) D SET^IBCNSP (START+4,O FFSET+6,"O ne Opt. Vi sit: "_$S( +IBCNS08:" YES",1:"NO ")) D SET^ IBCNSP(STA RT+5,OFFSE T+4,"Diff. Rev. Code s: "_$P(IB CNS0,"^",7 )) D SET^I BCNSP(STAR T+6,OFFSET +1,"Amb. S ur. Rev. C ode: "_$P( IBCNS0,"^" ,9)) D SET ^IBCNSP(ST ART+7,OFFS ET+1,"Rx R efill Rev. Code: "_$ P(IBCNS0," ^",15)) D SET^IBCNSP (START+8,O FFSET+3,"F iling Time Frame: "_ $P(IBCNS0, "^",12)_$S (+$P(IBCNS 0,"^",18): " ("_$$FTF N^IBCNSU31 (,+IBCNS)_ ")",1:"")) ; S OFFSE T=45 D SET ^IBCNSP(ST ART+1,OFFS ET+4,"Type Of Covera ge: "_$$EX PAND^IBTRE (36,.13,+$ P(IBCNS0,U ,13))) D S ET^IBCNSP( START+2,OF FSET+7,"Bi lling Phon e: "_$P(IB CNS13,"^", 2)) D SET^ IBCNSP(STA RT+3,OFFSE T+2,"Verif ication Ph one: "_$P( IBCNS13,"^ ",4)) D SE T^IBCNSP(S TART+4,OFF SET+2,"Pre cert Comp. Name: "_$ P($G(^DIC( 36,+$P(IBC NS13,"^",9 ),0)),"^", 1)) D SET^ IBCNSP(STA RT+5,OFFSE T+7,"Prece rt Phone: "_$$PHONE( IBCNS13)) I +IBCNS3= 2 D SET^IB CNSP(START +6,OFFSET, "Max # Tes t Bills/Da y: "_$P(IB CNS3,U,6)) ; S START =11,OFFSET =2 D SET^I BCNSP(STAR T,OFFSET+2 8," EDI Pa rameters " ,IORVON,IO RVOFF) D S ET^IBCNSP( START+1,OF FSET+13,"T ransmit?: "_$S(+IBCN S3=1:"YES- LIVE",+IBC NS3=2:"TES T ONLY",1: "NO")) D S ET^IBCNSP( START+2,OF FSET+1,"In st Payer P rimary ID: "_$P(IBCN S3,U,4)) ; JWS;IB*2.0 *592;Denta l Payer ID D SET^IBC NSP(START+ 4,OFFSET+7 ,"Dental P ayer ID: " _$P(IBCNS3 ,U,15)) ; ;WCJ;IB*2. 0*547; Lot s o Change s below to include n ew Alterna te Primary ID N IBAC ,IBACND,LO OP S IBACM AX=0 F IBA CND=15,16 D .S LOOP= 0 F S LOO P=$O(^DIC( 36,+IBCNS, IBACND,LOO P)) Q:'+LO OP D ..S IBAC(IBACN D,"CT")=$G (IBAC(IBAC ND,"CT"))+ 1 I IBAC(I BACND,"CT" )>IBACMAX S IBACMAX= IBAC(IBACN D,"CT") .. S IBAC(IBA CND,IBAC(I BACND,"CT" ))=$P($G(^ DIC(36,+IB CNS,IBACND ,LOOP,0)), U,1,2) ; S LOOP=0 F S LOOP=$O (IBAC(15,L OOP)) Q:'L OOP D .D SET^IBCNSP (START+2+( LOOP*2-1), OFFSET,"Al t-I Payer Prim ID Ty pe: "_$$GE T1^DIQ(355 .98,+$P($G (IBAC(15,L OOP)),U),. 01)) .D SE T^IBCNSP(S TART+2+(LO OP*2),OFFS ET,"Alt-In st Payer P rim ID: "_ $P($G(IBAC (15,LOOP)) ,U,2)) ; D SET^IBCNS P(START+3+ (2*IBACMAX ),OFFSET," Inst Payer Sec ID Qu al: "_$$GE T1^DIQ(36, +IBCNS,6.0 1)) D SET^ IBCNSP(STA RT+4+(2*IB ACMAX),OFF SET+5,"Ins t Payer Se c ID: "_$$ GET1^DIQ(3 6,+IBCNS,6 .02)) D SE T^IBCNSP(S TART+5+(2* IBACMAX),O FFSET,"Ins t Payer Se c ID Qual: "_$$GET1^ DIQ(36,+IB CNS,6.03)) D SET^IBC NSP(START+ 6+(2*IBACM AX),OFFSET +5,"Inst P ayer Sec I D: "_$$GET 1^DIQ(36,+ IBCNS,6.04 )) D SET^I BCNSP(STAR T+7+(2*IBA CMAX),OFFS ET+12,"Bin Number: " _$P($G(^DI C(36,+IBCN S,3)),"^", 3)) ; ; ;I B*2.0*547; WCJ Added and bumped HPID down D SET^IBC NSP(START+ 8+(2*IBACM AX),OFFSET +10,"UMO ( 278) ID: " _$P($G(^DI C(36,+IBCN S,7)),U)) ;ib*2.0*51 9 S IBHPD= $$HPD^IBCN HUT1(+IBCN S) D SET^I BCNSP(STAR T+9+(2*IBA CMAX),OFFS ET+13,$P($ $HOD^IBCNH UT1(IBHPD) ,U,2)_": " _IBHPD) ; S OFFSET=4 1 D SET^IB CNSP(START +1,OFFSET+ 8," Insura nce Type: "_$$EXPAND ^IBTRE(36, 3.09,+$P(I BCNS3,U,9) )) D SET^I BCNSP(STAR T+2,OFFSET +1," Prof Payer Prim ary ID: "_ $P(IBCNS3, U,2)) ; S LOOP=0 F S LOOP=$O( IBAC(16,LO OP)) Q:'LO OP D .D S ET^IBCNSP( START+2+(L OOP*2-1),O FFSET+1,"A lt-P Payer Prim ID T ype: "_$$G ET1^DIQ(35 5.98,+$P($ G(IBAC(16, LOOP)),U), .01)) .D S ET^IBCNSP( START+2+(L OOP*2),OFF SET+1,"Alt -Prof Paye r Prim ID: "_$P($G(I BAC(16,LOO P)),U,2)) ; D SET^IB CNSP(START +3+(2*IBAC MAX),OFFSE T," Prof P ayer Sec I D Qual: "_ $$GET1^DIQ (36,+IBCNS ,6.05)) D SET^IBCNSP (START+4+( 2*IBACMAX) ,OFFSET+5, " Prof Pay er Sec ID: "_$$GET1^ DIQ(36,+IB CNS,6.06)) D SET^IBC NSP(START+ 5+(2*IBACM AX),OFFSET ," Prof Pa yer Sec ID Qual: "_$ $GET1^DIQ( 36,+IBCNS, 6.07)) D S ET^IBCNSP( START+6+(2 *IBACMAX), OFFSET+5," Prof Paye r Sec ID: "_$$GET1^D IQ(36,+IBC NS,6.08)) ;IB*2.0*43 2/TAZ Adde d fields 6 .09 and 6. 1 D SET^IB CNSP(START +7+(2*IBAC MAX),OFFSE T-3," Prnt Sec/Tert Auto Claim s: "_$$GET 1^DIQ(36,+ IBCNS,6.09 )) D SET^I BCNSP(STAR T+8+(2*IBA CMAX),OFFS ET-5," Prn t Med Sec Claims w/o MRA: "_$$ GET1^DIQ(3 6,+IBCNS,6 .1)) Q ;PH ONE(IBCNS1 3) ; -- Co mpute prec ert compan y phone N IBX,IBSAVE ,IBCNT S I BX="" I '$ P(IBCNS13, "^",9) S I BX=$P(IBCN S13,"^",3) G PHONEQR EDOX S IBS AVE=+$P(IB CNS13,"^", 9) S IBCNT =$G(IBCNT) +1 ; -- if you proce ss the sam e co. more than once you are i n an infin ite loop I $D(IBCNT( IBCNS)) G PHONEQ S I BCNT(IBCNS )="" S IBC NS13=$G(^D IC(36,+$P( IBCNS13,"^ ",9),.13)) S IBX=$P( IBCNS13,"^ ") S:$L($P (IBCNS13," ^",3)) IBX =$P(IBCNS1 3,"^",3) ; -- if pro cess the s ame co. mo re than on ce you are in an inf inite loop I $P(IBCN S13,"^",9) ,$P(IBCNS1 3,"^",9)'= IBSAVE G R EDOXPHONEQ Q IBX ;MA IN ; -- In surance co mpany main address N OFFSET,ST ART,IBCNS1 1,IBCNS13, IBADD S IB CNS11=$G(^ DIC(36,+IB CNS,.11)) S IBCNS13= $G(^DIC(36 ,+IBCNS,.1 3)) ; ;S S TART=21,OF FSET=25 S START=22+( 2*IBACMAX) ,OFFSET=25 D SET^IBC NSP(START, OFFSET," M ain Mailin g Address ",IORVON,I ORVOFF) N OFFSET S O FFSET=2 D SET^IBCNSP (START+1,O FFSET," St reet: "_$P (IBCNS11," ^",1)) S I BADD=1 D S ET^IBCNSP( START+2,OF FSET," Str eet 2: "_$ P(IBCNS11, "^",2)) S IBADD=2 D SET^IBCNSP (START+3,O FFSET," St reet 3: "_ $P(IBCNS11 ,"^",3)) S IBADD=3 ; D SET^IBC NSP(START+ 4,OFFSET," Claim Off. ID: "_$P( IBCNS11,U, 11)) N OFF SET S OFFS ET=45 D SE T^IBCNSP(S TART+1,OFF SET," City /State: "_ $E($P(IBCN S11,"^",4) ,1,15)_$S( $P(IBCNS11 ,"^",4)="" :"",1:", " )_$P($G(^D IC(5,+$P(I BCNS11,"^" ,5),0)),"^ ",2)_" "_$ E($P(IBCNS 11,"^",6), 1,5)) D SE T^IBCNSP(S TART+2,OFF SET," Phon e: "_$P(IB CNS13,"^", 1)) D SET^ IBCNSP(STA RT+3,OFFSE T," Fax: " _$P(IBCNS1 1,"^",9)) Q ; ;PAYER ; This pr ocedure bu ilds the d isplay for the payer associate d with ; t his insura nce compan y. ; ESG - 7/29/02 - IIV proje ct ; - 9/9 /09 - eIV updated ; - 2/4/13 - remove eP harmacy re ferences ( IB*2*494) ; NEW PAYE RIEN,PAYR, APPDATA,AP P,DATA,APP NAME,A1,A2 ,A3,A4,A5, A6,A7,A8 N EW START,T ITLE,OFFSE T,IBLINE S PAYERIEN= $P($G(^DIC (36,+IBCNS ,3)),U,10) ,PAYR="",A PPDATA=0 I PAYERIEN D . S PAYR =$G(^IBE(3 65.12,PAYE RIEN,0)) . S APP=0 . F S APP= $O(^IBE(36 5.12,PAYER IEN,1,APP) ) Q:'APP D .. S DAT A=$G(^IBE( 365.12,PAY ERIEN,1,AP P,0)) .. S APPNAME=$ $EXTERNAL^ DILFD(365. 121,.01,"" ,$P(DATA,U ,1)) .. I APPNAME="" Q .. I AP PNAME="IIV " S APPNAM E="eIV" ; IB*2*416 - change external d isplay to be eIV .. I APPNAME= "E-PHARM" Q ; IB*2 *494 - don 't display ePharmacy applicati on data .. I $D(APPD ATA(APPNAM E)) Q .. S (A1,A2,A3 ,A4,A5,A6, A7)="NO",A 8="" .. I $P(DATA,U, 2) S A1="Y ES" ; national active .. I $P(DATA, U,3) S A2= "YES" ; local a ctive .. I $P(DATA,U ,7) S A3=" YES" ; auto-acc ept .. I $ P(DATA,U,8 ) S A4="YE S" ; ident inqu iries requ ire subscr ID (*416 field not used) .. I $P(DATA,U ,9) S A5=" YES" ; use SSN for subscr iber ID (* 416 field not used) .. I $P(DA TA,U,10) S A6="YES" ; tran smit SSN ( *416 field not used) .. I $P(D ATA,U,11) S A7="YES" ; dea ctivated? .. ; A8 = deactivati on date .. I $P(DATA ,U,12) S A 8=$P($$FMT E^XLFDT($P (DATA,U,12 ),"5Z"),"@ ",1) .. S APPDATA(AP PNAME)=A1_ U_A2_U_A3_ U_A4_U_A5_ U_A6_U_A7_ U_A8 .. S APPDATA=AP PDATA+1 .. Q . Q ; S START=$O( ^TMP("IBCN SC",$J,"") ,-1)+1 S I B1ST("PAYE R")=START S TITLE=" Payer Info rmation: e -IV " ; esg - IB *2*494 - r emove ePha rmacy refe rence S OF FSET=(40-( $L(TITLE)/ 2))\1+1 D SET^IBCNSP (START,OFF SET,TITLE, IORVON,IOR VOFF) D SE T^IBCNSP(S TART+1,9," Payer Name : "_$P(PAY R,U,1)) D SET^IBCNSP (START+2,5 ,"VA Natio nal ID: "_ $P(PAYR,U, 2)) D SET^ IBCNSP(STA RT+2,51,"C MS Nationa l ID: "_$P (PAYR,U,3) ) S IBLINE =START+2 ; ; Handle the case w here no ap plication data is de fined I 'A PPDATA D G PAYERX . S IBLINE= IBLINE+1 . D SET^IBC NSP(IBLINE ,2," ") ; blank line . S IBLIN E=IBLINE+1 . D SET^I BCNSP(IBLI NE,16,"Pay er Applica tion data is not def ined!") . Q ; ; Disp lay all th e applicat ions S APP NAME="" F S APPNAME =$O(APPDAT A(APPNAME) ) Q:APPNAM E="" D . S IBLINE=I BLINE+1 . D SET^IBCN SP(IBLINE, 2," ") ; b lank line . ; . S IB LINE=IBLIN E+1 . D SE T^IBCNSP(I BLINE,2,"P ayer Appli cation: "_ APPNAME) . D SET^IBC NSP(IBLINE ,51,"FSC A uto-Update : "_$P(APP DATA(APPNA ME),U,3)) . ; . S IB LINE=IBLIN E+1 . D SE T^IBCNSP(I BLINE,4,"N ational Ac tive: "_$P (APPDATA(A PPNAME),U, 1)) . D SE T^IBCNSP(I BLINE,55," Deactivate d: "_$P(AP PDATA(APPN AME),U,7)) . ; . S I BLINE=IBLI NE+1 . D S ET^IBCNSP( IBLINE,7," Local Acti ve: "_$P(A PPDATA(APP NAME),U,2) ) . ; . ; If no deac tivated da te, then e xit . I $P (APPDATA(A PPNAME),U, 8)="" Q . ; . D SET^ IBCNSP(IBL INE,50,"Da te Deactiv ated: "_$P (APPDATA(A PPNAME),U, 8)) . ; . QPAYERX ; ; Two trai ling blank lines aft er payer i nformation display S IBLINE=IB LINE+1 D S ET^IBCNSP( IBLINE,2," ") ; blan k line S I BLINE=IBLI NE+1 D SET ^IBCNSP(IB LINE,2," " ) ; blank line Q ; ; REMARKS ; ; N OFFSET ,START,IBL CNT,IBI S START=$O(^ TMP("IBCNS C",$J,""), -1)+1,OFFS ET=2 S IB1 ST("REM")= START ; D SET^IBCNSP (START,OFF SET," Rema rks ",IORV ON,IORVOFF ) S (IBLCN T,IBI)=0 F S IBI=$O (^DIC(36,+ IBCNS,11,I BI)) Q:IBI <1 D . S I BLCNT=IBLC NT+1 . D S ET^IBCNSP( START+IBLC NT,OFFSET, " "_$E($G( ^DIC(36,+I BCNS,11,IB I,0)),1,80 )) . Q D S ET^IBCNSP( START+IBLC NT+1,OFFSE T," ") ; b lank line after rema rks Q ;SYN ; N OFFSE T,START,SY N,SYNOI S START=$O(^ TMP("IBCNS C",$J,""), -1)+1,OFFS ET=2 S IB1 ST("SYN")= START D SE T^IBCNSP(S TART,OFFSE T," Synony ms ",IORVO N,IORVOFF) S SYN="" F SYNOI=1: 1:8 S SYN= $O(^DIC(36 ,+IBCNS,10 ,"B",SYN)) Q:SYN="" D SET^IBC NSP(START+ SYNOI,OFFS ET,$S(SYNO I>7:" ...e dit to see more...", 1:" "_SYN) ) Q ; | |
| 870 | ||
| 871 | Routines | |
| 872 | Activities | |
| 873 | Routine Na me | |
| 874 | IBCNADD | |
| 875 | Enhancemen t Category | |
| 876 | New | |
| 877 | Modify | |
| 878 | Delete | |
| 879 | No Change | |
| 880 | RTM | |
| 881 | ||
| 882 | Related Op tions | |
| 883 | None | |
| 884 | Related Ro utines | |
| 885 | Routines “ Called By” | |
| 886 | Routines “ Called” | |
| 887 | ||
| 888 | ||
| 889 | ||
| 890 | ||
| 891 | Data Dicti onary (DD) Reference s | |
| 892 | ||
| 893 | Related Pr otocols | |
| 894 | None | |
| 895 | Related In tegration Control Re gistration s (ICRs) | |
| 896 | None | |
| 897 | Data Passi ng | |
| 898 | Input | |
| 899 | Output Re ference | |
| 900 | Both | |
| 901 | Global Re ference | |
| 902 | Local | |
| 903 | Input Attr ibute Name and Defin ition | |
| 904 | Name: | |
| 905 | Definition : | |
| 906 | Output Att ribute Nam e and Defi nition | |
| 907 | Name: | |
| 908 | Definition : | |
| 909 | Current Lo gic | |
| 910 | IBCNADD ;A LB/AAS - A DDRESS RET RIEVAL ENG INE FOR FI LE 399 ; 2 9-AUG-93 ; ;2.0;INTEG RATED BILL ING;**52,8 0,377**;21 -MAR-94;Bu ild 23 ;;P er VHA Dir ective 200 4-038, thi s routine should not be modifi ed. ;ADD(D A,IBCOB) ; -- Retrie ve correct billing a ddress for a bill, m ailing add ress of Bi ll Payer ; assumes t hat new po licy field points to valid ins . policy ; DA = ien to file 39 9 ; IBCOB = payer se quence PST or 123 (o ptional) ; N X,Y,I,J ,IB01,IB02 ,IBTYP,DFN ,IBCNS,IBC DFN,IBCNT, IBAGAIN,IB FND,IBBILL TY,IBCHRGT Y S IB02=" " S DFN=$P ($G(^DGCR( 399,DA,0)) ,"^",2) S IBBILLTY=$ P($G(^DGCR (399,DA,0) ),"^",5),I BCHRGTY=$P ($$CHGTYPE ^IBCU(DA), "^;",1) ; S IBCNS=+$ P($G(^DGCR (399,DA,"M P")),U,1) S IBCDFN=$ P($G(^DGCR (399,DA,"M P")),U,2) ; ; If a s pecific pa yer sequen ce was pas sed in, ge t the ins. company a nd the pol icy ptr ; No address returned for Medica re I $G(IB COB)'="" D I $$MCRW NR^IBEFUNC (IBCNS) G MAINQ . S IBCOB=$TR( IBCOB,"PST ","123") . S IBCNS=+ $P($G(^DGC R(399,DA," I"_IBCOB)) ,U,1) . S IBCDFN=+$P ($G(^DGCR( 399,DA,"M" )),U,IBCOB +11) . Q ; I 'IBCNS G MAINQ I IBCDFN S I BCNS=+$G(^ DPT(+DFN,. 312,+IBCDF N,0)) I '$ D(^DIC(36, +IBCNS,0)) G MAINQ ; ; -- if s end bill t o employer and state is filled in use th is I +$G(^ DPT(DFN,.3 12,+IBCDFN ,2)),+$P(^ (2),"^",6) S IB02=$P (^(2),"^", 2,99) G MA INQ ;MAIN ; -- deter mine addre ss for com pany for t ype bill ; ; -- get main addre ss S IB02= $S($D(^DIC (36,+IBCNS ,.11)):^(. 11),1:"") S IBCNT=$G (IBCNT)+1 ; ; -- if process th e same co. more than once you are in an infinite l oop I $D(I BCNT(IBCNS )) G MAINQ ;already processed this compa ny use mai n add S IB CNT(IBCNS) ="" ; ; -- type of c harges: Rx charges - if ins co mpany has an rx addr ess use it , otherwis e use opt address I IBCHRGTY=3 S IBTYP=" R" D @IBTY P G:$D(IBF ND) MAINQ I $D(IBAGA IN) K IBAG AIN G MAIN ; ; -- ty pe of bill : inpatien t<3, outpa tient>2 S IBTYP=$S(I BBILLTY<3: "I",1:"O") D @IBTYP I $D(IBAGA IN) K IBAG AIN G MAIN ; ; -- re turn addre ssMAINQ Q IB02 ;I ; -- see if there is a n inpatien t address ; -- use i f state is there I $ P($G(^DIC( 36,+IBCNS, .12)),"^", 5) S IB02= $P($G(^(.1 2)),"^",1, 6) ; ; -- if other c ompany pro cesses cla ims start again I $P ($G(^DIC(3 6,+IBCNS,. 12)),"^",7 ) S IBCNS= $P($G(^DIC (36,+IBCNS ,.12)),"^" ,7) S IBAG AIN=1 Q ;O ; -- see if there i s an outpa tient addr ess ; -- u se if stat e is there I $P($G(^ DIC(36,+IB CNS,.16)), "^",5) S I B02=$P($G( ^(.16)),"^ ",1,6) ; ; -- if oth er company processes claims st art again I $P($G(^D IC(36,+IBC NS,.16))," ^",7) S IB CNS=$P($G( ^DIC(36,+I BCNS,.16)) ,"^",7) S IBAGAIN=1 Q ;R ; -- see if the re is an R x address ; -- use i f state is there I $ P($G(^DIC( 36,+IBCNS, .18)),"^", 5) S IB02= $P($G(^(.1 8)),"^",1, 6) S IBFND =1 ; ; -- if other c ompany pro cesses cla ims start again I $P ($G(^DIC(3 6,+IBCNS,. 18)),"^",7 ) S IBCNS= $P($G(^DIC (36,+IBCNS ,.18)),"^" ,7) S IBAG AIN=1 K IB FND Q | |
| 911 | Modified L ogic (Chan ges are in bold) | |
| 912 | IBCNADD ;A LB/AAS - A DDRESS RET RIEVAL ENG INE FOR FI LE 399 ; 2 9-AUG-93 ; ;2.0;INTEG RATED BILL ING;**52,8 0,377,592* *;21-MAR-9 4;Build 23 ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. ;A DD(DA,IBCO B) ; -- Re trieve cor rect billi ng address for a bil l, mailing address o f Bill Pay er ; assum es that ne w policy f ield point s to valid ins. poli cy ; DA = ien to fil e 399 ; IB COB = paye r sequence PST or 12 3 (optiona l) ; N X,Y ,I,J,IB01, IB02,IBTYP ,DFN,IBCNS ,IBCDFN,IB CNT,IBAGAI N,IBFND,IB BILLTY,IBC HRGTY S IB 02="" S DF N=$P($G(^D GCR(399,DA ,0)),"^",2 ) S IBBILL TY=$P($G(^ DGCR(399,D A,0)),"^", 5),IBCHRGT Y=$P($$CHG TYPE^IBCU( DA),"^;",1 ) ; S IBCN S=+$P($G(^ DGCR(399,D A,"MP")),U ,1) S IBCD FN=$P($G(^ DGCR(399,D A,"MP")),U ,2) ; ; If a specifi c payer se quence was passed in , get the ins. compa ny and the policy pt r ; No add ress retur ned for Me dicare I $ G(IBCOB)'= "" D I $$ MCRWNR^IBE FUNC(IBCNS ) G MAINQ . S IBCOB= $TR(IBCOB, "PST","123 ") . S IBC NS=+$P($G( ^DGCR(399, DA,"I"_IBC OB)),U,1) . S IBCDFN =+$P($G(^D GCR(399,DA ,"M")),U,I BCOB+11) . Q ; I 'IB CNS G MAIN Q I IBCDFN S IBCNS=+ $G(^DPT(+D FN,.312,+I BCDFN,0)) I '$D(^DIC (36,+IBCNS ,0)) G MAI NQ ; ; -- if send bi ll to empl oyer and s tate is fi lled in us e this I + $G(^DPT(DF N,.312,+IB CDFN,2)),+ $P(^(2),"^ ",6) S IB0 2=$P(^(2), "^",2,99) G MAINQ ;M AIN ; -- d etermine a ddress for company f or type bi ll ; ; -- get main a ddress S I B02=$S($D( ^DIC(36,+I BCNS,.11)) :^(.11),1: "") S IBCN T=$G(IBCNT )+1 ; ; -- if proces s the same co. more than once you are in an infini te loop I $D(IBCNT(I BCNS)) G M AINQ ;alre ady proces sed this c ompany use main add S IBCNT(IB CNS)="" ; ; -- type of charges : Rx charg es - if in s company has an rx address us e it, othe rwise use opt addres s I IBCHRG TY=3 S IBT YP="R" D @ IBTYP G:$D (IBFND) MA INQ I $D(I BAGAIN) K IBAGAIN G MAIN ; ; - - type of bill: inpa tient<3, o utpatient> 2 S IBTYP= $S(IBBILLT Y<3:"I",1: "O") D @IB TYP I $D(I BAGAIN) K IBAGAIN G MAIN ; ; - - return a ddressMAIN Q Q IB02 ; I ; -- see if there is an inpa tient addr ess ; -- u se if stat e is there I $P($G(^ DIC(36,+IB CNS,.12)), "^",5) S I B02=$P($G( ^(.12)),"^ ",1,6) ; ; -- if oth er company processes claims st art again I $P($G(^D IC(36,+IBC NS,.12))," ^",7) S IB CNS=$P($G( ^DIC(36,+I BCNS,.12)) ,"^",7) S IBAGAIN=1 Q ;O ; -- see if the re is an o utpatient address ; -- use if state is t here ;JWS; IB*2.0*592 ;Dental In surance ma iling addr ess I $$FT ^IBCEF(DA) =7 D Q . I $P($G(^D IC(36,+IBC NS,.19))," ^",5) S IB 02=$P(^(.1 9),"^",1,6 ) . I $P($ G(^DIC(36, +IBCNS,.19 )),"^",7) S IBCNS=$P (^(.19),"^ ",7) S IBA GAIN=1 ; I $P($G(^DI C(36,+IBCN S,.16)),"^ ",5) S IB0 2=$P($G(^( .16)),"^", 1,6) ; ; - - if other company p rocesses c laims star t again I $P($G(^DIC (36,+IBCNS ,.16)),"^" ,7) S IBCN S=$P($G(^D IC(36,+IBC NS,.16))," ^",7) S IB AGAIN=1 Q ;R ; -- se e if there is an Rx address ; -- use if state is t here I $P( $G(^DIC(36 ,+IBCNS,.1 8)),"^",5) S IB02=$P ($G(^(.18) ),"^",1,6) S IBFND=1 ; ; -- if other com pany proce sses claim s start ag ain I $P($ G(^DIC(36, +IBCNS,.18 )),"^",7) S IBCNS=$P ($G(^DIC(3 6,+IBCNS,. 18)),"^",7 ) S IBAGAI N=1 K IBFN D Q | |
| 913 | ||
| 914 | Routines | |
| 915 | Activities | |
| 916 | Routine Na me | |
| 917 | IBCNSCD1 | |
| 918 | Enhancemen t Category | |
| 919 | New | |
| 920 | Modify | |
| 921 | Delete | |
| 922 | No Change | |
| 923 | RTM | |
| 924 | ||
| 925 | Related Op tions | |
| 926 | None | |
| 927 | Related Ro utines | |
| 928 | Routines “ Called By” | |
| 929 | Routines “ Called” | |
| 930 | ||
| 931 | ||
| 932 | ||
| 933 | ||
| 934 | Data Dicti onary (DD) Reference s | |
| 935 | ||
| 936 | Related Pr otocols | |
| 937 | None | |
| 938 | Related In tegration Control Re gistration s (ICRs) | |
| 939 | None | |
| 940 | Data Passi ng | |
| 941 | Input | |
| 942 | Output Re ference | |
| 943 | Both | |
| 944 | Global Re ference | |
| 945 | Local | |
| 946 | Input Attr ibute Name and Defin ition | |
| 947 | Name: | |
| 948 | Definition : | |
| 949 | Output Att ribute Nam e and Defi nition | |
| 950 | Name: | |
| 951 | Definition : | |
| 952 | Current Lo gic | |
| 953 | IBCNSCD1 ; ALB/CPM - DELETE INS URANCE COM PANY (CON' T) ; 02-FE B-95 ;;2.0 ;INTEGRATE D BILLING; **28,46,80 **;21-MAR- 94 ;;Per V HA Directi ve 10-93-1 42, this r outine sho uld not be modified. ; DQ ; Qu eued entry point for the final clean-up job. ; K ^ TMP($J,"IB CNSCD") L +^IB("IBCN SCD"):5 E G DDQ ; a nother cle an-up job got starte d S IBC=0 F S IBC=$ O(^DIC(36, "ADEL",IBC )) Q:'IBC S ^TMP($J ,"IBCNSCD" ,IBC)=$P($ G(^DIC(36, IBC,5)),"^ ",2) I '$D (^TMP($J," IBCNSCD")) G DDQ ; n o companie s to be de leted ; D NOW^%DTC S IBBDT=% ; ; - dispo sitions S DFN=0 F S DFN=$O(^D PT(DFN)) Q :'DFN S I BC=0 F S IBC=$O(^DP T(DFN,"DIS ",IBC)) Q: 'IBC S IB CO=$P($G(^ (IBC,2))," ^",6) I IB CO,$D(^TMP ($J,"IBCNS CD",IBCO)) D .S $P(^ DPT(DFN,"D IS",IBC,2) ,"^",6)=$G (^TMP($J," IBCNSCD",I BCO)) .S I BCT("DIS") =$G(IBCT(" DIS"))+1 . I $G(^TMP( $J,"IBCNSC D",IBCO))= "" S IBCT( "DIS",DFN, IBC)="" ; ; - insura nce compan ies S IBC= 0 F S IBC =$O(^DIC(3 6,IBC)) Q: 'IBC D .S IB0=$G(^D IC(36,IBC, 0)),IB12=$ G(^(.12)), IB13=$G(^( .13)),IB14 =$G(^(.14) ),IB16=$G( ^(.16)),IB 18=$G(^(.1 8)) .K IBV .I $P(IB0 ,"^",16),$ D(^TMP($J, "IBCNSCD", $P(IB0,"^" ,16))) S I BV(0)="16^ "_^($P(IB0 ,"^",16)) .I $P(IB12 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB12,"^" ,7))) S IB V(.12)="7^ "_^($P(IB1 2,"^",7)) .I $P(IB13 ,"^",9),$D (^TMP($J," IBCNSCD",$ P(IB13,"^" ,9))) S IB V(.13)="9^ "_^($P(IB1 3,"^",9)) .I $P(IB14 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB14,"^" ,7))) S IB V(.14)="7^ "_^($P(IB1 4,"^",7)) .I $P(IB16 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB16,"^" ,7))) S IB V(.16)="7^ "_^($P(IB1 6,"^",7)) .I $P(IB18 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB18,"^" ,7))) S IB V(.18)="7^ "_^($P(IB1 8,"^",7)) .Q:'$D(IBV ) .; .; - delete or repoint .S IBX="" F S IBX=$O( IBV(IBX)) Q:IBX="" D ..S $P(^ DIC(36,IBC ,IBX),"^", +IBV(IBX)) =$P(IBV(IB X),"^",2) ..S IBCT(" INS",IBX)= $G(IBCT("I NS",IBX))+ 1 ..I $P(I BV(IBX),"^ ",2)="" S IBCT("INS" ,IBX,IBC)= "" ; ; - i nsurance r eviews S I BC=0 F S IBC=$O(^IB T(356.2,IB C)) Q:'IBC S IBCO=$ P($G(^(IBC ,0)),"^",8 ) I IBCO,$ D(^TMP($J, "IBCNSCD", IBCO)) S I BCD=$G(^IB T(356.2,IB C,0)) D .S IBVAL=$G( ^TMP($J,"I BCNSCD",IB CO)) I 'IB VAL S IBVA L="@" .S D A=IBC,DR=" .08////"_I BVAL,DIE=" ^IBT(356.2 ," D ^DIE K DA,DIE,D R .S IBCT( "IR")=$G(I BCT("IR")) +1 .I IBVA L="@" S IB CT("IR",+$ P(IBCD,"^" ,5),+IBCD) ="" ; ; - bills S IB C=0 F S I BC=$O(^DGC R(399,IBC) ) Q:'IBC S IBCNS=0 F S IBCNS =$O(^DGCR( 399,IBC,"A IC",IBCNS) ) Q:'IBCNS I $D(^TM P($J,"IBCN SCD",IBCNS )) S (IBRE P,IBVAL)=$ G(^(IBCNS) ) D FIND ; ; - call AR to hand le receiva bles S IBC TAR=0 D IN S2^RCAMINS ("^TMP($J, ""IBCNSCD" ")",.IBCTA R) ; D NOW ^%DTC S IB EDT=% ; ; - mail res ults D MAI L^IBCNSCD2 ; ; - fin ally, dele te the com panies S I BC=0 F S IBC=$O(^TM P($J,"IBCN SCD",IBC)) Q:'IBC S DA=IBC,DI K="^DIC(36 ,",DIDEL=3 6 D ^DIK ; ; - delet e task num ber from # 350.9 S $P (^IBE(350. 9,1,4),"^" ,8)="" ;DD Q K IBC,IB CT,^TMP($J ,"IBCNSCD" ) L -^IB(" IBCNSCD") S ZTREQ="@ " Q ; ;FIN D ; Find t he carrier somewhere in the bi ll. ; Requ ired local variables are those described in CARR. S IB0=$G(^ DGCR(399,I BC,0)),IBM =$G(^("M") ) ; ; - lo ok for the carrier I +IBM=IBCN S D CARR(1 ,"I1") ; p rimary I $ P(IBM,"^", 2)=IBCNS D CARR(2,"I 2") ; seco ndary I $P (IBM,"^",3 )=IBCNS D CARR(3,"I3 ") ; terti ary ; ; - kill off t he x-ref K ^DGCR(399 ,IBC,"AIC" ,IBCNS) Q ;CARR(IBP, IBSUB) ; U pdate each carrier. ; Input: I BP -- carr ier [1:pri mary 2:sec ondary 3:t ertiary] ; IBSUB -- updated su bscript [" I1":prim " I2":sec "I 3":tert] ; ; The fol lowing loc al variabl es are als o required to be def ined: ; IB CNS, IB0, IBM, IBC, IBREP, IBV AL ; S IBC NS1=+IBREP S $P(^DGC R(399,IBC, "M"),"^",I BP)=IBVAL I $G(^DGCR (399,IBC,I BSUB))]"" S $P(^(IBS UB),"^",1) =IBVAL I I BVAL="" D .S IBS=0 . I $P(IB0," ^",2) S IB CNS1=+$G(^ DPT($P(IB0 ,"^",2),.3 12,+$P(IBM ,"^",IBP+1 1),0)) I I BCNS1 S IB S=1,$P(^DG CR(399,IBC ,"M"),"^", IBP)=IBCNS 1 S:$G(^(I BSUB))]"" $P(^(IBSUB ),"^",1)=I BCNS1 .I ' IBS S IBCT ("BL",IBP, IBC)="" ; I IBCNS1 S ^DGCR(399 ,IBC,"AIC" ,IBCNS1)=" " ; I IBCN S=+$G(^DGC R(399,IBC, "MP")) D . I $P(IB0," ^",2),+IBC NS K ^DGCR (399,"AE", $P(IB0,"^" ,2),IBCNS, IBC) .S $P (^DGCR(399 ,IBC,"MP") ,U,1)=IBCN S1 .I $P(I B0,"^",2), +IBCNS1 S ^DGCR(399, "AE",$P(IB 0,"^",2),+ IBCNS1,IBC )="" ; S I BCT("BL",I BP)=$G(IBC T("BL",IBP ))+1 Q ; ; BILL(IBBIL LN,IBCNS,I BREP) ; Ca llable Ent ry Point f or Account s Receivab le ; Input : IBBILLN -- Bill Nu mber for b ill to be repointed ; IBCNS -- Pointer t o the insu rance comp any in fil e #36 ; th at is bein g merged ; IBREP -- Pointer to the insur ance compa ny in file #36 ; int o which in formation is being m erged ; N IBC,IBCT,I BVAL,IBCNS 1,IB0,IBM I $G(IBBIL LN)=""!'$G (IBCNS)!($ G(IBREP)=" ") G BILLQ S IBC=$O( ^DGCR(399, "B",IBBILL N,0)) I 'I BC G BILLQ S IBVAL=$ S(IBREP:IB REP,1:"") D FINDBILL Q Q | |
| 954 | Modified L ogic (Chan ges are in bold) | |
| 955 | IBCNSCD1 ; ALB/CPM - DELETE INS URANCE COM PANY (CON' T) ; 02-FE B-95 ;;2.0 ;INTEGRATE D BILLING; **28,46,80 ,592**;21- MAR-94 ;;P er VHA Dir ective 10- 93-142, th is routine should no t be modif ied. ; DQ ; Queued e ntry point for the f inal clean -up job. ; K ^TMP($J ,"IBCNSCD" ) L +^IB(" IBCNSCD"): 5 E G DDQ ; another clean-up job got st arted S IB C=0 F S I BC=$O(^DIC (36,"ADEL" ,IBC)) Q:' IBC S ^TM P($J,"IBCN SCD",IBC)= $P($G(^DIC (36,IBC,5) ),"^",2) I '$D(^TMP( $J,"IBCNSC D")) G DDQ ; no comp anies to b e deleted ; D NOW^%D TC S IBBDT =% ; ; - d isposition s S DFN=0 F S DFN=$ O(^DPT(DFN )) Q:'DFN S IBC=0 F S IBC=$O (^DPT(DFN, "DIS",IBC) ) Q:'IBC S IBCO=$P( $G(^(IBC,2 )),"^",6) I IBCO,$D( ^TMP($J,"I BCNSCD",IB CO)) D .S $P(^DPT(DF N,"DIS",IB C,2),"^",6 )=$G(^TMP( $J,"IBCNSC D",IBCO)) .S IBCT("D IS")=$G(IB CT("DIS")) +1 .I $G(^ TMP($J,"IB CNSCD",IBC O))="" S I BCT("DIS", DFN,IBC)=" " ; ; - in surance co mpanies S IBC=0 F S IBC=$O(^D IC(36,IBC) ) Q:'IBC D .;JWS;IB *2.0*592;a dd Dental Ins addres s .S IB0=$ G(^DIC(36, IBC,0)),IB 12=$G(^(.1 2)),IB13=$ G(^(.13)), IB14=$G(^( .14)),IB16 =$G(^(.16) ),IB18=$G( ^(.18)),IB 19=$G(^(.1 9)) .K IBV .I $P(IB0 ,"^",16),$ D(^TMP($J, "IBCNSCD", $P(IB0,"^" ,16))) S I BV(0)="16^ "_^($P(IB0 ,"^",16)) .I $P(IB12 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB12,"^" ,7))) S IB V(.12)="7^ "_^($P(IB1 2,"^",7)) .I $P(IB13 ,"^",9),$D (^TMP($J," IBCNSCD",$ P(IB13,"^" ,9))) S IB V(.13)="9^ "_^($P(IB1 3,"^",9)) .I $P(IB14 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB14,"^" ,7))) S IB V(.14)="7^ "_^($P(IB1 4,"^",7)) .I $P(IB16 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB16,"^" ,7))) S IB V(.16)="7^ "_^($P(IB1 6,"^",7)) .I $P(IB18 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB18,"^" ,7))) S IB V(.18)="7^ "_^($P(IB1 8,"^",7)) .;JWS;IB*2 .0*592;add Dental In s address .I $P(IB19 ,"^",7),$D (^TMP($J," IBCNSCD",$ P(IB19,"^" ,7))) S IB V(.19)="7^ "_^($P(IB1 9,"^",7)) .Q:'$D(IBV ) .; .; - delete or repoint .S IBX="" F S IBX=$O( IBV(IBX)) Q:IBX="" D ..S $P(^ DIC(36,IBC ,IBX),"^", +IBV(IBX)) =$P(IBV(IB X),"^",2) ..S IBCT(" INS",IBX)= $G(IBCT("I NS",IBX))+ 1 ..I $P(I BV(IBX),"^ ",2)="" S IBCT("INS" ,IBX,IBC)= "" ; ; - i nsurance r eviews S I BC=0 F S IBC=$O(^IB T(356.2,IB C)) Q:'IBC S IBCO=$ P($G(^(IBC ,0)),"^",8 ) I IBCO,$ D(^TMP($J, "IBCNSCD", IBCO)) S I BCD=$G(^IB T(356.2,IB C,0)) D .S IBVAL=$G( ^TMP($J,"I BCNSCD",IB CO)) I 'IB VAL S IBVA L="@" .S D A=IBC,DR=" .08////"_I BVAL,DIE=" ^IBT(356.2 ," D ^DIE K DA,DIE,D R .S IBCT( "IR")=$G(I BCT("IR")) +1 .I IBVA L="@" S IB CT("IR",+$ P(IBCD,"^" ,5),+IBCD) ="" ; ; - bills S IB C=0 F S I BC=$O(^DGC R(399,IBC) ) Q:'IBC S IBCNS=0 F S IBCNS =$O(^DGCR( 399,IBC,"A IC",IBCNS) ) Q:'IBCNS I $D(^TM P($J,"IBCN SCD",IBCNS )) S (IBRE P,IBVAL)=$ G(^(IBCNS) ) D FIND ; ; - call AR to hand le receiva bles S IBC TAR=0 D IN S2^RCAMINS ("^TMP($J, ""IBCNSCD" ")",.IBCTA R) ; D NOW ^%DTC S IB EDT=% ; ; - mail res ults D MAI L^IBCNSCD2 ; ; - fin ally, dele te the com panies S I BC=0 F S IBC=$O(^TM P($J,"IBCN SCD",IBC)) Q:'IBC S DA=IBC,DI K="^DIC(36 ,",DIDEL=3 6 D ^DIK ; ; - delet e task num ber from # 350.9 S $P (^IBE(350. 9,1,4),"^" ,8)="" ;DD Q K IBC,IB CT,^TMP($J ,"IBCNSCD" ) L -^IB(" IBCNSCD") S ZTREQ="@ " Q ; ;FIN D ; Find t he carrier somewhere in the bi ll. ; Requ ired local variables are those described in CARR. S IB0=$G(^ DGCR(399,I BC,0)),IBM =$G(^("M") ) ; ; - lo ok for the carrier I +IBM=IBCN S D CARR(1 ,"I1") ; p rimary I $ P(IBM,"^", 2)=IBCNS D CARR(2,"I 2") ; seco ndary I $P (IBM,"^",3 )=IBCNS D CARR(3,"I3 ") ; terti ary ; ; - kill off t he x-ref K ^DGCR(399 ,IBC,"AIC" ,IBCNS) Q ;CARR(IBP, IBSUB) ; U pdate each carrier. ; Input: I BP -- carr ier [1:pri mary 2:sec ondary 3:t ertiary] ; IBSUB -- updated su bscript [" I1":prim " I2":sec "I 3":tert] ; ; The fol lowing loc al variabl es are als o required to be def ined: ; IB CNS, IB0, IBM, IBC, IBREP, IBV AL ; S IBC NS1=+IBREP S $P(^DGC R(399,IBC, "M"),"^",I BP)=IBVAL I $G(^DGCR (399,IBC,I BSUB))]"" S $P(^(IBS UB),"^",1) =IBVAL I I BVAL="" D .S IBS=0 . I $P(IB0," ^",2) S IB CNS1=+$G(^ DPT($P(IB0 ,"^",2),.3 12,+$P(IBM ,"^",IBP+1 1),0)) I I BCNS1 S IB S=1,$P(^DG CR(399,IBC ,"M"),"^", IBP)=IBCNS 1 S:$G(^(I BSUB))]"" $P(^(IBSUB ),"^",1)=I BCNS1 .I ' IBS S IBCT ("BL",IBP, IBC)="" ; I IBCNS1 S ^DGCR(399 ,IBC,"AIC" ,IBCNS1)=" " ; I IBCN S=+$G(^DGC R(399,IBC, "MP")) D . I $P(IB0," ^",2),+IBC NS K ^DGCR (399,"AE", $P(IB0,"^" ,2),IBCNS, IBC) .S $P (^DGCR(399 ,IBC,"MP") ,U,1)=IBCN S1 .I $P(I B0,"^",2), +IBCNS1 S ^DGCR(399, "AE",$P(IB 0,"^",2),+ IBCNS1,IBC )="" ; S I BCT("BL",I BP)=$G(IBC T("BL",IBP ))+1 Q ; ; BILL(IBBIL LN,IBCNS,I BREP) ; Ca llable Ent ry Point f or Account s Receivab le ; Input : IBBILLN -- Bill Nu mber for b ill to be repointed ; IBCNS -- Pointer t o the insu rance comp any in fil e #36 ; th at is bein g merged ; IBREP -- Pointer to the insur ance compa ny in file #36 ; int o which in formation is being m erged ; N IBC,IBCT,I BVAL,IBCNS 1,IB0,IBM I $G(IBBIL LN)=""!'$G (IBCNS)!($ G(IBREP)=" ") G BILLQ S IBC=$O( ^DGCR(399, "B",IBBILL N,0)) I 'I BC G BILLQ S IBVAL=$ S(IBREP:IB REP,1:"") D FINDBILL Q Q | |
| 956 | ||
| 957 | Routines | |
| 958 | Activities | |
| 959 | Routine Na me | |
| 960 | IBCNSCD2 | |
| 961 | Enhancemen t Category | |
| 962 | New | |
| 963 | Modify | |
| 964 | Delete | |
| 965 | No Change | |
| 966 | RTM | |
| 967 | ||
| 968 | Related Op tions | |
| 969 | None | |
| 970 | Related Ro utines | |
| 971 | Routines “ Called By” | |
| 972 | Routines “ Called” | |
| 973 | ||
| 974 | ||
| 975 | ||
| 976 | ||
| 977 | Data Dicti onary (DD) Reference s | |
| 978 | ||
| 979 | Related Pr otocols | |
| 980 | None | |
| 981 | Related In tegration Control Re gistration s (ICRs) | |
| 982 | None | |
| 983 | Data Passi ng | |
| 984 | Input | |
| 985 | Output Re ference | |
| 986 | Both | |
| 987 | Global Re ference | |
| 988 | Local | |
| 989 | Input Attr ibute Name and Defin ition | |
| 990 | Name: | |
| 991 | Definition : | |
| 992 | Output Att ribute Nam e and Defi nition | |
| 993 | Name: | |
| 994 | Definition : | |
| 995 | Current Lo gic | |
| 996 | IBCNSCD2 ; ALB/CPM - DELETE INS URANCE COM PANY (CON' T) ; 03-FE B-95 ;;Ver sion 2.0 ; INTEGRATE D BILLING ;**28,46** ; 21-MAR-9 4 ;;Per VH A Directiv e 10-93-14 2, this ro utine shou ld not be modified. ; MAIL ; S end result s out. S X MSUB="Insu rance Comp any Deleti on Clean-u p Completi on" S XMDU Z="INTEGRA TED BILLIN G PACKAGE" ,XMTEXT="^ TMP($J,""I BT"",",XMY (DUZ)="" ; K ^TMP($J ,"IBT") S IBC=0 D SE T("The fin al clean-u p for dele ted Insura nce Compan y(s) has c ompleted." ) D SET(" ") S Y=IBB DT D D^DIQ D SET("Jo b Start Ti me: "_Y) S Y=IBEDT D D^DIQ D S ET(" Job E nd Time: " _Y) ; D SE T(" ") D S ET("DELETE D COMPANY" _$J("",24) _"REPOINTE D TO") D S ET($TR($J( "",79)," " ,"=")) S I BX=0 F S IBX=$O(^TM P($J,"IBCN SCD",IBX)) Q:'IBX S IBX1=+$G( ^(IBX)) D .S X=$E($P ($G(^DIC(3 6,IBX,0)), "^")_" (#" _IBX_")"_$ J("",39),1 ,39) .S X= X_$S(IBX1: $P($G(^DIC (36,IBX1,0 )),"^")_" (#"_IBX1_" )",1:"not repointed" ) .D SET(X ) ; D SET( " ") D SET (" ") D SE T("1. Corr ection of the Dispos ition (sub -file #2.1 01) field" ) D SET(" 'INJURING PARTIES IN SURANCE' ( #25)") D S ET(" Numbe r of Dispo sition rec ords updat ed: "_+$G( IBCT("DIS" ))) I $O(I BCT("DIS", 0)) D .D S ET($J("",8 )_"The fol lowing dis positions had this f ield delet ed and not merged:") .S DFN=0 F S DFN=$ O(IBCT("DI S",DFN)) Q :'DFN D . .S IBNAM=$ $PT^IBEFUN C(DFN),IBH =0 ..S IBX =$J("",10) _$E($P(IBN AM,"^"),1, 25)_" ("_$ P(IBNAM,"^ ",3)_")" . .S IBDAT=" " F S IBD AT=$O(IBCT ("DIS",DFN ,IBDAT)) Q :IBDAT="" D ...S IB DAT1="Date /Time: "_$ $DAT2^IBOU TL(9999999 -IBDAT) .. .I 'IBH D SET($E(IBX _$J("",45) ,1,45)_IBD AT1) ...E D SET($J( "",45)_IBD AT1) ...S IBH=1 ; ; - insuranc e companie s S IBINS( 0)="REPOIN T PATIENTS TO^.16" S IBINS(.12 )="CLAIMS (INPT) COM PANY NAME^ .127" S IB INS(.13)=" PRECERT CO MPANY NAME ^.139" S I BINS(.14)= "APPEALS C OMPANY NAM E^.147" S IBINS(.16) ="CLAIMS ( OPT) COMPA NY NAME^.1 67" S IBIN S(.18)="CL AIMS (RX) COMPANY NA ME^.187" D SET(" ") D SET("2. Correction of other Insurance Company (f ile #36) r ecords:") S IBX="" F S IBX=$O (IBINS(IBX )) Q:IBX=" " S IBS=I BINS(IBX) D .D SET(" Number of records w ith '"_$P( IBS,"^")_" ' (#"_$P(I BS,"^",2)_ ") updated : "_+$G(IB CT("INS",I BX))) .I $ O(IBCT("IN S",IBX,0)) D ..D SET ($J("",8)_ "The follo wing compa nies had t his field deleted an d not merg ed:") ..S IBCO=0 F S IBCO=$O( IBCT("INS" ,IBX,IBCO) ) Q:'IBCO D ...D SE T($J("",10 )_$P($G(^D IC(36,IBCO ,0)),"^")_ " (ien "_I BCO_")") ; ; - insur ance revie ws D SET(" ") D SET( "3. Correc tion of th e Insuranc e Review ( file #356. 2) field") D SET(" ' INSURANCE COMPANY CO NTACTED' ( #.08)") D SET(" Numb er of Insu rance Revi ew records updated: "_+$G(IBCT ("IR"))) I $O(IBCT(" IR",0)) D .D SET($J( "",8)_"The following Insurance reviews h ad this fi eld delete d and not merged:") .S DFN=0 F S DFN=$O (IBCT("IR" ,DFN)) Q:' DFN D ..S IBNAM=$$P T^IBEFUNC( DFN),IBH=0 ..S IBX=$ J("",10)_$ E($P(IBNAM ,"^"),1,25 )_" ("_$P( IBNAM,"^", 3)_")" ..S IBDAT="" F S IBDAT =$O(IBCT(" IR",DFN,IB DAT)) Q:IB DAT="" D ...S IBDAT 1="Review Date/Time: "_$$DAT2^ IBOUTL(IBD AT) ...I ' IBH D SET( $E(IBX_$J( "",45),1,4 5)_IBDAT1) ...E D S ET($J("",4 5)_IBDAT1) ...S IBH= 1 ; ; - bi lls K IBIN S S IBINS( 1)="PRIMAR Y INSURANC E CARRIER^ 101" S IBI NS(2)="SEC ONDARY INS URANCE CAR RIER^102" S IBINS(3) ="TERTIARY INSURANCE CARRIER^1 03" D SET( " ") D SET ("4. Corre ction of B ill/Claims (file #39 9) records :") S IBX= "" F S IB X=$O(IBINS (IBX)) Q:I BX="" S I BS=IBINS(I BX) D .D S ET(" Numbe r of recor ds with '" _$P(IBS,"^ ")_"' (#"_ $P(IBS,"^" ,2)_") upd ated: "_+$ G(IBCT("BL ",IBX))) . I $O(IBCT( "BL",IBX,0 )) D ..D S ET($J("",8 )_"The fol lowing bil ls had thi s field de leted and not merged :") ..S IB CO=0 F S IBCO=$O(IB CT("BL",IB X,IBCO)) Q :'IBCO D ...S IBS=$ G(^DGCR(39 9,IBCO,0)) ...S IBNA M=$$PT^IBE FUNC(+$P(I BS,"^",2)) ...D SET( $J("",10)_ $E($E($P(I BNAM,"^"), 1,25)_" (" _$P(IBNAM, "^",3)_")" _$J("",35) ,1,35)_"Bi ll #: "_$P (IBS,"^")) ; ; - rec eivables i n AR D SET (" ") D SE T("5. Numb er of upda ted second ary and te rtiary car riers of A R receivab les: "_+$G (IBCTAR)) ; D ^XMD K ^TMP($J," IBT") Q ;S ET(X) ; Se t Message Text Array S IBC=IBC +1,^TMP($J ,"IBT",IBC )=X Q | |
| 997 | Modified L ogic (Chan ges are in bold) | |
| 998 | IBCNSCD2 ; ALB/CPM - DELETE INS URANCE COM PANY (CON' T) ; 03-FE B-95 ;;Ver sion 2.0 ; INTEGRATE D BILLING ;**28,46,5 92**; 21-M AR-94 ;;Pe r VHA Dire ctive 10-9 3-142, thi s routine should not be modifi ed. ; MAIL ; Send re sults out. S XMSUB=" Insurance Company De letion Cle an-up Comp letion" S XMDUZ="INT EGRATED BI LLING PACK AGE",XMTEX T="^TMP($J ,""IBT""," ,XMY(DUZ)= "" ; K ^TM P($J,"IBT" ) S IBC=0 D SET("The final cle an-up for deleted In surance Co mpany(s) h as complet ed.") D SE T(" ") S Y =IBBDT D D ^DIQ D SET ("Job Star t Time: "_ Y) S Y=IBE DT D D^DIQ D SET(" J ob End Tim e: "_Y) ; D SET(" ") D SET("DE LETED COMP ANY"_$J("" ,24)_"REPO INTED TO") D SET($TR ($J("",79) ," ","=")) S IBX=0 F S IBX=$O (^TMP($J," IBCNSCD",I BX)) Q:'IB X S IBX1= +$G(^(IBX) ) D .S X=$ E($P($G(^D IC(36,IBX, 0)),"^")_" (#"_IBX_" )"_$J("",3 9),1,39) . S X=X_$S(I BX1:$P($G( ^DIC(36,IB X1,0)),"^" )_" (#"_IB X1_")",1:" not repoin ted") .D S ET(X) ; D SET(" ") D SET(" ") D SET("1. Correction of the Di sposition (sub-file #2.101) fi eld") D SE T(" 'INJUR ING PARTIE S INSURANC E' (#25)") D SET(" N umber of D isposition records u pdated: "_ +$G(IBCT(" DIS"))) I $O(IBCT("D IS",0)) D .D SET($J( "",8)_"The following dispositi ons had th is field d eleted and not merge d:") .S DF N=0 F S D FN=$O(IBCT ("DIS",DFN )) Q:'DFN D ..S IBN AM=$$PT^IB EFUNC(DFN) ,IBH=0 ..S IBX=$J("" ,10)_$E($P (IBNAM,"^" ),1,25)_" ("_$P(IBNA M,"^",3)_" )" ..S IBD AT="" F S IBDAT=$O( IBCT("DIS" ,DFN,IBDAT )) Q:IBDAT ="" D ... S IBDAT1=" Date/Time: "_$$DAT2^ IBOUTL(999 9999-IBDAT ) ...I 'IB H D SET($E (IBX_$J("" ,45),1,45) _IBDAT1) . ..E D SET ($J("",45) _IBDAT1) . ..S IBH=1 ; ; - insu rance comp anies S IB INS(0)="RE POINT PATI ENTS TO^.1 6" S IBINS (.12)="CLA IMS (INPT) COMPANY N AME^.127" S IBINS(.1 3)="PRECER T COMPANY NAME^.139" S IBINS(. 14)="APPEA LS COMPANY NAME^.147 " S IBINS( .16)="CLAI MS (OPT) C OMPANY NAM E^.167" S IBINS(.18) ="CLAIMS ( RX) COMPAN Y NAME^.18 7" ;JWS;IB *2.0*592;a dd Dental Ins addres s S IBINS( .19)="CLAI MS (DENTAL ) COMPANY NAME^.197" D SET(" " ) D SET("2 . Correcti on of othe r Insuranc e Company (file #36) records:" ) S IBX="" F S IBX= $O(IBINS(I BX)) Q:IBX ="" S IBS =IBINS(IBX ) D .D SET (" Number of records with '"_$ P(IBS,"^") _"' (#"_$P (IBS,"^",2 )_") updat ed: "_+$G( IBCT("INS" ,IBX))) .I $O(IBCT(" INS",IBX,0 )) D ..D S ET($J("",8 )_"The fol lowing com panies had this fiel d deleted and not me rged:") .. S IBCO=0 F S IBCO=$ O(IBCT("IN S",IBX,IBC O)) Q:'IBC O D ...D SET($J("", 10)_$P($G( ^DIC(36,IB CO,0)),"^" )_" (ien " _IBCO_")") ; ; - ins urance rev iews D SET (" ") D SE T("3. Corr ection of the Insura nce Review (file #35 6.2) field ") D SET(" 'INSURANC E COMPANY CONTACTED' (#.08)") D SET(" Nu mber of In surance Re view recor ds updated : "_+$G(IB CT("IR"))) I $O(IBCT ("IR",0)) D .D SET($ J("",8)_"T he followi ng Insuran ce reviews had this field dele ted and no t merged:" ) .S DFN=0 F S DFN= $O(IBCT("I R",DFN)) Q :'DFN D . .S IBNAM=$ $PT^IBEFUN C(DFN),IBH =0 ..S IBX =$J("",10) _$E($P(IBN AM,"^"),1, 25)_" ("_$ P(IBNAM,"^ ",3)_")" . .S IBDAT=" " F S IBD AT=$O(IBCT ("IR",DFN, IBDAT)) Q: IBDAT="" D ...S IBD AT1="Revie w Date/Tim e: "_$$DAT 2^IBOUTL(I BDAT) ...I 'IBH D SE T($E(IBX_$ J("",45),1 ,45)_IBDAT 1) ...E D SET($J("" ,45)_IBDAT 1) ...S IB H=1 ; ; - bills K IB INS S IBIN S(1)="PRIM ARY INSURA NCE CARRIE R^101" S I BINS(2)="S ECONDARY I NSURANCE C ARRIER^102 " S IBINS( 3)="TERTIA RY INSURAN CE CARRIER ^103" D SE T(" ") D S ET("4. Cor rection of Bill/Clai ms (file # 399) recor ds:") S IB X="" F S IBX=$O(IBI NS(IBX)) Q :IBX="" S IBS=IBINS (IBX) D .D SET(" Num ber of rec ords with '"_$P(IBS, "^")_"' (# "_$P(IBS," ^",2)_") u pdated: "_ +$G(IBCT(" BL",IBX))) .I $O(IBC T("BL",IBX ,0)) D ..D SET($J("" ,8)_"The f ollowing b ills had t his field deleted an d not merg ed:") ..S IBCO=0 F S IBCO=$O( IBCT("BL", IBX,IBCO)) Q:'IBCO D ...S IBS =$G(^DGCR( 399,IBCO,0 )) ...S IB NAM=$$PT^I BEFUNC(+$P (IBS,"^",2 )) ...D SE T($J("",10 )_$E($E($P (IBNAM,"^" ),1,25)_" ("_$P(IBNA M,"^",3)_" )"_$J("",3 5),1,35)_" Bill #: "_ $P(IBS,"^" )) ; ; - r eceivables in AR D S ET(" ") D SET("5. Nu mber of up dated seco ndary and tertiary c arriers of AR receiv ables: "_+ $G(IBCTAR) ) ; D ^XMD K ^TMP($J ,"IBT") Q ;SET(X) ; Set Messag e Text Arr ay S IBC=I BC+1,^TMP( $J,"IBT",I BC)=X Q | |
| 999 | ||
| 1000 | Routines | |
| 1001 | Activities | |
| 1002 | Routine Na me | |
| 1003 | IBJTU3 | |
| 1004 | Enhancemen t Category | |
| 1005 | New | |
| 1006 | Modify | |
| 1007 | Delete | |
| 1008 | No Change | |
| 1009 | RTM | |
| 1010 | ||
| 1011 | Related Op tions | |
| 1012 | None | |
| 1013 | Related Ro utines | |
| 1014 | Routines “ Called By” | |
| 1015 | Routines “ Called” | |
| 1016 | ||
| 1017 | ||
| 1018 | ||
| 1019 | ||
| 1020 | Data Dicti onary (DD) Reference s | |
| 1021 | ||
| 1022 | Related Pr otocols | |
| 1023 | None | |
| 1024 | Related In tegration Control Re gistration s (ICRs) | |
| 1025 | None | |
| 1026 | Data Passi ng | |
| 1027 | Input | |
| 1028 | Output Re ference | |
| 1029 | Both | |
| 1030 | Global Re ference | |
| 1031 | Local | |
| 1032 | Input Attr ibute Name and Defin ition | |
| 1033 | Name: | |
| 1034 | Definition : | |
| 1035 | Output Att ribute Nam e and Defi nition | |
| 1036 | Name: | |
| 1037 | Definition : | |
| 1038 | Current Lo gic | |
| 1039 | IBJTU3 ;AL B/ARH - TP I UTILITIE S - INS AD DRESS ; 2/ 14/95 ;;2. 0;INTEGRAT ED BILLING ;**39,80** ;21-MAR-94 ;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified. ; BADD(IBIFN ) ; return s mailing address fo r bill ; r eturns: CO MPANY NAME ^ PHONE N UMBER ^ ST R 1 ^ STR 2 ^ STR 3 ^ CITY ^ S TATE ^ ZIP ^ ^ FAX # N DFN,IBX ,IBCNS,IBC DFN,IBTYP ; S IBX="" ,DFN=$G(^D GCR(399,+$ G(IBIFN),0 )) S IBTYP =$P(DFN,U, 5),DFN=+$P (DFN,U,2) I 'DFN G B ADDQ S IBC NS=$G(^DGC R(399,+IBI FN,"MP")) I 'IBCNS G BADDQ S I BCDFN=$P(I BCNS,U,2) I +IBCDFN S IBCNS=+$ G(^DPT(DFN ,.312,+IBC DFN,0)) ; ; -- if se nd to empl oyer and s tate defin ed, return employer address I +IBCDFN S IBCDFN=$G( ^DPT(DFN,. 312,+IBCDF N,2)) I +I BCDFN,+$P( IBCDFN,U,6 ) D G BAD DQ . S IBX =$P(IBCDFN ,U,9)_U_$P (IBCDFN,U, 8)_U_$P(IB CDFN,U,2,7 ) ; S IBTY P=$S(IBTYP <3:"INP",1 :"OPT") S IBX=$$INSA DD(+IBCNS, IBTYP) ;BA DDQ Q IBX ; ;INSADD( IBCNS,IBAT YP) ; retu rns specif ic type of address/p hone # for an insura nce compan y, follows ptrs to c ompany res ponsible ; returns: COMPANY NA ME ^ PHONE NUMBER ^ STR 1 ^ ST R 2 ^ STR 3 ^ CITY ^ STATE ^ Z IP ^ ^ FAX # ; if ty pe does no t have an address or phone num ber then m ain mailin g addr/ph # is retur ned ; N IB D0,IBD13,I BADD,IBNM, IBPH,IBDN, IBCNT,IBAG AIN S (IBA DD,IBNM,IB PH)="" ;MA IN ; -- de termine ad dress for company fo r type bil l ; S IBD0 =$G(^DIC(3 6,+$G(IBCN S),0)) I I BD0="" G M AINQ S IBD 13=$G(^DIC (36,IBCNS, .13)) ; ; -- get nam e, main ad dress, pho ne number S IBNM=$P( IBD0,U,1), IBPH=$P(IB D13,U,1),I BADD=$G(^D IC(36,+IBC NS,.11)) ; ; -- if p rocess the same co. more than once you a re in an i nfinate lo op I $D(IB CNT(IBCNS) ) G MAINQ ;already p rocessed t his compan y use main add S IBC NT(IBCNS)= "" ; ; -- type of bi ll I $G(IB ATYP)'="", $T(@IBATYP )'="" D @I BATYP I $D (IBAGAIN) K IBAGAIN G MAIN ; ; -- return addressMA INQ S IBNM =IBNM_U_IB PH_U_IBADD Q IBNM ;V ER ; -- ve rification phone num ber I $P(I BD13,U,4)' ="" S IBPH =$P(IBD13, U,4) Q ;BI LL ; -- bi lling phon e number I $P(IBD13, U,2)'="" S IBPH=$P(I BD13,U,2) Q ;PCERT ; -- precer tification phone num ber I $P(I BD13,U,3)' ="" S IBPH =$P(IBD13, U,3) ; ; - - if other company p rocesses p recerts st art again I $P(IBD13 ,"^",9) S IBCNS=$P(I BD13,"^",9 ) S IBAGAI N=1 Q ;INP ; -- inpa tient phon e number I $P(IBD13, U,5)'="" S IBPH=$P(I BD13,U,5) ; ; -- see if there is an inpa tient addr ess, use i f state is there S I BDN=$G(^DI C(36,+IBCN S,.12)) I $P(IBDN,"^ ",5) S IBA DD=IBDN ; ; -- if ot her compan y processe s claims s tart again I $P(IBDN ,"^",7) S IBCNS=$P(I BDN,"^",7) S IBAGAIN =1 Q ;OPT ; -- outpa tient phon e number I $P(IBD13, U,6)'="" S IBPH=$P(I BD13,U,6) ; ; -- see if there is an outp atient add ress, use if state i s there S IBDN=$G(^D IC(36,+IBC NS,.16)) I $P(IBDN," ^",5) S IB ADD=IBDN ; ; -- if o ther compa ny process es claims start agai n I $P(IBD N,"^",7) S IBCNS=$P( IBDN,"^",7 ) S IBAGAI N=1 Q ;RX ; -- presc ription ph one number I $P(IBD1 3,U,11)'=" " S IBPH=$ P(IBD13,U, 11) ; ; -- see if th ere is an prescripti on address , use if s tate is th ere S IBDN =$G(^DIC(3 6,+IBCNS,. 18)) I $P( IBDN,"^",5 ) S IBADD= IBDN ; ; - - if other company p rocesses c laims star t again I $P(IBDN,"^ ",7) S IBC NS=$P(IBDN ,"^",7) S IBAGAIN=1 Q ;APL ; - - appeals phone numb er I $P(IB D13,U,7)'= "" S IBPH= $P(IBD13,U ,7) ; ; -- see if th ere is an appeals ad dress, use if state is there S IBDN=$G(^ DIC(36,+IB CNS,.14)) I $P(IBDN, "^",5) S I BADD=IBDN ; ; -- if other comp any proces ses claims start aga in I $P(IB DN,"^",7) S IBCNS=$P (IBDN,"^", 7) S IBAGA IN=1 Q ;IN Q ; -- inq uiry phone number I $P(IBD13,U ,8)'="" S IBPH=$P(IB D13,U,8) ; ; -- see if there i s an outpa tient addr ess, use i f state is there S I BDN=$G(^DI C(36,+IBCN S,.15)) I $P(IBDN,"^ ",5) S IBA DD=IBDN ; ; -- if ot her compan y processe s claims s tart again I $P(IBDN ,"^",7) S IBCNS=$P(I BDN,"^",7) S IBAGAIN =1 Q | |
| 1040 | Modified L ogic (Chan ges are in bold) | |
| 1041 | IBJTU3 ;AL B/ARH - TP I UTILITIE S - INS AD DRESS ; 2/ 14/95 ;;2. 0;INTEGRAT ED BILLING ;**39,80,5 92**;21-MA R-94 ;;Per VHA Direc tive 10-93 -142, this routine s hould not be modifie d. ;BADD(I BIFN) ; re turns mail ing addres s for bill ; returns : COMPANY NAME ^ PHO NE NUMBER ^ STR 1 ^ STR 2 ^ ST R 3 ^ CITY ^ STATE ^ ZIP ^ ^ F AX # N DFN ,IBX,IBCNS ,IBCDFN,IB TYP ; S IB X="",DFN=$ G(^DGCR(39 9,+$G(IBIF N),0)) S I BTYP=$P(DF N,U,5),DFN =+$P(DFN,U ,2) I 'DFN G BADDQ S IBCNS=$G( ^DGCR(399, +IBIFN,"MP ")) I 'IBC NS G BADDQ S IBCDFN= $P(IBCNS,U ,2) I +IBC DFN S IBCN S=+$G(^DPT (DFN,.312, +IBCDFN,0) ) ; ; -- i f send to employer a nd state d efined, re turn emplo yer addres s I +IBCDF N S IBCDFN =$G(^DPT(D FN,.312,+I BCDFN,2)) I +IBCDFN, +$P(IBCDFN ,U,6) D G BADDQ . S IBX=$P(IB CDFN,U,9)_ U_$P(IBCDF N,U,8)_U_$ P(IBCDFN,U ,2,7) ; S IBTYP=$S(I BTYP<3:"IN P",1:"OPT" ) S IBX=$$ INSADD(+IB CNS,IBTYP) ;BADDQ Q IBX ; ;INS ADD(IBCNS, IBATYP) ; returns sp ecific typ e of addre ss/phone # for an in surance co mpany, fol lows ptrs to company responsib le ; retur ns: COMPAN Y NAME ^ P HONE NUMBE R ^ STR 1 ^ STR 2 ^ STR 3 ^ CI TY ^ STATE ^ ZIP ^ ^ FAX # ; i f type doe s not have an addres s or phone number th en main ma iling addr /ph # is r eturned ; N IBD0,IBD 13,IBADD,I BNM,IBPH,I BDN,IBCNT, IBAGAIN S (IBADD,IBN M,IBPH)="" ;MAIN ; - - determin e address for compan y for type bill ; S IBD0=$G(^D IC(36,+$G( IBCNS),0)) I IBD0="" G MAINQ S IBD13=$G( ^DIC(36,IB CNS,.13)) ; ; -- get name, mai n address, phone num ber S IBNM =$P(IBD0,U ,1),IBPH=$ P(IBD13,U, 1),IBADD=$ G(^DIC(36, +IBCNS,.11 )) ; ; -- if process the same co. more t han once y ou are in an infinat e loop I $ D(IBCNT(IB CNS)) G MA INQ ;alrea dy process ed this co mpany use main add S IBCNT(IBC NS)="" ; ; -- type o f bill I $ G(IBATYP)' ="",$T(@IB ATYP)'="" D @IBATYP I $D(IBAGA IN) K IBAG AIN G MAIN ; ; -- re turn addre ssMAINQ S IBNM=IBNM_ U_IBPH_U_I BADD Q IBN M ;VER ; - - verifica tion phone number I $P(IBD13,U ,4)'="" S IBPH=$P(IB D13,U,4) Q ;BILL ; - - billing phone numb er I $P(IB D13,U,2)'= "" S IBPH= $P(IBD13,U ,2) Q ;PCE RT ; -- pr ecertifica tion phone number I $P(IBD13,U ,3)'="" S IBPH=$P(IB D13,U,3) ; ; -- if o ther compa ny process es precert s start ag ain I $P(I BD13,"^",9 ) S IBCNS= $P(IBD13," ^",9) S IB AGAIN=1 Q ;INP ; -- inpatient phone numb er I $P(IB D13,U,5)'= "" S IBPH= $P(IBD13,U ,5) ; ; -- see if th ere is an inpatient address, u se if stat e is there S IBDN=$G (^DIC(36,+ IBCNS,.12) ) I $P(IBD N,"^",5) S IBADD=IBD N ; ; -- i f other co mpany proc esses clai ms start a gain I $P( IBDN,"^",7 ) S IBCNS= $P(IBDN,"^ ",7) S IBA GAIN=1 Q ; OPT ; -- o utpatient phone numb er ;JWS;IB *2.0*592;D ental Insu rance mail ing addres s I $$FT^I BCEF(IBIFN )=7 D Q . I $P($G(^ DIC(36,+IB CNS,.19)), "^",11)'=" " S IBPH=$ P(^(.19)," ^",11) . I $P($G(^DI C(36,+IBCN S,.19)),"^ ",5) S IB0 2=$P(^(.19 ),"^",1,6) . I $P($G (^DIC(36,+ IBCNS,.19) ),"^",7) S IBCNS=$P( ^(.19),"^" ,7) S IBAG AIN=1 I $P (IBD13,U,6 )'="" S IB PH=$P(IBD1 3,U,6) ; ; -- see if there is an outpati ent addres s, use if state is t here S IBD N=$G(^DIC( 36,+IBCNS, .16)) I $P (IBDN,"^", 5) S IBADD =IBDN ; ; -- if othe r company processes claims sta rt again I $P(IBDN," ^",7) S IB CNS=$P(IBD N,"^",7) S IBAGAIN=1 Q ;RX ; - - prescrip tion phone number I $P(IBD13,U ,11)'="" S IBPH=$P(I BD13,U,11) ; ; -- se e if there is an pre scription address, u se if stat e is there S IBDN=$G (^DIC(36,+ IBCNS,.18) ) I $P(IBD N,"^",5) S IBADD=IBD N ; ; -- i f other co mpany proc esses clai ms start a gain I $P( IBDN,"^",7 ) S IBCNS= $P(IBDN,"^ ",7) S IBA GAIN=1 Q ; APL ; -- a ppeals pho ne number I $P(IBD13 ,U,7)'="" S IBPH=$P( IBD13,U,7) ; ; -- se e if there is an app eals addre ss, use if state is there S IB DN=$G(^DIC (36,+IBCNS ,.14)) I $ P(IBDN,"^" ,5) S IBAD D=IBDN ; ; -- if oth er company processes claims st art again I $P(IBDN, "^",7) S I BCNS=$P(IB DN,"^",7) S IBAGAIN= 1 Q ;INQ ; -- inquir y phone nu mber I $P( IBD13,U,8) '="" S IBP H=$P(IBD13 ,U,8) ; ; -- see if there is a n outpatie nt address , use if s tate is th ere S IBDN =$G(^DIC(3 6,+IBCNS,. 15)) I $P( IBDN,"^",5 ) S IBADD= IBDN ; ; - - if other company p rocesses c laims star t again I $P(IBDN,"^ ",7) S IBC NS=$P(IBDN ,"^",7) S IBAGAIN=1 Q | |
| 1042 | ||
| 1043 | ||
| 1044 | Routines | |
| 1045 | Activities | |
| 1046 | Routine Na me | |
| 1047 | IBY592PR | |
| 1048 | Enhancemen t Category | |
| 1049 | New | |
| 1050 | Modify | |
| 1051 | Delete | |
| 1052 | No Change | |
| 1053 | RTM | |
| 1054 | ||
| 1055 | Related Op tions | |
| 1056 | None | |
| 1057 | Related Ro utines | |
| 1058 | Routines “ Called By” | |
| 1059 | Routines “ Called” | |
| 1060 | ||
| 1061 | ||
| 1062 | ||
| 1063 | ||
| 1064 | Data Dicti onary (DD) Reference s | |
| 1065 | IB DATA EL EMENT DEFI NITION [#3 64.5] | |
| 1066 | IB FORM SK ELETON DEF INITION [# 364.6] | |
| 1067 | IB FORM FI ELD CONTEN T [#364.7] | |
| 1068 | Related Pr otocols | |
| 1069 | None | |
| 1070 | Related In tegration Control Re gistration s (ICRs) | |
| 1071 | None | |
| 1072 | Data Passi ng | |
| 1073 | Input | |
| 1074 | Output Re ference | |
| 1075 | Both | |
| 1076 | Global Re ference | |
| 1077 | Local | |
| 1078 | Input Attr ibute Name and Defin ition | |
| 1079 | Name: | |
| 1080 | Definition : | |
| 1081 | Output Att ribute Nam e and Defi nition | |
| 1082 | Name: | |
| 1083 | Definition : | |
| 1084 | Current Lo gic | |
| 1085 | N/A | |
| 1086 | Modified L ogic (Chan ges are in bold) | |
| 1087 | IBY592PR ; EDE/JWS - Pre-Instal lation for IB patch 592 ; 2/28 /17 4:33pm ;;2.0;INT EGRATED BI LLING;**59 2**;21-MAR -94;Build 119 ;;Per VA Directi ve 6402, t his routin e should n ot be modi fied. ; ; delete all output fo rmatter (O .F.) data elements i ncluded in build D D ELOF Q ;IN CLUDE(FILE ,Y) ; func tion to de termine if O.F. entr y should b e included in the bu ild ; FILE =5,6,7 ind icating fi le 364.x ; Y=ien to file NEW O K,LN,TAG,D ATA S OK=0 F LN=2:1 S TAG="ENT "_FILE_"+" _LN,DATA=$ P($T(@TAG) ,";;",2) Q :DATA="" I $F(DATA, U_Y_U) S O K=1 Q Q OK ; ;Delete edited en tries to i nsure clea n install of new ent ries ;Dele te obsolet e entries. DELOF ; Delete inc luded OF e ntries NEW FILE,DIK, LN,TAG,TAG LN,DATA,PC E,DA,Y F F ILE=5,6,7 S DIK="^IB A(364."_FI LE_"," D . F TAG="EN T"_FILE,"D EL"_FILE D .. F LN=2 :1 S TAGLN =TAG_"+"_L N,DATA=$P( $T(@TAGLN) ,";;",2) Q :DATA="" D ... F PC E=2:1 S DA =$P(DATA,U ,PCE) Q:'D A I $D(^I BA("364."_ FILE,DA,0) ) D ^DIK Q ; ; Examp le for ENT 5, ENT6, E NT7, DEL5, DEL6, and DEL7: ;;^ 195^254^25 9^269^324^ 325^ ; Not e: Must ha ve beginni ng and end ing up-car at ; ;---- ---------- ---------- ---------- ---------- ---------- ---------- ------- ; 364.5 entr ies modifi ed: ; ; 83 - N-ATT/R END PHYSIC IAN NAME ; 97 - N-NO N-INSTITUT IONAL CLAI M TYPE ; 2 49 - N-ATT /REND PHYS ICIAN SPEC ; 261 - N -ATT/REND PROVIDER I D ; 370 - N-ATT/REND PHYSICIAN NAME BR ; 378 - N-O RTHO BANDI NG QUALIFI ER ; 379 - N-ORTHO B ANDIN DATE ; 380 - N -ORTHO TX MTHS COUNT ; 381 - N -ORTHO TX MTHS COUNT TRANSFER ; 382 - N- ORTHO TX I NDICATOR ; 383 - N-T OOTH NUMBE R ; 384 - N-HCFA J43 0D SERV LI NE (EDI) ; ENT5 ; OF entries in file 364. 5 to be in cluded ; ; ;^83^97^24 9^261^370^ 378^379^38 0^381^382^ 383^384^ ; ;-------- ---------- ---------- ---------- ---------- ---------- ---------- --- ; 364. 6 entries modified: ; ; 2258 - seg 62, 1 -RECORD ID 'DN1 ' ; 2259 - seq 62, 2-ORT HO BANDING QUALIFIER ; 2260 - seq 62, 3- ORTHO BAND ING DATE ; 2261 - se q 62, 4-OR THO TX MON THS COUNT ; 2262 - s eq 62, 5-O RTHO TX MT HS CT TRAN S ; 2263 - seq 62, 6 -ORTHO TX INDICATOR ; 2264 - s eq 63, 1-R ECORD ID ' DN2 ' ; 22 66 - seq 6 3, 2-TOOTH NUMBER ; 2267 - seq 63, 3-TOO TH STATUS CODE ; 226 8 - seq 63 , 4-TOOTH CODE LIST QUALIFIER ; 2269 - s eq 101, 8- REFERRING PROVIDER C ODE ; 2270 - seq 101 , 9-REFERR ING PROVID ER CODE QU ALIFIER ; 2271 - seq 101, 10-R EFERRING P ROVIDER TA XONOMY ; 2 272 - seq 104.6, 1-R ECORD ID ' OPRB' ; 22 73 - seq 1 04.6, 2-AS ST SURGEON QUALIFIER ; 2274 - seq 104.6, 3-ASST SU RGEON TYPE ; 2275 - seq 104.6, 4-ASST SU RGEON LAST NAME ; 22 76 - seq 1 04.6, 5-AS ST SURGEON FIRST NAM E ; 2277 - seq 104.6 , 6-ASST S URGEON MID DLE NAME ; 2278 - se q 104.6, 7 -ASST SURG EON NAME S UFFIX ; 22 79 - seq 1 04.6, 8-AS ST SURGEON PRIMARY I D QUALIFIE R ; 2280 - seq 104.6 , 9-ASST S URGEON PRI MARY ID ; 2281 - seq 104.6, 10 -ASST SURG EON TAXONO MY QUALIFI ER ; 2282 - seq 104. 6, 11-ASST SURGEON T AXONOMY ; 2283 - seq 104.6, 1. 5-OPRB Set up ; 2284 - seq 104. 6, 99.5-OP RG Cleanup ; 2285 - seq 104.61 , 1-RECORD ID 'OPRC' ; 2286 - seq 104.61 , 2-ASST S URGEON SEC ID QUALIF IER(1) ; 2 287 - seq 104.61, 3- ASST SURGE ON SEC ID (1) ; 2288 - seq 104 .61, 1.5-O PRC Setup ; 2289 - s eq 104.61, 4-ASST SU RGEON SEC ID QIALIFI ER(2) ; 22 90 - seq 1 04.61, 5-A SST SURGEO N SEC ID ( 2) ; 2291 - seq 104. 61, 6-ASST SURGEON S EC ID QUAL IFIER(3) ; 2292 - se q 104.61, 7-ASST SUR GEON SEC I D (3) ; 22 93 - seq 1 04.61, 8-A SST SURGEO N SEC ID Q IALIFIER(4 ) ; 2294 - seq 104.6 1, 9-ASST SURGEON SE C ID (4) ; 2295 - se q 104.61, 99.5-OPRC Cleanup ; 2296 - seq 178.1, 1- RECORD ID 'OP10' ; 2 297 - seq 178.1, 1.5 -OP10 Setu p ; 2298 - seq 178.1 , 2-PAYER RESPONSIBI LITY SEQ # CODE ; 22 99 - seq 1 78.1, 3-OT HER PAYER ASST SURGE ON ENTITY ID ; 2300 - seq 178. 1, 4-OTHER PAYER ASS T SURGEON ENTITY QUA L ; 2301 - seq 178.1 , 5-OTHER PAYER ASST SURGEON S EC ID QUAL (1) ; 2302 - seq 178 .1, 6-OTHE R PAYER AS ST SURGEON SEC ID(1) ; 2303 - seq 178.1, 7-OTHER P AYER ASST SURGEON SE C ID QUAL( 2) ; 2304 - seq 178. 1, 8-OTHER PAYER ASS T SURGEON SEC ID(2) ; 2305 - s eq 178.1, 9-OTHER PA YER ASST S URGEON SEC ID QUAL(3 ) ; 2306 - seq 178.1 , 10-OTHER PAYER ASS T SURGEON SEC ID(3) ; 2307 - s eq 178.1, 99.5-OP10 Cleanup ; 2308 - seq 186, 1-RE CORD ID 'D EN ' ; 230 9 - seq 18 6, 2-SERVI CE LINE # ; 2310 - s eq 186, 3- DATE/TIME QUALIFIER ; 2311 - s eq 186, 4- SERVICE DA TE ; 2312 - seq 186, 5-SERVICE ID QUALIF IER ; 2313 - seq 186 , 6-PROCED URE CODE ; 2314 - se q 186, 7-P ROCEDURE M ODIFIER(1) ; 2315 - seq 186, 8 -PROCEDURE MODIFIER( 2) ; 2316 - seq 186, 9-PROCEDU RE MODIFIE R(3) ; 231 7 - seq 18 6, 10-PROC EDURE MODI FIER(4) ; 2318 - seq 186, 11-P ROCEDURE C ODE DESCRI PTION ; 23 19 - seq 1 86, 12-LIN E ITEM CHA RGE AMT ; 2320 - seq 186, 13-P LACE OF SE RVICE CODE ; 2321 - seq 186, 1 4-ORAL CAV ITY DESIGN ATION(1) ; 2322 - se q 186, 15- ORAL CAVIT Y DESIGNAT ION(2) ; 2 323 - seq 186, 16-OR AL CAVITY DESIGNATIO N(3) ; 232 4 - seq 18 6, 17-ORAL CAVITY DE SIGNATION( 4) ; 2325 - seq 186, 18-ORAL C AVITY DESI GNATION(5) ; 2326 - seq 186, 1 9-PROSTHES IS CROWN I NLAY CODE ; 2327 - s eq 186.1, 1-RECORD I D 'DEN1' ; 2328 - se q 186.1, 2 -SERVICE L INE # ; 23 29 - seq 1 86.1, 3-PR OCEDURE CO UNT ; 2330 - seq 186 .1, 4-DIAG NOSIS CODE POINTER(1 ) ; 2331 - seq 186.1 , 5-DIAGNO SIS CODE P OINTER(2) ; 2332 - s eq 186.1, 6-DIAGNOSI S CODE POI NTER(3) ; 2333 - seq 186.1, 7- DIAGNOSIS CODE POINT ER(4) ; 23 34 - seq 1 86.1, 8-PR IOR PLACEM ENT DATE Q UALIFIER ; 2335 - se q 186.1, 9 -PRIOR PLA CEMENT DAT E ; 2336 - seq 186.1 , 10-ORTHO BANDING D ATE QUALIF IER ; 2337 - seq 186 .1, 11-ORT HO BANDING DATE ; 23 38 - seq 1 86.1, 12-R EPLACEMENT DATE QUAL IFIER ; 23 39 - seq 1 86.1, 13-R EPLACEMENT DATE ; 23 40 - seq 1 86.1, 14-T REATMENT S TART DATE QUALIFIER ; 2341 - s eq 186.1, 15-TREATME NT START D ATE ; 2342 - seq 186 .1, 16-TRE ATMENT COM PLETION DA TE QUALIFI ER ; 2343 - seq 186. 1, 17-TREA TMENT COMP LETION DAT E ; 2344 - seq 186.2 , 1-RECORD ID 'DEN2' ; 2345 - seq 186.2, 2-SERVICE LINE # ; 2346 - seq 186.2, 3- TOOTH CODE QUALIFIER ; 2347 - seq 186.2, 4-TOOTH C ODE ; 2348 - seq 186 .2, 5-TOOT H SURFACE( 1) ; 2349 - seq 186. 2, 6-TOOTH SURFACE(2 ) ; 2350 - seq 186.2 , 7-TOOTH SURFACE(3) ; 2351 - seq 186.2, 8-TOOTH S URFACE(4) ; 2352 - s eq 186.2, 9-TOOTH SU RFACE(5) ; 2353 - se q 194.5, 1 -RECORD ID 'LSUR' ; 2354 - seq 194.5, 2- SERVICE LI NE COUNTER ; 2355 - seq 194.5, 3-ASST SU RGEON QUAL IFIER ; 23 56 - seq 1 94.5, 4-AS ST SURGEON LAST NAME ; 2357 - seq 194.5, 5-ASST SU RGEON FIRS T NAME ; 2 358 - seq 194.5, 6-A SST SURGEO N MIDDLE N AME ; 2359 - seq 194 .5, 7-ASST SURGEON N AME SUFFIX ; 2360 - seq 194.5, 8-ASST SU RGEON PRIM ARY ID QUA LIFIER ; 2 361 - seq 194.5, 9-A SST SURGEO N PRIMARY ID ; 2370 - seq 194. 5, 1.9-LSU R DATA EXT RACT ; 237 2 - seq 19 4.6, 1-REC ORD ID 'LS UR1' ; 237 3 - seq 19 4.6, 1.9-L SUR1 DATA EXTRACT ; 2374 - seq 194.6, 2- SERVICE LI NE COUNTER ; 2375 - seq 194.6, 3-ASST SU RGEON SECO NDARY ID Q UALIFIER(1 ) ; 2376 - seq 194.6 , 4-ASST S URGEON SEC ONDARY ID( 1) ; 2377 - seq 194. 6, 5-ASST SURGEON SE CONDARY ID QUALIFIER (2) ; 2378 - seq 194 .6, 6-ASST SURGEON S ECONDARY I D(2) ; 237 9 - seq 19 4.6, 7-ASS T SURGEON SECONDARY ID QUALIFI ER(3) ; 23 80 - seq 1 94.6, 8-AS ST SURGEON SECONDARY ID(3) ; 2 381 - seq 194.6, 9-A SST SURGEO N TAXONOMY QUALIFIER ; 2382 - seq 194.6, 10-ASST S URGEON TAX ONOMY CODE ;ENT6 ; O .F. entrie s in file 364.6 to b e included ; ;;^2258 ^2259^2260 ^2261^2262 ^2263^2264 ^2266^2267 ^2268^2269 ^2270^2271 ^2272^ ;;^ 2273^2274^ 2275^2276^ 2277^2278^ 2279^2280^ 2281^2282^ 2283^2284^ 2285^2286^ ;;^2287^2 288^2289^2 290^2291^2 292^2293^2 294^2295^2 296^2297^2 298^2299^2 300^ ;;^23 01^2302^23 03^2304^23 05^2306^23 07^2308^23 09^2310^23 11^2312^23 13^2314^ ; ;^2315^231 6^2317^231 8^2319^232 0^2321^232 2^2323^232 4^2325^232 6^2327^232 8^ ;;^2329 ^2330^2331 ^2332^2333 ^2334^2335 ^2336^2337 ^2338^2339 ^2340^2341 ^2342^ ;;^ 2343^2344^ 2345^2346^ 2347^2348^ 2349^2350^ 2351^2352^ 2353^2354^ 2355^2356^ ;;^2357^2 358^2359^2 360^2361^2 370^2372^2 373^2374^2 375^2376^2 377^2378^2 379^ ;;^23 80^2381^23 82^ ;----- ---------- ---------- ---------- ---------- ---------- ---------- ------ ; 3 64.7 entri es modifie d: ; ;ENT7 ; O.F. en tries in f ile 364.7 to be incl uded ; ;;^ 1425^1426^ 1460^1461^ 1462^1463^ 1464^1465^ 1466^1467^ 1468^1469^ 1470^1471^ ;;^1472^1 473^1474^1 475^1476^1 477^1478^1 479^1480^1 481^1482^1 483^1484^1 485^ ;;^14 86^1487^14 88^1489^14 90^1491^14 92^1493^14 94^1495^14 96^1497^14 98^1499^ ; ;^1505^150 6^1507^150 8^1509^151 0^1511^151 2^1513^151 4^1515^151 6^1517^152 8^ ;;^1548 ^1549^1552 ^1553^1554 ^1555^1556 ^1557^1558 ^1559^1560 ^1580^1581 ^1582^ ;;^ 1583^1584^ 1585^1586^ 1587^1588^ 1589^1590^ 1591^1592^ 1593^1594^ 1595^1596^ ;;^1597^1 598^1599^1 600^1601^1 602^1603^1 604^1605^1 606^1607^1 608^1609^1 614^ ;;^16 88^1689^17 28^1729^17 30^1731^19 57^1958^19 59^1960^19 61^1962^19 63^1964^ ; ;^1965^196 6^1967^31^ 37^1006^10 23^1015^16 ^127^75^10 08^1727^85 4^ ; ;---- ---------- ---------- ---------- ---------- ---------- ---------- ------- ; 364.5 entr ies delete d: ;DEL5 ; remove O.F. entr ies in fil e 364.5 (n ot re-adde d) ; ;; ; ;--------- ---------- ---------- ---------- ---------- ---------- ---------- -- ; 364.6 entries d eleted: ; ;DEL6 ; remove O. F. entries in file 3 64.6 (not re-added) ; ;; ; ;-- ---------- ---------- ---------- ---------- ---------- ---------- --------- ; 364.7 en tries dele ted: ; ;DE L7 ; re move O.F. entries in file 364. 7 (not re- added) ; ; ; ; ;----- ---------- ---------- ---------- ---------- ---------- ---------- ------ | |
| 1088 | ||
| 1089 | ||
| 1090 | ||
| 1091 | The Output Formatter control f iles will be changed in order to create the 837D t ransaction . The fol lowing are entries t hat will n eed modifi ed and new (*) entrie s to file 364.5 IB D ATA ELEMEN T DEFINITI ON. | |
| 1092 | NUMBER: 83 | |
| 1093 | NAME: N-AT T/REND PHY SICIAN NAM E | |
| 1094 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1095 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
| 1096 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1097 | BASE FILE: BILL/CLAI MS | |
| 1098 | EXTRACT CO DE: N IBZ, IBT S IBT= $S($$FT^IB CEF(IBXIEN )=2:3,$$FT ^IBCEF(IBX IEN)=7:3 | |
| 1099 | ,1:4) D GE TPRV^IBCEU (IBXIEN,IB T,.IBZ) S | |
| 1100 | IBXDATA=$ P($G(IBZ(I BT,1)),U)_ U_$P($G(IB Z | |
| 1101 | (IBT,1)),U ,3)_U_$P($ G(IBZ(IBT, 1)),U,4) | |
| 1102 | DESCRIPTIO N: The nam e of the a ttending ( inpatient) or render ing | |
| 1103 | (outpatien t) physici an for bil l entry IB XIEN. Inp atient | |
| 1104 | type=4, ou tpatient=3 1st '^'-p iece is na me, 2nd is new | |
| 1105 | person fil e ien, 3rd is creden tials | |
| 1106 | ||
| 1107 | ||
| 1108 | NUMBER: 97 | |
| 1109 | NAME: N-NO N-INSTITUT IONAL CLAI M TYPE | |
| 1110 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 1111 | TYPE OF ELEMEN T: EXTRACT ED VIA COD E | |
| 1112 | ELEMENT CATEGORY: INDIVIDUAL ELEMENT | |
| 1113 | BASE FIL E: BILL/CL AIMS | |
| 1114 | EXTRACT CO DE: S IBXD ATA="" I | |
| 1115 | $$FT^IB CEF(IBXIEN )=2!($$FT^ IBCEF(IBXI EN)=7) S I BX | |
| 1116 | DATA=$S( $O(^IBA(36 2.4,"AIFN" _IBXIEN,0) ):"RX",1:" MD") | |
| 1117 | DESCRIPTI ON: If an outpatient bill-'MD' ; if a pre scription bill-'RX' | |
| 1118 | for bill entry IBXI EN. | |
| 1119 | ||
| 1120 | NUMBER: 24 9 | |
| 1121 | NAME: N-AT T/REND PHY SICIAN SPE C | |
| 1122 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 1123 | TYPE OF ELEMEN T: EXTRACT ED VIA COD E | |
| 1124 | ELEMENT CATEGORY: INDIVIDUAL ELEMENT | |
| 1125 | BASE FILE: BILL/CLAI MS | |
| 1126 | EXTRACT CODE: N IB Z,IBI S | |
| 1127 | IBI=$S($ $FT^IBCEF( IBXIEN)=2! ($$FT^IBCE F(IBXIEN)= 7):3 | |
| 1128 | ,1:4) D GETPRV^IBC EU(IBXIEN, IBI,.IBZ) S | |
| 1129 | IBXDATA= $$SPEC^IBC EU($P($G(I BZ(IBI,1)) ,U | |
| 1130 | ,3),+$G( ^DGCR(399, IBXIEN,"U" ))) | |
| 1131 | DESCRIPTI ON: Find t he special ty from th e VA code of the per son class | |
| 1132 | attached t o the atte nding/rend ering prov ider for b ill | |
| 1133 | IBXIEN, if it can be determine d. | |
| 1134 | ||
| 1135 | NUMBER: 26 1 | |
| 1136 | NAME: N-AT T/REND PRO VIDER ID | |
| 1137 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1138 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
| 1139 | ELEMENT CATEGORY: INDIVIDUAL ELEMENT | |
| 1140 | BASE FILE: BILL/CLAI MS | |
| 1141 | EXTRACT CO DE: N IBZ, IBI,IBS S | |
| 1142 | IBS=+$$C OBN^IBCEF( IBXIEN),IB I=$S($$FT^ IBCEF(IBXI | |
| 1143 | EN)=2!($ $FT^IBCEF( IBXIEN)=7) :3,1:4) D | |
| 1144 | GETPRV^I BCEU(IBXIE N,IBI,.IBZ ) S IBXDAT A=$S | |
| 1145 | ($P($G(IBZ (IBI,1,IBS )),U)'="": $P(IBZ(IBI ,1,IBS),U) ,1:$P($G(I BZ(IBI,1,1 )),U)) | |
| 1146 | DESCRIPTI ON: The id # of the attending/ rendering physician for the | |
| 1147 | current i nsurance c ompany for bill entr y IBXIEN. | |
| 1148 | ||
| 1149 | NUMBER: 37 0 | |
| 1150 | NAME: N-AT T/REND PHY SICIAN NAM E BR | |
| 1151 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1152 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
| 1153 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1154 | BASE FILE: BILL/CLAI MS | |
| 1155 | EXTRACT CO DE: N IBT S | |
| 1156 | IBT=$S($ $FT^IBCEF( IBXIEN)=2! ($$FT^IBCE F(IBXIEN)= 7):3,1:4 | |
| 1157 | ) S IBXD ATA=$$GETP RV^IBCEF83 (IBXIEN,,I BT,"A1")_U _ | |
| 1158 | $$GETPRV ^IBCEF83(I BXIEN,,IBT ,"A0")_U_ | |
| 1159 | $$GETPRV ^IBCEF83(I BXIEN,,IBT ,"A6") | |
| 1160 | DESCRIPTIO N: The nam e of the A TTENDING o r RENDERIN G provider for bill | |
| 1161 | entry IBX IEN. The pieces ret urned are: provider name^vp | |
| 1162 | ien for p rovider ( 200/355.93 )^credenti als. | |
| 1163 | ||
| 1164 | NUMBER: 37 8* | |
| 1165 | NAME: N-OR THO BANDIN G QUALIFIE R | |
| 1166 | SECURITY L EVEL: NAT IONAL,NO E DIT | |
| 1167 | TYPE OF EL EMENT: CON STANT VALU E | |
| 1168 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1169 | BASE FILE: BILL/CLAI MS | |
| 1170 | CONSTANT V ALUE: 452 | |
| 1171 | ||
| 1172 | NUMBER: 37 9* | |
| 1173 | NAME: N-OR THO BANDIN G DATE | |
| 1174 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1175 | TYPE OF EL EMENT: NON -MULTIPLE FILEMAN FI ELD | |
| 1176 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1177 | BASE FILE: BILL/CLAI MS | |
| 1178 | FILEMAN FI ELD REFERE NCE: BANDI NG DATE | |
| 1179 | FILEMAN RE TURN FORMA T: INTERNA L | |
| 1180 | ||
| 1181 | NUMBER: 38 0* | |
| 1182 | NAME: N-OR THO TX MTH S COUNT | |
| 1183 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1184 | TYPE OF EL EMENT: NON -MULTIPLE FILEMAN FI ELD | |
| 1185 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1186 | BASE FILE: BILL/CLAI MS | |
| 1187 | FILEMAN FI ELD REFERE NCE: TREAT MENT MONTH S COUNT | |
| 1188 | FILEMAN RE TURN FORMA T: INTERNA L | |
| 1189 | ||
| 1190 | NUMBER: 38 1* | |
| 1191 | NAME: N-OR THO TX MTH S COUNT TR ANSFER | |
| 1192 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1193 | TYPE OF EL EMENT: NON -MULTIPLE FILEMAN FI ELD | |
| 1194 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1195 | BASE FILE: BILL/CLAI MS | |
| 1196 | FILEMAN FI ELD REFERE NCE: TREAT MENT MONTH S REMAININ G | |
| 1197 | FILEMAN RE TURN FORMA T: INTERNA L | |
| 1198 | ||
| 1199 | NUMBER: 38 2* | |
| 1200 | NAME: N-OR THO TX IND ICATOR | |
| 1201 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1202 | TYPE OF EL EMENT: NON -MULTIPLE FILEMAN FI ELD | |
| 1203 | ELEMENT CA TEGORY: IN DIVIDUAL E LEMENT | |
| 1204 | BASE FILE: BILL/CLAI MS | |
| 1205 | FILEMAN FI ELD REFERE NCE: TREAT MENT INDIC ATOR | |
| 1206 | FILEMAN RE TURN FORMA T: EXTERNA L | |
| 1207 | ||
| 1208 | NUMBER: 38 3* | |
| 1209 | NAME: N-TO OTH NUMBER | |
| 1210 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1211 | TYPE OF EL EMENT: EXT RACTED VIA COD | |
| 1212 | ELEMENT CA TEGORY: GR OUP ELEMEN T | |
| 1213 | BASE FILE: BILL/CLAI MS | |
| 1214 | EXTRACT CO DE: S IBXD ATA="" I $ $FT^IBCEF( IBXIEN)=7 D TNUM^IBC EF12(IBXIE N) | |
| 1215 | ||
| 1216 | NUMBER: 38 4* | |
| 1217 | NAME: N-HC FA J430D S ERV LINE ( EDI) | |
| 1218 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 1219 | TYPE OF EL EMENT: EXT RACTED VIA CODE | |
| 1220 | ELEMENT CATEGORY: GROUP ELEM ENT | |
| 1221 | BASE FILE: BILL/CLAI MS | |
| 1222 | EXTRACT CODE: S IB XDATA="" I $$FT^IBCE F(IBXIEN)= 7 D OUTPT^ IBCEF11(IB XIEN,0) | |
| 1223 | DESCRIPTI ON: The elements o f the outp atient ser vices line on the HC FA J430D | |
| 1224 | for bil l entry IB XIEN. For mat is beg in date^en d date^pla ce of serv ice | |
| 1225 | code^ty pe of serv ice code^p rocedure o r revenue code^type of | |
| 1226 | code^dia gnosis poi nters^unit charge^un its^modifi er pointer ien(s) | |
| 1227 | separate d by comma s^purchase d charge a mount^anes thesia | |
| 1228 | minutes^ emergency indicator^ lap type o f service flag. Dat a is | |
| 1229 | returned in an arr ay IBXDATA (1-n). Al so returns the array s | |
| 1230 | IBXDATA( n,"AUX")=t he 'AUX' n ode for th e procedur e entry on the | |
| 1231 | claim IBX DATA("ITEM ",item typ e,item poi nter)=n^ct r if this data can b e | |
| 1232 | gatherd. | |
| 1233 | ||
| 1234 | The follow ing are ad ditional e ntries to file 364.6 IB FORM S KELETON DE FINITION. These ent ries are u sed by the VistA Out put Format ter when g enerating the 837D t ransaction . | |
| 1235 | ||
| 1236 | NUMBER: 22 58BILL FOR M: IB 837 TRANSMISSI ON | |
| 1237 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 62 | |
| 1238 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1239 | STARTING C OLUMN OR P IECE: 1 LE NGTH: 4 | |
| 1240 | SHORT DESC RIPTION: R ECORD ID ' DN1 ' TR ANSMIT IGN ORES IF NU LL: TRUE | |
| 1241 | DATA REQUI RED FOR FI ELD: YES | |
| 1242 | ||
| 1243 | NUMBER: 22 59 BILL FORM: IB 837 TR ANSMISSION | |
| 1244 | SECURITY L EVEL: NATI ONAL,NO ED IT PA GE OR SEQU ENCE: 62 | |
| 1245 | FIRST LINE NUMBER: 1 LO CAL OVERRI DE ALLOWED : NO | |
| 1246 | STARTING C OLUMN OR P IECE: 2 LE NGTH: 3 | |
| 1247 | SHORT DESC RIPTION: O RTHO BANDI NG QUALIFI ER | |
| 1248 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1249 | ||
| 1250 | NUMBER: 22 60BILL FOR M: IB 837 TRANSMISSI ON | |
| 1251 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 62 | |
| 1252 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1253 | STARTING C OLUMN OR P IECE: 3LEN GTH: 35 | |
| 1254 | SHORT DESC RIPTION: O RTHO BANDI NG DATE | |
| 1255 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1256 | ||
| 1257 | NUMBER: 22 61BILL FOR M: IB 837 TRANSMISSI ON | |
| 1258 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 62 | |
| 1259 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1260 | STARTING C OLUMN OR P IECE: 4LEN GTH: 15 | |
| 1261 | SHORT DESC RIPTION: O RTHO TX MO NTHS COUNT | |
| 1262 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1263 | ||
| 1264 | NUMBER: 22 62BILL FOR M: IB 837 TRANSMISSI ON | |
| 1265 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 62 | |
| 1266 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1267 | STARTING C OLUMN OR P IECE: 5LEN GTH: 15 | |
| 1268 | SHORT DESC RIPTION: O RTHO TX MT HS CT TRAN S | |
| 1269 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1270 | ||
| 1271 | NUMBER: 22 63BILL FOR M: IB 837 TRANSMISSI ON | |
| 1272 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 62 | |
| 1273 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1274 | STARTING C OLUMN OR P IECE: 6LEN GTH: 80 | |
| 1275 | SHORT DESC RIPTION: O RTHO TX IN DICATOR | |
| 1276 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1277 | ||
| 1278 | NUMBER: 22 64BILL FOR M: IB 837 TRANSMISSI ON | |
| 1279 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 63 | |
| 1280 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1281 | STARTING C OLUMN OR P IECE: 1 LE NGTH: 4 | |
| 1282 | SHORT DESC RIPTION: R ECORD ID ' DN2 ' TR ANSMIT IGN ORES IF NU LL: TRUE | |
| 1283 | DATA REQUI RED FOR FI ELD: YES | |
| 1284 | ||
| 1285 | NUMBER: 22 66BILL FOR M: IB 837 TRANSMISSI ON | |
| 1286 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 63 | |
| 1287 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1288 | STARTING C OLUMN OR P IECE: 2 LE NGTH: 50 | |
| 1289 | SHORT DESC RIPTION: T OOTH NUMBE R TRANSMI T IGNORES IF NULL: T RUE | |
| 1290 | DATA REQUI RED FOR FI ELD: NO | |
| 1291 | ||
| 1292 | NUMBER: 22 67BILL FOR M: IB 837 TRANSMISSI ON | |
| 1293 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 63 | |
| 1294 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1295 | STARTING C OLUMN OR P IECE: 3 L ENGTH: 2 | |
| 1296 | SHORT DESC RIPTION: T OOTH STATU S CODE TR ANSMIT IGN ORES IF NU LL: TRUE | |
| 1297 | DATA REQUI RED FOR FI ELD: NO | |
| 1298 | ||
| 1299 | NUMBER: 22 68 BILL FO RM: IB 837 TRANSMISS ION | |
| 1300 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 63 | |
| 1301 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1302 | STARTING C OLUMN OR P IECE: 4LEN GTH: 3 | |
| 1303 | SHORT DESC RIPTION: T OOTH CODE LIST QUALI FIER | |
| 1304 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1305 | ||
| 1306 | NUMBER: 22 69 BILL FO RM: IB 837 TRANSMISS ION | |
| 1307 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 101 | |
| 1308 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1309 | STARTING C OLUMN OR P IECE: 8LEN GTH: 3 | |
| 1310 | SHORT DESC RIPTION: R EFERRING P ROVIDER CO DE | |
| 1311 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1312 | ||
| 1313 | NUMBER: 22 70BILL FOR M: IB 837 TRANSMISSI ON | |
| 1314 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 101 | |
| 1315 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1316 | STARTING C OLUMN OR P IECE: 9LEN GTH: 3 | |
| 1317 | SHORT DESC RIPTION: R EFERRING P ROVIDER CO DE QUALIFI ER | |
| 1318 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1319 | ||
| 1320 | NUMBER: 22 71BILL FOR M: IB 837 TRANSMISSI ON | |
| 1321 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 101 | |
| 1322 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1323 | STARTING C OLUMN OR P IECE: 10LE NGTH: 50 | |
| 1324 | SHORT DESC RIPTION: R EFERRING P ROVIDER TA XONOMY | |
| 1325 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1326 | ||
| 1327 | NUMBER: 22 72BILL FOR M: IB 837 TRANSMISSI ON | |
| 1328 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1329 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1330 | STARTING C OLUMN OR P IECE: 1LEN GTH: 4 | |
| 1331 | SHORT DESC RIPTION: R ECORD ID ' OPRB'TRANS MIT IGNORE S IF NULL: TRUE | |
| 1332 | DATA REQUI RED FOR FI ELD: NO | |
| 1333 | ||
| 1334 | NUMBER: 22 83BILL FOR M: IB 837 TRANSMISSI ON | |
| 1335 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1336 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1337 | STARTING C OLUMN OR P IECE: 1.5S HORT DESCR IPTION: OP RB Setup | |
| 1338 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1339 | ||
| 1340 | NUMBER: 22 73BILL FOR M: IB 837 TRANSMISSI ON | |
| 1341 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1342 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1343 | STARTING C OLUMN OR P IECE: 2LEN GTH: 3 | |
| 1344 | SHORT DESC RIPTION: A SST SURGEO N QUALIFIE R | |
| 1345 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1346 | ||
| 1347 | NUMBER: 22 74BILL FOR M: IB 837 TRANSMISSI ON | |
| 1348 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1349 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1350 | STARTING C OLUMN OR P IECE: 3LEN GTH: 1 | |
| 1351 | SHORT DESC RIPTION: A SST SURGEO N TYPETRAN SMIT IGNOR ES IF NULL : TRUE | |
| 1352 | DATA REQUI RED FOR FI ELD: NO | |
| 1353 | ||
| 1354 | NUMBER: 22 75BILL FOR M: IB 837 TRANSMISSI ON | |
| 1355 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1356 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1357 | STARTING C OLUMN OR P IECE: 4LEN GTH: 60 | |
| 1358 | SHORT DESC RIPTION: A SST SURGEO N LAST NAM E | |
| 1359 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1360 | ||
| 1361 | NUMBER: 22 76BILL FOR M: IB 837 TRANSMISSI ON | |
| 1362 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1363 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1364 | STARTING C OLUMN OR P IECE: 5LEN GTH: 35 | |
| 1365 | SHORT DESC RIPTION: A SST SURGEO N FIRST NA ME | |
| 1366 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1367 | ||
| 1368 | NUMBER: 22 77BILL FOR M: IB 837 TRANSMISSI ON | |
| 1369 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1370 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1371 | STARTING C OLUMN OR P IECE: 6LEN GTH: 25 | |
| 1372 | SHORT DESC RIPTION: A SST SURGEO N MIDDLE N AME | |
| 1373 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1374 | ||
| 1375 | NUMBER: 22 78BILL FOR M: IB 837 TRANSMISSI ON | |
| 1376 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1377 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1378 | STARTING C OLUMN OR P IECE: 7LEN GTH: 10 | |
| 1379 | SHORT DESC RIPTION: A SST SURGEO N NAME SUF FIX | |
| 1380 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1381 | ||
| 1382 | NUMBER: 22 79BILL FOR M: IB 837 TRANSMISSI ON | |
| 1383 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1384 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1385 | STARTING C OLUMN OR P IECE: 8LEN GTH: 2 | |
| 1386 | SHORT DESC RIPTION: A SST SURGEO N PRIMARY ID QUALIFI ER | |
| 1387 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1388 | ||
| 1389 | NUMBER: 22 80BILL FOR M: IB 837 TRANSMISSI ON | |
| 1390 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1391 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1392 | STARTING C OLUMN OR P IECE: 9LEN GTH: 80 | |
| 1393 | SHORT DESC RIPTION: A SST SURGEO N PRIMARY ID | |
| 1394 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1395 | ||
| 1396 | NUMBER: 22 81BILL FOR M: IB 837 TRANSMISSI ON | |
| 1397 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1398 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1399 | STARTING C OLUMN OR P IECE: 10LE NGTH: 3 | |
| 1400 | SHORT DESC RIPTION: A SST SURGEO N TAXONOMY QUALIFIER | |
| 1401 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1402 | ||
| 1403 | NUMBER: 22 82BILL FOR M: IB 837 TRANSMISSI ON | |
| 1404 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1405 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1406 | STARTING C OLUMN OR P IECE: 11LE NGTH: 10 | |
| 1407 | SHORT DESC RIPTION: A SST SURGEO N TAXONOMY | |
| 1408 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1409 | ||
| 1410 | NUMBER: 22 84BILL FOR M: IB 837 TRANSMISSI ON | |
| 1411 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.6 | |
| 1412 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1413 | STARTING C OLUMN OR P IECE: 99.5 SHORT DESC RIPTION: O PRB Cleanu p | |
| 1414 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1415 | ||
| 1416 | NUMBER: 22 85BILL FOR M: IB 837 TRANSMISSI ON | |
| 1417 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1418 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1419 | STARTING C OLUMN OR P IECE: 1 LE NGTH: 4 | |
| 1420 | SHORT DESC RIPTION: R ECORD ID ' OPRC'TRANS MIT IGNORE S IF NULL: TRUE | |
| 1421 | DATA REQUI RED FOR FI ELD: YES | |
| 1422 | ||
| 1423 | NUMBER: 22 88BILL FOR M: IB 837 TRANSMISSI ON | |
| 1424 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1425 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1426 | STARTING C OLUMN OR P IECE: 1.5S HORT DESCR IPTION: OP RC Setup | |
| 1427 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1428 | ||
| 1429 | NUMBER: 22 86 BILL FO RM: IB 837 TRANSMISS ION | |
| 1430 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1431 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1432 | STARTING C OLUMN OR P IECE: 2 LE NGTH: 3 | |
| 1433 | SHORT DESC RIPTION: A SST SURGEO N SEC ID Q UALIFIER ( 1) | |
| 1434 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1435 | ||
| 1436 | NUMBER: 22 87 BILL FO RM: IB 837 TRANSMISS ION | |
| 1437 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE OR SEQUENCE: 104.61 | |
| 1438 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1439 | STARTING C OLUMN OR P IECE: 3LEN GTH: 50 | |
| 1440 | SHORT DESC RIPTION: A SST SURGEO N SEC ID ( 1) | |
| 1441 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1442 | ||
| 1443 | NUMBER: 22 89BILL FOR M: IB 837 TRANSMISSI ON | |
| 1444 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE OR SEQUENCE: 104.61 | |
| 1445 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1446 | STARTING C OLUMN OR P IECE: 4LEN GTH: 3 | |
| 1447 | SHORT DESC RIPTION: A SST SURGEO N SEC ID Q UALIFIER ( 2) | |
| 1448 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1449 | ||
| 1450 | NUMBER: 22 90 BILL F ORM: IB 83 7 TRANSMIS SION | |
| 1451 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1452 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1453 | STARTING C OLUMN OR P IECE: 5 LE NGTH: 50 | |
| 1454 | SHORT DESC RIPTION: A SST SURGEO N SEC ID ( 2) | |
| 1455 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1456 | ||
| 1457 | NUMBER: 22 91 BILL F ORM: IB 83 7 TRANSMIS SION | |
| 1458 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE O R SEQUENCE : 104.61 | |
| 1459 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1460 | STARTING C OLUMN OR P IECE: 6 LE NGTH: 3 | |
| 1461 | SHORT DESC RIPTION: A SST SURGEO N SEC ID Q UALIFIER ( 3) | |
| 1462 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1463 | ||
| 1464 | NUMBER: 22 92BILL FOR M: IB 837 TRANSMISSI ON | |
| 1465 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1466 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1467 | STARTING C OLUMN OR P IECE: 7LEN GTH: 50 | |
| 1468 | SHORT DESC RIPTION: A SST SURGEO N SEC ID ( 3) | |
| 1469 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1470 | ||
| 1471 | NUMBER: 22 93BILL FOR M: IB 837 TRANSMISSI ON | |
| 1472 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1473 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1474 | STARTING C OLUMN OR P IECE: 8 LE NGTH: 3 | |
| 1475 | SHORT DESC RIPTION: A SST SURGEO N SEC ID Q UALIFIER ( 4) | |
| 1476 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1477 | ||
| 1478 | NUMBER: 22 94 BILL FO RM: IB 837 TRANSMISS ION | |
| 1479 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1480 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1481 | STARTING C OLUMN OR P IECE: 9 LE NGTH: 50 | |
| 1482 | SHORT DESC RIPTION: A SST SURGEO N SEC ID ( 4) | |
| 1483 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1484 | ||
| 1485 | NUMBER: 22 95 BILL FO RM: IB 837 TRANSMISS ION | |
| 1486 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 104.61 | |
| 1487 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1488 | STARTING C OLUMN OR P IECE: 99.5 SHORT DESC RIPTION: O PRC Cleanu p | |
| 1489 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1490 | ||
| 1491 | NUMBER: 22 96 BILL FO RM: IB 837 TRANSMISS ION | |
| 1492 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1493 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1494 | STARTING C OLUMN OR P IECE: 1 LE NGTH: 4 | |
| 1495 | SHORT DESC RIPTION: R ECORD ID ' OP10' TRA NSMIT IGNO RES IF NUL L: TRUE | |
| 1496 | DATA REQUI RED FOR FI ELD: NO | |
| 1497 | ||
| 1498 | NUMBER: 22 97 BILL FO RM: IB 837 TRANSMISS ION | |
| 1499 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1500 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1501 | STARTING C OLUMN OR P IECE: 1.5S HORT DESCR IPTION: OP 10 Setup | |
| 1502 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1503 | ||
| 1504 | NUMBER: 22 98 BILL F ORM: IB 83 7 TRANSMIS SION | |
| 1505 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1506 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1507 | STARTING C OLUMN OR P IECE: 2 LE NGTH: 1 | |
| 1508 | SHORT DESC RIPTION: P AYER RESPO NSIBILITY SEQ # CODE | |
| 1509 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1510 | ||
| 1511 | NUMBER: 22 99BILL FOR M: IB 837 TRANSMISSI ON | |
| 1512 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE OR SEQUENCE: 178.1 | |
| 1513 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1514 | STARTING C OLUMN OR P IECE: 3LEN GTH: 3 | |
| 1515 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON ENTITY ID | |
| 1516 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1517 | ||
| 1518 | NUMBER: 23 00BILL FOR M: IB 837 TRANSMISSI ON | |
| 1519 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1520 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1521 | STARTING C OLUMN OR P IECE: 4LEN GTH: 1 | |
| 1522 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON ENTITY QUAL | |
| 1523 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1524 | ||
| 1525 | NUMBER: 23 01BILL FOR M: IB 837 TRANSMISSI ON | |
| 1526 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1527 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1528 | STARTING C OLUMN OR P IECE: 5LEN GTH: 3 | |
| 1529 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID QUAL(1) | |
| 1530 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1531 | ||
| 1532 | NUMBER: 23 02BILL FOR M: IB 837 TRANSMISSI ON | |
| 1533 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1534 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1535 | STARTING C OLUMN OR P IECE: 6 LE NGTH: 50 | |
| 1536 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID (1) | |
| 1537 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1538 | ||
| 1539 | NUMBER: 23 03 BILL FO RM: IB 837 TRANSMISS ION | |
| 1540 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1541 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1542 | STARTING C OLUMN OR P IECE: 7 LE NGTH: 3 | |
| 1543 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID QUAL(2) | |
| 1544 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1545 | ||
| 1546 | NUMBER: 23 04BILL FOR M: IB 837 TRANSMISSI ON | |
| 1547 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1548 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1549 | STARTING C OLUMN OR P IECE: 8 LE NGTH: 50 | |
| 1550 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID (2) | |
| 1551 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1552 | ||
| 1553 | NUMBER: 23 05 BILL FO RM: IB 837 TRANSMISS ION | |
| 1554 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1555 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1556 | STARTING C OLUMN OR P IECE: 9LEN GTH: 3 | |
| 1557 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID QUAL(3) | |
| 1558 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1559 | ||
| 1560 | NUMBER: 23 06 BILL FO RM: IB 837 TRANSMISS ION | |
| 1561 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1562 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1563 | STARTING C OLUMN OR P IECE: 10 LENGTH: 50 | |
| 1564 | SHORT DESC RIPTION: O THER PAYER ASST SURG EON SEC ID (3) | |
| 1565 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1566 | ||
| 1567 | NUMBER: 23 07BILL FOR M: IB 837 TRANSMISSI ON | |
| 1568 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 178.1 | |
| 1569 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1570 | STARTING C OLUMN OR P IECE: 99.5 SHORT DESC RIPTION: O P10 Cleanu p | |
| 1571 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1572 | ||
| 1573 | NUMBER: 23 08BILL FOR M: IB 837 TRANSMISSI ON | |
| 1574 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1575 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1576 | STARTING C OLUMN OR P IECE: 1 LENGTH: 4 | |
| 1577 | SHORT DESC RIPTION: R ECORD ID ' DEN 'TRANS MIT IGNORE S IF NULL: TRUE | |
| 1578 | DATA REQUI RED FOR FI ELD: YES | |
| 1579 | ||
| 1580 | NUMBER: 23 09BILL FOR M: IB 837 TRANSMISSI ON | |
| 1581 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1582 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1583 | STARTING C OLUMN OR P IECE: 2LEN GTH: 6 | |
| 1584 | SHORT DESC RIPTION: S ERVICE LIN E #TRANSMI T IGNORES IF NULL: T RUE | |
| 1585 | DATA REQUI RED FOR FI ELD: NO | |
| 1586 | ||
| 1587 | NUMBER: 23 10BILL FOR M: IB 837 TRANSMISSI ON | |
| 1588 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1589 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1590 | STARTING C OLUMN OR P IECE: 3 L ENGTH: 3 | |
| 1591 | SHORT DESC RIPTION: D ATE/TIME Q UALIFIER | |
| 1592 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1593 | ||
| 1594 | NUMBER: 23 11BILL FOR M: IB 837 TRANSMISSI ON | |
| 1595 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1596 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1597 | STARTING C OLUMN OR P IECE: 4 LE NGTH: 35 | |
| 1598 | SHORT DESC RIPTION: S ERVICE DAT ETRANSMIT IGNORES IF NULL: TRU E | |
| 1599 | DATA REQUI RED FOR FI ELD: NO | |
| 1600 | ||
| 1601 | NUMBER: 23 12 BILL FO RM: IB 837 TRANSMISS ION | |
| 1602 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1603 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1604 | STARTING C OLUMN OR P IECE: 5LEN GTH: 2 | |
| 1605 | SHORT DESC RIPTION: S ERVICE ID QUALIFIER | |
| 1606 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1607 | ||
| 1608 | NUMBER: 23 13BILL FOR M: IB 837 TRANSMISSI ON | |
| 1609 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1610 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1611 | STARTING C OLUMN OR P IECE: 6LEN GTH: 48 | |
| 1612 | SHORT DESC RIPTION: P ROCEDURE C ODETRANSMI T IGNORES IF NULL: T RUE | |
| 1613 | DATA REQUI RED FOR FI ELD: NO | |
| 1614 | ||
| 1615 | NUMBER: 23 14BILL FOR M: IB 837 TRANSMISSI ON | |
| 1616 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1617 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1618 | STARTING C OLUMN OR P IECE: 7LEN GTH: 2 | |
| 1619 | SHORT DESC RIPTION: P ROCEDURE M ODIFIER(1) | |
| 1620 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1621 | ||
| 1622 | NUMBER: 23 15 BILL FO RM: IB 837 TRANSMISS ION | |
| 1623 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1624 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1625 | STARTING C OLUMN OR P IECE: 8LEN GTH: 2 | |
| 1626 | SHORT DESC RIPTION: P ROCEDURE M ODIFIER(2) | |
| 1627 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1628 | ||
| 1629 | NUMBER: 23 16BILL FOR M: IB 837 TRANSMISSI ON | |
| 1630 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1631 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1632 | STARTING C OLUMN OR P IECE: 9LEN GTH: 2 | |
| 1633 | SHORT DESC RIPTION: P ROCEDURE M ODIFIER(3) | |
| 1634 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1635 | ||
| 1636 | NUMBER: 23 17BILL FOR M: IB 837 TRANSMISSI ON | |
| 1637 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1638 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1639 | STARTING C OLUMN OR P IECE: 10LE NGTH: 2 | |
| 1640 | SHORT DESC RIPTION: P ROCEDURE M ODIFIER(4) | |
| 1641 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1642 | ||
| 1643 | NUMBER: 23 18 BILL FO RM: IB 837 TRANSMISS ION | |
| 1644 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1645 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1646 | STARTING C OLUMN OR P IECE: 11LE NGTH: 80 | |
| 1647 | SHORT DESC RIPTION: P ROCEDURE C ODE DESCRI PTION | |
| 1648 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1649 | ||
| 1650 | NUMBER: 23 19 BILL FORM: IB 837 TR ANSMISSION | |
| 1651 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1652 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1653 | STARTING C OLUMN OR P IECE: 12LE NGTH: 18 | |
| 1654 | SHORT DESC RIPTION: L INE ITEM C HARGE AMT | |
| 1655 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1656 | ||
| 1657 | NUMBER: 23 20BILL FOR M: IB 837 TRANSMISSI ON | |
| 1658 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1659 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1660 | STARTING C OLUMN OR P IECE: 13LE NGTH: 2 | |
| 1661 | SHORT DESC RIPTION: P LACE OF SE RVICE CODE | |
| 1662 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1663 | ||
| 1664 | NUMBER: 23 21BILL FOR M: IB 837 TRANSMISSI ON | |
| 1665 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1666 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1667 | STARTING C OLUMN OR P IECE: 14LE NGTH: 3 | |
| 1668 | SHORT DESC RIPTION: O RAL CAVITY DESIGNATI ON(1) | |
| 1669 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1670 | ||
| 1671 | NUMBER: 23 22BILL FOR M: IB 837 TRANSMISSI ON | |
| 1672 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1673 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1674 | STARTING C OLUMN OR P IECE: 15LE NGTH: 3 | |
| 1675 | SHORT DESC RIPTION: O RAL CAVITY DESIGNATI ON(2) | |
| 1676 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1677 | ||
| 1678 | NUMBER: 23 23BILL FOR M: IB 837 TRANSMISSI ON | |
| 1679 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1680 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1681 | STARTING C OLUMN OR P IECE: 16LE NGTH: 3 | |
| 1682 | SHORT DESC RIPTION: O RAL CAVITY DESIGNATI ON(3) | |
| 1683 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1684 | ||
| 1685 | NUMBER: 23 24BILL FOR M: IB 837 TRANSMISSI ON | |
| 1686 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1687 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1688 | STARTING C OLUMN OR P IECE: 17LE NGTH: 3 | |
| 1689 | SHORT DESC RIPTION: O RAL CAVITY DESIGNATI ON(4) | |
| 1690 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1691 | ||
| 1692 | NUMBER: 23 25BILL FOR M: IB 837 TRANSMISSI ON | |
| 1693 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1694 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1695 | STARTING C OLUMN OR P IECE: 18LE NGTH: 3 | |
| 1696 | SHORT DESC RIPTION: O RAL CAVITY DESIGNATI ON(5) | |
| 1697 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1698 | ||
| 1699 | NUMBER: 23 26BILL FOR M: IB 837 TRANSMISSI ON | |
| 1700 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186 | |
| 1701 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1702 | STARTING C OLUMN OR P IECE: 19LE NGTH: 1 | |
| 1703 | SHORT DESC RIPTION: P ROSTHESIS CROWN INLA Y CODE | |
| 1704 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1705 | ||
| 1706 | NUMBER: 23 27BILL FOR M: IB 837 TRANSMISSI ON | |
| 1707 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1708 | FIRST LINE NUMBER: 1 LOCAL O VERRIDE AL LOWED: NO | |
| 1709 | STARTING C OLUMN OR P IECE: 1LEN GTH: 4 | |
| 1710 | SHORT DESC RIPTION: R ECORD ID ' DEN1'TRANS MIT IGNORE S IF NULL: TRUE | |
| 1711 | DATA REQUI RED FOR FI ELD: YES | |
| 1712 | ||
| 1713 | NUMBER: 23 28 BILL FO RM: IB 837 TRANSMISS ION | |
| 1714 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1715 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1716 | STARTING C OLUMN OR P IECE: 2LEN GTH: 6 | |
| 1717 | SHORT DESC RIPTION: S ERVICE LIN E #TRANSMI T IGNORES IF NULL: T RUE | |
| 1718 | DATA REQUI RED FOR FI ELD: NO | |
| 1719 | ||
| 1720 | NUMBER: 23 29 BILL FO RM: IB 837 TRANSMISS ION | |
| 1721 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1722 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1723 | STARTING C OLUMN OR P IECE: 3 LE NGTH: 15 | |
| 1724 | SHORT DESC RIPTION: P ROCEDURE C OUNTTRANSM IT IGNORES IF NULL: TRUE | |
| 1725 | DATA REQUI RED FOR FI ELD: NO | |
| 1726 | ||
| 1727 | NUMBER: 23 30 BILL FO RM: IB 837 TRANSMISS ION | |
| 1728 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1729 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1730 | STARTING C OLUMN OR P IECE: 4 LE NGTH: 2 | |
| 1731 | SHORT DESC RIPTION: D IAGNOSIS C ODE POINTE R(1) | |
| 1732 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1733 | ||
| 1734 | NUMBER: 23 31BILL FOR M: IB 837 TRANSMISSI ON | |
| 1735 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE OR SEQUENCE: 186.1 | |
| 1736 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1737 | STARTING C OLUMN OR P IECE: 5 LE NGTH: 2 | |
| 1738 | SHORT DESC RIPTION: D IAGNOSIS C ODE POINTE R(2) | |
| 1739 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1740 | ||
| 1741 | NUMBER: 23 32BILL FOR M: IB 837 TRANSMISSI ON | |
| 1742 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1743 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1744 | STARTING C OLUMN OR P IECE: 6 LE NGTH: 2 | |
| 1745 | SHORT DESC RIPTION: D IAGNOSIS C ODE POINTE R(3) | |
| 1746 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1747 | ||
| 1748 | NUMBER: 23 33BILL FOR M: IB 837 TRANSMISSI ON | |
| 1749 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1750 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1751 | STARTING C OLUMN OR P IECE: 7LEN GTH: 2 | |
| 1752 | SHORT DESC RIPTION: D IAGNOSIS C ODE POINTE R(4) | |
| 1753 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1754 | ||
| 1755 | NUMBER: 23 34BILL FOR M: IB 837 TRANSMISSI ON | |
| 1756 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1757 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1758 | STARTING C OLUMN OR P IECE: 8 LE NGTH: 3 | |
| 1759 | SHORT DESC RIPTION: P RIOR PLACE MENT DATE QUALIFIER | |
| 1760 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1761 | ||
| 1762 | NUMBER: 23 35BILL FOR M: IB 837 TRANSMISSI ON | |
| 1763 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1764 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1765 | STARTING C OLUMN OR P IECE: 9 LE NGTH: 35 | |
| 1766 | SHORT DESC RIPTION: P RIOR PLACE MENT DATE | |
| 1767 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1768 | ||
| 1769 | NUMBER: 23 36BILL FOR M: IB 837 TRANSMISSI ON | |
| 1770 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1771 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1772 | STARTING C OLUMN OR P IECE: 10LE NGTH: 3 | |
| 1773 | SHORT DESC RIPTION: O RTHO BANDI NG DATE QU ALIFIER | |
| 1774 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1775 | ||
| 1776 | NUMBER: 23 37 BILL FO RM: IB 837 TRANSMISS ION | |
| 1777 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1778 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1779 | STARTING C OLUMN OR P IECE: 11 L ENGTH: 35 | |
| 1780 | SHORT DESC RIPTION: O RTHO BANDI NG DATE | |
| 1781 | TRANSMIT I GNORES IF NULL: TRUE DATA REQ UIRED FOR FIELD: NO | |
| 1782 | ||
| 1783 | NUMBER: 23 38 BILL FO RM: IB 837 TRANSMISS ION | |
| 1784 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1785 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1786 | STARTING C OLUMN OR P IECE: 12LE NGTH: 3 | |
| 1787 | SHORT DESC RIPTION: R EPLACEMENT DATE QUAL IFIER | |
| 1788 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1789 | ||
| 1790 | NUMBER: 23 39BILL FOR M: IB 837 TRANSMISSI ON | |
| 1791 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1792 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1793 | STARTING C OLUMN OR P IECE: 13LE NGTH: 35 | |
| 1794 | SHORT DESC RIPTION: R EPLACEMENT DATE TR ANSMIT IGN ORES IF NU LL: TRUE | |
| 1795 | DATA REQUI RED FOR FI ELD: NO | |
| 1796 | ||
| 1797 | NUMBER: 23 40 BILL FO RM: IB 837 TRANSMISS ION | |
| 1798 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1799 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1800 | STARTING C OLUMN OR P IECE: 14 L ENGTH: 3 | |
| 1801 | SHORT DESC RIPTION: T REATMENT S TART DATE QUALIFIER | |
| 1802 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1803 | ||
| 1804 | NUMBER: 23 41BILL FOR M: IB 837 TRANSMISSI ON | |
| 1805 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1806 | FIRST LINE NUMBER: 1 LOCAL OV ERRIDE ALL OWED: NO | |
| 1807 | STARTING C OLUMN OR P IECE: 15 L ENGTH: 35 | |
| 1808 | SHORT DESC RIPTION: T REATMENT S TART DATE | |
| 1809 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1810 | ||
| 1811 | NUMBER: 23 42 BILL FO RM: IB 837 TRANSMISS ION | |
| 1812 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1813 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1814 | STARTING C OLUMN OR P IECE: 16 LENGTH: 3 | |
| 1815 | SHORT DESC RIPTION: T REATMENT C OMPLETION DATE QUALI FIER | |
| 1816 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1817 | ||
| 1818 | NUMBER: 23 43BILL FOR M: IB 837 TRANSMISSI ON | |
| 1819 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.1 | |
| 1820 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1821 | STARTING C OLUMN OR P IECE: 17 L ENGTH: 35 | |
| 1822 | SHORT DESC RIPTION: T REATMENT C OMPLETION DATE | |
| 1823 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1824 | ||
| 1825 | NUMBER: 23 44BILL FOR M: IB 837 TRANSMISSI ON | |
| 1826 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1827 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1828 | STARTING C OLUMN OR P IECE: 1LEN GTH: 4 | |
| 1829 | SHORT DESC RIPTION: R ECORD ID ' DEN2'TRANS MIT IGNORE S IF NULL: TRUE | |
| 1830 | DATA REQUI RED FOR FI ELD: YES | |
| 1831 | ||
| 1832 | NUMBER: 23 45BILL FOR M: IB 837 TRANSMISSI ON | |
| 1833 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1834 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1835 | STARTING C OLUMN OR P IECE: 2 LE NGTH: 6 | |
| 1836 | SHORT DESC RIPTION: S ERVICE LIN E # TRANSM IT IGNORES IF NULL: TRUE | |
| 1837 | DATA REQUI RED FOR FI ELD: NO | |
| 1838 | ||
| 1839 | NUMBER: 23 46BILL FOR M: IB 837 TRANSMISSI ON | |
| 1840 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1841 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1842 | STARTING C OLUMN OR P IECE: 3LEN GTH: 3 | |
| 1843 | SHORT DESC RIPTION: T OOTH CODE QUALIFIER | |
| 1844 | TRANSMIT I GNORES IF NULL: TRUE DATA REQU IRED FOR F IELD: NO | |
| 1845 | ||
| 1846 | NUMBER: 23 47BILL FOR M: IB 837 TRANSMISSI ON | |
| 1847 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1848 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1849 | STARTING C OLUMN OR P IECE: 4 LE NGTH: 30 | |
| 1850 | SHORT DESC RIPTION: T OOTH CODET RANSMIT IG NORES IF N ULL: TRUE | |
| 1851 | DATA REQUI RED FOR FI ELD: NO | |
| 1852 | ||
| 1853 | NUMBER: 23 48BILL FOR M: IB 837 TRANSMISSI ON | |
| 1854 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1855 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1856 | STARTING C OLUMN OR P IECE: 5LEN GTH: 2 | |
| 1857 | SHORT DESC RIPTION: T OOTH SURFA CE(1)TRANS MIT IGNORE S IF NULL: TRUE | |
| 1858 | DATA REQUI RED FOR FI ELD: NO | |
| 1859 | ||
| 1860 | NUMBER: 23 49BILL FOR M: IB 837 TRANSMISSI ON | |
| 1861 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1862 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1863 | STARTING C OLUMN OR P IECE: 6LEN GTH: 2 | |
| 1864 | SHORT DESC RIPTION: T OOTH SURFA CE(2)TRANS MIT IGNORE S IF NULL: TRUE | |
| 1865 | DATA REQUI RED FOR FI ELD: NO | |
| 1866 | ||
| 1867 | NUMBER: 23 50BILL FOR M: IB 837 TRANSMISSI ON | |
| 1868 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1869 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1870 | STARTING C OLUMN OR P IECE: 7LEN GTH: 2 | |
| 1871 | SHORT DESC RIPTION: T OOTH SURFA CE(3)TRANS MIT IGNORE S IF NULL: TRUE | |
| 1872 | DATA REQUI RED FOR FI ELD: NO | |
| 1873 | ||
| 1874 | NUMBER: 23 51BILL FOR M: IB 837 TRANSMISSI ON | |
| 1875 | SECURITY L EVEL: NATI ONAL,NO ED IT PAGE OR SEQUENCE: 186.2 | |
| 1876 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1877 | STARTING C OLUMN OR P IECE: 8LEN GTH: 2 | |
| 1878 | SHORT DESC RIPTION: T OOTH SURFA CE(4)TRANS MIT IGNORE S IF NULL: TRUE | |
| 1879 | DATA REQUI RED FOR FI ELD: NO | |
| 1880 | ||
| 1881 | NUMBER: 23 52BILL FOR M: IB 837 TRANSMISSI ON | |
| 1882 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 186.2 | |
| 1883 | FIRST LINE NUMBER: 1 LOCAL OVE RRIDE ALLO WED: NO | |
| 1884 | STARTING C OLUMN OR P IECE: 9 L ENGTH: 2 | |
| 1885 | SHORT DESC RIPTION: T OOTH SURFA CE(5)TRANS MIT IGNORE S IF NULL: TRUE | |
| 1886 | DATA REQUI RED FOR FI ELD: NO | |
| 1887 | ||
| 1888 | NUMBER: 23 53BILL FOR M: IB 837 TRANSMISSI ON | |
| 1889 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1890 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1891 | STARTING C OLUMN OR P IECE: 1LEN GTH: 4 | |
| 1892 | SHORT DESC RIPTION: N -RECORD 'L SUR'TRANSM IT IGNORES IF NULL: TRUE | |
| 1893 | DATA REQUI RED FOR FI ELD: NO | |
| 1894 | ||
| 1895 | NUMBER: 23 70BILL FOR M: IB 837 TRANSMISSI ON | |
| 1896 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1897 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1898 | STARTING C OLUMN OR P IECE: 1.9 | |
| 1899 | SHORT DESC RIPTION: L SUR DATA E XTRACT | |
| 1900 | CALCULATE ONLY OR OU TPUT: CALC ULATE ONLY | |
| 1901 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1902 | ||
| 1903 | NUMBER: 23 54BILL FOR M: IB 837 TRANSMISSI ON | |
| 1904 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1905 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1906 | STARTING C OLUMN OR P IECE: 2LEN GTH: 6 | |
| 1907 | SHORT DESC RIPTION: S ERVICE LIN E COUNTER | |
| 1908 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1909 | ||
| 1910 | NUMBER: 23 55BILL FOR M: IB 837 TRANSMISSI ON | |
| 1911 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1912 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1913 | STARTING C OLUMN OR P IECE: 3LEN GTH: 3 | |
| 1914 | SHORT DESC RIPTION: A SST SURGEO N QUALIFIE R | |
| 1915 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1916 | ||
| 1917 | NUMBER: 23 56BILL FOR M: IB 837 TRANSMISSI ON | |
| 1918 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1919 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1920 | STARTING C OLUMN OR P IECE: 4LEN GTH: 60 | |
| 1921 | SHORT DESC RIPTION: A SST SURGEO N LAST NAM E | |
| 1922 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1923 | ||
| 1924 | NUMBER: 23 57BILL FOR M: IB 837 TRANSMISSI ON | |
| 1925 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1926 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1927 | STARTING C OLUMN OR P IECE: 5LEN GTH: 35 | |
| 1928 | SHORT DESC RIPTION: A SST SURGEO N FIRST NA ME | |
| 1929 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1930 | ||
| 1931 | NUMBER: 23 58BILL FOR M: IB 837 TRANSMISSI ON | |
| 1932 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1933 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1934 | STARTING C OLUMN OR P IECE: 6LEN GTH: 25 | |
| 1935 | SHORT DESC RIPTION: A SST SURGEO N MIDDLE N AME | |
| 1936 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1937 | ||
| 1938 | NUMBER: 23 59BILL FOR M: IB 837 TRANSMISSI ON | |
| 1939 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1940 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1941 | STARTING C OLUMN OR P IECE: 7LEN GTH: 10 | |
| 1942 | SHORT DESC RIPTION: A SST SURGEO N NAME SUF FIX | |
| 1943 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1944 | ||
| 1945 | NUMBER: 23 60BILL FOR M: IB 837 TRANSMISSI ON | |
| 1946 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1947 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1948 | STARTING C OLUMN OR P IECE: 8LEN GTH: 2 | |
| 1949 | SHORT DESC RIPTION: A SST SURGEO N PRIMARY ID QUALIFI ER | |
| 1950 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1951 | ||
| 1952 | NUMBER: 23 61BILL FOR M: IB 837 TRANSMISSI ON | |
| 1953 | SECURITY L EVEL: NATI ONAL,NO ED ITPAGE OR SEQUENCE: 194.5 | |
| 1954 | FIRST LINE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1955 | STARTING C OLUMN OR P IECE: 9LEN GTH: 10 | |
| 1956 | SHORT DESC RIPTION: A SST SURGEO N PRIMARY ID | |
| 1957 | TRANSMIT I GNORES IF NULL: TRUE DATA REQUI RED FOR FI ELD: NO | |
| 1958 | ||
| 1959 | NUMBER: 23 72 BILL FORM: IB 837 TR ANSMISSION | |
| 1960 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1961 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1962 | STARTING COLUMN OR PIECE: 1 LENGTH: 5 | |
| 1963 | SHORT DE SCRIPTION: RECORD ID 'LSUR1'TR ANSMIT IGN ORES IF NU LL: TRUE | |
| 1964 | DATA REQ UIRED FOR FIELD: NO | |
| 1965 | ||
| 1966 | NUMBER: 23 73 BILL FORM: IB 837 TR ANSMISSION | |
| 1967 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1968 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1969 | STARTING COLUMN OR PIECE: 1. 9 | |
| 1970 | SHORT DESC RIPTION: L SUR1 DATA EXTRACT | |
| 1971 | CALCULAT E ONLY OR OUTPUT: CA LCULATE ON LY | |
| 1972 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 1973 | ||
| 1974 | NUMBER: 23 74 BILL FORM: IB 837 TR ANSMISSION | |
| 1975 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1976 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1977 | STARTING COLUMN OR PIECE: 2 LENGTH: 6 | |
| 1978 | SHORT DE SCRIPTION: SERVICE L INE COUNTE R | |
| 1979 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 1980 | ||
| 1981 | NUMBER: 23 75 BILL FORM: IB 837 TR ANSMISSION | |
| 1982 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1983 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1984 | STARTING COLUMN OR PIECE: 3 LENGTH: 3 | |
| 1985 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID QUA LIFIER(1) | |
| 1986 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 1987 | ||
| 1988 | NUMBER: 23 76 BILL FORM: IB 837 TR ANSMISSION | |
| 1989 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1990 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1991 | STARTING COLUMN OR PIECE: 4 LENGTH: 15 | |
| 1992 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID(1) | |
| 1993 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 1994 | ||
| 1995 | NUMBER: 23 77 BILL FORM: IB 837 TR ANSMISSION | |
| 1996 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 1997 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 1998 | STARTING COLUMN OR PIECE: 5 LENGTH: 3 | |
| 1999 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID QUA LIFIER(2) | |
| 2000 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2001 | ||
| 2002 | NUMBER: 23 78 BILL FORM: IB 837 TR ANSMISSION | |
| 2003 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 2004 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 2005 | STARTING COLUMN OR PIECE: 6 LENGTH: 15 | |
| 2006 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID(2) | |
| 2007 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2008 | ||
| 2009 | NUMBER: 23 79 BILL FORM: IB 837 TR ANSMISSION | |
| 2010 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 2011 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 2012 | STARTING COLUMN OR PIECE: 7 LENGTH: 3 | |
| 2013 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID QUA LIFIER(3) | |
| 2014 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2015 | ||
| 2016 | NUMBER: 23 80 BILL FORM: IB 837 TR ANSMISSION | |
| 2017 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 2018 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 2019 | STARTING COLUMN OR PIECE: 8 LENGTH: 15 | |
| 2020 | SHORT DE SCRIPTION: ASST SURG EON SECOND ARY ID(3) | |
| 2021 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2022 | ||
| 2023 | NUMBER: 23 81 BILL FORM: IB 837 TR ANSMISSION | |
| 2024 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 2025 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 2026 | STARTING COLUMN OR PIECE: 9 LENGTH: 2 | |
| 2027 | SHORT DE SCRIPTION: ASST SURG EON TAXONO MY QUALIFI ER | |
| 2028 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2029 | ||
| 2030 | NUMBER: 23 82 BILL FORM: IB 837 TR ANSMISSION | |
| 2031 | SECURITY LEVEL: NA TIONAL,NO EDIT PAGE OR SE QUENCE: 19 4.6 | |
| 2032 | FIRST LI NE NUMBER: 1 LOCAL OVER RIDE ALLOW ED: NO | |
| 2033 | STARTING COLUMN OR PIECE: 10 LENGTH: 10 | |
| 2034 | SHORT DE SCRIPTION: ASST SURG EON TAXONO MY CODE | |
| 2035 | TRANSMIT IGNORES I F NULL: TR UE DATA REQUI RED FOR FI ELD: NO | |
| 2036 | ||
| 2037 | ||
| 2038 | ||
| 2039 | The follow ing are ad ditional e ntries to file 364.7 IB FORM F IELD CONTE NT. These entries a re used by the VistA Output Fo rmatter wh en generat ing the 83 7D transac tion. | |
| 2040 | ||
| 2041 | NUMBER: 14 25 | |
| 2042 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2043 | SECURITY L EVEL: NATI ONAL,NO ED IT DA TA ELEMENT : N-RECORD ID | |
| 2044 | PAD CHARAC TER: NO PA D REQUIRED FORMAT COD E: S IBXDA TA="DN1 " | |
| 2045 | FORMAT COD E DESCRIPT ION: Out put RECORD ID for DN 1 record. | |
| 2046 | ||
| 2047 | NUMBER: 14 26 | |
| 2048 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2049 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2050 | DATA ELEME NT: N-ORTH O BANDING QUALIFIER | |
| 2051 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$P($ G(^DGCR(39 9,IBXIEN," DEN")),U | |
| 2052 | )'="" S ID XDATA=452 | |
| 2053 | FORMAT COD E DESCRIPT ION: Ort hodontic B anding Qua lifier alw ays will b e 452. | |
| 2054 | ||
| 2055 | NUMBER: 14 60 | |
| 2056 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2057 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2058 | DATA ELEME NT: N-ORTH O BANDING DATE | |
| 2059 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2060 | FORMAT COD E: S:$$FT^ IBCEF(IBXI EN)'=7 IBX DATA="" I $$FT^IBCEF (IBXIEN)=7 S IBXDA | |
| 2061 | TA=$$DT^IB CEFG1(IBXD ATA,"","D8 ") | |
| 2062 | FORMAT COD E DESCRIPT ION: For mat date i s CCYYMMDD | |
| 2063 | ||
| 2064 | NUMBER: 14 61 | |
| 2065 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2066 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2067 | DATA ELEME NT: N-ORTH O TX MTHS COUNT | |
| 2068 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2069 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)'=7 K I BXDATA | |
| 2070 | FORMAT COD E DESCRIPT ION: Ort ho Treatme nt Months count for Dental Cla im | |
| 2071 | ||
| 2072 | NUMBER: 14 62 | |
| 2073 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2074 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2075 | DATA ELEME NT: N-ORTH O TX MTHS COUNT TRAN SFER | |
| 2076 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2077 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)'=7 K I BXDATA | |
| 2078 | FORMAT COD E DESCRIPT ION: Ort ho Treatme nt months remaining for a tran sfer | |
| 2079 | patient. | |
| 2080 | ||
| 2081 | NUMBER: 14 63 | |
| 2082 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2083 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2084 | DATA ELEME NT: N-ORTH O TX INDIC ATOR | |
| 2085 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2086 | FORMAT CO DE: I $$FT ^IBCEF(IBX IEN)=7 D T RANS^IBCEF 12 | |
| 2087 | ||
| 2088 | NUMBER: 14 64 | |
| 2089 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2090 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2091 | DATA ELEME NT: N-RECO RD ID | |
| 2092 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2093 | FORMAT COD E: S IBXDA TA="DN2 " | |
| 2094 | FORMAT COD E DESCRIPT ION: Out put the re cord id fo r 'DN2' re cord. | |
| 2095 | ||
| 2096 | NUMBER: 14 65 | |
| 2097 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2098 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2099 | DATA ELEME NT: N-TOOT H NUMBER | |
| 2100 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2101 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(^TMP ("IBXSAV | |
| 2102 | E",$J,"TO" ,IBXIEN,Z) ) Q:'Z S Z1=^(Z),IB XSAVE("OUT PT",Z)=Z1, IBXDATA(Z) =$P(Z1,U) | |
| 2103 | I Z>1 D ID ^IBCEF2(Z, "DN2 ") | |
| 2104 | FORMAT COD E DESCRIPT ION: Too th number of treatme nt | |
| 2105 | ||
| 2106 | NUMBER: 14 66 | |
| 2107 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2108 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2109 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2110 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2111 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2112 | PT",Z)) Q: 'Z S IBXD ATA(Z)=$P( IBXSAVE("O UTPT",Z),U ,2) | |
| 2113 | FORMAT COD E DESCRIPT ION: Too th Status code, eith er E (to b e extracte d) or M | |
| 2114 | (Missing) | |
| 2115 | ||
| 2116 | NUMBER: 14 67 | |
| 2117 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2118 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2119 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2120 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2121 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2122 | PT",Z)) Q: 'Z S IBXD ATA(Z)=$P( IBXSAVE("O UTPT",Z),U ,3) | |
| 2123 | FORMAT COD E DESCRIPT ION: Cod e List Qua lifier Cod e - will a lways be J P for | |
| 2124 | Dental cl aim. | |
| 2125 | ||
| 2126 | NUMBER: 14 68 | |
| 2127 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2128 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2129 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2130 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2131 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$G(I BXSAVE("PR OVINF",IBX IEN,"C", | |
| 2132 | 1,1,"TAXON OMY"))'="" S IBXDATA ="RF" | |
| 2133 | FORMAT COD E DESCRIPT ION: Cod e identifi ng the typ e of provi der. For Dental, | |
| 2134 | always RF for Refer ring. | |
| 2135 | ||
| 2136 | NUMBER: 14 69 | |
| 2137 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2138 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2139 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2140 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2141 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$G(I BXSAVE("PR OVINF",IBX IEN,"C", | |
| 2142 | 1,1,"TAXON OMY"))'="" S IBXDATA ="PXC" | |
| 2143 | FORMAT COD E DESCRIPT ION: Cod e qualifin g the Refe rence Iden tification . For | |
| 2144 | Dental, i t will alw ays be PXC for Taxon omy Code. | |
| 2145 | ||
| 2146 | NUMBER: 14 70 | |
| 2147 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2148 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2149 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2150 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2151 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$G(I BXSAVE("PR OVINF",I | |
| 2152 | BXIEN,"C", 1,1,"TAXON OMY")) | |
| 2153 | FORMAT COD E DESCRIPT ION: Ref erence inf ormation a s specifie d by the R eference | |
| 2154 | Identific ation Qual ifier. Fo r Dental, this will be the Tax onomy Code . | |
| 2155 | ||
| 2156 | NUMBER: 14 71 | |
| 2157 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2158 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2159 | DATA ELEME NT: N-RECO RD ID | |
| 2160 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2161 | FORMAT COD E: S IBXDA TA="OPRB" | |
| 2162 | ||
| 2163 | NUMBER: 14 72 | |
| 2164 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2165 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2166 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2167 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2168 | FORMAT COD E: D CLEAN UP^IBCEFP1 (.IBXSAVE) ,ALLIDS^IB CEFP(IBXIE N,.IBXSAVE ,1) | |
| 2169 | FORMAT COD E DESCRIPT ION: Set up IBXSAVE array for OPRB reco rd. | |
| 2170 | ||
| 2171 | NUMBER: 14 73 | |
| 2172 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2173 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2174 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2175 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2176 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$D(I BXSAVE("PR OVINF",IBX IEN,"C", | |
| 2177 | 1,6,"NAME" )) S IBXDA TA="DD" | |
| 2178 | ||
| 2179 | NUMBER: 14 74 | |
| 2180 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2181 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2182 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2183 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2184 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$D(I BXSAVE("PR OVINF",IBX IEN,"C", | |
| 2185 | 1,6,"NAME" )) S IBXDA TA=1 | |
| 2186 | ||
| 2187 | NUMBER: 14 75 | |
| 2188 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2189 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2190 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2191 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2192 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2193 | ",IBXIEN," C",1,6,"NA ME")),U) | |
| 2194 | ||
| 2195 | NUMBER: 14 76 | |
| 2196 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2197 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2198 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2199 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2200 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2201 | ",IBXIEN," C",1,6,"NA ME")),U,2) | |
| 2202 | ||
| 2203 | NUMBER: 14 77 | |
| 2204 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2205 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2206 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2207 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2208 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2209 | ",IBXIEN," C",1,6,"NA ME")),U,3) | |
| 2210 | ||
| 2211 | NUMBER: 14 78 | |
| 2212 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2213 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2214 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2215 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2216 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2217 | ",IBXIEN," C",1,6,"NA ME")),U,5) | |
| 2218 | ||
| 2219 | NUMBER: 14 79 | |
| 2220 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2221 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2222 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2223 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2224 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2225 | ",IBXIEN," C",1,6,0)) ,U,3) | |
| 2226 | ||
| 2227 | NUMBER: 14 80 | |
| 2228 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2229 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2230 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2231 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2232 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF | |
| 2233 | ",IBXIEN," C",1,6,0)) ,U,4) | |
| 2234 | ||
| 2235 | NUMBER: 14 81 | |
| 2236 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2237 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2238 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2239 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2240 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7,$G(I BXSAVE("PR OVINF",IBX IEN,"C", | |
| 2241 | 1,6,"TAXON OMY"))'="" S IBXDATA ="AS" | |
| 2242 | ||
| 2243 | NUMBER: 14 82 | |
| 2244 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2245 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2246 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2247 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2248 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$G(I BXSAVE("PR OVINF",I | |
| 2249 | BXIEN,"C", 1,6,"TAXON OMY")) | |
| 2250 | ||
| 2251 | NUMBER: 14 83 | |
| 2252 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2253 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2254 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2255 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2256 | FORMAT COD E: D CLEAN UP^IBCEFP1 (.IBXSAVE) | |
| 2257 | ||
| 2258 | NUMBER: 14 84 | |
| 2259 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2260 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2261 | DATA ELEME NT: N-RECO RD ID | |
| 2262 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2263 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA="OPR C" | |
| 2264 | ||
| 2265 | NUMBER: 14 85 | |
| 2266 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2267 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2268 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2269 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2270 | FORMAT COD E: D CLEAN UP^IBCEFP1 (.IBXSAVE) ,ALLIDS^IB CEFP(IBXIE N,.IBXSAVE ,1) | |
| 2271 | FORMAT COD E DESCRIPT ION: Set up IBXSAV E array fo r OPRC rec ord. | |
| 2272 | ||
| 2273 | NUMBER: 14 86 | |
| 2274 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2275 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2276 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2277 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2278 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF", IBXIEN,"C" ,1,6,1)),U ,3) | |
| 2279 | ||
| 2280 | NUMBER: 14 87 | |
| 2281 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2282 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2283 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2284 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2285 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$$NO PUNCT^IBCE F($P($G(IB XSAVE("PRO VINF",IBXI EN,"C",1,6 ,1)),"^",4 ),1) | |
| 2286 | ||
| 2287 | NUMBER: 14 88 | |
| 2288 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2289 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2290 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2291 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2292 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF", IBXIEN,"C" ,1,6,2)),U ,3) | |
| 2293 | ||
| 2294 | NUMBER: 14 89 | |
| 2295 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2296 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2297 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2298 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2299 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$$NO PUNCT^IBCE F($P($G(IB XSAVE("PRO VINF",IBXI EN,"C",1,6 ,2)),U,4), 1) | |
| 2300 | ||
| 2301 | NUMBER: 14 90 | |
| 2302 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2303 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2304 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2305 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2306 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF", IBXIEN,"C" ,1,6,3)),U ,3) | |
| 2307 | ||
| 2308 | NUMBER: 14 91 | |
| 2309 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2310 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2311 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2312 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2313 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$$NO PUNCT^IBCE F($P($G(IB XSAVE("PRO VINF",IBXI EN,"C",1,6 ,3)),U,4), 1) | |
| 2314 | ||
| 2315 | NUMBER: 14 92 | |
| 2316 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2317 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2318 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2319 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2320 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$P($ G(IBXSAVE( "PROVINF", IBXIEN,"C" ,1,6,4)),U ,3) | |
| 2321 | ||
| 2322 | NUMBER: 14 93 | |
| 2323 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2324 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2325 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2326 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2327 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 S IB XDATA=$$NO PUNCT^IBCE F($P($G(IB XSAVE("PRO VINF",IBXI EN,"C",1,6 ,4)),U,4), 1) | |
| 2328 | ||
| 2329 | NUMBER: 14 94 | |
| 2330 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2331 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2332 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2333 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2334 | FORMAT COD E: D CLEAN UP^IBCEFP1 (.IBXSAVE) | |
| 2335 | ||
| 2336 | NUMBER: 14 95 | |
| 2337 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2338 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2339 | DATA ELEME NT: N-RECO RD ID | |
| 2340 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2341 | FORMAT COD E: S IBXDA TA="OP10" | |
| 2342 | ||
| 2343 | NUMBER: 14 96 | |
| 2344 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2345 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2346 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2347 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D CL EANUP^IBCE FP1(.IBXSA VE),ALLIDS ^IBCEFP(IB XIEN,.IBXS AVE,1) | |
| 2348 | FORMAT COD E DESCRIPT ION: Set up IBXSAVE array for the OP10 record. | |
| 2349 | ||
| 2350 | NUMBER: 14 97 | |
| 2351 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2352 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2353 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2354 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2355 | FORMAT COD E: K IBXSA VE("OSQ") N C,Z,Q,OK M Q=IBXSA VE("PROVIN F",IBXIEN, "O") S (C, Z)=0 F S Z=$O(Q(Z)) Q:'Z S O K=0 X "N A F A=1:1 Q :'$D(Q(Z,6 ,A)) I $P (Q(Z,6,A), U | |
| 2356 | ,4)'="""" S OK=1 Q" I OK S C=C +1,IBXDATA (C)=$G(Q(Z )),IBXSAVE ("OSQ",Z)= C D:C>1 ID | |
| 2357 | ^IBCEF2(C, "OP10") | |
| 2358 | ||
| 2359 | NUMBER: 14 98 | |
| 2360 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2361 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2362 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2363 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2364 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYC^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"ZZ") | |
| 2365 | ||
| 2366 | NUMBER: 14 99 | |
| 2367 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2368 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2369 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2370 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2371 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYC^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"1") | |
| 2372 | ||
| 2373 | NUMBER: 15 05 | |
| 2374 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2375 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2376 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2377 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2378 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYV^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"Q",1) | |
| 2379 | ||
| 2380 | NUMBER: 15 06 | |
| 2381 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2382 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2383 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2384 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2385 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYV^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"I",1) I $D(IBXDATA ) D NOPUNC T^IBCEF73( .IBXDATA,1 ) | |
| 2386 | ||
| 2387 | NUMBER: 15 07 | |
| 2388 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2389 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2390 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2391 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2392 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYV^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"Q",2) | |
| 2393 | ||
| 2394 | NUMBER: 15 08 | |
| 2395 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2396 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2397 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2398 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2399 | FORMAT COD E: K IBXDA TA D OTHPA YV^IBCEF71 (IBXIEN,.I BXSAVE,.IB XDATA,6,"I ",2) I $D( IBXDATA) D NOPUNCT^I BCEF73(.IB XDATA,1) | |
| 2400 | ||
| 2401 | NUMBER: 15 09 | |
| 2402 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2403 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2404 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2405 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2406 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYV^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"Q",3) | |
| 2407 | ||
| 2408 | NUMBER: 15 10 | |
| 2409 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2410 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2411 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2412 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2413 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D OT HPAYV^IBCE F71(IBXIEN ,.IBXSAVE, .IBXDATA,6 ,"I",3) I $D(IBXDATA ) D NOPUNC T^IBCEF73( .IBXDATA,1 ) | |
| 2414 | ||
| 2415 | NUMBER: 15 11 | |
| 2416 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2417 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2418 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2419 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2420 | FORMAT COD E: D CLEAN UP^IBCEFP1 (.IBXSAVE) | |
| 2421 | FORMAT COD E DESCRIPT ION: Cle an up IBXS AVE arry a fter OP10 record. | |
| 2422 | ||
| 2423 | NUMBER: 15 12 | |
| 2424 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2425 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2426 | DATA ELEME NT: N-RECO RD ID | |
| 2427 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2428 | FORMAT COD E: S IBXDA TA="DEN " | |
| 2429 | FORMAT COD E DESCRIPT ION: Out put the re cord id fo r 'DEN' re cord. | |
| 2430 | ||
| 2431 | NUMBER: 15 13 | |
| 2432 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2433 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2434 | DATA ELEME NT: N-HCFA J430D SER V LINE (ED I) | |
| 2435 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2436 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D DE N^IBCEF12 | |
| 2437 | ||
| 2438 | NUMBER: 15 14 | |
| 2439 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2440 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2441 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2442 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2443 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D SR VDTQ^IBCEF 12 | |
| 2444 | ||
| 2445 | NUMBER: 15 15 | |
| 2446 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2447 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2448 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2449 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2450 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D SR VDT^IBCEF1 2 | |
| 2451 | ||
| 2452 | NUMBER: 15 16 | |
| 2453 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2454 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2455 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2456 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2457 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2458 | PT",Z)) Q: 'Z S IBXD ATA(Z)="AD " | |
| 2459 | ||
| 2460 | NUMBER: 15 17 | |
| 2461 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2462 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2463 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2464 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2465 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 S IB XNOREQ=$$N FT^IBCEF1( 2,IBXIEN) K IBXDATA N Z S Z=0 F S Z=$O( IBXSAVE("O UTPT",Z)) Q:'Z S:$P (IBXSAVE(" OUTPT",Z), U,5)'="" I BXDATA(Z)= $P(IBXSAVE ("OUTPT",Z ),U,5) | |
| 2466 | ||
| 2467 | NUMBER: 15 28 | |
| 2468 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2469 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2470 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2471 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2472 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXDATA(Z)) Q:'Z D | |
| 2473 | SETMODS^I BCVA1(IBXD ATA(Z),Z,. IBXSAVE) S Z0=$P($G( IBXSAVE("P ROCMODS",Z )),",") I Z0'="" S I BXDATA(Z)= Z0 | |
| 2474 | ||
| 2475 | NUMBER: 15 48 | |
| 2476 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2477 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2478 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2479 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2480 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXSAVE(" | |
| 2481 | OUTPT",Z)) Q:'Z S Z 0=$P($G(IB XSAVE("PRO CMODS",Z)) ,",",2) I Z0'="" S I BXDATA(Z)= | |
| 2482 | Z0 | |
| 2483 | ||
| 2484 | NUMBER: 15 49 | |
| 2485 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2486 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2487 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2488 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2489 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXSAVE(" | |
| 2490 | OUTPT",Z)) Q:'Z S Z 0=$P($G(IB XSAVE("PRO CMODS",Z)) ,",",3) I Z0'="" S I BXDATA(Z)= | |
| 2491 | Z0 | |
| 2492 | ||
| 2493 | NUMBER: 15 52 | |
| 2494 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2495 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2496 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2497 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2498 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXSAVE(" | |
| 2499 | OUTPT",Z)) Q:'Z S Z 0=$P($G(IB XSAVE("PRO CMODS",Z)) ,",",4) K IBXSAVE("P ROCMODS",Z ) I Z0'="" S IBXDATA (Z)=Z0 | |
| 2500 | ||
| 2501 | NUMBER: 15 53 | |
| 2502 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2503 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2504 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2505 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2506 | ||
| 2507 | NUMBER: 15 54 | |
| 2508 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2509 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2510 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2511 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2512 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2513 | PT",Z)) Q: 'Z S IBXD ATA(Z)=$S( $P(IBXSAVE ("OUTPT",Z ),U,8)="": $$DOLLAR^I BCEFG1("0. | |
| 2514 | 00"),1:$$D OLLAR^IBCE FG1($P(IBX SAVE("OUTP T",Z),U,8) *$P(IBXSAV E("OUTPT", Z),U,9))) | |
| 2515 | ||
| 2516 | NUMBER: 15 55 | |
| 2517 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2518 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2519 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2520 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2521 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2522 | PT",Z)) Q: 'Z S:$P(I BXSAVE("OU TPT",Z),U, 3)'="" IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z), | |
| 2523 | U,3) | |
| 2524 | ||
| 2525 | NUMBER: 15 56 | |
| 2526 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2527 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2528 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2529 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2530 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2531 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2532 | DEN"),U) | |
| 2533 | ||
| 2534 | NUMBER: 15 57 | |
| 2535 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2536 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2537 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2538 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2539 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2540 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2541 | DEN"),U,2) | |
| 2542 | ||
| 2543 | NUMBER: 15 58 | |
| 2544 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2545 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2546 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2547 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2548 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2549 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2550 | DEN"),U,3) | |
| 2551 | ||
| 2552 | NUMBER: 15 59 | |
| 2553 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2554 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2555 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2556 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2557 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2558 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2559 | DEN"),U,4) | |
| 2560 | ||
| 2561 | NUMBER: 15 60 | |
| 2562 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2563 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2564 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2565 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2566 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2567 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2568 | DEN"),U,4) | |
| 2569 | ||
| 2570 | NUMBER: 15 80 | |
| 2571 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2572 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2573 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2574 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2575 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2576 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2577 | DEN"),U,6) | |
| 2578 | ||
| 2579 | NUMBER: 15 81 | |
| 2580 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2581 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2582 | DATA ELEME NT: N-RECO RD ID | |
| 2583 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2584 | FORMAT COD E: S IBXDA TA="DEN1" | |
| 2585 | FORMAT COD E DESCRIPT ION: Out put the re cord id fo r 'DEN1' r ecord. | |
| 2586 | ||
| 2587 | NUMBER: 15 82 | |
| 2588 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2589 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2590 | DATA ELEME NT: N-HCFA 1500 SERV ICE LINE ( EDI) | |
| 2591 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2592 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D DE N1^IBCEF12 | |
| 2593 | ||
| 2594 | NUMBER: 15 83 | |
| 2595 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2596 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2597 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2598 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2599 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D PR OC^IBCEF12 | |
| 2600 | ||
| 2601 | NUMBER: 15 84 | |
| 2602 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2603 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2604 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2605 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2606 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2607 | PT",Z)) Q: 'Z S Z0=$ P(IBXSAVE( "OUTPT",Z) ,U,7) S:$P (Z0,",")'= "" IBXDATA (Z)=$P(Z0, | |
| 2608 | ",") | |
| 2609 | ||
| 2610 | NUMBER: 15 85 | |
| 2611 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2612 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2613 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2614 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2615 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 F S Z= $O(IBXSAVE ("OUTPT" | |
| 2616 | ,Z)) Q:'Z S Z0=$P(I BXSAVE("OU TPT",Z),U, 7) S:$P(Z0 ,",",2) IB XDATA(Z)=$ P(Z0,",",2 | |
| 2617 | ) | |
| 2618 | ||
| 2619 | NUMBER: 15 86 | |
| 2620 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2621 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2622 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2623 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2624 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXSAVE(" | |
| 2625 | OUTPT",Z)) Q:'Z S Z 0=$P(IBXSA VE("OUTPT" ,Z),U,7) S :$P(Z0,"," ,3) IBXDAT A(Z)=$P(Z0 | |
| 2626 | ,",",3) | |
| 2627 | ||
| 2628 | NUMBER: 15 87 | |
| 2629 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2630 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2631 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2632 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2633 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, Z0 S Z=0 F S Z=$O(I BXSAVE(" | |
| 2634 | OUTPT",Z)) Q:'Z S Z 0=$P(IBXSA VE("OUTPT" ,Z),U,7) S :$P(Z0,"," ,4) IBXDAT A(Z)=$P(Z0 | |
| 2635 | ,",",4) | |
| 2636 | ||
| 2637 | NUMBER: 15 88 | |
| 2638 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2639 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2640 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2641 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2642 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2643 | PT",Z)) Q: 'Z I $D(I BXSAVE("OU TPT",Z,"DE N")) S IBX DATA(Z)=$P (IBXSAVE(" OUTPT",Z," | |
| 2644 | DEN"),U,7) | |
| 2645 | ||
| 2646 | NUMBER: 15 89 | |
| 2647 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2648 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2649 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2650 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2651 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, DT S Z=0 F S Z=$O(I BXSAVE(" | |
| 2652 | OUTPT",Z)) Q:'Z I $ D(IBXSAVE( "OUTPT",Z, "DEN")) S DT=$P(IBXS AVE("OUTPT ",Z,"DEN") ,U,8) I DT '="" S IBX DATA(Z)=$$ DT^IBCEFG1 (DT,"","D8 ") | |
| 2653 | ||
| 2654 | NUMBER: 15 90 | |
| 2655 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2656 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2657 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2658 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2659 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2660 | PT",Z)) Q: 'Z I $P($ G(IBXSAVE( "OUTPT",Z, "DEN")),U, 9)'="" S I BXDATA(Z)= 452 | |
| 2661 | ||
| 2662 | NUMBER: 15 91 | |
| 2663 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2664 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2665 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2666 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2667 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, DT S Z=0 F S Z=$O(I BXSAVE(" | |
| 2668 | OUTPT",Z)) Q:'Z I $ D(IBXSAVE( "OUTPT",Z, "DEN")) S DT=$P(IBXS AVE("OUTPT ",Z,"DEN") ,U,9) I DT '="" S IBX DATA(Z)=$$ DT^IBCEFG1 (DT,"","D8 ") | |
| 2669 | ||
| 2670 | NUMBER: 15 92 | |
| 2671 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2672 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2673 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2674 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2675 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2676 | PT",Z)) Q: 'Z I $P($ G(IBXSAVE( "OUTPT",Z, "DEN")),U, 10)'="" S IBXDATA(Z) =446 | |
| 2677 | ||
| 2678 | NUMBER: 15 93 | |
| 2679 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2680 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2681 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2682 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2683 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, DT S Z=0 F S Z=$O(I BXSAVE(" | |
| 2684 | OUTPT",Z)) Q:'Z I $ D(IBXSAVE( "OUTPT",Z, "DEN")) S DT=$P(IBXS AVE("OUTPT ",Z,"DEN") ,U,10) I D T'="" S IB XDATA(Z)=$ $DT^IBCEFG 1(DT,"","D 8") | |
| 2685 | ||
| 2686 | NUMBER: 15 94 | |
| 2687 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2688 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2689 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2690 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2691 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2692 | PT",Z)) Q: 'Z I $P($ G(IBXSAVE( "OUTPT",Z, "DEN")),U, 11)'="" S IBXDATA(Z) =196 | |
| 2693 | ||
| 2694 | NUMBER: 15 95 | |
| 2695 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2696 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2697 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2698 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2699 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, DT S Z=0 F S Z=$O(I BXSAVE(" | |
| 2700 | OUTPT",Z)) Q:'Z I $ D(IBXSAVE( "OUTPT",Z, "DEN")) S DT=$P(IBXS AVE("OUTPT ",Z,"DEN") ,U,11) I D T'="" S IB XDATA(Z)=$ $DT^IBCEFG 1(DT,"","D 8") | |
| 2701 | ||
| 2702 | NUMBER: 15 96 | |
| 2703 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2704 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2705 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2706 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2707 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z S Z=0 F S Z=$O(IBXS AVE("OUT | |
| 2708 | PT",Z)) Q: 'Z I $P($ G(IBXSAVE( "OUTPT",Z, "DEN")),U, 12)'="" S IBXDATA(Z) =198 | |
| 2709 | ||
| 2710 | NUMBER: 15 97 | |
| 2711 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2712 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2713 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2714 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2715 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 N Z, DT S Z=0 F S Z=$O(I BXSAVE(" | |
| 2716 | OUTPT",Z)) Q:'Z I $ D(IBXSAVE( "OUTPT",Z, "DEN")) S DT=$P(IBXS AVE("OUTPT ",Z,"DEN") ,U,12) I D T'="" S IB XDATA(Z)=$ $DT^IBCEFG 1(DT,"","D 8") | |
| 2717 | ||
| 2718 | NUMBER: 15 98 | |
| 2719 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2720 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2721 | DATA ELEME NT: N-RECO RD ID | |
| 2722 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2723 | FORMAT COD E: S IBXDA TA="DEN2" | |
| 2724 | ||
| 2725 | NUMBER: 15 99 | |
| 2726 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2727 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2728 | DATA ELEME NT: N-HCFA 1500 SERV ICE LINE ( EDI) | |
| 2729 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2730 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D DE N2^IBCEF12 | |
| 2731 | ||
| 2732 | NUMBER: 16 00 | |
| 2733 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2734 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2735 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2736 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2737 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N23^IBCEF1 2 | |
| 2738 | ||
| 2739 | NUMBER: 16 01 | |
| 2740 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2741 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2742 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2743 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2744 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N24^IBCEF1 2 | |
| 2745 | ||
| 2746 | NUMBER: 16 02 | |
| 2747 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2748 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2749 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2750 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2751 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N25^IBCEF1 2 | |
| 2752 | ||
| 2753 | NUMBER: 16 03 | |
| 2754 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2755 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2756 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2757 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2758 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N26^IBCEF1 2 | |
| 2759 | ||
| 2760 | NUMBER: 16 04 | |
| 2761 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2762 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2763 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2764 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2765 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N27^IBCEF1 2 | |
| 2766 | ||
| 2767 | NUMBER: 16 05 | |
| 2768 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2769 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2770 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2771 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2772 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N28^IBCEF1 2 | |
| 2773 | ||
| 2774 | NUMBER: 16 06 | |
| 2775 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2776 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2777 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2778 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2779 | FORMAT COD E: K IBXDA TA I $$FT^ IBCEF(IBXI EN)=7 D DE N29^IBCEF1 2 | |
| 2780 | ||
| 2781 | NUMBER: 16 07 | |
| 2782 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2783 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2784 | DATA ELEME NT: N-RECO RD ID | |
| 2785 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2786 | FORMAT COD E: S IBXDA TA="LSUR" | |
| 2787 | ||
| 2788 | NUMBER: 16 09 | |
| 2789 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2790 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2791 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2792 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2793 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 D CL EANUP^IBCE FP1(.IBXSA VE),ALLIDS ^IBCEFP(IB XIEN,.IBXS AVE,1,"LSU R") | |
| 2794 | ||
| 2795 | NUMBER: 16 08 | |
| 2796 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2797 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2798 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2799 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2800 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2801 | RV",Z)) Q: 'Z S IBXD ATA(Z)=$G( IBXSAVE("S LPRV",Z,"S LC")) D:Z> 1 ID^IBCEF 2(Z,"LSUR" | |
| 2802 | ) | |
| 2803 | ||
| 2804 | NUMBER: 16 14 | |
| 2805 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2806 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2807 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2808 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2809 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2810 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U)'="" IBXDATA(Z )="DD" | |
| 2811 | ||
| 2812 | NUMBER: 16 88 | |
| 2813 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2814 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2815 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2816 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2817 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2818 | RV",Z)) Q: 'Z S IBXD ATA(Z)=$P( IBXSAVE("S LPRV",Z),U ) | |
| 2819 | ||
| 2820 | NUMBER: 16 89 | |
| 2821 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2822 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2823 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2824 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2825 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2826 | RV",Z)) Q: 'Z S IBXD ATA(Z)=$P( IBXSAVE("S LPRV",Z),U ,2) | |
| 2827 | ||
| 2828 | NUMBER: 17 28 | |
| 2829 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2830 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2831 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2832 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2833 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2834 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,3) | |
| 2835 | ||
| 2836 | NUMBER: 17 29 | |
| 2837 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2838 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2839 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2840 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2841 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2842 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,4) | |
| 2843 | ||
| 2844 | NUMBER: 17 30 | |
| 2845 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2846 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2847 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2848 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2849 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2850 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U,6)'= "" IBXDATA (Z)="XX" | |
| 2851 | ||
| 2852 | NUMBER: 17 31 | |
| 2853 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2854 | SECURITY L EVEL: NATI ONAL,NO ED IT | |
| 2855 | DATA ELEME NT: N-GET FROM PREVI OUS EXTRAC T | |
| 2856 | PAD CH ARACTER: N O PAD REQU IRED | |
| 2857 | FORMAT COD E: I $$FT^ IBCEF(IBXI EN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBXS AVE("SLP | |
| 2858 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,6) | |
| 2859 | ||
| 2860 | NUMBER: 19 57 | |
| 2861 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2862 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2863 | DATA ELEME NT: N-RECO RD ID | |
| 2864 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2865 | FORMAT COD E: S IBXDA TA="LSUR1" | |
| 2866 | ||
| 2867 | NUMBER: 19 58 | |
| 2868 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2869 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2870 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2871 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2872 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 D | |
| 2873 | CLEANUP^ IBCEFP1(.I BXSAVE),AL LIDS^IBCEF P( | |
| 2874 | IBXIEN,. IBXSAVE,1, "LSUR1") | |
| 2875 | ||
| 2876 | NUMBER: 19 59 | |
| 2877 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2878 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2879 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2880 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2881 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2882 | RV",Z)) Q: 'Z S IBXD ATA(Z)=$G( IBXSAVE("S LPRV",Z,"S LC")) D:Z> 1 | |
| 2883 | ID^IBCEF2( Z,"LSUR1") | |
| 2884 | ||
| 2885 | ||
| 2886 | NUMBER: 19 60 | |
| 2887 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2888 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2889 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2890 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2891 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2892 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U,7)'= "" IBXDATA (Z)=$P(IBX SAVE("SLPR V",Z),U,8) | |
| 2893 | ||
| 2894 | ||
| 2895 | NUMBER: 19 61 | |
| 2896 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2897 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2898 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2899 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2900 | FORMAT CO DE: I $$FT ^IBCEF(IBX IEN)=7 N Z K IBXDATA S Z=0 F S Z=$O(IBX SAVE("SLP | |
| 2901 | RV",Z) ) Q:'Z S IBXDATA(Z) =$P(IBXSAV E("SLPRV", Z),U,7) | |
| 2902 | ||
| 2903 | ||
| 2904 | NUMBER: 19 62 | |
| 2905 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2906 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2907 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2908 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2909 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2910 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U,9)'= "" IBXDA TA(Z)=$P(I BXSAVE("SL PRV",Z),U, 10) | |
| 2911 | ||
| 2912 | NUMBER: 19 63 | |
| 2913 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2914 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2915 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2916 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2917 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2918 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,9) | |
| 2919 | ||
| 2920 | NUMBER: 19 64 | |
| 2921 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2922 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2923 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2924 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2925 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2926 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U,11)' ="" IBXD ATA(Z)=$P( IBXSAVE("S LPRV",Z),U ,12) | |
| 2927 | ||
| 2928 | ||
| 2929 | NUMBER: 19 65 | |
| 2930 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2931 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2932 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2933 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2934 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2935 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,11) | |
| 2936 | ||
| 2937 | ||
| 2938 | NUMBER: 19 66 | |
| 2939 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2940 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2941 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2942 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2943 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2944 | RV",Z)) Q: 'Z S IBXD ATA(Z)="" S:$P(IBXSA VE("SLPRV" ,Z),U,5)'= "" IBXDA TA(Z)="AS" | |
| 2945 | ||
| 2946 | NUMBER: 19 67 | |
| 2947 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2948 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2949 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 2950 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2951 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)=7 N Z K IBXDAT A S Z=0 F S Z=$O(IB XSAVE("SLP | |
| 2952 | RV",Z)) Q:'Z S IB XDATA(Z)=$ P(IBXSAVE( "SLPRV",Z) ,U,5) | |
| 2953 | ||
| 2954 | The follow ing are mo dified ent ries to fi le 364.7 I B FORM FIE LD CONTENT . These e ntries are used by t he VistA O utput Form atter when generatin g the 837D transacti on. | |
| 2955 | ||
| 2956 | NUMBER: 31 | |
| 2957 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2958 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2959 | DATA ELEME NT: N-SPEC IAL PROGRA M | |
| 2960 | PAD CHARAC TER: NO PA D REQUIRED | |
| 2961 | FORMAT COD E: I IBXDA TA="",$$WN RBILL^IBEF UNC(IBXIEN ),$$FT^IBC EF(IBXIEN) =2 | |
| 2962 | !($$FT^I BCEF(IBXIE N)=7) S IB XDATA="31" | |
| 2963 | ||
| 2964 | NUMBER: 37 | |
| 2965 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2966 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2967 | DATA ELEME NT: N-UB-0 4 PROCEDUR ES | |
| 2968 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2969 | FORMAT C ODE: K:$$F T^IBCEF(IB XIEN)=2!($ $FT^IBCEF( IBXIEN)=7) !'$$INPAT^ IBCEF(IBXI | |
| 2970 | EN) IBXDAT A N Z S Z= 0 F S Z=$ O(IBXDATA( Z)) K:'Z I BXDATA Q:' Z I '$D (IBXDATA(Z ,"M")) S I BXSAVE("PR OC",Z)=IBX DATA(Z) I Z'<25 K IB XDATA Q | |
| 2971 | FORMAT CO DE DESCRIP TION: Th is is a gr oup data e lement so more than 1 | |
| 2972 | occurrence of a valu e is possi ble for th e data ele ment in t he IBXDATA array. I f an insti tutional b ill or if the bill i s professi onal and t he procedu re being e xtracted w as not add ed as a re sult of be ing a modi fier with a 5-digit code start ing with 0 ("M" node does not exist), sa ve in an I BXSAVE arr ay for lat er use. N o output. | |
| 2973 | ||
| 2974 | NUMBER: 10 06 | |
| 2975 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2976 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2977 | DATA ELEME NT: N-OTHE R INSURANC E CO TYPES | |
| 2978 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 2979 | FORMAT C ODE: N A,Q ,Z S Q=$G( IBXDATA) K IBXDATA I $$FT^IBCE F(IBXIEN)= 2!($$FT^IB | |
| 2980 | CEF(IBXIEN )=7) F Z=1 ,2 S A=$P( Q,U,Z) I $D(^DGCR(3 99,IBXIEN, "I"_(Z+1)) ) S IBXDAT A(Z)=$S(A= 1:"HM",A=2 :"C1",A=3: "MB",A=4:" MC",A=5:"G P",1:"OT") | |
| 2981 | FORMAT CO DE DESCRIP TION: Th is is a gr oup data e lement so more than 1 | |
| 2982 | occurr ence of a value is p ossible fo r the data element i n | |
| 2983 | the IBXDAT A array. If any 'ot her' insur ance compa ny | |
| 2984 | data is fo und, the d ata is for matted as the | |
| 2985 | insurance type of t he insuran ce company in X12 fo rmat | |
| 2986 | (see codes below or refer to t he 837 V40 10 field | |
| 2987 | 2320/SBR/ 05 - profe ssional gu ide) | |
| 2988 | ||
| 2989 | Type codes: = 1:HMO (H M) | |
| 2990 | 2:COMMERCI AL (C1) | |
| 2991 | 3:MEDICARE (MB) | |
| 2992 | 4:MEDICAID (MC) | |
| 2993 | 5:GROUP PO LICY (GP) | |
| 2994 | 9:OTHER ( OT) | |
| 2995 | ||
| 2996 | NUMBER: 10 23 | |
| 2997 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 2998 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 2999 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3000 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3001 | FORMAT COD E: D OTH^I BCEF76( | |
| 3002 | IBXIEN, .IBXSAVE,. IBXDATA,($ $FT^IBCEF( IBXIEN)=2! ($$F | |
| 3003 | T^IBCEF (IBXIEN)=7 )),"OP7 ") | |
| 3004 | FORMAT CO DE DESCRIP TION: OP 7-2 other payer sequ ence. Cal l provider ID | |
| 3005 | funct ion only w hen claim is a 1500 claim. | |
| 3006 | ||
| 3007 | NUMBER: 10 15 | |
| 3008 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3009 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3010 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3011 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3012 | FORMAT C ODE: S IBX DATA="592. 0" I '$$PR OD^XUPROD( 1) S $E(IB XDATA,11)= "D" | |
| 3013 | FORMAT CO DE DESCRIP TION: Th is field c ontains th e VistA IB patch# th at | |
| 3014 | pertains t o the appl icable cha nges in th e claim ma p. Aus tin uses t his field to determi ne which s et of EDI claim maps to use wh en process ing the ED I claims. If the EDI claims ar e being tr ansmitted from a non -productio n account, then the "D" in the 11th posi tion indic ates to Au stin that it is test data. | |
| 3015 | ||
| 3016 | NUMBER: 16 | |
| 3017 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3018 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3019 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3020 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3021 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)'=7 S IBXDATA=$ P($G(IBXSA VE("EMP")) ,U) | |
| 3022 | FORMAT CO DE DESCRIP TION: Re trieves in sured empl oyment inf o from IBX SAVE | |
| 3023 | array prev iously ext racted. I f data ele ment's val ue is nul l, do not output. | |
| 3024 | ||
| 3025 | NUMBER: 12 7 | |
| 3026 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3027 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3028 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3029 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3030 | FORMAT C ODE: K IBX DATA I $$F T^IBCEF(IB XIEN)'=7 N Z F Z=1,2 I $D(^DGC R(399,IBXI | |
| 3031 | EN,"I"_(Z+ 1))),$P($G (IBXSAVE(" OIEMP",Z)) ,U)'="" S IBXDATA (Z)=$P(IBX SAVE("OIEM P",Z),U) | |
| 3032 | FORMAT CO DE DESCRIP TION: Th is is a gr oup data e lement so more than 1 | |
| 3033 | occurrence of a valu e is possi ble for th e data ele ment in the previ ously extr act IBXSAV E array. If any oth er insuran ce employe r data is found, the data is o utput. | |
| 3034 | ||
| 3035 | NUMBER: 75 | |
| 3036 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3037 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3038 | DATA ELE MENT: N-HC FA 1500 BA LANCE DUE BOX | |
| 3039 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3040 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)'=7 S IBXNOREQ= '$$REQ^IBC EF1(2,"",I BXIEN) S I | |
| 3041 | BXDATA=$ $DOLLAR^IB CEFG1(IBXD ATA) | |
| 3042 | FORMAT CO DE DESCRIP TION: Fo rmat data element so it is num eric inclu ding | |
| 3043 | cents, wit hout the d ecimal. I f data ele ment's val ue is nu ll, do not output. | |
| 3044 | ||
| 3045 | ||
| 3046 | NUMBER: 10 08 | |
| 3047 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3048 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3049 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3050 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3051 | FORMAT C ODE: I $$F T^IBCEF(IB XIEN)'=7 S | |
| 3052 | IBXDATA =$P($G(IBX SAVE("PROV INF",IBXIE N, "C",1,3 ,"NAME")), U,4) | |
| 3053 | FORMAT CO DE DESCRIP TION: Cr edentials should be in the 4th piece of the | |
| 3054 | "NAME" node of t he Renderi ng Provide r IBXSAVE array. | |
| 3055 | ||
| 3056 | NUMBER: 17 27 | |
| 3057 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3058 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3059 | DATA ELE MENT: N-GE T FROM PRE VIOUS EXTR ACT | |
| 3060 | FORMAT C ODE: N Z,Z 0,IBZ K IB XDATA I $$ FT^IBCEF(I BXIEN)'=7 S (IBZ,Z0) =0 F S IB | |
| 3061 | Z=$O(IBXSA VE("CCOB", IBZ)) Q:'I BZ S Z0=Z 0+1,Z=0 F S Z=$O( IBXSAVE("C COB",IBZ,Z )) Q:'Z I $P($G(IBX SAVE("CCOB ",IBZ,Z,0) ),U,21)'=" " S IBXDAT A(Z0)=$P(I BXSAVE("CC OB",IBZ,Z, 0),U,21) | |
| 3062 | ||
| 3063 | NUMBER: 85 4 | |
| 3064 | FORM FIELD REFERENCE : IB 837 T RANSMISSIO N | |
| 3065 | SECURITY LEVEL: NA TIONAL,NO EDIT | |
| 3066 | DATA ELEME NT: N-DRG USED | |
| 3067 | PAD CHAR ACTER: NO PAD REQUIR ED | |
| 3068 | FORMAT COD E: K:$$FT^ IBCEF(IBXI EN)=7 IBXD ATA I +$G( IBXDATA)=0 K IBXDATA | |
| 3069 | ||
| 3070 | ||
| 3071 | The follow ing field definition s need to be added o r modified in order to process Dental cl aims. The se fields are locate d in the I nsurance C ompany fil e (#36) an d are acce ssible via the INSUR ANCE COMPA NY ENTRY/E DIT option . These n ew fields are necess ary to add ress the n eed for th e new Dent al Payer I D and the Provider I D requirem ents for D ental form J430D. | |
| 3072 | 36,3.15 EDI ID NUMBER - DENTAL 3;1 5 FREE TEX T | |
| 3073 | ||
| 3074 | INPUT TRAN SFORM: K:$ L(X)>30!($ L(X)<1)! | |
| 3075 | ($$UP^XL FSTR(X)["P RNT") X | |
| 3076 | MAXIMU M LENGTH: 30 | |
| 3077 | LAST E DITED: JUL 21, 2 017 | |
| 3078 | HELP-P ROMPT: Answer mu st be 1-30 character s in | |
| 3079 | length. PRNT value s are not allowed. | |
| 3080 | DESCRI PTION: This is t he ID numb er used to identify | |
| 3081 | The Paye r on Denta l claim | |
| 3082 | transmis sions. PR NT values are not | |
| 3083 | valid Pa yer IDs. | |
| 3084 | ||
| 3085 | NOTES: XXXX--CAN 'T BE ALTE RED EXCEPT BY | |
| 3086 | PROGRAMM ER | |
| 3087 | ||
| 3088 | ||
| 3089 | 36,.191 CLAIMS (DENTAL) STREET ADD R 1 .19;1 FREE TEXT | |
| 3090 | ||
| 3091 | INPUT TRANSFORM: K:$L(X)> 30!($L(X)< 3)!'$G(IBC NS) X | |
| 3092 | MAXIMU M LENGTH: 30 | |
| 3093 | LAST E DITED: JUL 25, 2017 | |
| 3094 | HELP-P ROMPT: If the D ental clai ms process address o f this | |
| 3095 | company is differe nt from it s main add ress, | |
| 3096 | enter Li ne 1 of th e Dental c laims stre et | |
| 3097 | address. Answer m ust be 3-3 0 characte rs in | |
| 3098 | length. | |
| 3099 | DESCRI PTION: If the D ental clai ms process address o f this | |
| 3100 | company is differe nt from it s main add ress, | |
| 3101 | enter Li ne 1 of th e Dental c laims stre et | |
| 3102 | address. Answer m ust be 3-3 0 characte rs in | |
| 3103 | length. | |
| 3104 | ||
| 3105 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
| 3106 | ||
| 3107 | CROSS- REFERENCE: ^^TRIGGE R^36^.192 | |
| 3108 | 1)= K DI V S DIV=X, D0=DA,DIV( 0)=D0 S | |
| 3109 | Y(1) =$S($D(^DI C(36,D0,.1 9)):^(.19) ,1:"") | |
| 3110 | S X=$P(Y(1 ),U,2),X=X S DIU=X K Y S X="" | |
| 3111 | S DIH=$G(^ DIC(36,DIV (0),.19)), DIV=X | |
| 3112 | S $P(^(.19 ),U,2)=DIV ,DIH=36,DI G=.192 | |
| 3113 | D ^DICR | |
| 3114 | ||
| 3115 | 2)= K DI V S DIV=X, D0=DA,DIV( 0)=D0 S | |
| 3116 | Y(1)=$S($D (^DIC(36,D 0,.19)):^( .19),1:"") | |
| 3117 | S X=$P(Y(1 ),U,2),X=X S DIU=X K Y S X="" | |
| 3118 | S DIH=$G(^ DIC(36,DIV (0),.19)), DIV=X | |
| 3119 | S $P(^(.19 ),U,2)=DIV ,DIH=36,DI G=.192 | |
| 3120 | D ^DICR | |
| 3121 | 3)= When changing or deletin g CLAIMS ( DENTAL) | |
| 3122 | STREET ADD R 1 delete CLAIMS (D ENTAL) | |
| 3123 | STREET ADD R2. | |
| 3124 | ||
| 3125 | CREATE V ALUE)= @ | |
| 3126 | DELETE V ALUE)= @ | |
| 3127 | FIELD)= CLAIMS (DE NTAL) STRE ET ADDR 2 | |
| 3128 | When cha nging or d eleting CL AIMS (DENT AL) | |
| 3129 | STREET A DDR 1 dele te CLAIMS (DENTAL) S TREET | |
| 3130 | ADDR 2. | |
| 3131 | ||
| 3132 | ||
| 3133 | 36,.1911 CLAIMS (DENTAL) PHONE NUMB ER .19;11 FREE TEXT | |
| 3134 | ||
| 3135 | INPUT TRANSFORM: K:$L(X)> 20!($L(X)< 7) X | |
| 3136 | MAXIMU M LENGTH: 20 | |
| 3137 | LAST E DITED: JUL 25, 2017 | |
| 3138 | HELP-P ROMPT: Enter th e telephon e number o f the Dent al | |
| 3139 | claims o ffice with 7-20 char acters, e. g. | |
| 3140 | 777-8888 , 415 111 2222 x123. | |
| 3141 | DESCRI PTION: Enter th e telephon e number a t which th is | |
| 3142 | insuranc e carrier' s Dental c laims offi ce can | |
| 3143 | be reach ed. | |
| 3144 | ||
| 3145 | ||
| 3146 | 36,.192 CLAIMS (DENTAL) STREET ADD R 2 .19;2 FREE TEXT | |
| 3147 | ||
| 3148 | INPUT TRANSFORM: K:$L(X)>3 0!($L(X)<3 )! | |
| 3149 | $$DUPADDR L^IBCNSU(X ,+$G(IBCNS ),.191) X | |
| 3150 | MAXIMU M LENGTH: 30 | |
| 3151 | LAST E DITED: JUL 25, 2017 | |
| 3152 | HELP-P ROMPT: If the D ental Clai ms Process Address i s | |
| 3153 | longer t han one li ne, enter a second l ine | |
| 3154 | between 3-30 chara cters. Th e response can | |
| 3155 | not be t he same as Line 1. | |
| 3156 | DESCRI PTION: If the D ental Clai ms Process Address i s | |
| 3157 | longer t han one li ne, enter a second l ine | |
| 3158 | between 3-30 chara cters. Th e response can | |
| 3159 | not be t he same as line 1. | |
| 3160 | ||
| 3161 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
| 3162 | TRIGGERE D by the C LAIMS (DEN TAL) STREE T ADDR1 | |
| 3163 | field of the INSUR ANCE COMPA NY File | |
| 3164 | ||
| 3165 | ||
| 3166 | 36,.193 BLANK .19 ;3 FREE TE XT | |
| 3167 | ||
| 3168 | INPUT TRANSFORM: K:$L(X)> 30!($L(X)< 1) X | |
| 3169 | MAXIMU M LENGTH: 30 | |
| 3170 | LAST E DITED: JUL 25, 2017 | |
| 3171 | HELP-P ROMPT: Answer m ust be 1-3 0 characte rs in leng th. | |
| 3172 | DESCRI PTION: This is a place ho lder for a 3rd addre ss | |
| 3173 | line, if needed. | |
| 3174 | ||
| 3175 | ||
| 3176 | 36,.194 CLAIMS (DENTAL) PROCESS CI TY .19;4 F REE TEXT | |
| 3177 | ||
| 3178 | INPUT TRANSFORM: K:$L(X)> 25!($L(X)< 2) X | |
| 3179 | MAXIMU M LENGTH: 25 | |
| 3180 | LAST E DITED: JUL 25, 2017 | |
| 3181 | HELP-P ROMPT: If the D ental clai ms process address o f this | |
| 3182 | company is differe nt from it s main add ress, | |
| 3183 | enter ci ty of the Dental cla ims proces s | |
| 3184 | address. Answer m ust be 2-2 5 characte rs in | |
| 3185 | length. | |
| 3186 | DESCRI PTION: Enter th e state in which thi s insuranc e | |
| 3187 | company' s Dental c laims offi ce is loca ted. | |
| 3188 | Enter st ate even i f it is th e same as the | |
| 3189 | state of the compa ny's main address. | |
| 3190 | ||
| 3191 | ||
| 3192 | 36,.195 CLAIMS (DENTAL) PROCESS ST ATE .19;5 POINTER TO STATE | |
| 3193 | FILE (#5 ) | |
| 3194 | ||
| 3195 | LAST E DITED: JUL 25, 2017 | |
| 3196 | HELP-P ROMPT: If the D ental clai ms process address o f this | |
| 3197 | company is differe nt from it s main add ress, | |
| 3198 | enter st ate of the Dental cl aims proce ss | |
| 3199 | address. | |
| 3200 | DESCRI PTION: Enter th e state in which thi s insuranc e | |
| 3201 | company' s Dental c laims offi ce is loca ted. | |
| 3202 | Enter st ate even i f it is th e same as the | |
| 3203 | State of the compa ny's main address. | |
| 3204 | ||
| 3205 | ||
| 3206 | 36,.196 CLAIMS (DENTAL) PROCESS ZI P .19;6 FR EE TEXT | |
| 3207 | ||
| 3208 | INPUT TRANSFORM: K:$L(X)> 10!($L(X)< 9) X | |
| 3209 | I $D(X) K:'$$ZIPCH K9^IBCNSU( X) X | |
| 3210 | I $D(X) D ZIPIN^VA FADDR | |
| 3211 | MAXIMU M LENGTH: 10 | |
| 3212 | LAST E DITED: JUL 25, 2017 | |
| 3213 | HELP-P ROMPT: Answer m ust be nin e (9999999 99) or ten | |
| 3214 | characte rs (99999- 9999) in l ength. Th e last | |
| 3215 | 4 cannot be '0000' or '9999' . | |
| 3216 | DESCRI PTION: This is the ZIP co de for the address o f the | |
| 3217 | Dental c laims proc essing loc ation when it | |
| 3218 | differs from the p ayer's mai n mailing | |
| 3219 | address. Enter a 9 or 10 cha racter ZIP code. | |
| 3220 | ||
| 3221 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
| 3222 | ||
| 3223 | ||
| 3224 | 36,.197 CLAIMS (DENTAL) COMPANY NA ME .19;7 P OINTER TO INSURANCE | |
| 3225 | COMPANY FILE (#36) | |
| 3226 | ||
| 3227 | INPUT TRANSFORM: S DIC(0) =DIC(0)_"F ",DIC("S") = | |
| 3228 | "I '$P(^ (0),U,5),' $P($G(^(.1 9)),U,7),Y '=DA" | |
| 3229 | D ^DIC K DIC S DIC =DIE,X=+Y K:Y<0 X | |
| 3230 | LAST E DITED: JUL 25, 2017 | |
| 3231 | DESCRI PTION: You can only selec t a compan y that pro cesses | |
| 3232 | claims. The compa ny specifi ed in this field | |
| 3233 | must be an active insurance company, n ot the | |
| 3234 | same com pany as th e entry be ing edited , and | |
| 3235 | must not have anot her compan y specifie d as | |
| 3236 | handling Dental Cl aims for i t. | |
| 3237 | ||
| 3238 | SCREEN : S DIC("S ")="I $P(^ (0),U,5), | |
| 3239 | '$P($G(^ (.19)),U,7 ),Y'=DA" | |
| 3240 | EXPLAN ATION: Select a company t hat proces ses Dental claims | |
| 3241 | for this company. Must be a ctive, not this | |
| 3242 | company, and proce ss its own Dental cl aims. | |
| 3243 | NOTES: XXXX--CA N'T BE ALT ERED EXCEP T BY PROGR AMMER | |
| 3244 | TRIGGERE D by the A NOTHER CO. PROC DENT | |
| 3245 | CLAIMS? field of t he INSURAN CE COMPANY File | |
| 3246 | ||
| 3247 | ||
| 3248 | 36,.198 ANOTHE R CO. PROC DENT CLAI MS? .19;8 SET | |
| 3249 | ||
| 3250 | '0' FOR NO; | |
| 3251 | '1' FOR YES; | |
| 3252 | LAST E DITED: JUL 25, 2017 | |
| 3253 | DESCRI PTION: Enter 'Y es' if ano ther insur ance compa ny | |
| 3254 | processe s Dental C laims. | |
| 3255 | ||
| 3256 | CROSS- REFERENCE: ^^TRIGGE R^36^.197 | |
| 3257 | 1)= K DI V S DIV=X, D0=DA,DIV( 0)=D0 S Y( 0)=X | |
| 3258 | S X='$P($G (^DIC(36,D A,.19)),"^ ",8) | |
| 3259 | I X S X=DI V S Y(1)=$ S($D(^DIC( 36,D0,.19) ) | |
| 3260 | :^(.19),1: "") S X=$P (Y(1),U,7) ,X=X | |
| 3261 | S DIU=X K Y S X="" X ^DD(36,.1 98,1,1,1.4 ) | |
| 3262 | ||
| 3263 | 1.4)= S DIH=$G(^DI C(36,DIV(0 ),.19)),DI V=X | |
| 3264 | S $P(^(. 19),U,7)=D IV,DIH=36, DIG=.197 | |
| 3265 | D ^DICR | |
| 3266 | ||
| 3267 | 2)= Q | |
| 3268 | ||
| 3269 | CREATE C ONDITION)= S X= | |
| 3270 | '$P($G( ^DIC(36,DA ,.19)), | |
| 3271 | "^",8) | |
| 3272 | CREATE V ALUE)= @ | |
| 3273 | DELETE V ALUE)= NO EFFECT | |
| 3274 | FIELD)= CLAIMS (DE NTAL) COMP ANY NAME | |
| 3275 | Enter 'Y es' if ano ther insur ance compa ny | |
| 3276 | processe s Dental C laims. | |
| 3277 | ||
| 3278 | ||
| 3279 | ||
| 3280 | 36,.199 CLAIMS (DENTAL) FAX .19 ;9 FREE TE XT | |
| 3281 | ||
| 3282 | INPUT TRANSFORM: K:$L(X)> 20!($L(X)< 7) X | |
| 3283 | MAXIMU M LENGTH: 20 | |
| 3284 | LAST E DITED: JUL 25, 2017 | |
| 3285 | HELP-P ROMPT: Enter th e fax numb er of the inpatient claims | |
| 3286 | office w ith 7-20 c haracters, e.g. 444- 8888, | |
| 3287 | 614-333- 9999. | |
| 3288 | DESCRI PTION: Enter th e fax numb er of this insurance | |
| 3289 | carrier' s Dental c laims offi ce. | |
| 3290 | ||
| 3291 | ||
| 3292 | ||
| 3293 | FILE S POINTED TO FIELDS | |
| 3294 | ||
| 3295 | INSURANCE COMPANY (# 36) CLAIMS (DENTAL) COMPANY NA ME (#.197) | |
| 3296 | ||
| 3297 | STATE (#5) CLAIMS (DENTAL) PROCESS ST ATE (#.195 ) | |
| 3298 | ||
| 3299 | ||
| 3300 | 36,4.14 PERF P ROV SECOND ID TYPE J 430D 4;14 POINTER TO | |
| 3301 | IB PROV IDER ID # TYPE FILE (#355.97) | |
| 3302 | ||
| 3303 | INPUT TRANSFORM: S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3304 | $P(^(0) ,U,3)'=""T J"",$$RAIN S^IBCEPU(Y ) | |
| 3305 | !($$RAOW N^IBCEPU(Y ))" D ^DIC K DIC S | |
| 3306 | DIC=DIE, X=+Y K:Y<0 X | |
| 3307 | LAST E DITED: MAY 30, 2017 | |
| 3308 | HELP-P ROMPT: Enter th e type of performing provider | |
| 3309 | id # th e insuranc e co requi res on its | |
| 3310 | J430D b ills. | |
| 3311 | DESCRI PTION: This is the type o f performi ng provide r | |
| 3312 | secondar y id # tha t the insu rance | |
| 3313 | company expects on J430D bil ls receive d | |
| 3314 | from the V.A. Whe n the paye r-specific | |
| 3315 | provider id is ext racted, th is field i s | |
| 3316 | used to determine where to g et the | |
| 3317 | default data from if another secondary | |
| 3318 | id is no t entered for the cl aim. | |
| 3319 | ||
| 3320 | SCREEN : S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3321 | $P(^(0) ,U,3)'=""T J"",$$RAIN S^IBCEPU(Y ) | |
| 3322 | !($$RAOW N^IBCEPU(Y ))" | |
| 3323 | EXPLAN ATION: Must be valid id t ype for pe rforming | |
| 3324 | provide r id | |
| 3325 | 36,4.15 REF PR OV SEC ID DEF J430D 4;15 POINT ER TO | |
| 3326 | IB PROVI DER ID # T YPE FILE ( #355.97) | |
| 3327 | INPUT TRANSFORM: S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3328 | $$RAINS^ IBCEPU(Y)! ($$RAOWN^I BCEPU(Y))" | |
| 3329 | D ^DIC K DIC S DIC =DIE,X=+Y K:Y<0 X | |
| 3330 | LAST E DITED: MAY 30, 2017 | |
| 3331 | HELP-P ROMPT: Enter th e referrin g provider s secondar y ID | |
| 3332 | type to be used on outgoing claims. | |
| 3333 | DESCRI PTION: This is the defaul t qualifie r for a re ferring | |
| 3334 | provider if there is a refer ring provi der and | |
| 3335 | the form type is J 430D. | |
| 3336 | SCREEN : S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3337 | $$RAINS^ IBCEPU(Y)! ($$RAOWN^I BCEPU(Y))" | |
| 3338 | EXPLAN ATION: Must be an allowab le ID for a person | |
| 3339 | ||
| 3340 | 36,4.16 ATT/RE ND ID BILL SEC ID J4 30D 4;16 S ET | |
| 3341 | '0' FOR NO; | |
| 3342 | '1' FOR YES; | |
| 3343 | LAST E DITED: MAY 30, 2017 | |
| 3344 | HELP-P ROMPT: Enter 1 if att/ren d ID shoul d be used as | |
| 3345 | Billing Provider's secondary ID for De ntal | |
| 3346 | J430D cl aims. | |
| 3347 | DESCRI PTION: This fla g is set f or insuran ce compani es that | |
| 3348 | wish to have the a ttending/r endering p rovider | |
| 3349 | secondar y ID used as a billi ng provide r | |
| 3350 | secondar y ID. Thi s applies to J430D c laims | |
| 3351 | only. | |
| 3352 | FILE S POINTED TO FIELDS | |
| 3353 | IB PROVIDE R ID # TYP E (#355.97 ) PERF P ROV SECOND ID TYPE J 430D (#4.1 4) | |
| 3354 | REF PR OV SEC ID DEF J430D (#4.15) | |
| 3355 | 36,4.17 AS SIST SURG SEC ID DEF J430D 4;1 7 POINTER TO IB PROV IDER ID # | |
| 3356 | TY PE FILE (# 355.97) | |
| 3357 | ||
| 3358 | INPUT TRANSFORM: S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3359 | $$RAINS^ IBCEPU(Y)! ($$RAOWN^I BCEPU(Y))" | |
| 3360 | D ^DIC K DIC S DIC =DIE,X=+Y K:Y<0 X | |
| 3361 | LAST E DITED: JUL 21, 2017 | |
| 3362 | HELP-P ROMPT: Enter th e assistan t surgeon' s secondar y ID | |
| 3363 | type to be used on outgoing claims. | |
| 3364 | DESCRI PTION: This is the defaul t qualifie r for an | |
| 3365 | Assistan t surgeon if there i s an assis tant | |
| 3366 | surgeon and the fo rm type is J430D. | |
| 3367 | ||
| 3368 | SCREEN : S DIC("S ")="I $P(^ (0),U,3)'= ""1A"", | |
| 3369 | $$RAINS^ IBCEPU(Y)! ($$RAOWN^I BCEPU(Y))" | |
| 3370 | EXPLAN ATION: Must be an allowab le ID for a person | |
| 3371 | ||
| 3372 | ||
| 3373 | FILE S POINTED TO FIELDS | |
| 3374 | ||
| 3375 | IB PROVIDE R ID # TYP E (#355.97 ) ASSIST SURG SEC ID DEF J43 0D (#4.17) | |
| 3376 | ||
| 3377 | 355.9,.04 FORM TYPE APPLIED TO 0;4 SET (Required ) | |
| 3378 | '0' FOR UB-04 , CMS-1500 and J430D FORMS; | |
| 3379 | '1' FOR UB-04 FOR MS ONLY; | |
| 3380 | '2' FOR CMS-1500 FORMS ONLY ; | |
| 3381 | '4' FOR J430D FOR MS ONLY; | |
| 3382 | LAST EDITE D: MA Y 12, 2017 | |
| 3383 | HELP-PROMP T: En ter the fo rm types t hat this i d # will a pply | |
| 3384 | to . | |
| 3385 | DESCRIPTIO N: Th is designa tes whethe r the id n umber is t o be | |
| 3386 | us ed for jus t UB-04 fo rm types, just CMS-1 500, | |
| 3387 | ju st J430D, or all for m types. | |
| 3388 | RECORD IND EX: AU NIQ (#115) MUMPS IR S ORTING ONL Y | |
| 3389 | Short Desc r: Xref b y provider ,ins co(or ALL),care unit,form | |
| 3390 | type,p t stat,pro v type | |
| 3391 | Descriptio n: This c ross refer ence provi des an ind ex to insu re | |
| 3392 | that each record in this file has a uniq ue combina tion of pr ovider,ins urance com pany, form type, pat ient statu s and prov ider id ty pe. | |
| 3393 | Set Logic: S ^IBA(3 55.9,"AUNI Q",X(1),$E (X(2),1,30 ),$E(X(3) | |
| 3394 | ,1,30),X (4),X(5),X (6),DA)="" | |
| 3395 | Kill Logic : K ^IBA( 355.9,"AUN IQ",X(1),$ E(X(2),1,3 0),$E(X(3) | |
| 3396 | ,1,30),X (4),X(5),X (6),DA) | |
| 3397 | Whole Kill : K ^IBA( 355.9,"AUN IQ") | |
| 3398 | X(1) : PRACTIT IONER (35 5.9,.01) (Subscr 1) | |
| 3399 | (forward s) | |
| 3400 | X(2) : INDEX V ALUE INSUR ANCE CO ( 355.9,.15) | |
| 3401 | (Subscr 2) (Len 3 0) (forwa rds) | |
| 3402 | X(3) : INDEX V ALUE CARE UNIT (355 .9,.16) ( Subscr 3) | |
| 3403 | (Len 30) (forward s) | |
| 3404 | X(4) : FORM TY PE APPLIED TO (355. 9,.04) (S ubscr 4) | |
| 3405 | (forward s) | |
| 3406 | X(5) : BILL CA RE TYPE ( 355.9,.05) (Subscr 5) | |
| 3407 | (forward s) | |
| 3408 | X(6) : PROVIDE R ID TYPE (355.9,.0 6) (Subsc r 6) | |
| 3409 | (forward s) | |
| 3410 | ||
| 3411 | 355.91,.04 FORM TYP E APPLIED TO 0;4 S ET (Requir ed) | |
| 3412 | '0' FOR UB-04, CMS-1500 and J430D FORMS; | |
| 3413 | '1' FOR UB-04 FORMS ONLY ; | |
| 3414 | '2' FOR CMS-15 00 FORMS O NLY; | |
| 3415 | '4' FOR J430D FORMS ONLY ; | |
| 3416 | LAST EDITE D: MA Y 12, 2017 | |
| 3417 | HELP-PROMP T: Se lect one o r all form s that the provider id | |
| 3418 | wi ll apply t o. | |
| 3419 | DESCRIPTIO N: Th is designa tes whethe r the id n umber is t o be | |
| 3420 | us ed for jus t UB-04 fo rm types, just CMS-1 500, | |
| 3421 | ju st J430D, or all for m types. | |
| 3422 | RECORD IND EX: AU NIQ (#117) MUMPS IR S ORTING ONL Y | |
| 3423 | Sh ort Descr: Xref by ins co,car e unit,for m | |
| 3424 | type,pt st at,prov ty pe | |
| 3425 | Descriptio n: This c ross refer ence provi des an ind ex to | |
| 3426 | insure that each record in this file has a | |
| 3427 | unique combinati on of insu rance comp any, form | |
| 3428 | type, patient st atus and p rovider id type. | |
| 3429 | Set Logic: S ^IBA(3 55.91,"AUN IQ",X(1),$ S(X(2):$E( X(2),1,30) | |
| 3430 | ,1:"*N/A*" ),X(3),X(4 ),X(5),DA) ="" | |
| 3431 | Kill Logic : K ^IBA( 355.91,"AU NIQ",X(1), $S(X(2):$E (X(2),1,30 | |
| 3432 | ),1:"*N /A*"),X(3) ,X(4),X(5) ,DA) | |
| 3433 | Whole Kill : K ^IBA( 355.91,"AU NIQ") | |
| 3434 | X(1) : INSURAN CE CO (35 5.91,.01) (Subscr 1 ) | |
| 3435 | (forwar ds) | |
| 3436 | X(2) : INDEX V ALUE CARE UNIT (355 .91,.1) ( Subscr 2) | |
| 3437 | (Len 30 ) (forwar ds) | |
| 3438 | X(3) : FORM TY PE APPLIED TO (355. 91,.04) ( Subscr 3) | |
| 3439 | (forwar ds) | |
| 3440 | X(4) : BILL CA RE TYPE ( 355.91,.05 ) (Subscr 4) | |
| 3441 | (forwar ds) | |
| 3442 | X(5) : PROVIDE R ID TYPE (355.91,. 06) (Subs cr 5) | |
| 3443 | (forwar ds) | |
| 3444 | ||
| 3445 | 355.92,.04 FORM T YPE APPLIE D TO 0;4 SET (Requ ired) | |
| 3446 | '0' FOR UB-04, CMS -1500 and J430D FORM S; | |
| 3447 | '1' F OR UB-04 F ORMS ONLY; | |
| 3448 | '2' F OR CMS-150 0 ONLY; | |
| 3449 | '3' F OR PRESCRI PTION ONLY ; | |
| 3450 | '4' F OR J430D O NLY; | |
| 3451 | LAST EDITE D: MA Y 12, 2017 | |
| 3452 | HELP-PROMP T: Sele ct the for ms that th e facility id will | |
| 3453 | apply to . | |
| 3454 | DESCRIPTIO N: This designate s whether the id num ber is to be | |
| 3455 | used for just UB-0 4 form typ es, CMS-15 00 form | |
| 3456 | types, J 430D form types, or all form t ypes. | |
| 3457 | ||
| 3458 | RECORD IND EX: AU NIQ (#140) MUMPS IR S ORTING ONL Y | |
| 3459 | Short Desc r: Xref b y ins co,c are unit,f orm type,d ivision,pr ov id type | |
| 3460 | Descriptio n: This c ross refer ence allow s edits to the addit onal provi der id's t o be | |
| 3461 | replicated to linked insurance companies . | |
| 3462 | Set Logic: S ^IBA(3 55.92,"AUN IQ",X(1),$ E(X(2),1,3 0),X(3),X | |
| 3463 | (4),X(5),D A)="" | |
| 3464 | Set Cond: S X=0 I X (1)]"",X(2 )]"",X(3)] "",X(4)]"" ,X(5)]"" | |
| 3465 | ,$P($G(^ IBA(355.92 ,DA,0)),U, 8)="A" S X =1 | |
| 3466 | Kill Logic : K ^IBA( 355.92,"AU NIQ",X(1), $E(X(2),1, 30),X(3),X | |
| 3467 | (4),X(5) ,DA) | |
| 3468 | Kill Cond: S X=0 I X(1)]"",X( 2)]"",X(3) ]"",X(4)]" ",X(5)]"" | |
| 3469 | S X=1 | |
| 3470 | Whole Kill : K ^IBA( 355.92,"AU NIQ") | |
| 3471 | X(1): INSURANC E COMPANY (355.92,. 01) (forw ards) | |
| 3472 | X(2): INDEX VA LUE CARE U NIT (355. 92,.1) (L en 30) | |
| 3473 | (forward s) | |
| 3474 | X(3): FORM TYP E APPLIED TO (355.9 2,.04) (f orwards) | |
| 3475 | X(4): INDEX VA LUE DIVISI ON (355.9 2,.11) (f orwards) | |
| 3476 | X(5): PROVIDER ID TYPE (355.92,.0 6) (forwa rds) | |
| 3477 | ||
| 3478 | 350.9,1.22 MULTIP LE FORM TY PES 1;2 2 SET | |
| 3479 | '1' FOR Y ES; | |
| 3480 | '0' FOR N O; | |
| 3481 | LAST EDITE D: AP R 28, 2017 | |
| 3482 | HELP-PROMP T: En ter 'Y'es if your fa cility use s the CMS- 1500 | |
| 3483 | & J430D as w ell as the UB claim form. | |
| 3484 | DESCRIPTIO N: Se t this fie ld to 'YES ' if the f acility us es | |
| 3485 | mo re than on e health i nsurance f orm type. | |
| 3486 | Th erefore, i f your sit e uses the UB form a nd | |
| 3487 | th e CMS-1500 & J430D f orms, this should be | |
| 3488 | an swered 'YE S'. If yo ur site is only usin g the | |
| 3489 | UB form, the n answer ' NO'. If t his is set to | |
| 3490 | 'N O' or left blank the n only the UB type c laim | |
| 3491 | fo rms will b e allowed. | |
| 3492 | ||
| 3493 | 355.96,.04 FORM T YPE APPLIE D TO 0;4 SET (Requ ired) | |
| 3494 | ' 0' FOR UB- 04, CMS-15 00 and J43 0D FORMS; | |
| 3495 | '1' FOR U B-04 FORM ONLY; | |
| 3496 | '2' FOR CMS-1500 F ORM ONLY; | |
| 3497 | '4' FOR J430D FORM ONLY; | |
| 3498 | LAST EDITE D: MA Y 12, 2017 | |
| 3499 | HELP-PROMP T: Se lect one o r both for ms that th e provider id | |
| 3500 | wi ll apply t o. | |
| 3501 | DESCRIPTIO N: Th is designa tes whethe r the id n umber is t o be | |
| 3502 | us ed for the UB-04, CM S-1500, an d J430D fo rm | |
| 3503 | ty pes, just the UB-04 form type, just the | |
| 3504 | CM S-1500 for m type or just the J 430D form type. | |
| 3505 | ||
| 3506 | ||
| 3507 | 355.97,.07 ALLOWA BLE FORM T YPE 0;7 SET | |
| 3508 | ' I' FOR INS TITUTIONAL ; | |
| 3509 | 'P' FOR P ROFESSIONA L; | |
| 3510 | 'B' FOR BO TH INSTITU TIONAL AND PROFESSIO NAL; | |
| 3511 | LAST EDITE D: AP R 28, 2017 | |
| 3512 | HELP-PROMP T: En ter I if t his is use d on UB ty pe forms, P if | |
| 3513 | used on CM S & J430D type forms , or B if used on | |
| 3514 | ei ther type. | |
| 3515 | DESCRIPTIO N: Th is is a fl ag used to determine what type of | |
| 3516 | fo rm this qu alifier is valid for . It is u sed | |
| 3517 | to validate provider i d file set -up. | |
| 3518 | ||
| 3519 | 364.4,.05 FORM T YPE 0;5 SET (Requ ired) | |
| 3520 | ||
| 3521 | ' 1' FOR INS TITUTIONAL (UB-04) o nly; | |
| 3522 | '2' FOR P ROFESSIONA L (CMS-150 0 and J430 D) only; | |
| 3523 | '3' FOR Bo th INST (U B-04) and PROF (CMS- 1500 and | |
| 3524 | J430D); | |
| 3525 | LAST EDITE D: AP R 28, 2017 | |
| 3526 | HELP-PROMP T: Se lect the f orm type t his rule w ill apply to | |
| 3527 | DESCRIPTIO N: Th is is the form type that the r ule will b e | |
| 3528 | ex ecuted for . | |
| 3529 | ||
| 3530 | RECORD IND EX: AD (#133) MUMPS IR SORT ING ONLY | |
| 3531 | Short Desc r: Sets t he first l evel of xr ef to dete rmine whic h | |
| 3532 | edits are most g eneral. | |
| 3533 | Set Logic: S ^IBE(3 64.4,"AD", X2(1),X2(2 ),$S(X2(3) =3:X2(3), | |
| 3534 | X2(6)= 0:X2(3)#2+ 1,1:X2(3)) ,X2(4),DA) =+X2(5) | |
| 3535 | Set Cond: I X2(1)=" "!(X2(2)=" ")!(X2(3)= "")!(X2(4) ="") S X | |
| 3536 | =0 | |
| 3537 | Kill Logic : K ^IBE( 364.4,"AD" ,X1(1),X1( 2),$S(X1(3 )=3:X1(3), | |
| 3538 | X1(6 )=0:X1(3)# 2+1,1:X1(3 )),X1(4),D A) | |
| 3539 | Kill Cond: I X1(1)= ""!(X1(2)= "")!(X1(3) ="")!(X1(4 )="") S X | |
| 3540 | =0 | |
| 3541 | Whole Kill : K ^IBE( 364.4,"AD" ) | |
| 3542 | X(1) : TRANSMI SSION TYPE (364.4,. 03) (Subs cr 1) | |
| 3543 | (forwar ds) | |
| 3544 | X(2) : TYPE OF CARE (36 4.4,.04) (Subscr 2) | |
| 3545 | (forwar ds) | |
| 3546 | X(3) : FORM TY PE (364.4 ,.05) (Su bscr 3) ( forwards) | |
| 3547 | X(4) : INSURAN CE COMPANY OPTION ( 364.4,.07) | |
| 3548 | (Subscr 4) (forw ards) | |
| 3549 | X(5) : INACTIV E DATE (3 64.4,.06) (forwards ) | |
| 3550 | X(6) : TYPE OF RULE (36 4.4,.11) (forwards) | |
| 3551 | ||
| 3552 | 364.1,.06 BILL T YPE 0;6 SET | |
| 3553 | ||
| 3554 | '2' FOR CM S-1500 (PR OF); | |
| 3555 | '3' FOR UB-04 (INST); | |
| 3556 | '7' FOR J430D (DENT); | |
| 3557 | LAST EDITE D: MA R 09, 2017 | |
| 3558 | HELP-PROMP T: EN TER THE TY PE OF BILL CONTAINED IN THIS B ATCH | |
| 3559 | DESCRIPTIO N: TH IS IS THE TYPE OF BI LL THAT IS CONTAINED IN | |
| 3560 | TH IS BATCH | |
| 3561 | ||
| 3562 | ||
| 3563 | 36,4.03 SECOND ARY ID REQ UIREMENTS 4;3 SET | |
| 3564 | '0' FOR NONE REQUIRED; | |
| 3565 | '1' FOR CM S-1500 REQ UIRED; | |
| 3566 | '2' FOR U B-04 REQUI RED; | |
| 3567 | '3' FOR BOTH UB-04 AND CMS-1 500 REQUIR ED; | |
| 3568 | '4' FOR J430D REQU IRED; | |
| 3569 | '5' FOR BOTH CMS-1 500 AND J4 30D REQUIR ED; | |
| 3570 | '6' FOR UB-04, CMS -1500 AND J430D REQU IRED; | |
| 3571 | LAST EDITE D: MA Y 30, 2017 | |
| 3572 | HELP-PROMP T: Enter the code t o specify the second ary | |
| 3573 | performing provider id require ment for t his ins co | |
| 3574 | by form ty pe | |
| 3575 | DESCRIPTIO N: This f ield is us ed to iden tify if th e insuranc e | |
| 3576 | compan y requires the perfo rming prov ider | |
| 3577 | second ary id on the UB-04, the CMS-1 500 or the | |
| 3578 | J430D. | |
| 3579 | ||
| 3580 | 36,4.05 REF PR OV SEC ID REQ ON CLA IMS 4;5 SE T | |
| 3581 | '1' FOR CMS-1500 & J430D; | |
| 3582 | '0' FOR NONE; | |
| 3583 | LAST EDITE D: MA Y 30, 2017 | |
| 3584 | HELP-PROMP T: En ter 1 if t his qualif ier is req uired on | |
| 3585 | CMS-1500 claims th at have a referring provider | |
| 3586 | DESCRIPTIO N: Se t this fie ld to CMS- 1500 & J43 0D if the | |
| 3587 | de fault ID f or a Refer ring Provi der is REQ UIRED | |
| 3588 | on a claim. | |
| 3589 | ||
| 3590 | NOTES: TR IGGERED by the NAME field of t he INSURAN CE | |
| 3591 | CO MPANY File | |
| 3592 | ||
| 3593 | 399.0222,. 01 FUNCTI ON 0; 1 SET (Req uired) (Mu ltiply ask ed) | |
| 3594 | ||
| 3595 | '1' FOR REFER RING; | |
| 3596 | '2' FOR OPERATING; | |
| 3597 | '3' FOR RENDERING; | |
| 3598 | '4' FOR ATTENDING; | |
| 3599 | '5' FOR SUPERVISIN G; | |
| 3600 | '9' FOR OTHER OPER ATING; | |
| 3601 | '6' FOR ASSISTANT SURGEON; | |
| 3602 | LAST EDITE D: MA R 07, 2017 | |
| 3603 | HELP-PROMP T: Se lect the f unction pe rformed by a provide r for | |
| 3604 | this bill. | |
| 3605 | DESCRIPTIO N: Th ere are pr oviders wh o performe d specific | |
| 3606 | fu nctions fo r the serv ices on th is bill. These | |
| 3607 | pr oviders ar e needed t o enable t he V.A. t o | |
| 3608 | co llect reim bursement when more than one | |
| 3609 | pr ovider fun ction is i nvolved in the billa ble | |
| 3610 | ep isode (lik e an opera ting physi cian or | |
| 3611 | re ferring pr ovider). This data identifies the | |
| 3612 | ty pe of func tion that was perfor med by a | |
| 3613 | pr ovider. Th ere can on ly be 1 pr ovider rec orded | |
| 3614 | fo r each fun ction on a claim. | |
| 3615 | ||
| 3616 | SCREEN: S DIC("S")=" I $$PRVOK^ IBCEU(+Y,$ S($G(D0):D 0,1 | |
| 3617 | :$G(DA)))" | |
| 3618 | EXPLANATIO N:Function must matc h bill for m type. U se '??' | |
| 3619 | to see the function definition s. | |
| 3620 | EXECUTABLE HELP: D PRVHELP^IB CEU5 | |
| 3621 | CROSS-REFE RENCE: 39 9.0222^B | |
| 3622 | 1)= S ^DGC R(399,DA(1 ),"PRV","B ",$E(X,1,3 0),DA)="" | |
| 3623 | 2)= K ^DGC R(399,DA(1 ),"PRV","B ",$E(X,1,3 0),DA) | |
| 3624 | ||
| 3625 | CROSS- REFERENCE: ^^TRIGGE R^399.0222 ^.04 | |
| 3626 | 1)= K DIV S DIV=X,D0 =DA(1),DIV (0)=D0,D1= DA, | |
| 3627 | DIV(1)=D 1 S Y(0)=X S X=Y(0), X=X S X=X' =1 | |
| 3628 | I X S X= DIV S (1)= $S($D(^DGC R(399,D0," PRV",D1,0) ): | |
| 3629 | ^(0),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y S X= "" | |
| 3630 | X ^DD(39 9.0222,.01 ,1,2,1.4) | |
| 3631 | 1. 4)= S DIH= $S($D(^DGC R(399,DIV( 0),"PRV",D IV(1) | |
| 3632 | ,0)):^ (0),1:""), DIV=X S $P (^(0),U,4) =DIV, | |
| 3633 | DIH=399. 0222,DIG=. 04 D ^DICR :$O(^DD(DI H,DIG,1,0) )>0 | |
| 3634 | 2)= K DIV S DIV=X,D0 =DA(1),DIV (0)=D0,D1= DA, | |
| 3635 | DIV(1)=D 1 S Y(1)=$ S($D(^DGCR (399,D0,"P RV",D1,0)) : | |
| 3636 | ^(0),1:" ") S X=$P( Y(1),U,4), X=X S DIU= X K Y | |
| 3637 | S X="" X ^DD(399.0 222,.01,1, 2,2.4) | |
| 3638 | 2. 4)= S DIH= $S($D(^DGC R(399,DIV( 0),"PRV",D IV(1) | |
| 3639 | ,0)):^ (0),1:""), DIV=X S $P (^(0),U,4) =DIV, | |
| 3640 | DIH=399. 0222,DIG=. 04 D ^DICR :$O(^DD(DI H,DIG,1,0) )>0 | |
| 3641 | 3)= Do not delete | |
| 3642 | CRE ATE CONDIT ION)= INTE RNAL(PROVI DER FUNCTI ON)'=1 | |
| 3643 | CR EATE VALUE )= @ | |
| 3644 | DE LETE VALUE )= @ | |
| 3645 | FIELD )= PROVIDE R STATE | |
| 3646 | This xref is used to delete th e state fi eld if | |
| 3647 | the provid er is not a referrin g provider | |
| 3648 | function t ype. | |
| 3649 | ||
| 3650 | CROSS-REFE RENCE: 39 9.0222^C^M UMPS | |
| 3651 | 1)= S ^DGC R(399,DA(1 ),"PRV","C ",$E( | |
| 3652 | $$EXTERN AL^DILFD(3 99.0222,.0 1,,X),1,30 ),DA)="" | |
| 3653 | 2)= K ^DGC R(399,DA(1 ),"PRV","C ",$E( | |
| 3654 | $$EXTERN AL^DILFD(3 99.0222,.0 1,,X),1,30 ),DA) | |
| 3655 | ||
| 3656 | CROSS-REFE RENCE: 39 9.0222^CA^ MUMPS | |
| 3657 | 1)= S ^DGC R(399,DA(1 ),"PRV","C ",$$LOW^XL FSTR( | |
| 3658 | $E($$EXT ERNAL^DILF D(399.0222 ,.01,,X),1 ,30)),DA)= "" | |
| 3659 | 2)= K ^DGC R(399,DA(1 ),"PRV","C ",$$LOW^XL FSTR( | |
| 3660 | $E($$EXT ERNAL^DILF D(399.0222 ,.01,,X),1 ,30)),DA) | |
| 3661 | ||
| 3662 | 399.0404,. 01 LINE F UNCTION 0;1 SET (Mult iply asked ) | |
| 3663 | '1' FOR RE FERRING; | |
| 3664 | '2' FOR OPERATING; | |
| 3665 | '3' FOR RENDERING; | |
| 3666 | '4' FOR ATTENDING; | |
| 3667 | '5' FOR SUPERVISIN G; | |
| 3668 | '9' FOR OTHER OPER ATING; | |
| 3669 | '6' FOR ASSISTANT SURGEON; | |
| 3670 | LAST EDI TED: MAR 01, 20 17 | |
| 3671 | HELP-PRO MPT: Select the function performed by a provi der for | |
| 3672 | this c laim line. | |
| 3673 | ||
| 3674 | DESCRIPTIO N: Ther e are prov iders who performed specific | |
| 3675 | functions for the s ervices on this clai m line. | |
| 3676 | These pro viders are needed to enable th e V.A. | |
| 3677 | to collec t reimburs ement when more than one | |
| 3678 | provider function i s involved in the bi llable | |
| 3679 | episode ( like an op erating ph ysician or | |
| 3680 | referring provider) . This dat a identifi es the | |
| 3681 | type of f unction th at was per formed by a | |
| 3682 | provider. There ca n only be 1 provider | |
| 3683 | recorded for each f unction on a claim l ine. | |
| 3684 | ||
| 3685 | SCREE N: S D IC("S")="I $$LNPRVOK ^IBCEU7(+Y ,$G(DA(2)) )" | |
| 3686 | EXPLANATIO N: Funct ion must m atch bill form type. Use '??' to | |
| 3687 | see the function d efinitions . | |
| 3688 | EXECUTA BLE HELP: D LNPRVHL P^IBCEU7 | |
| 3689 | CROSS- REFERENCE: 399.0404 ^B | |
| 3690 | 1)= S ^D GCR(399,DA (2),"CP",D A(1),"LNPR V","B", | |
| 3691 | $E(X,1, 30),DA)="" | |
| 3692 | 2) = K ^DGCR( 399,DA(2), "CP",DA(1) ,"LNPRV"," B", | |
| 3693 | $E(X,1, 30),DA) | |
| 3694 | ||
| 3695 | CROSS-REF ERENCE: ^ ^TRIGGER^3 99.0404^.0 4 | |
| 3696 | 1)= K DIV S D IV=X,D0=DA (2),DIV(0) =D0,D1=DA( 1), | |
| 3697 | DIV(1)=D1 ,D2=DA,DIV (2)=D2 S Y (0)=X S X= Y(0),X=X | |
| 3698 | S X=X'= 1 I X S X= DIV S Y(1) =$S($D(^DG CR(399,D0, | |
| 3699 | "CP",D1 ,"LNPRV",D 2,0)):^(0) ,1:"") S X =$P(Y(1),U ,4),X=X | |
| 3700 | S DIU=X K Y S X="" X ^DD(399 .0404,.01, 1,2,1.4) | |
| 3701 | 1.4)= S DIH=$G(^ DGCR(399,D IV(0),"CP" ,DIV(1), | |
| 3702 | "LNPRV", DIV(2),0)) ,DIV=X S $ P(^(0),U,4 )=DIV, | |
| 3703 | IH=399. 0404,DIG=. 04 D ^DICR | |
| 3704 | 2)= K DIV S D IV=X,D0=DA (2),DIV(0) =D0,D1=DA( 1), | |
| 3705 | DIV(1)=D 1,D2=DA,DI V(2)=D2 S Y(1)=$S( | |
| 3706 | $D(^DGCR( 399,D0,"CP ",D1,"LNPR V",D2,0)): ^(0),1:"") | |
| 3707 | S X=$P(Y (1),U,4),X =X S DIU=X K Y S X=" " | |
| 3708 | X ^DD(399 .0404,.01, 1,2,2.4) | |
| 3709 | 2.4)= S DIH=$G( ^DGCR(399, DIV(0),"CP ",DIV(1)," LNPRV", | |
| 3710 | DIV(2), 0)),DIV=X S $P(^(0), U,4)=DIV,D IH=399.040 4, | |
| 3711 | DIG=.04 D ^DICR | |
| 3712 | 3) = Do Not D elete | |
| 3713 | CREATE CONDITION) = INTERNAL (LINE PROV IDER LINE | |
| 3714 | F UNCTION)'= 1 | |
| 3715 | CREATE VAL UE)= @ | |
| 3716 | DELETE VAL UE)= @ | |
| 3717 | FI ELD)= LINE PROVIDER STATE | |
| 3718 | This xref is used to delete th e state fi eld if the provider is not a r eferring p rovider | |
| 3719 | function t ype. | |
| 3720 | FIELD INDEX: C (#172) REGULA R IR LOOKUP & SORTING | |
| 3721 | Sho rt Descr: External value of L INE FUNCTI ON field. | |
| 3722 | Set Lo gic: S ^D GCR(399,DA (2),"CP",D A(1),"LNPR V","C", | |
| 3723 | $E(X (2),1,30), DA)="" | |
| 3724 | Kill Logic : K ^DGCR (399,DA(2) ,"CP",DA(1 ),"LNPRV", "C", | |
| 3725 | $E( X(2),1,30) ,DA) | |
| 3726 | Whole Kill : K ^DGCR (399,DA(2) ,"CP",DA(1 ),"LNPRV", "C") | |
| 3727 | X (1): LINE FUNCTION (399.0404 ,.01) (Le n 30) | |
| 3728 | ( forwards) | |
| 3729 | X (2): Comp uted Code: S X=$$EXT ERNAL^DILF D(399.0404 ,.0 | |
| 3730 | 1, ,X(1)) | |
| 3731 | ( Subscr 1) (Len 30) | |
| 3732 | ||
| 3733 | The Input Template IBEDIT INS CO1 for t he INSURAN CE COMPANY (#36) fil e needs to be modifi ed in orde r to proce ss Dental claims. T his Input Template w ill be mod ified to a llow for t he entry o f the new Insurance Payer ID f or Dental and also t he fields related to Provider Secondary Insurance IDs. | |
| 3734 | ||
| 3735 | NUMBER: 18 38 NA ME: IBEDIT INS CO1 | |
| 3736 | DATE CRE ATED: JUL 21, 2017@1 3:11 FILE: INSU RANCE COMP ANY | |
| 3737 | USER #: 520824637 DATE LAST USED: AUG 07, 2017 | |
| 3738 | EDIT FIELD S (c) | |
| 3739 | : S:",6,"' [IBY Y="@0 " | |
| 3740 | : NAME | |
| 3741 | : @0 | |
| 3742 | : S:",0, 1,6,12,"'[ IBY Y="@10 " | |
| 3743 | : S:",12 ,"[IBY Y=" @18" | |
| 3744 | : SIGNAT URE REQUIR ED ON BILL ? | |
| 3745 | : REIMBU RSE? | |
| 3746 | : ALLOW MULTIPLE B EDSECTIONS | |
| 3747 | : DIFFER ENT REVENU E CODES TO USE | |
| 3748 | : ONE OP T. VISIT O N BILL ONL Y | |
| 3749 | : AMBULA TORY SURG. REV. CODE | |
| 3750 | : PRESCR IPTION REF ILL REV. C ODE | |
| 3751 | : STANDA RD FTF;"ST ANDARD FIL ING TIME F RAME" | |
| 3752 | : I 'X S Y="@016" | |
| 3753 | : I '$$F TFV^IBCNSU 31(X) S Y= "@016" | |
| 3754 | : STANDA RD FTF VAL UE;"STANDA RD FILING TIME FRAME VALUE" | |
| 3755 | : @016 | |
| 3756 | : FILING TIME FRAM E | |
| 3757 | : TYPE OF COVERAGE | |
| 3758 | : BILLIN G PHONE NU MBER | |
| 3759 | : VERIFI CATION PHO NE NUMBER | |
| 3760 | : ANOTHE R CO. PROC ESS PRECER TS?;T | |
| 3761 | : S:'X Y ="@11" | |
| 3762 | : PRECER T COMPANY NAME | |
| 3763 | : S Y="@ 16" | |
| 3764 | : @11 | |
| 3765 | : PRECER TIFICATION PHONE NUM BER | |
| 3766 | : @16 | |
| 3767 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @171" | |
| 3768 | : TRANSM IT ELECTRO NICALLY;"E DI - Trans mit?" | |
| 3769 | : S DIPA ("IBTX")=X | |
| 3770 | : I X=$G (IBEDIKEY( 1))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 3771 | @1721" | |
| 3772 | : TRANSM IT ELECTRO NICALLY/// /^S X=$G(I BEDIKEY(1) ) | |
| 3773 | : I $$ED IKEY^IBCNS C() | |
| 3774 | : S Y="@ 171" | |
| 3775 | : @1721 | |
| 3776 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3777 | : EDI ID NUMBER - INST;"EDI - Inst Pay er Primary ID" | |
| 3778 | : I X=$G (IBEDIKEY( 4))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 3779 | @17211" | |
| 3780 | : EDI ID NUMBER - INST////^S X=$G(IBED IKEY(4)) | |
| 3781 | : I $$ED IKEY^IBCNS C() | |
| 3782 | : S Y="@ 171" | |
| 3783 | : @17211 | |
| 3784 | : 15;"ED I - Alt In st Payer P rimary ID Type" | |
| 3785 | : .01 ;"EDI - Al t Inst Pay er Primary ID Type" | |
| 3786 | : .02 ;"EDI - Al t Inst Pay er Primary ID" | |
| 3787 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3788 | : EDI IN ST SECONDA RY ID QUAL (1);"EDI - 1ST Inst Payer Sec. ID Qua | |
| 3789 | lifier" | |
| 3790 | : I X="" &($G(IBEDI KEY(3,6))= "")&$$KCHK ^XUSRB("IB EDI INSUR ANCE ED | |
| 3791 | IT") S Y=" @1722" | |
| 3792 | : I X=$G (IBEDIKEY( 1,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3793 | ="@17212" | |
| 3794 | : EDI IN ST SECONDA RY ID QUAL (1)////^S X=$G(IBEDI KEY(1,6)) | |
| 3795 | : EDI IN ST SECONDA RY ID(1)// //^S X=$G( IBEDIKEY(2 ,6)) | |
| 3796 | : I $$ED IKEY^IBCNS C() | |
| 3797 | : S Y="@ 171" | |
| 3798 | : @17212 | |
| 3799 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3800 | : EDI IN ST SECONDA RY ID(1);" EDI - 1ST Inst Payer Sec. ID" | |
| 3801 | : I X=$G (IBEDIKEY( 2,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3802 | ="@17213" | |
| 3803 | : EDI IN ST SECONDA RY ID(1)// //^S X=$G( IBEDIKEY(2 ,6)) | |
| 3804 | : EDI IN ST SECONDA RY ID QUAL (1)////^S X=$G(IBEDI KEY(1,6)) | |
| 3805 | : I $$ED IKEY^IBCNS C() | |
| 3806 | : S Y="@ 171" | |
| 3807 | : @17213 | |
| 3808 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3809 | : EDI IN ST SECONDA RY ID QUAL (2);"EDI - 2ND Inst Payer Sec. ID Qua | |
| 3810 | lifier" | |
| 3811 | : I X="" &$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@1722" | |
| 3812 | : I X=$G (IBEDIKEY( 3,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3813 | ="@17214" | |
| 3814 | : EDI IN ST SECONDA RY ID QUAL (2)////^S X=$G(IBEDI KEY(3,6)) | |
| 3815 | : EDI IN ST SECONDA RY ID(2)// //^S X=$G( IBEDIKEY(4 ,6)) | |
| 3816 | : I $$ED IKEY^IBCNS C() | |
| 3817 | : S Y="@ 171" | |
| 3818 | : @17214 | |
| 3819 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3820 | : EDI IN ST SECONDA RY ID(2);" EDI - 2ND Inst Payer Sec. ID" | |
| 3821 | : I X=$G (IBEDIKEY( 4,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3822 | ="@1722" | |
| 3823 | : EDI IN ST SECONDA RY ID(2)// //^S X=$G( IBEDIKEY(4 ,6)) | |
| 3824 | : EDI IN ST SECONDA RY ID QUAL (2)////^S X=$G(IBEDI KEY(3,6)) | |
| 3825 | : I $$ED IKEY^IBCNS C() | |
| 3826 | : S Y="@ 171" | |
| 3827 | : @1722 | |
| 3828 | : EDI ID NUMBER - PROF;"EDI - Prof Pay er Primary ID" | |
| 3829 | : I X=$G (IBEDIKEY( 2))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 3830 | @17221" | |
| 3831 | : EDI ID NUMBER - PROF////^S X=$G(IBED IKEY(2)) | |
| 3832 | : I $$ED IKEY^IBCNS C() | |
| 3833 | : S Y="@ 171" | |
| 3834 | : @17221 | |
| 3835 | : 16;"ED I - Alt Pr of Payer P rimary ID Type" | |
| 3836 | : .01 ;"EDI - Al t Prof Pay er Primary ID Type" | |
| 3837 | : .02 ;"EDI - Al t Prof Pay er Primary ID" | |
| 3838 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3839 | : EDI PR OF SECONDA RY ID QUAL (1);"EDI - 1ST Prof Payer Sec. ID Qua | |
| 3840 | lifier" | |
| 3841 | : I X="" &($G(IBEDI KEY(7,6))= "")&$$KCHK ^XUSRB("IB EDI INSUR ANCE ED | |
| 3842 | IT") S Y=" @1723" | |
| 3843 | : I X=$G (IBEDIKEY( 5,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3844 | ="@17222" | |
| 3845 | : EDI PR OF SECONDA RY ID QUAL (1)////^S X=$G(IBEDI KEY(5,6)) | |
| 3846 | : EDI PR OF SECONDA RY ID(1)// //^S X=$G( IBEDIKEY(6 ,6)) | |
| 3847 | : I $$ED IKEY^IBCNS C() | |
| 3848 | : S Y="@ 171" | |
| 3849 | : @17222 | |
| 3850 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3851 | : EDI PR OF SECONDA RY ID(1);" EDI - 1ST Prof Payer Sec. ID" | |
| 3852 | : I X=$G (IBEDIKEY( 6,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3853 | ="@17223" | |
| 3854 | : EDI PR OF SECONDA RY ID(1)// //^S X=$G( IBEDIKEY(6 ,6)) | |
| 3855 | : EDI PR OF SECONDA RY ID QUAL (1)////^S X=$G(IBEDI KEY(5,6)) | |
| 3856 | : I $$ED IKEY^IBCNS C() | |
| 3857 | : S Y="@ 171" | |
| 3858 | : @17223 | |
| 3859 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3860 | : EDI PR OF SECONDA RY ID QUAL (2);"EDI - 2ND Prof Payer Sec. ID Qua | |
| 3861 | lifier" | |
| 3862 | : I X="" &$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@1723" | |
| 3863 | : I X=$G (IBEDIKEY( 7,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3864 | ="@17224" | |
| 3865 | : EDI PR OF SECONDA RY ID QUAL (2)////^S X=$G(IBEDI KEY(7,6)) | |
| 3866 | : EDI PR OF SECONDA RY ID(2)// //^S X=$G( IBEDIKEY(8 ,6)) | |
| 3867 | : I $$ED IKEY^IBCNS C() | |
| 3868 | : S Y="@ 171" | |
| 3869 | : @17224 | |
| 3870 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 3871 | : EDI PR OF SECONDA RY ID(2);" EDI - 2ND Prof Payer Sec. ID" | |
| 3872 | : I X=$G (IBEDIKEY( 8,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 3873 | ="@1723" | |
| 3874 | : EDI PR OF SECONDA RY ID(2)// //^S X=$G( IBEDIKEY(8 ,6)) | |
| 3875 | : EDI PR OF SECONDA RY ID QUAL (2)////^S X=$G(IBEDI KEY(7,6)) | |
| 3876 | : I $$ED IKEY^IBCNS C() | |
| 3877 | : S Y="@ 171" | |
| 3878 | : @1723 | |
| 3879 | : EDI ID NUMBER - DENTAL;"ED I - Dental Payer Pri mary ID" | |
| 3880 | : I X=$G (IBEDIKEY( 15))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 3881 | "@17225" | |
| 3882 | : EDI ID NUMBER - DENTAL//// ^S X=$G(IB EDIKEY(15) ) | |
| 3883 | : I $$ED IKEY^IBCNS C() | |
| 3884 | : S Y="@ 171" | |
| 3885 | : @17225 | |
| 3886 | : @17 | |
| 3887 | : ELECTR ONIC INSUR ANCE TYPE; "EDI - Ins urance Typ e" | |
| 3888 | : I X=$G (IBEDIKEY( 9))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 3889 | @1724" | |
| 3890 | : ELECTR ONIC INSUR ANCE TYPE/ ///^S X=$G (IBEDIKEY( 9)) | |
| 3891 | : I $$ED IKEY^IBCNS C() | |
| 3892 | : S Y="@ 171" | |
| 3893 | : @1724 | |
| 3894 | : @171 | |
| 3895 | : BIN NU MBER;"EDI - Bin Numb er" | |
| 3896 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @1725" | |
| 3897 | : EDI - UMO (278) ID | |
| 3898 | : @1725 | |
| 3899 | : PRINT SEC/TERT A UTO CLAIMS ?;"EDI - P rint Sec/T ert Auto C laims?" | |
| 3900 | : PRINT SEC MED CL AIMS W/O M RA;"EDI - Print Medi care Sec C laims w | |
| 3901 | /o MRA?" | |
| 3902 | : I $G(D IPA("IBTX" ))'=2 S Y= "@18" | |
| 3903 | : MAX NU MBER TEST BILLS PER DAY;"MAX # TEST BILL S TO TRANS MIT PER | |
| 3904 | DAY" | |
| 3905 | : @18 | |
| 3906 | : S:",6, 12,"'[IBY Y="@181" | |
| 3907 | : W !!," Attending/ Rendering Provider S econdary I D" | |
| 3908 | : PERF P ROV SECOND ID TYPE 1 500;"Defau lt ID (150 0)" | |
| 3909 | : PERF P ROV SECOND ID TYPE J 430D;"Defa ult ID (J4 30D)" | |
| 3910 | : PERF P ROV SECOND ID TYPE U B;"Default ID (UB)" | |
| 3911 | : SECOND ARY ID REQ UIREMENTS; "Require I D on Claim " | |
| 3912 | : W !!," Referring Provider S econdary I D" | |
| 3913 | : REF PR OV SEC ID DEF CMS-15 00//UPIN;" Default ID (1500)" | |
| 3914 | : REF PR OV SEC ID DEF J430D/ /UPIN;"Def ault ID (J 430D)" | |
| 3915 | : REF PR OV SEC ID REQ ON CLA IMS;"Requi re ID on C laim" | |
| 3916 | : W !!," Billing Pr ovider Sec ondary IDs " | |
| 3917 | : ATT/RE ND ID BILL SEC ID PR OF//NO;"Us e Att/Rend ID as Bil ling Pr | |
| 3918 | ovider Sec . ID (1500 )?" | |
| 3919 | : ATT/RE ND ID BILL SEC ID J4 30D//NO;"U se Att/Ren d ID as Bi lling P | |
| 3920 | rovider Se c. ID (J43 0D)?" | |
| 3921 | : ATT/RE ND ID BILL SEC ID IN ST//NO;"Us e Att/Rend ID as Bil ling Pr | |
| 3922 | ovider Sec . ID (UB)? " | |
| 3923 | : W !!," Billing Pr ovider/Ser vice Facil ity" | |
| 3924 | : @181 | |
| 3925 | : S:IBY[ "1" Y="@99 " | |
| 3926 | : @10 | |
| 3927 | : S:",0, 2,6,"'[IBY Y="@20" | |
| 3928 | : STREET ADDRESS [ LINE 1] | |
| 3929 | : S:X="" Y="@1" | |
| 3930 | : STREET ADDRESS [ LINE 2] | |
| 3931 | : S:X="" Y="@1" | |
| 3932 | : STREET ADDRESS [ LINE 3] | |
| 3933 | : @1 | |
| 3934 | : CITY | |
| 3935 | : STATE | |
| 3936 | : ZIP CO DE | |
| 3937 | : PHONE NUMBER | |
| 3938 | : FAX NU MBER | |
| 3939 | : S:(IBY ["0")!(IBY ["2") Y="@ 99" | |
| 3940 | : @20 | |
| 3941 | : S:",3, 6,"'[IBY Y ="@30" | |
| 3942 | : ANOTHE R CO. PROC ESS IP CLA IMS?;T | |
| 3943 | : S:'X Y ="@21" | |
| 3944 | : CLAIMS (INPT) CO MPANY NAME | |
| 3945 | : S Y="@ 26" | |
| 3946 | : @21 | |
| 3947 | : CLAIMS (INPT) ST REET ADDRE SS 1 | |
| 3948 | : S:X="" Y="@2" | |
| 3949 | : CLAIMS (INPT) ST REET ADDRE SS 2 | |
| 3950 | : S:X="" Y="@2" | |
| 3951 | : CLAIMS (INPT) ST REET ADDRE SS 3 | |
| 3952 | : @2 | |
| 3953 | : CLAIMS (INPT) PR OCESS CITY | |
| 3954 | : CLAIMS (INPT) PR OCESS STAT E | |
| 3955 | : CLAIMS (INPT) PR OCESS ZIP | |
| 3956 | : CLAIMS (INPT) PH ONE NUMBER | |
| 3957 | : CLAIMS (INPT) FA X | |
| 3958 | : @26 | |
| 3959 | : S:IBY[ "3" Y="@99 " | |
| 3960 | : @30 | |
| 3961 | : S:",10 ,6,"'[IBY Y="@80" | |
| 3962 | : ANOTHE R CO. PROC ESS OP CLA IMS?;T | |
| 3963 | : S:'X Y ="@31" | |
| 3964 | : CLAIMS (OPT) COM PANY NAME | |
| 3965 | : S Y="@ 36" | |
| 3966 | : @31 | |
| 3967 | : CLAIMS (OPT) STR EET ADDRES S 1 | |
| 3968 | : S:X="" Y="@5" | |
| 3969 | : CLAIMS (OPT) STR EET ADDRES S 2 | |
| 3970 | : S:X="" Y="@5" | |
| 3971 | : CLAIMS (OPT) STR EET ADDRES S 3 | |
| 3972 | : @5 | |
| 3973 | : CLAIMS (OPT) PRO CESS CITY | |
| 3974 | : CLAIMS (OPT) PRO CESS STATE | |
| 3975 | : CLAIMS (OPT) PRO CESS ZIP | |
| 3976 | : CLAIMS (OPT) PHO NE NUMBER | |
| 3977 | : CLAIMS (OPT) FAX | |
| 3978 | : @36 | |
| 3979 | : S:IBY[ "10" Y="@9 9" | |
| 3980 | : @80 | |
| 3981 | : S:",11 ,6,"'[IBY Y="@90" | |
| 3982 | : ANOTHE R CO. PROC ESS RX CLA IMS?;T | |
| 3983 | : S:'X Y ="@81" | |
| 3984 | : CLAIMS (RX) COMP ANY NAME | |
| 3985 | : S Y="@ 86" | |
| 3986 | : @81 | |
| 3987 | : CLAIMS (RX) STRE ET ADDRESS 1 | |
| 3988 | : S:X="" Y="@6" | |
| 3989 | : CLAIMS (RX) STRE ET ADDRESS 2 | |
| 3990 | : S:X="" Y="@6" | |
| 3991 | : CLAIMS (RX) STRE ET ADDRESS 3 | |
| 3992 | : @6 | |
| 3993 | : CLAIMS (RX) CITY | |
| 3994 | : CLAIMS (RX) STAT E | |
| 3995 | : CLAIMS (RX) ZIP | |
| 3996 | : CLAIMS (RX) PHON E NUMBER | |
| 3997 | : CLAIMS (RX) FAX | |
| 3998 | : @86 | |
| 3999 | : S:IBY[ "11" Y="@9 9" | |
| 4000 | : @90 | |
| 4001 | : S:",4, 6,"'[IBY Y ="@40" | |
| 4002 | : ANOTHE R CO. PROC ESS APPEAL S?;T | |
| 4003 | : S:'X Y ="@41" | |
| 4004 | : APPEAL S COMPANY NAME | |
| 4005 | : S Y="@ 46" | |
| 4006 | : @41 | |
| 4007 | : APPEAL S ADDRESS ST. [LINE 1] | |
| 4008 | : S:X="" Y="@3" | |
| 4009 | : APPEAL S ADDRESS ST. [LINE 2] | |
| 4010 | : S:X="" Y="@3" | |
| 4011 | : APPEAL S ADDRESS ST. [LINE 3] | |
| 4012 | : @3 | |
| 4013 | : APPEAL S ADDRESS CITY | |
| 4014 | : APPEAL S ADDRESS STATE | |
| 4015 | : APPEAL S ADDRESS ZIP | |
| 4016 | : APPEAL S PHONE NU MBER | |
| 4017 | : APPEAL S FAX | |
| 4018 | : @46 | |
| 4019 | : S:IBY[ "4" Y="@99 " | |
| 4020 | : @40 | |
| 4021 | : S:",5, 6,"'[IBY Y ="@55" | |
| 4022 | : ANOTHE R CO. PROC ESS INQUIR IES?;T | |
| 4023 | : S:'X Y ="@51" | |
| 4024 | : INQUIR Y COMPANY NAME | |
| 4025 | : S Y="@ 56" | |
| 4026 | : @51 | |
| 4027 | : INQUIR Y ADDRESS ST. [LINE 1] | |
| 4028 | : S:X="" Y="@4" | |
| 4029 | : INQUIR Y ADDRESS ST. [LINE 2] | |
| 4030 | : S:X="" Y="@4" | |
| 4031 | : INQUIR Y ADDRESS ST. [LINE 3] | |
| 4032 | : @4 | |
| 4033 | : INQUIR Y ADDRESS CITY | |
| 4034 | : INQUIR Y ADDRESS STATE | |
| 4035 | : INQUIR Y ADDRESS ZIP CODE | |
| 4036 | : INQUIR Y PHONE NU MBER | |
| 4037 | : INQUIR Y FAX | |
| 4038 | : @56 | |
| 4039 | : S:IBY[ "5" Y="@99 " | |
| 4040 | : @55 | |
| 4041 | : S:",13 ,6,"'[IBY Y="@60" | |
| 4042 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @551" | |
| 4043 | : I $D(^ DIC(36,"AP C",+$G(DA) )),$P($G(^ DIC(36,+$G (DA),3)),U ,13)="P | |
| 4044 | " S Y="@55 1" | |
| 4045 | : INS CO MPANY LINK TYPE;T | |
| 4046 | : S DIPA ("IBLNK")= X | |
| 4047 | : I X=$G (IBEDIKEY( 13))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 4048 | "@552" | |
| 4049 | : INS CO MPANY LINK TYPE////^ S X=$G(IBE DIKEY(13)) | |
| 4050 | : I $$ED IKEY^IBCNS C() | |
| 4051 | : S Y="@ 551" | |
| 4052 | : @552 | |
| 4053 | : I $G(D IPA("IBLNK "))'="C" S Y="@551" | |
| 4054 | : INS CO MPANY LINK PARENT;T | |
| 4055 | : I X=$G (IBEDIKEY( 14))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 4056 | "@553" | |
| 4057 | : INS CO MPANY LINK PARENT/// /^S X=$G(I BEDIKEY(14 )) | |
| 4058 | : I $$ED IKEY^IBCNS C() | |
| 4059 | : S Y="@ 551" | |
| 4060 | : @553 | |
| 4061 | : D COPY ^IBCEPCID( +$G(DA)) | |
| 4062 | : @551 | |
| 4063 | : S:IBY= ",13," Y=" @99" | |
| 4064 | : @60 | |
| 4065 | : S:",7, 6,"'[IBY Y ="@50" | |
| 4066 | : PAYER | |
| 4067 | : @50 | |
| 4068 | : S:",8, 6,"'[IBY Y ="@70" | |
| 4069 | : REMARK S | |
| 4070 | : S:IBY[ "8" Y="@99 " | |
| 4071 | : @70 | |
| 4072 | : S:",9, 6,"'[IBY Y ="@99" | |
| 4073 | : SYNONY M | |
| 4074 | : ALL | |
| 4075 | : @99 COM PILED (c): NO | |
| 4076 | EDIT FIELD S (c): S:" ,6,"'[IBY Y="@0" | |
| 4077 | : NAME | |
| 4078 | : @0 | |
| 4079 | : S:",0, 1,6,12,"'[ IBY Y="@10 " | |
| 4080 | : S:",12 ,"[IBY Y=" @18" | |
| 4081 | : SIGNAT URE REQUIR ED ON BILL ? | |
| 4082 | : REIMBU RSE? | |
| 4083 | : ALLOW MULTIPLE B EDSECTIONS | |
| 4084 | : DIFFER ENT REVENU E CODES TO USE | |
| 4085 | : ONE OP T. VISIT O N BILL ONL Y | |
| 4086 | : AMBULA TORY SURG. REV. CODE | |
| 4087 | : PRESCR IPTION REF ILL REV. C ODE | |
| 4088 | : STANDA RD FTF;"ST ANDARD FIL ING TIME F RAME" | |
| 4089 | : I 'X S Y="@016" | |
| 4090 | : I '$$F TFV^IBCNSU 31(X) S Y= "@016" | |
| 4091 | : STANDA RD FTF VAL UE;"STANDA RD FILING TIME FRAME VALUE" | |
| 4092 | : @016 | |
| 4093 | : FILING TIME FRAM E | |
| 4094 | : TYPE O F COVERAGE | |
| 4095 | : BILLIN G PHONE NU MBER | |
| 4096 | : VERIFI CATION PHO NE NUMBER | |
| 4097 | : ANOTHE R CO. PROC ESS PRECER TS?;T | |
| 4098 | : S:'X Y ="@11" | |
| 4099 | : PRECER T COMPANY NAME | |
| 4100 | : S Y="@ 16" | |
| 4101 | : @11 | |
| 4102 | : PRECER TIFICATION PHONE NUM BER | |
| 4103 | : @16 | |
| 4104 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @171" | |
| 4105 | : TRANSM IT ELECTRO NICALLY;"E DI - Trans mit?" | |
| 4106 | : S DIPA ("IBTX")=X | |
| 4107 | : I X=$G (IBEDIKEY( 1))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 4108 | @1721" | |
| 4109 | : 3.01// //^S X=$G( IBEDIKEY(1 )) | |
| 4110 | : I $$ED IKEY^IBCNS C() | |
| 4111 | : S Y="@ 171" | |
| 4112 | : @1721 | |
| 4113 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4114 | : EDI ID NUMBER - INST;"EDI - Inst Pay er Primary ID" | |
| 4115 | : I X=$G (IBEDIKEY( 4))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 4116 | @17211" | |
| 4117 | : 3.04// //^S X=$G( IBEDIKEY(4 )) | |
| 4118 | : I $$ED IKEY^IBCNS C() | |
| 4119 | : S Y="@ 171" | |
| 4120 | : @17211 | |
| 4121 | : 15;"ED I - Alt In st Payer P rimary ID Type" | |
| 4122 | : .01 ;"EDI - Al t Inst Pay er Primary ID Type" | |
| 4123 | : .02 ;"EDI - Al t Inst Pay er Primary ID" | |
| 4124 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4125 | : EDI IN ST SECONDA RY ID QUAL (1);"EDI - 1ST Inst Payer Sec. ID Qua | |
| 4126 | lifier" | |
| 4127 | : I X="" &($G(IBEDI KEY(3,6))= "")&$$KCHK ^XUSRB("IB EDI INSUR ANCE ED | |
| 4128 | IT") S Y=" @1722" | |
| 4129 | : I X=$G (IBEDIKEY( 1,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4130 | ="@17212" | |
| 4131 | : 6.01// //^S X=$G( IBEDIKEY(1 ,6)) | |
| 4132 | : 6.02// //^S X=$G( IBEDIKEY(2 ,6)) | |
| 4133 | : I $$ED IKEY^IBCNS C() | |
| 4134 | : S Y="@ 171" | |
| 4135 | : @17212 | |
| 4136 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4137 | : EDI IN ST SECONDA RY ID(1);" EDI - 1ST Inst Payer Sec. ID" | |
| 4138 | : I X=$G (IBEDIKEY( 2,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4139 | ="@17213" | |
| 4140 | : 6.02// //^S X=$G( IBEDIKEY(2 ,6)) | |
| 4141 | : 6.01// //^S X=$G( IBEDIKEY(1 ,6)) | |
| 4142 | : I $$ED IKEY^IBCNS C() | |
| 4143 | : S Y="@ 171" | |
| 4144 | : @17213 | |
| 4145 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4146 | : EDI IN ST SECONDA RY ID QUAL (2);"EDI - 2ND Inst Payer Sec. ID Qua | |
| 4147 | lifier" | |
| 4148 | : I X="" &$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@1722" | |
| 4149 | : I X=$G (IBEDIKEY( 3,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4150 | ="@17214" | |
| 4151 | : 6.03// //^S X=$G( IBEDIKEY(3 ,6)) | |
| 4152 | : 6.04// //^S X=$G( IBEDIKEY(4 ,6)) | |
| 4153 | : I $$ED IKEY^IBCNS C() | |
| 4154 | : S Y="@ 171" | |
| 4155 | : @17214 | |
| 4156 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4157 | : EDI IN ST SECONDA RY ID(2);" EDI - 2ND Inst Payer Sec. ID" | |
| 4158 | : I X=$G (IBEDIKEY( 4,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4159 | ="@1722" | |
| 4160 | : 6.04// //^S X=$G( IBEDIKEY(4 ,6)) | |
| 4161 | : 6.03// //^S X=$G( IBEDIKEY(3 ,6)) | |
| 4162 | : I $$ED IKEY^IBCNS C() | |
| 4163 | : S Y="@ 171" | |
| 4164 | : @1722 | |
| 4165 | : EDI ID NUMBER - PROF;"EDI - Prof Pay er Primary ID" | |
| 4166 | : I X=$G (IBEDIKEY( 2))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 4167 | @17221" | |
| 4168 | : 3.02// //^S X=$G( IBEDIKEY(2 )) | |
| 4169 | : I $$ED IKEY^IBCNS C() | |
| 4170 | : S Y="@ 171" | |
| 4171 | : @17221 | |
| 4172 | : 16;"ED I - Alt Pr of Payer P rimary ID Type" | |
| 4173 | : .01 ;"EDI - Al t Prof Pay er Primary ID Type" | |
| 4174 | : .02 ;"EDI - Al t Prof Pay er Primary ID" | |
| 4175 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4176 | : EDI PR OF SECONDA RY ID QUAL (1);"EDI - 1ST Prof Payer Sec. ID Qua | |
| 4177 | lifier" | |
| 4178 | : I X="" &($G(IBEDI KEY(7,6))= "")&$$KCHK ^XUSRB("IB EDI INSUR ANCE ED | |
| 4179 | IT") S Y=" @1723" | |
| 4180 | : I X=$G (IBEDIKEY( 5,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4181 | ="@17222" | |
| 4182 | : 6.05// //^S X=$G( IBEDIKEY(5 ,6)) | |
| 4183 | : 6.06// //^S X=$G( IBEDIKEY(6 ,6)) | |
| 4184 | : I $$ED IKEY^IBCNS C() | |
| 4185 | : S Y="@ 171" | |
| 4186 | : @17222 | |
| 4187 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4188 | : EDI PR OF SECONDA RY ID(1);" EDI - 1ST Prof Payer Sec. ID" | |
| 4189 | : I X=$G (IBEDIKEY( 6,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4190 | ="@17223" | |
| 4191 | : 6.06// //^S X=$G( IBEDIKEY(6 ,6)) | |
| 4192 | : 6.05// //^S X=$G( IBEDIKEY(5 ,6)) | |
| 4193 | : I $$ED IKEY^IBCNS C() | |
| 4194 | : S Y="@ 171" | |
| 4195 | : @17223 | |
| 4196 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4197 | : EDI PR OF SECONDA RY ID QUAL (2);"EDI - 2ND Prof Payer Sec. ID Qua | |
| 4198 | lifier" | |
| 4199 | : I X="" &$$KCHK^XU SRB("IB ED I INSURANC E EDIT") S Y="@1723" | |
| 4200 | : I X=$G (IBEDIKEY( 7,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4201 | ="@17224" | |
| 4202 | : 6.07// //^S X=$G( IBEDIKEY(7 ,6)) | |
| 4203 | : 6.08// //^S X=$G( IBEDIKEY(8 ,6)) | |
| 4204 | : I $$ED IKEY^IBCNS C() | |
| 4205 | : S Y="@ 171" | |
| 4206 | : @17224 | |
| 4207 | : I '$G( DIPA("IBTX ")) S Y="@ 17" | |
| 4208 | : EDI PR OF SECONDA RY ID(2);" EDI - 2ND Prof Payer Sec. ID" | |
| 4209 | : I X=$G (IBEDIKEY( 8,6))!$$KC HK^XUSRB(" IB EDI INS URANCE EDI T") S Y | |
| 4210 | ="@1723" | |
| 4211 | : 6.08// //^S X=$G( IBEDIKEY(8 ,6)) | |
| 4212 | : 6.07// //^S X=$G( IBEDIKEY(7 ,6)) | |
| 4213 | : I $$ED IKEY^IBCNS C() | |
| 4214 | : S Y="@ 171" | |
| 4215 | : @1723 | |
| 4216 | : EDI ID NUMBER - DENTAL;"ED I - Dental Payer Pri mary ID" | |
| 4217 | : I X=$G (IBEDIKEY( 15))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 4218 | "@17225" | |
| 4219 | : 3.15// //^S X=$G( IBEDIKEY(1 5)) | |
| 4220 | : I $$ED IKEY^IBCNS C() | |
| 4221 | : S Y="@ 171" | |
| 4222 | : @17225 | |
| 4223 | : @17 | |
| 4224 | : ELECTR ONIC INSUR ANCE TYPE; "EDI - Ins urance Typ e" | |
| 4225 | : I X=$G (IBEDIKEY( 9))!$$KCHK ^XUSRB("IB EDI INSUR ANCE EDIT" ) S Y=" | |
| 4226 | @1724" | |
| 4227 | : 3.09// //^S X=$G( IBEDIKEY(9 )) | |
| 4228 | : I $$ED IKEY^IBCNS C() | |
| 4229 | : S Y="@ 171" | |
| 4230 | : @1724 | |
| 4231 | : @171 | |
| 4232 | : BIN NU MBER;"EDI - Bin Numb er" | |
| 4233 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @1725" | |
| 4234 | : EDI - UMO (278) ID | |
| 4235 | : @1725 | |
| 4236 | : PRINT SEC/TERT A UTO CLAIMS ?;"EDI - P rint Sec/T ert Auto C laims?" | |
| 4237 | : PRINT SEC MED CL AIMS W/O M RA;"EDI - Print Medi care Sec C laims w | |
| 4238 | /o MRA?" | |
| 4239 | : I $G(D IPA("IBTX" ))'=2 S Y= "@18" | |
| 4240 | : MAX NU MBER TEST BILLS PER DAY;"MAX # TEST BILL S TO TRANS MIT PER | |
| 4241 | DAY" | |
| 4242 | : @18 | |
| 4243 | : S:",6, 12,"'[IBY Y="@181" | |
| 4244 | : W !!," Attending/ Rendering Provider S econdary I D" | |
| 4245 | : PERF P ROV SECOND ID TYPE 1 500;"Defau lt ID (150 0)" | |
| 4246 | : PERF P ROV SECOND ID TYPE J 430D;"Defa ult ID (J4 30D)" | |
| 4247 | : PERF P ROV SECOND ID TYPE U B;"Default ID (UB)" | |
| 4248 | : SECOND ARY ID REQ UIREMENTS; "Require I D on Claim " | |
| 4249 | : W !!," Referring Provider S econdary I D" | |
| 4250 | : REF PR OV SEC ID DEF CMS-15 00//UPIN;" Default ID (1500)" | |
| 4251 | : REF PR OV SEC ID DEF J430D/ /UPIN;"Def ault ID (J 430D)" | |
| 4252 | : REF PR OV SEC ID REQ ON CLA IMS;"Requi re ID on C laim" | |
| 4253 | : W !!," Billing Pr ovider Sec ondary IDs " | |
| 4254 | : ATT/RE ND ID BILL SEC ID PR OF//NO;"Us e Att/Rend ID as Bil ling Pr | |
| 4255 | ovider Sec . ID (1500 )?" | |
| 4256 | : ATT/RE ND ID BILL SEC ID J4 30D//NO;"U se Att/Ren d ID as Bi lling P | |
| 4257 | rovider Se c. ID (J43 0D)?" | |
| 4258 | : ATT/RE ND ID BILL SEC ID IN ST//NO;"Us e Att/Rend ID as Bil ling Pr | |
| 4259 | ovider Sec . ID (UB)? " | |
| 4260 | : W !!," Billing Pr ovider/Ser vice Facil ity" | |
| 4261 | : @181 | |
| 4262 | : S:IBY[ "1" Y="@99 " | |
| 4263 | : @10 | |
| 4264 | : S:",0, 2,6,"'[IBY Y="@20" | |
| 4265 | : STREET ADDRESS [ LINE 1] | |
| 4266 | : S:X="" Y="@1" | |
| 4267 | : STREET ADDRESS [ LINE 2] | |
| 4268 | : S:X="" Y="@1" | |
| 4269 | : STREET ADDRESS [ LINE 3] | |
| 4270 | : @1 | |
| 4271 | : CITY | |
| 4272 | : STATE | |
| 4273 | : ZIP CO DE | |
| 4274 | : PHONE NUMBER | |
| 4275 | : FAX NU MBER | |
| 4276 | : S:(IBY ["0")!(IBY ["2") Y="@ 99" | |
| 4277 | : @20 | |
| 4278 | : S:",3, 6,"'[IBY Y ="@30" | |
| 4279 | : ANOTHE R CO. PROC ESS IP CLA IMS?;T | |
| 4280 | : S:'X Y ="@21" | |
| 4281 | : CLAIMS (INPT) CO MPANY NAME | |
| 4282 | : S Y="@ 26" | |
| 4283 | : @21 | |
| 4284 | : CLAIMS (INPT) ST REET ADDRE SS 1 | |
| 4285 | : S:X="" Y="@2" | |
| 4286 | : CLAIMS (INPT) ST REET ADDRE SS 2 | |
| 4287 | : S:X="" Y="@2" | |
| 4288 | : CLAIMS (INPT) ST REET ADDRE SS 3 | |
| 4289 | : @2 | |
| 4290 | : CLAIMS (INPT) PR OCESS CITY | |
| 4291 | : CLAIMS (INPT) PR OCESS STAT E | |
| 4292 | : CLAIMS (INPT) PR OCESS ZIP | |
| 4293 | : CLAIMS (INPT) PH ONE NUMBER | |
| 4294 | : CLAIMS (INPT) FA X | |
| 4295 | : @26 | |
| 4296 | : S:IBY[ "3" Y="@99 " | |
| 4297 | : @30 | |
| 4298 | : S:",10 ,6,"'[IBY Y="@80" | |
| 4299 | : ANOTHE R CO. PROC ESS OP CLA IMS?;T | |
| 4300 | : S:'X Y ="@31" | |
| 4301 | : CLAIMS (OPT) COM PANY NAME | |
| 4302 | : S Y="@ 36" | |
| 4303 | : @31 | |
| 4304 | : CLAIMS (OPT) STR EET ADDRES S 1 | |
| 4305 | : S:X="" Y="@5" | |
| 4306 | : CLAIMS (OPT) STR EET ADDRES S 2 | |
| 4307 | : S:X="" Y="@5" | |
| 4308 | : CLAIMS (OPT) STR EET ADDRES S 3 | |
| 4309 | : @5 | |
| 4310 | : CLAIMS (OPT) PRO CESS CITY | |
| 4311 | : CLAIMS (OPT) PRO CESS STATE | |
| 4312 | : CLAIMS (OPT) PRO CESS ZIP | |
| 4313 | : CLAIMS (OPT) PHO NE NUMBER | |
| 4314 | : CLAIMS (OPT) FAX | |
| 4315 | : @36 | |
| 4316 | : S:IBY[ "10" Y="@9 9" | |
| 4317 | : @80 | |
| 4318 | : S:",11 ,6,"'[IBY Y="@90" | |
| 4319 | : ANOTHE R CO. PROC ESS RX CLA IMS?;T | |
| 4320 | : S:'X Y ="@81" | |
| 4321 | : CLAIMS (RX) COMP ANY NAME | |
| 4322 | : S Y="@ 86" | |
| 4323 | : @81 | |
| 4324 | : CLAIMS (RX) STRE ET ADDRESS 1 | |
| 4325 | : S:X="" Y="@6" | |
| 4326 | : CLAIMS (RX) STRE ET ADDRESS 2 | |
| 4327 | : S:X="" Y="@6" | |
| 4328 | : CLAIMS (RX) STRE ET ADDRESS 3 | |
| 4329 | : @6 | |
| 4330 | : CLAIMS (RX) CITY | |
| 4331 | : CLAIMS (RX) STAT E | |
| 4332 | : CLAIMS (RX) ZIP | |
| 4333 | : CLAIMS (RX) PHON E NUMBER | |
| 4334 | : CLAIMS (RX) FAX | |
| 4335 | : @86 | |
| 4336 | : S:IBY[ "11" Y="@9 9" | |
| 4337 | : @90 | |
| 4338 | : S:",4, 6,"'[IBY Y ="@40" | |
| 4339 | : ANOTHE R CO. PROC ESS APPEAL S?;T | |
| 4340 | : S:'X Y ="@41" | |
| 4341 | : APPEAL S COMPANY NAME | |
| 4342 | : S Y="@ 46" | |
| 4343 | : @41 | |
| 4344 | : APPEAL S ADDRESS ST. [LINE 1] | |
| 4345 | : S:X="" Y="@3" | |
| 4346 | : APPEAL S ADDRESS ST. [LINE 2] | |
| 4347 | : S:X="" Y="@3" | |
| 4348 | : APPEAL S ADDRESS ST. [LINE 3] | |
| 4349 | : @3 | |
| 4350 | : APPEAL S ADDRESS CITY | |
| 4351 | : APPEAL S ADDRESS STATE | |
| 4352 | : APPEAL S ADDRESS ZIP | |
| 4353 | : APPEAL S PHONE NU MBER | |
| 4354 | : APPEAL S FAX | |
| 4355 | : @46 | |
| 4356 | : S:IBY[ "4" Y="@99 " | |
| 4357 | : @40 | |
| 4358 | : S:",5, 6,"'[IBY Y ="@55" | |
| 4359 | : ANOTHE R CO. PROC ESS INQUIR IES?;T | |
| 4360 | : S:'X Y ="@51" | |
| 4361 | : INQUIR Y COMPANY NAME | |
| 4362 | : S Y="@ 56" | |
| 4363 | : @51 | |
| 4364 | : INQUIR Y ADDRESS ST. [LINE 1] | |
| 4365 | : S:X="" Y="@4" | |
| 4366 | : INQUIR Y ADDRESS ST. [LINE 2] | |
| 4367 | : S:X="" Y="@4" | |
| 4368 | : INQUIR Y ADDRESS ST. [LINE 3] | |
| 4369 | : @4 | |
| 4370 | : INQUIR Y ADDRESS CITY | |
| 4371 | : INQUIR Y ADDRESS STATE | |
| 4372 | : INQUIR Y ADDRESS ZIP CODE | |
| 4373 | : INQUIR Y PHONE NU MBER | |
| 4374 | : INQUIR Y FAX | |
| 4375 | : @56 | |
| 4376 | : S:IBY[ "5" Y="@99 " | |
| 4377 | : @55 | |
| 4378 | : S:",13 ,6,"'[IBY Y="@60" | |
| 4379 | : I '$$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S Y=" @551" | |
| 4380 | : I $D(^ DIC(36,"AP C",+$G(DA) )),$P($G(^ DIC(36,+$G (DA),3)),U ,13)="P | |
| 4381 | " S Y="@55 1" | |
| 4382 | : INS CO MPANY LINK TYPE;T | |
| 4383 | : S DIPA ("IBLNK")= X | |
| 4384 | : I X=$G (IBEDIKEY( 13))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 4385 | "@552" | |
| 4386 | : 3.13// //^S X=$G( IBEDIKEY(1 3)) | |
| 4387 | : I $$ED IKEY^IBCNS C() | |
| 4388 | : S Y="@ 551" | |
| 4389 | : @552 | |
| 4390 | : I $G(D IPA("IBLNK "))'="C" S Y="@551" | |
| 4391 | : INS CO MPANY LINK PARENT;T | |
| 4392 | : I X=$G (IBEDIKEY( 14))!$$KCH K^XUSRB("I B EDI INSU RANCE EDIT ") S Y= | |
| 4393 | "@553" | |
| 4394 | : 3.14// //^S X=$G( IBEDIKEY(1 4)) | |
| 4395 | : I $$ED IKEY^IBCNS C() | |
| 4396 | : S Y="@ 551" | |
| 4397 | : @553 | |
| 4398 | : D COPY ^IBCEPCID( +$G(DA)) | |
| 4399 | : @551 | |
| 4400 | : S:IBY= ",13," Y=" @99" | |
| 4401 | : @60 | |
| 4402 | : S:",7, 6,"'[IBY Y ="@50" | |
| 4403 | : PAYER | |
| 4404 | : @50 | |
| 4405 | : S:",8, 6,"'[IBY Y ="@70" | |
| 4406 | : REMARK S | |
| 4407 | : S:IBY[ "8" Y="@99 " | |
| 4408 | : @70 | |
| 4409 | : S:",9, 6,"'[IBY Y ="@99" | |
| 4410 | : SYNONY M | |
| 4411 | : ALL | |
| 4412 | : @99 | |
| 4413 | BUILD(S) ( c): IB*2.0 *52 | |
| 4414 | : IB*2.0 *137 | |
| 4415 | : IB*2.0 *191 | |
| 4416 | : IB*2.0 *184 | |
| 4417 | : IB*2.0 *232 | |
| 4418 | : IB*2.0 *291 | |
| 4419 | : IB*2.0 *320 | |
| 4420 | : IB*2.0 *348 | |
| 4421 | : IB*2.0 *349 | |
| 4422 | : IB*2.0 *371 | |
| 4423 | : IB*2.0 *399 | |
| 4424 | : IB*2.0 *400 | |
| 4425 | : IB*2.0 *432 | |
| 4426 | : IB*2.0 *516 | |
| 4427 | : IB*2.0 *547 | |
| 4428 | : IB*2.0 *592 | |
| 4429 | ||
| 4430 | The Insura nce Compan y Editor s creens wil l need to be modifie d in order to allow for the ad ditional D ental Clai m Payer ID Mailing A ddress. T he screen changes be low have b een propos ed for the menu chan ges. | |
| 4431 | ||
| 4432 | Insurance Company Ed itor Jul 25, 20 17@15:20:3 3 Page: 1 of 9 | |
| 4433 | Insurance Company In formation for: AETNA | |
| 4434 | Type of Co mpany: HEA LTH INSURA NCE Curren tly Active | |
| 4435 | ||
| 4436 | Bil ling Param eters | |
| 4437 | Signatur e Required ?: NO Ty pe Of Cove rage: HEAL TH INSURAN | |
| 4438 | Reimburse ?: WILL RE IMBURSE Billing P hone: 888 632-3862 | |
| 4439 | Mult. Bedsection s: Veri fication P hone: 877. 277.3368 | |
| 4440 | One Opt. V isit: NO P recert Com p. Name: | |
| 4441 | Diff. Rev . Codes: Pre cert Phone : 877 277- 3368 | |
| 4442 | Amb. Sur . Rev. Cod e: | |
| 4443 | Rx Refil l Rev. Cod e: | |
| 4444 | Filing Time Fram e: (27 MO NTH(S)) | |
| 4445 | ||
| 4446 | ||
| 4447 | ||
| 4448 | BP Billin g/EDI Para m PA Payer AI (In) Activate C ompany | |
| 4449 | AD Billin g Addresse s RE Remarks CC Chan ge Insuran ce Co. | |
| 4450 | AC Associ ate Compan ies SY Synonyms DC Dele te Company | |
| 4451 | ID Prov I Ds/ID Para m EA Edit All VP View Plans | |
| 4452 | EX Exit I D | |
| 4453 | ||
| 4454 | Select Act ion: Next Screen// A D Billing Addresses | |
| 4455 | New Addres s Listman | |
| 4456 | Claims Off ice Addres ses Jul 25, 2017@15:3 5:50 Page: 1 of 1 | |
| 4457 | Insurance Co: AETNA | |
| 4458 | Street: C ity/State: | |
| 4459 | Street 2: Phon e: | |
| 4460 | Fax: | |
| 4461 | Prescripti on Claims Office Inf ormation | |
| 4462 | Company Name: AETN A S treet 3: | |
| 4463 | St reet: Cit y/State: | |
| 4464 | Stre et 2: Phone: | |
| 4465 | Fax: | |
| 4466 | ||
| 4467 | ||
| 4468 | + Enter ?? f or more ac tions >>> | |
| 4469 | MM Main M ailing Add ress AO Appeals Office DE Den tal Claims Office | |
| 4470 | IC Inpt C laims Offi ce PC Prescr C laims Of EX Exi t | |
| 4471 | OC Opt Cl aims Offic e IO Inquiry Office | |
| 4472 | Select Act ion: Next Screen// | |
| 4473 | ||
| 4474 | ||
| 4475 | ||
| 4476 | In order t o accompli sh the tas k of getti ng the scr eens to ap pear like the mockup and store a new Den tal addres s the foll owing need s to be ac complished : | |
| 4477 | 9.Know the current m enu option order set up to che ck against when fini shed so en sure prope r executio n order an d that not hing is mi ssing. | |
| 4478 | ||
| 4479 | ||
| 4480 | Select OPT ION NAME: INSURANCE CO | |
| 4481 | 1 I NSURANCE C OMPANY EDI PARAMETE IBCN INSU RANCE EDI REPORT Insurance | |
| 4482 | Company E DI Paramet er Report | |
| 4483 | 2 I NSURANCE C OMPANY ENT RY/EDIT D G INSURANC E COMPANY EDIT I nsurance C ompany Ent ry/Edit | |
| 4484 | 3 I NSURANCE C OMPANY ENT RY/EDIT I BCN INSURA NCE CO EDI T Insu rance Comp | |
| 4485 | any Entry/ Edit | |
| 4486 | CHOOSE 1-3 : 3 IBCN INSURANCE CO EDIT Insuranc e Company Entry/Edit | |
| 4487 | Insurance Company En try/Edit | |
| 4488 | Select INS URANCE COM PANY NAME: ZZ BLUE C ROSS OF W PA* PO BOX 124 9 | |
| 4489 | PITTSBURGH PENNS YLVANIA Y..... .......... .... | |
| 4490 | ||
| 4491 | ||
| 4492 | ||
| 4493 | 10.Create a protocol action fo r the new action opt ion DE- De ntal Addre ss | |
| 4494 | ||
| 4495 | Using the List manag er tool ^V ALMWB | |
| 4496 | ||
| 4497 | Template: IBCNS INSU RANCE COMP ANY | |
| 4498 | ||
| 4499 | Demographi cs List Regio n | |
| 4500 | Template N ame: IBCNS INSURANCE COMPANY Top Mar gin: 5 | |
| 4501 | Entity Nam e: Insuran ce Company Bo ttom " : 16 | |
| 4502 | Screen Tit le: Insura nce Compan y Editor Right " : 90 | |
| 4503 | ||
| 4504 | ||
| 4505 | Protocol I nformation Other Fiel ds | |
| 4506 | Type of Li st: PROTOC OL OK to Tr ansport?: OK | |
| 4507 | Protocol M enu: IBCNS C INSURANC E CO Use Curso r Control: YES | |
| 4508 | Print Prot ocol: Allowab le Number of Actions : | |
| 4509 | Hidden Men u: VALM HI DDEN ACTIO NS Date Rang e Limit: | |
| 4510 | Automatic Defaults: | |
| 4511 | ||
| 4512 | ||
| 4513 | + Enter ?? f or more ac tions >>> | |
| 4514 | DE Demogr aphic Edit MC MUMPS Code Edit PE Prot ocol Edit | |
| 4515 | PI Protoc ol Informa tion CE Caption Ed it RN Run List | |
| 4516 | LR List R egion Edit CL Change Lis t Template IT Inpu t Template | |
| 4517 | OF Other Fields EA Edit All RO Rout ine Editor | |
| 4518 | Select Too l:Next Scr een// pe Protocol Edit | |
| 4519 | ||
| 4520 | Select PRO TOCOL NAME : zz new a ction item | |
| 4521 | ||
| 4522 | 11.Create a new prot ocol menu – option A D- Billing Addresses to contai n the prot ocol actio ns of the DE- Dental Address o ption as w ell as the actions t o be moved , MM, IC, OC, AO, PC , IO | |
| 4523 | Using the List manag er tool ^V ALMWB | |
| 4524 | List Manag er Workben ch Aug 15, 20 17@20:00:5 2 Page: 1 of 3 | |
| 4525 | Template: IBCNS INSU RANCE COMP ANY | |
| 4526 | ||
| 4527 | Demograp hics List Reg ion | |
| 4528 | Template Name: IBCN S INSURANC E COMPANY Top Ma rgin: 5 | |
| 4529 | Entity Name: Insu rance Comp any Bottom " : 16 | |
| 4530 | Screen T itle: Insu rance Comp any Editor Right " : 90 | |
| 4531 | ||
| 4532 | ||
| 4533 | Protocol Informati on Other Fi elds | |
| 4534 | Type of List: PRO TOCOL OK to Transport ?: OK | |
| 4535 | Protocol Menu: IBC NSC INSURA NCE CO Use Cur sor Contro l: YES | |
| 4536 | Print Pro tocol: Allowa ble Number of Action s: | |
| 4537 | Hidden Menu: VAL M HIDDEN A CTIONS Date Range Limi t: | |
| 4538 | Automat ic Default s: | |
| 4539 | ||
| 4540 | ||
| 4541 | + Enter ?? f or more ac tions >>> | |
| 4542 | DE Demogr aphic Edit MC MUMPS Code Edit PE Prot ocol Edit | |
| 4543 | PI Protoc ol Informa tion CE Caption Ed it RN Run List | |
| 4544 | LR List R egion Edit CL Change Lis t Template IT Inpu t Template | |
| 4545 | OF Other Fields EA Edit All RO Rout ine Editor | |
| 4546 | Select Too l:Next Scr een// PE Protocol Edit | |
| 4547 | ||
| 4548 | Select PRO TOCOL NAME : Set up n ew AD- Bil ling Addre sses | |
| 4549 | TYPE: menu // | |
| 4550 | ENTRY ACTI ON: ? | |
| 4551 | ENTER STANDARD MUMPS CODE | |
| 4552 | ENTRY ACTI ON: | |
| 4553 | EXIT ACTIO N: I $G(IB FASTXT)=1 S VALMBCK= "Q" Repla ce | |
| 4554 | Select ITE M: IBCNSC INS CO ASS OCIATION// ? | |
| 4555 | Answer wi th ITEM | |
| 4556 | Do you wa nt the ent ire 35-Ent ry ITEM Li st? YES ( Yes) | |
| 4557 | Choose from: | |
| 4558 | IBCNSC INS CO EDI T ALL | |
| 4559 | IBCNSC INS CO BIL LING PARAM ETERS | |
| 4560 | IBCNSC INS CO MAI N MAILING ADDRESS | |
| 4561 | IBCNSC INS CO APP EALS OFFIC E | |
| 4562 | IBCNSC INS CO INQ UIRY OFFIC E | |
| 4563 | IBCNSC INS CO CHA NGE COMPAN Y | |
| 4564 | IBCNSC INS CO REM ARKS | |
| 4565 | IBCNSC INS CO SYN ONYMS | |
| 4566 | IBCNSC INS CO (IN )ACTIVATE COMPANY | |
| 4567 | IBCNSC INS CO INP T CLAIMS | |
| 4568 | IBCNSC INS CO OPT CLAIMS | |
| 4569 | IBCNSC INS CO RX CLAIMS | |
| 4570 | IBCNS Q UIT | |
| 4571 | IBCNSC INS CO DEL ETE COMPAN Y | |
| 4572 | IBCNSJ INS CO PLA NS | |
| 4573 | IBCNSC PROVIDER I D PARAMETE RS | |
| 4574 | IBCNSC INS CO PAY ER | |
| 4575 | IBCNSC INS CO ASS OCIATION | |
| 4576 | ||
| 4577 | Yo u may ente r a new IT EM, if you wish | |
| 4578 | Type <E nter> to c ontinue or '^' to ex it: | |
| 4579 | ||
| 4580 | ||
| 4581 | 12.Modify the Templa te IBCNS I NSURANCE C OMPANY to add in the new menu item AD- B illing add resses by doing opti on PE- pro tocol file edit IBCN SC INSURAN CE CO | |
| 4582 | ||
| 4583 | Using the List manag er tool ^V ALMWB | |
| 4584 | List Manag er Workben ch Aug 15, 20 17@20:00:5 2 Page: 1 of 3 | |
| 4585 | Template: IBCNS INSU RANCE COMP ANY | |
| 4586 | ||
| 4587 | Demograp hics List Reg ion | |
| 4588 | Template Name: IBCN S INSURANC E COMPANY Top Ma rgin: 5 | |
| 4589 | Entity Name: Insu rance Comp any Bottom " : 16 | |
| 4590 | Screen T itle: Insu rance Comp any Editor Right " : 90 | |
| 4591 | ||
| 4592 | ||
| 4593 | Protocol Informati on Other Fi elds | |
| 4594 | Type of List: PRO TOCOL OK to Transport ?: OK | |
| 4595 | Protocol Menu: IBC NSC INSURA NCE CO Use Cur sor Contro l: YES | |
| 4596 | Print Pro tocol: Allowa ble Number of Action s: | |
| 4597 | Hidden Menu: VAL M HIDDEN A CTIONS Date Range Limi t: | |
| 4598 | Automat ic Default s: | |
| 4599 | ||
| 4600 | ||
| 4601 | + Enter ?? f or more ac tions >>> | |
| 4602 | DE Demogr aphic Edit MC MUMPS Code Edit PE Prot ocol Edit | |
| 4603 | PI Protoc ol Informa tion CE Caption Ed it RN Run List | |
| 4604 | LR List R egion Edit CL Change Lis t Template IT Inpu t Template | |
| 4605 | OF Other Fields EA Edit All RO Rout ine Editor | |
| 4606 | Select Too l:Next Scr een// PE Protocol Edit | |
| 4607 | ||
| 4608 | Select PRO TOCOL NAME : IBCNSC I NSURANCE C O In surance Co mpany Edit | |
| 4609 | NAME: IBCN SC INSURAN CE CO ITEM TEXT: Insurance Company E dit | |
| 4610 | TYPE: me nu CREATOR: S HURMAN,JIL LIAN A | |
| 4611 | PACKAGE: INTEGRATE D BILLING COLUMN WID TH: 26 | |
| 4612 | MNEMONIC WIDTH: 4 | |
| 4613 | ITEM: IBCN SC INS CO EDIT ALL MNEMONIC: EA | |
| 4614 | SEQUENCE : 26 | |
| 4615 | ITEM: IBCN SC INS CO APPEALS OF FICE MNEMONIC: AO | |
| 4616 | SEQUENCE : 21 | |
| 4617 | ITEM: IBCN SC INS CO INQUIRY OF FICE MNEMONIC: IO | |
| 4618 | SEQUENCE : 22 | |
| 4619 | ITEM: IBCN SC INS CO MAIN MAILI NG ADDRESS | |
| 4620 | MNEMONIC : MM SEQUENCE: 12 | |
| 4621 | ITEM: IBCN SC INS CO BILLING PA RAMETERS MNEMONIC: BP | |
| 4622 | SEQUENCE : 11 | |
| 4623 | ITEM: IBCN SC INS CO CHANGE COM PANY MNEMONIC: CC | |
| 4624 | SEQUENCE : 32 | |
| 4625 | ITEM: IBCN SC INS CO REMARKS MNEMONIC: RE | |
| 4626 | SEQUENCE : 24 | |
| 4627 | ITEM: IBCN SC INS CO SYNONYMS MNEMONIC: SY | |
| 4628 | ||
| 4629 | Type <Ente r> to cont inue or '^ ' to exit: | |
| 4630 | SEQUENCE : 25 | |
| 4631 | ITEM: IBCN SC INS CO (IN)ACTIVA TE COMPANY | |
| 4632 | MNEMONIC : AI SEQUENCE: 31 | |
| 4633 | ITEM: IBCN SC INS CO INPT CLAIM S MNEMONIC: IC | |
| 4634 | SEQUENCE : 13 | |
| 4635 | ITEM: IBCN SC INS CO OPT CLAIMS MNEMONIC: OC | |
| 4636 | SEQUENCE : 14 | |
| 4637 | ITEM: IBCN SC INS CO RX CLAIMS MNEMONIC: PC | |
| 4638 | SEQUENCE : 15 | |
| 4639 | ITEM: IBCN SC INS CO DELETE COM PANY MNEMONIC: DC | |
| 4640 | SEQUENCE : 33 | |
| 4641 | ITEM: IBCN S QUIT MNEMONIC: EX | |
| 4642 | SEQUENCE : 35 | |
| 4643 | ITEM: IBCN SJ INS CO PLANS MNEMONIC: VP | |
| 4644 | SEQUENCE : 34 | |
| 4645 | ITEM: IBCN SC PROVIDE R ID PARAM ETERS MNEMONIC: ID | |
| 4646 | SEQUENCE : 23 | |
| 4647 | ITEM: IBCN SC INS CO PAYER MNEMONIC: PA | |
| 4648 | SEQUENCE : 23 | |
| 4649 | ITEM: IBCN SC INS CO ASSOCIATIO N MNEMONIC: AC | |
| 4650 | SEQUENCE : 22 | |
| 4651 | ||
| 4652 | Type <Ente r> to cont inue or '^ ' to exit: | |
| 4653 | EXIT ACT ION: I $G( IBFASTXT)= 1 S VALMBC K="Q" | |
| 4654 | SCREEN: I 1 X:$D(^ ORD(101,+$ P(^ORD(101 ,DA(1),10, DA,0),"^") ,24)) ^(24 ) | |
| 4655 | HEADER: D SHOW^VAL M MENU PROMP T: Select Action: | |
| 4656 | TIMESTAM P: 62028,2 9972 | |
| 4657 | ||
| 4658 | ||
| 4659 | NAME: IBCN SC INSURAN CE CO// | |
| 4660 | ||
| 4661 | ||
| 4662 | ||
| 4663 | Select PRO TOCOL NAME : IBCNSC I N | |
| 4664 | 1 I BCNSC INS CO (IN)ACT IVATE COMP ANY (In)Activa te Company AI | |
| 4665 | 2 I BCNSC INS CO APPEALS OFFICE Appeal s Office AA | |
| 4666 | 3 I BCNSC INS CO ASSOCIA TION Associate Companies | |
| 4667 | 4 I BCNSC INS CO BILLING PARAMETER S Bi lling/EDI Param EP | |
| 4668 | 5 I BCNSC INS CO CHANGE COMPANY Change Insurance Co. C C | |
| 4669 | Press <Ent er> to see more, '^' to exit t his list, OR | |
| 4670 | CHOOSE 1-5 : | |
| 4671 | 6 I BCNSC INS CO DELETE COMPANY Delete Company | |
| 4672 | 7 I BCNSC INS CO EDIT AL L Ed it All EA | |
| 4673 | 8 I BCNSC INS CO INPT CL AIMS Inpt Clai ms Office IC | |
| 4674 | 9 I BCNSC INS CO INQUIRY OFFICE Inquir y Office IA | |
| 4675 | 10 I BCNSC INS CO MAIN MA ILING ADDR ESS Main Maili ng Address EM | |
| 4676 | Press <Ent er> to see more, '^' to exit t his list, OR | |
| 4677 | CHOOSE 1-1 0: | |
| 4678 | 11 I BCNSC INS CO OPT CLA IMS Opt Claims Office OC | |
| 4679 | 12 I BCNSC INS CO PAYER Payer PA | |
| 4680 | 13 I BCNSC INS CO REMARKS Rem arks R E | |
| 4681 | 14 I BCNSC INS CO RX CLAI MS P rescr Clai ms Of PC | |
| 4682 | 15 I BCNSC INS CO SYNONYM S Sy nonyms ES | |
| 4683 | Press <Ent er> to see more, '^' to exit t his list, OR | |
| 4684 | CHOOSE 1-1 5: | |
| 4685 | 16 I BCNSC INS CO TELEPHO NE T elephone N umbers ET | |
| 4686 | 17 I BCNSC INSU RANCE CO Insur ance Compa ny Edit | |
| 4687 | CHOOSE 1-1 7: 17 IBC NSC INSURA NCE CO Insurance Company E dit | |
| 4688 | NAME: IBCN SC INSURAN CE CO ITEM TEXT: Insurance Company E dit | |
| 4689 | TYPE: me nu CREATOR: S HURMAN,JIL LIAN A | |
| 4690 | PACKAGE: INTEGRATE D BILLING COLUMN WID TH: 26 | |
| 4691 | MNEMONIC WIDTH: 4 | |
| 4692 | ITEM: IBCN SC INS CO EDIT ALL MNEMONIC: EA | |
| 4693 | SEQUENCE : 26 | |
| 4694 | ITEM: IBCN SC INS CO APPEALS OF FICE MNEMONIC: AO | |
| 4695 | SEQUENCE : 21 | |
| 4696 | ITEM: IBCN SC INS CO INQUIRY OF FICE MNEMONIC: IO | |
| 4697 | SEQUENCE : 22 | |
| 4698 | ITEM: IBCN SC INS CO MAIN MAILI NG ADDRESS | |
| 4699 | MNEMONIC : MM SEQUENCE: 12 | |
| 4700 | ITEM: IBCN SC INS CO BILLING PA RAMETERS MNEMONIC: BP | |
| 4701 | SEQUENCE : 11 | |
| 4702 | ITEM: IBCN SC INS CO CHANGE COM PANY MNEMONIC: CC | |
| 4703 | SEQUENCE : 32 | |
| 4704 | ITEM: IBCN SC INS CO REMARKS MNEMONIC: RE | |
| 4705 | SEQUENCE : 24 | |
| 4706 | ITEM: IBCN SC INS CO SYNONYMS MNEMONIC: SY | |
| 4707 | ||
| 4708 | Type <Ente r> to cont inue or '^ ' to exit: ^ | |
| 4709 | ||
| 4710 | ||
| 4711 | NAME: IBCN SC INSURAN CE CO// | |
| 4712 | PACKAGE: I NTEGRATED BILLING// | |
| 4713 | ITEM TEXT: Insurance Company E dit Repla ce | |
| 4714 | TYPE: menu // | |
| 4715 | ENTRY ACTI ON: ? | |
| 4716 | ENTER STANDARD MUMPS CODE | |
| 4717 | ENTRY ACTI ON: | |
| 4718 | EXIT ACTIO N: I $G(IB FASTXT)=1 S VALMBCK= "Q" Repla ce | |
| 4719 | Select ITE M: IBCNSC INS CO ASS OCIATION// ? | |
| 4720 | Answer wi th ITEM | |
| 4721 | Do you wa nt the ent ire 35-Ent ry ITEM Li st? YES ( Yes) | |
| 4722 | Choose from: | |
| 4723 | IBCNSC INS CO EDI T ALL | |
| 4724 | IBCNSC INS CO BIL LING PARAM ETERS | |
| 4725 | IBCNSC INS CO MAI N MAILING ADDRESS | |
| 4726 | IBCNSC INS CO APP EALS OFFIC E | |
| 4727 | IBCNSC INS CO INQ UIRY OFFIC E | |
| 4728 | IBCNSC INS CO CHA NGE COMPAN Y | |
| 4729 | IBCNSC INS CO REM ARKS | |
| 4730 | IBCNSC INS CO SYN ONYMS | |
| 4731 | IBCNSC INS CO (IN )ACTIVATE COMPANY | |
| 4732 | IBCNSC INS CO INP T CLAIMS | |
| 4733 | IBCNSC INS CO OPT CLAIMS | |
| 4734 | IBCNSC INS CO RX CLAIMS | |
| 4735 | IBCNS Q UIT | |
| 4736 | IBCNSC INS CO DEL ETE COMPAN Y | |
| 4737 | IBCNSJ INS CO PLA NS | |
| 4738 | IBCNSC PROVIDER I D PARAMETE RS | |
| 4739 | IBCNSC INS CO PAY ER | |
| 4740 | IBCNSC INS CO ASS OCIATION | |
| 4741 | ||
| 4742 | Yo u may ente r a new IT EM, if you wish | |
| 4743 | Type <E nter> to c ontinue or '^' to ex it: | |
| 4744 | ||
| 4745 | ||
| 4746 | 13.Create the code b ehind the DE- Dental Address f or the sto rage of th e address to be like the OC- o pt Claims office fun ctionality . Can cop y code fro m routine CLAIMS2^IB CNSC0 for Dental dis play but t he dental address da ta element s are to b e stored i n the Insu rance file #36, .19 section. N ew fields have been created fo r Dental a ddress in .191 throu gh .1911 | |
| 4747 | ||
| 4748 | Select Act ion: Next Screen// O C Opt Cl aims Offic e | |
| 4749 | ||
| 4750 | ||
| 4751 | Are Outpat ient Claim s Processe d by Anoth er Insuran ce Co.?: Y ES | |
| 4752 | // NO NO | |
| 4753 | CLAIMS (OP T) STREET ADDRESS 1: DENTAL AD D1 | |
| 4754 | CLAIMS (OP T) STREET ADDRESS 2: DENTAL AD D2 | |
| 4755 | CLAIMS (OP T) STREET ADDRESS 3: | |
| 4756 | CLAIMS (OP T) PROCESS CITY: DCI TY | |
| 4757 | CLAIMS (OP T) PROCESS STATE: DE LAWARE | |
| 4758 | CLAIMS (OP T) PROCESS ZIP: 1970 9?? | |
| 4759 | Answer mus t be nine (999999999 ) or ten c haracters (99999-999 9) in leng th. | |
| 4760 | The last 4 cannot be '0000' or '9999'. | |
| 4761 | CLAIMS (OP T) PROCESS ZIP: 1970 95552 | |
| 4762 | CLAIMS (OP T) PHONE N UMBER: 123 456789 | |
| 4763 | CLAIMS (OP T) FAX: 99 9-3100.... .......... ......... | |
| 4764 | ||
| 4765 | CLAIMS2 ; display Ou tpatient C laims info rmation ; N OFFSET,S TART,IBCNS 16,IBADD ; WCJ;IB*2.0 *547 ;S ST ART=34,OFF SET=2 S ST ART=35+(2* $G(IBACMAX )),OFFSET= 2 D SET^IB CNSP(START ,OFFSET+20 ," Outpati ent Claims Office In formation ",IORVON,I ORVOFF) ; ;WCJ;IB*2. 0*547;Call New API ; S IBCNS16= $$ADDRESS( IBCNS,.16, 6) S IBCNS 16=$$ADD2( IBCNS,.16, 6) ; D SET ^IBCNSP(ST ART+1,OFFS ET," Compa ny Name: " _$P($G(^DI C(36,+$P(I BCNS16,"^" ,7),0)),"^ ",1)) D SE T^IBCNSP(S TART+2,OFF SET," Stre et: "_$P(I BCNS16,"^" ,1)) D SET ^IBCNSP(ST ART+3,OFFS ET," Stree t 2: "_$P( IBCNS16,"^ ",2)) N OF FSET S OFF SET=45 D S ET^IBCNSP( START+1,OF FSET," Str eet 3: "_$ P(IBCNS16, "^",3)) S IBADD=1 D SET^IBCNSP (START+1+I BADD,OFFSE T," City/S tate: "_$E ($P(IBCNS1 6,"^",4),1 ,15)_$S($P (IBCNS16," ^",4)="":" ",1:", ")_ $P($G(^DIC (5,+$P(IBC NS16,"^",5 ),0)),"^", 2)_" "_$E( $P(IBCNS16 ,"^",6),1, 5)) D SET^ IBCNSP(STA RT+2+IBADD ,OFFSET," Phone: "_$ P(IBCNS16, "^",8)) D SET^IBCNSP (START+3+I BADD,OFFSE T," Fax: " _$P(IBCNS1 6,"^",9)) Q ; | |
| 4766 | 14.Modify the input Template f or the ins urance fil e #36 to i nclude the DE Dental items lik e the OC o pt claims: | |
| 4767 | ||
| 4768 | ||
| 4769 | ||
| 4770 | ||
| 4771 | Select OPT ION: ? | |
| 4772 | Answer with OPTI ON NUMBER, or NAME | |
| 4773 | Choose from: | |
| 4774 | 1 ENTE R OR EDIT FILE ENTRI ES | |
| 4775 | 2 PRIN T FILE ENT RIES | |
| 4776 | 3 SEAR CH FILE EN TRIES | |
| 4777 | 4 MODI FY FILE AT TRIBUTES | |
| 4778 | 5 INQU IRE TO FIL E ENTRIES | |
| 4779 | 6 UTIL ITY FUNCTI ONS | |
| 4780 | 7 OTHE R OPTIONS | |
| 4781 | 8 DATA DICTIONAR Y UTILITIE S | |
| 4782 | 9 TRAN SFER ENTRI ES | |
| 4783 | ||
| 4784 | Select OPT ION: 6 UT ILITY FUNC TIONS | |
| 4785 | Select UTI LITY OPTIO N: ? | |
| 4786 | Answer wi th UTILITY OPTION NU MBER, or N AME | |
| 4787 | Do you wa nt the ent ire 11-Ent ry UTILITY OPTION Li st? yes ( Yes) | |
| 4788 | Choose from: | |
| 4789 | 1 VERI FY FIELDS | |
| 4790 | 2 CROS S-REFERENC E A FIELD OR FILE | |
| 4791 | 3 IDEN TIFIER | |
| 4792 | 4 RE-I NDEX FILE | |
| 4793 | 5 INPU T TRANSFOR M (SYNTAX) | |
| 4794 | 6 EDIT FILE | |
| 4795 | 7 OUTP UT TRANSFO RM | |
| 4796 | 8 TEMP LATE EDIT | |
| 4797 | 9 UNED ITABLE DAT A | |
| 4798 | 10 MAND ATORY/REQU IRED FIELD CHECK | |
| 4799 | 11 KEY DEFINITION | |
| 4800 | ||
| 4801 | Select UTI LITY OPTIO N: 8 TEMP LATE EDIT | |
| 4802 | ||
| 4803 | ||
| 4804 | Modify wha t File: 36 INSURANC E COMPANY (1558 en tries) | |
| 4805 | Select TEM PLATE File : IBEDIT ? ? | |
| 4806 | ||
| 4807 | Select TEM PLATE File : > ?? | |
| 4808 | ||
| 4809 | Select TEM PLATE File : ? | |
| 4810 | Answer with TEMP LATE FILE NUMBER, or NAME | |
| 4811 | Choose from: | |
| 4812 | .4 PRIN T TEMPLATE | |
| 4813 | .401 SORT TEMPLATE | |
| 4814 | .402 INPU T TEMPLATE | |
| 4815 | ||
| 4816 | Select TEM PLATE File : .402 IN PUT TEMPLA TE | |
| 4817 | ||
| 4818 | ||
| 4819 | Select INP UT TEMPLAT E: ? | |
| 4820 | Answer wi th INPUT T EMPLATE | |
| 4821 | Do you wa nt the ent ire INPUT TEMPLATE L ist? YES (Yes) | |
| 4822 | Choose from: | |
| 4823 | AJKEDIT COLLECTIO N AMOUNT AJKEDI T COLLECTI ON AMOUNT | |
| 4824 | (SEP 20, 2 001@10:50) User #452 File #36 | |
| 4825 | IBEDIT INS CO1 IBEDIT INS CO1 | |
| 4826 | (AUG 10, 2 017@16:43) User #520 824637 Fil e #36 | |
| 4827 | TEST BI LL TE ST BILL (MAR 06, 2 017@09:48) User #520 824635 Fil e #36 | |
| 4828 | ||
| 4829 | Select INP UT TEMPLAT E: IBEDIT INS CO1 I BEDIT INS CO1 | |
| 4830 | (AUG 10, 2 017@16:43) User #520 824637 Fil e #36 | |
| 4831 | Do you wan t to use t he screen- mode versi on? YES// | |
| 4832 | TEMPLATE N AME: IBEDI T INS CO1 | |
| 4833 | ||
| 4834 | ||
| 4835 | DAT E LAST MOD IFIED: AUG 10,2017@1 6:43 | |
| 4836 | DATE LAST USED: AUG 15,2017 | |
| 4837 | READ A CCESS: | |
| 4838 | WRITE A CCESS: | |
| 4839 | U SER #: 520 824637 | |
| 4840 | ||
| 4841 | DESCRIPT ION... C ANONIC FOR FILE 36: | |
| 4842 | ||
| 4843 | ||
| 4844 | ||
| 4845 | ||
| 4846 | ||
| 4847 | ( Edit Field s on Next Page...) | |
| 4848 | ||
| 4849 | __________ __________ __________ __________ __________ __________ __________ _________ | |
| 4850 | ||
| 4851 | Exit Sa ve Next Page R efresh Quit | |
| 4852 | ||
| 4853 | Enter a CO MMAND, or "^" follow ed by the CAPTION of a FIELD t o jump to. | |
| 4854 | ||
| 4855 | COMMAND: N P ress <PF1> H for help Insert | |
| 4856 | ||
| 4857 | ||
| 4858 | ||
| 4859 | ||
| 4860 | ||
| 4861 | ||
| 4862 | ||
| 4863 | ||
| 4864 | ||
| 4865 | ||
| 4866 | ||
| 4867 | ||
| 4868 | ||
| 4869 | ||
| 4870 | ||
| 4871 | ||
| 4872 | ||
| 4873 | __________ __________ __________ __________ __________ __________ __________ _________. | |
| 4874 | ||
| 4875 | ||
| 4876 | ||
| 4877 | ||
| 4878 | ||
| 4879 | ||
| 4880 | Editing In put Templa te "IBEDIT INS CO1" | |
| 4881 | ========== ==[INSERT ]========= ======< (F ile 36) >= ===[Press <PF1>H for help]==== | |
| 4882 | @30 | |
| 4883 | S:",10,6," '[IBY Y="@ 80" | |
| 4884 | ANOTHER CO . PROCESS OP CLAIMS? ;T | |
| 4885 | S:'X Y="@3 1" | |
| 4886 | CLAIMS (OP T) COMPANY NAME | |
| 4887 | S Y="@36" | |
| 4888 | @31 | |
| 4889 | CLAIMS (OP T) STREET ADDRESS 1 | |
| 4890 | S:X="" Y=" @5" | |
| 4891 | CLAIMS (OP T) STREET ADDRESS 2 | |
| 4892 | S:X="" Y=" @5" | |
| 4893 | CLAIMS (OP T) STREET ADDRESS 3 | |
| 4894 | @5 | |
| 4895 | CLAIMS (OP T) PROCESS CITY | |
| 4896 | CLAIMS (OP T) PROCESS STATE | |
| 4897 | CLAIMS (OP T) PROCESS ZIP | |
| 4898 | CLAIMS (OP T) PHONE N UMBER | |
| 4899 | CLAIMS (OP T) FAX | |
| 4900 | @36 | |
| 4901 | <=======T= ======T=== ====T===== ==T======= T=======T= ======T=== ====T===== ==T======= | |
| 4902 | ||
| 4903 | 15.Modify routine ^I BCNSC to a dd in the new Dental option co de and ref lect the c orrect men u sequence order. | |
| 4904 | ||
| 4905 | Routines | |
| 4906 | Activities | |
| 4907 | Routine Na me | |
| 4908 | IBCNSC | |
| 4909 | Enhancemen t Category | |
| 4910 | New | |
| 4911 | Modify | |
| 4912 | Delete | |
| 4913 | No Change | |
| 4914 | RTM | |
| 4915 | ||
| 4916 | Related Op tions | |
| 4917 | None | |
| 4918 | Related Ro utines | |
| 4919 | Routines “ Called By” | |
| 4920 | Routines “ Called” | |
| 4921 | ||
| 4922 | ||
| 4923 | ||
| 4924 | ||
| 4925 | Data Dicti onary (DD) Reference s | |
| 4926 | ||
| 4927 | ||
| 4928 | Related Pr otocols | |
| 4929 | None | |
| 4930 | Related In tegration Control Re gistration s (ICRs) | |
| 4931 | None | |
| 4932 | Data Passi ng | |
| 4933 | Input | |
| 4934 | Output Re ference | |
| 4935 | Both | |
| 4936 | Global Re ference | |
| 4937 | Local | |
| 4938 | Input Attr ibute Name and Defin ition | |
| 4939 | Name: | |
| 4940 | Definition : | |
| 4941 | Output Att ribute Nam e and Defi nition | |
| 4942 | Name: | |
| 4943 | Definition : | |
| 4944 | Current Lo gic | |
| 4945 | IBCNSC ;AL B/NLR - IN SURANCE CO MPANY EDIT ;6/1/05 9 :42am ;;2. 0;INTEGRAT ED BILLING ;**46,137, 184,276,32 0,371,400, 488,547**; 21-MAR-94; Build 119 ;;Per VA D irective 6 402, this routine sh ould not b e modified . ; ;also used for I A #4694 ;E N ; -- mai n entry po int for IB CNS INSURA NCE COMPAN Y, IBCNS V IEW INS CO NEW IB1ST K IBFASTX T,VALMQUIT ,VALMEVL,X QORS,^TMP( "XQORS",$J ),IBCNS S IBCHANGE=" OKAY" I '$ G(IBVIEW) D EN^VALM( "IBCNS INS URANCE COM PANY") G E NQ D EN^VA LM("IBCNS VIEW INS C O")ENQ Q ; HDR ; -- h eader code S VALMHDR (1)="Insur ance Compa ny Informa tion for: "_$E($P(^D IC(36,IBCN S,0),"^"), 1,30) S VA LMHDR(2)=" Type of Co mpany: "_$ E($P($G(^I BE(355.2,+ $P($G(^DIC (36,+IBCNS ,0)),"^",1 3),0)),"^" ),1,20)_" Currently "_$S(+($P( $G(^DIC(36 ,+IBCNS,0) ),"^",5)): "Inactive" ,1:"Active ") Q ;INIT ; -- init variables and list array K VA LMQUIT S V ALMCNT=0,V ALMBG=1 I '$D(IBCNS) D INSCO Q :$D(VALMQU IT) D BLD, HDR QBLD ; -- list b uilder ;WC J;IB*2.0*5 47 ;NEW BL NKI NEW BL NKI,IBACMA X ; new va riable set in PARAM section an d needed t hroughout for displa y ; K ^TMP ("IBCNSC", $J) D KILL ^VALM10() ; delete a ll video a ttributes F BLNKI=1: 1:62 D BLA NK(.BLNKI) ; 62 blan k lines to start wit h D PARAM^ IBCNSC01 ; billing p arameters D MAIN^IBC NSC01 ; ma in mailing address D CLAIMS1^I BCNSC0 ; i npatient c laims offi ce D CLAIM S2^IBCNSC0 ; outpati ent claims office D PRESCR^IBC NSC1 ; pre scription claims off ice D APPE ALS ; ap peals offi ce D INQUI RY ; inq uiry offic e D DISP^I BCNSC02 ; parent/chi ld associa tions (ESG 11/3/05) D PROVID^I BCNSC1 ; p rovider ID s D PAYER^ IBCNSC01 ; payer/pay er apps (E SG 7/29/02 IIV proje ct) D REMA RKS^IBCNSC 01 ; remar ks D SYN^I BCNSC01 ; synonyms S VALMCNT=+ $O(^TMP("I BCNSC",$J, ""),-1) Q ;APPEALS ; N OFFSET, START,IBCN S14,IBADD ; ;WCJ;IB* 2.0*547;Ca ll new API ;S IBCNS1 4=$$ADDRES S^IBCNSC0( IBCNS,.14, 7) S IBCNS 14=$$ADD2^ IBCNSC0(IB CNS,.14,7) ; ;WCJ;IB *2.0*547 ; S START=48 ,OFFSET=2 S START=49 +(2*$G(IBA CMAX)),OFF SET=2 D SE T^IBCNSP(S TART,OFFSE T+25," App eals Offic e Informat ion ",IORV ON,IORVOFF ) D SET^IB CNSP(START +1,OFFSET, " Company Name: "_$P ($G(^DIC(3 6,+$P(IBCN S14,"^",7) ,0)),"^",1 )) D SET^I BCNSP(STAR T+2,OFFSET ," Street: "_$P(IBCN S14,"^",1) ) D SET^IB CNSP(START +3,OFFSET, " Street 2 : "_$P(IBC NS14,"^",2 )) N OFFSE T S OFFSET =45 D SET^ IBCNSP(STA RT+1,OFFSE T," Street 3: "_$P(I BCNS14,"^" ,3)) S IBA DD=1 D SET ^IBCNSP(ST ART+1+IBAD D,OFFSET," City/Stat e: "_$E($P (IBCNS14," ^",4),1,15 )_$S($P(IB CNS14,"^", 4)="":"",1 :", ")_$P( $G(^DIC(5, +$P(IBCNS1 4,"^",5),0 )),"^",2)_ " "_$E($P( IBCNS14,"^ ",6),1,5)) D SET^IBC NSP(START+ 2+IBADD,OF FSET," Pho ne: "_$P(I BCNS14,"^" ,8)) D SET ^IBCNSP(ST ART+3+IBAD D,OFFSET," Fax: "_$P (IBCNS14," ^",9)) Q ; INQUIRY ; ; N OFFSET ,START,IBC NS15,IBADD ; ;WCJ;IB *2.0*547;C all new AP I ;S IBCNS 15=$$ADDRE SS^IBCNSC0 (IBCNS,.15 ,8) S IBCN S15=$$ADD2 ^IBCNSC0(I BCNS,.15,8 ) ; ;WCJ;I B*2.0*547 ;S START=5 5,OFFSET=2 S START=5 6+(2*$G(IB ACMAX)),OF FSET=2 D S ET^IBCNSP( START,OFFS ET+25," In quiry Offi ce Informa tion ",IOR VON,IORVOF F) D SET^I BCNSP(STAR T+1,OFFSET ," Company Name: "_$ P($G(^DIC( 36,+$P(IBC NS15,"^",7 ),0)),"^", 1)) D SET^ IBCNSP(STA RT+2,OFFSE T," Street : "_$P(IBC NS15,"^")) D SET^IBC NSP(START+ 3,OFFSET," Street 2: "_$P(IBCN S15,"^",2) ) N OFFSET S OFFSET= 45 D SET^I BCNSP(STAR T+1,OFFSET ," Street 3: "_$P(IB CNS15,"^", 3)) S IBAD D=1 D SET^ IBCNSP(STA RT+1+IBADD ,OFFSET," City/State : "_$E($P( IBCNS15,"^ ",4),1,15) _$S($P(IBC NS15,"^",4 )="":"",1: ", ")_$P($ G(^DIC(5,+ $P(IBCNS15 ,"^",5),0) ),"^",2)_" "_$E($P(I BCNS15,"^" ,6),1,5)) D SET^IBCN SP(START+2 +IBADD,OFF SET," Phon e: "_$P(IB CNS15,"^", 8)) D SET^ IBCNSP(STA RT+3+IBADD ,OFFSET," Fax: "_$P( IBCNS15,"^ ",9)) Q ;H ELP ; -- h elp code S X="?" D D ISP^XQORM1 W !! Q ;E XIT ; -- e xit code K VALMQUIT, IBCNS,IBCH ANGE,IBFAS TXT D CLEA N^VALM10 Q ;INSCO ; -- select insurance company NE W DLAYGO,D IC,X,Y,DTO UT,DUOUT,I BCNS3 I '$ D(IBCNS) D G:$D(VAL MQUIT) INS COQ .S DIC ="^DIC(36, ",DIC(0)=" AEQMZ",DIC ("S")="I ' $G(^(5))" .I '$G(IBV IEW) S DLA YGO=36,DIC (0)=DIC(0) _"L" .D ^D IC K DIC . S IBCNS=+Y .;/Beginn ing of IB* 2.0*488 (v d) .I +IBC NS I $P($G (^DIC(36,+ IBCNS,3)), "^",1)="" D ; Se t default for EDI=Tr ansmit? to YES-LIVE ..S DR="3. 01////1",D IE="^DIC(3 6,",DA=IBC NS D ^DIE K DIE ..;/ End of IB* 2.0*488 (v d) I $G(IB CNS)<1 K I BCNS S VAL MQUIT="" G INSCOQINS COQ ; K DI C Q ;BLANK (LINE) ; - - Build bl ank line D SET^VALM1 0(.LINE,$J ("",80)) Q ;EDIKEY() ; input t ransform c ode to det ermine if user is al lowed to e dit ; cert ain fields in the in surance co mpany file NEW OK S OK=0 I $$K CHK^XUSRB( "IB EDI IN SURANCE ED IT") S OK= 1 G EDIKEY X D EN^DDI OL("You mu st hold th e IB EDI I NSURANCE E DIT securi ty key to edit this field.",," !!") D EN^ DDIOL("",, "!!?5")EDI KEYX ; Q O K ;DUPQUAL (IBCNS,QUA L,FIELD) ; input tra nsform to make sure that the s ame qualif ier is not used twic e for ; pa yer second ary IDs. T here are t wo sets of fields in file 36 t hat can no t be dupli cated. ; 6 .01 EDI IN ST SECONDA RY ID QUAL (1) can no t be the s ame as 6.0 3 EDI INST SECONDARY ID QUAL(2 ) ; 6.05 E DI PROF SE CONDARY ID QUAL(1) c an not be the same a s 6.07 EDI PROF SECO NDARY ID Q UAL(2) ; ; Input: ; IBCNS is the insura nce compan y internal number ; QUAL is th e internal code of t he value b eing input . ; FIELD is the fie ld it is b eing compa re with. ; ; Returns : ; TRUE/1 if they a re the sam e (duplica te) ; FALS E/0 if the y are not ; Q:$G(QUA L)="" 0 ; should not happen be cause this is invoke d as an in put transf orm Q:'+$G (IBCNS) 1 ; stop fro m editing through fi leman N DU P S DUP=$$ GET1^DIQ(3 6,+$G(IBCN S)_",",+$G (FIELD),"I ") D CLEAN ^DILF Q QU AL=DUP ; ; WCJ;IB*2.0 *547ALLOWE D(IBAC) ; input tran sform to m ake sure t hat Admini strative C ontractor is set up in the sit e paramete rs. ; it w ill be set up for ei ther comme rcial or m edicare. S ince the t ype is def ined my th e plan and we are at a higher ; level in the Insur ance Compa ny, we hav e to allow both. ; c alled from ^DD(36.01 5,.01,0) a nd ^DD(36. 016,.01,0) ; ;3/17/2 016 - A de cision was made to l imit which type is a llowed by using the TYPE OF CO VERAGE fie ld. (TAZ) ; ; ; Inpu t: ; IBAC is the int ernal code of the va lue being input. ; ; Returns: ; TRUE/1 i f allowed (set up in site para meters) ; FALSE/0 if they are not ; Q:$ D(^IBE(350 .9,1,$S($$ GET1^DIQ(3 6,IBCNS_", ","TYPE OF COVERAGE" )="MEDICAR E":81,1:82 ),"B",IBAC )) 1 Q 0 ; ; WCJ;IB* 2.0*547 ; This is to clean up any extran eous nodes if a user entered a n alternat e ID type, but not a n actual I D.CLEANIDS (INSIEN) ; ; INSIEN= Insurance Company IE N ; N NODE ,LOOP,DATA ,CLEANUP F NODE=15,1 6 D .S LOO P=0 F S L OOP=$O(^DI C(36,INSIE N,NODE,LOO P)) Q:'+LO OP S DATA =$G(^(LOOP ,0)) I DAT A]"",$P(DA TA,U,2)="" D ..N DIK ,DA ..S DA =LOOP,DA(1 )=INSIEN . .S DIK="^D IC(36,"_IN SIEN_","_N ODE_"," .. D ^DIK ..S CLEANUP=1 I $G(CLEA NUP) D . N DIR . S D IR("A",1)= "Payer ID Types with out corres ponding ID # were del eted." . S DIR(0)="E A",DIR("A" )="PRESS E NTER TO CO NTINUE " . D ^DIR .Q Q | |
| 4946 | ||
| 4947 | ||
| 4948 | Modified L ogic (Chan ges are in bold) | |
| 4949 | ||
| 4950 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.