- IBCEF79 ;ALB/ESG - Billing Provider functions ;13-Aug-2008
- ;;2.0;INTEGRATED BILLING;**400,419,432,516**;21-MAR-94;Build 123
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- B(IBIFN,COB) ; Determine Billing Provider and Service Facility information
- ; This function returns a string in the following format:
- ; [1] billing provider Institution file pointer (IEN to file 4) or "0"
- ; if the billing provider cannot be determined
- ; [2] billing provider name (.01 field in file 4) or Error reason why
- ; the billing provider cannot be determined - used when piece [1]=0
- ; [3] 0 if the service facility is a VA institution in file 4
- ; 1 if the service facility is a non-VA facility in file 355.93
- ; "" if the service facility is blank - when there is no service facility
- ; [4] service facility IEN - either an IEN to file 4 or to file 355.93
- ; or "" if the service facility is blank
- ;
- ; Input parameters
- ; IBIFN - claim# required
- ; COB - payer sequence# - optional - defaults to current payer sequence# if not passed in
- ;
- NEW %,Z,IBU2,NVAFAC,BP,IB0,EVDT,IBDIV,BPDIV,BPDIVCHK,RXFLG,D,D0,DI,DIQ2,X,Y
- S Z=""
- S IBIFN=+$G(IBIFN)
- I 'IBIFN S Z="0^Invalid claim.^^" G BX
- I '$D(^DGCR(399,IBIFN,0)) S Z="0^Claim doesn't exist.^^" G BX
- I '$G(COB) S COB=$$COBN^IBCEF(IBIFN) ; current payer sequence default
- I '$F(".1.2.3.","."_COB_".") S Z="0^Invalid Payer Sequence#: """_COB_"""^^" G BX
- ;
- ; set some initial variables for all claims
- S IB0=$G(^DGCR(399,IBIFN,0))
- S EVDT=$P(IB0,U,3) ; claim event date
- I 'EVDT S EVDT=DT ; - default today if undefined
- S IBDIV=+$P(IB0,U,22) ; division ptr file 40.8
- I 'IBDIV S IBDIV=$$PRIM^VASITE(EVDT) ; - default primary division as of event date
- I IBDIV'>0 S $P(Z,U,1,2)="0^Invalid Division for Event Date "_$$FMTE^XLFDT(EVDT,"5Z")_"." G BX
- S BPDIV=+$$SITE^VASITE(EVDT,IBDIV) ; division institution ptr file 4
- I BPDIV'>0 S $P(Z,U,1,2)="0^Invalid Institution for Event Date "_$$FMTE^XLFDT(EVDT,"5Z")_"." G BX
- ;
- ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- ; marked for deletion, to be deleted after 3/15/2018. That flag
- ; will now always be null. The following section of code was
- ; commented out because of this. This section can be deleted in
- ; the future.
- ;
- ;; check ins co switchback flag
- ;I $$INSFLGS(IBIFN,COB)>0 D G BX
- ;. N IBZ,SVCIEN,SVCTYP
- ;. ; revert billing provider and service facility calculation to pre-patch 400 methods
- ;. ;
- ;. ; service facility is legacy N-RENDERING INSTITUTION data
- ;. D F^IBCEF("N-RENDERING INSTITUTION","IBZ",,IBIFN)
- ;. S SVCIEN=+IBZ ; service facility ien
- ;. S SVCTYP=+$P(IBZ,U,2) ; service facility type - 0=VA inst, 1=non-VA facility
- ;. ;
- ;. I 'SVCIEN S $P(Z,U,3)="",$P(Z,U,4)="" ; no svc fac
- ;. I SVCIEN S $P(Z,U,3)=SVCTYP,$P(Z,U,4)=SVCIEN ; yes svc fac
- ;. ;
- ;. ; billing provider = institution of main division in the database
- ;. S BP=+$$SITE^VASITE
- ;. I BP,$$BPFACTYP(BP) S $P(Z,U,1,2)=$$CHK(BP) Q
- ;. S $P(Z,U,1,2)="0^Facility Type of Main Division Institution is invalid."
- ;. Q
- ;
- S IBU2=$G(^DGCR(399,IBIFN,"U2"))
- S NVAFAC=+$P(IBU2,U,10) ; non-VA facility
- I NVAFAC D G BX
- . S $P(Z,U,3)=1 ; service facility is the non-VA facility
- . S $P(Z,U,4)=NVAFAC ; ien to file 355.93
- . S BP=BPDIV ; institution of division on claim (IB*2*419)
- . I BP,$$BPFACTYP(BP) S $P(Z,U,1,2)=$$CHK(BP) Q
- . S $P(Z,U,1,2)="0^Facility Type of Claim's Division is invalid for the Billing Provider."
- . Q
- ;
- S BPDIVCHK=0 ; flag indicating if the div inst has been checked
- S RXFLG=$$ISRX^IBCEF1(IBIFN) ; pharmacy flag
- ;
- I RXFLG D
- . S BP=+$$RXSITE^IBCEF73A(IBIFN) ; dispensing pharmacy ien for pharmacy claims
- . I 'BP S BP=BPDIV,BPDIVCHK=1 ; use division institution if pharmacy not found
- . Q
- ;
- I 'RXFLG S BP=BPDIV,BPDIVCHK=1 ; non-Rx claims use division institution
- ;
- I BP,$$BPFACTYP(BP) D G BX ; billing provider type is valid
- . S $P(Z,U,1,2)=$$CHK(BP)
- . ;
- . ; 3/27/09 - Special Case
- . ; If we are printing the CMS-1500 claim form, then populate the service facility with the billing provider.
- . ; For any other calculation, the service facility is blank here.
- . ;
- . I $G(^TMP("IB 1500 PRINT",$J,IBIFN)) D
- .. S $P(Z,U,3)=0 ; service facility is in file 4
- .. S $P(Z,U,4)=$P(Z,U,1) ; move billing provider ien over
- .. Q
- . Q
- ;
- ; here, the BP has an invalid billing provider facility type
- ; move this BP over to the service facility
- S $P(Z,U,3)=0 ; service facility is in file 4
- S $P(Z,U,4)=BP ; move this BP over to the service facility
- ;
- I BPDIVCHK G B1 ; the division institution has already been checked...skip down to tag B1 to check the parent
- ;
- ; check the division institution
- S BP=BPDIV,BPDIVCHK=1
- I BP,$$BPFACTYP(BP) S $P(Z,U,1,2)=$$CHK(BP) G BX
- ;
- B1 ;
- ; check the parent
- S BP=$$BPPAR(BPDIV) ; institution of the parent of the division
- I BP,$$BPFACTYP(BP) S $P(Z,U,1,2)=$$CHK(BP) G BX
- ;
- ; here, the facility type of the parent is also not valid, so it is an error
- S $P(Z,U,1,2)="0^Facility Type of Division and the Division's Parent Institution are Invalid."
- BX ;
- Q Z
- ;
- CHK(IEN) ; Perform final billing provider checks on passed in Institution
- ; file pointer - File 4 ien
- ; Function returns final pieces 1 and 2 of $$B function as described above
- NEW BP
- S IEN=+$G(IEN)
- I 'IEN S BP="0^Invalid Institution pointer IEN." G CHKX
- I '$$BPCHKN(IEN) S BP="0^Not a National Institution." G CHKX
- I '$$BPCHKA(IEN) S BP="0^Not an Active Institution." G CHKX
- ;
- S BP=IEN_U_$P($$NS^XUAF4(IEN),U,1) ; ien^name DBIA# 2171
- CHKX ;
- Q BP
- ;
- BPCHKN(IEN) ; Is this a national Institution?
- N Z S Z=0
- I $$STATUS^XUAF4(+IEN)="N" S Z=1 ; DBIA# 2171
- BPCHKNX ;
- Q Z
- ;
- BPCHKA(IEN) ; Is this an active Institution?
- N Z S Z=0
- I $$ACTIVE^XUAF4(+IEN) S Z=1 ; DBIA# 2171
- BPCHKAX ;
- Q Z
- ;
- BPFACTYP(IEN) ; Is the facility type of this Institution a valid Billing Provider facility type?
- N Z S Z=0
- I $D(^IBE(350.9,1,20,"B",+$$GET1^DIQ(4,+IEN_",",13,"I"))) S Z=1
- BPFACTPX ;
- Q Z
- ;
- BPPAR(IEN) ; Who is the parent for this Institution?
- ; Function returns the IEN to file 4 of the parent institution as defined in File 4
- N Z,PIA
- D PARENT^XUAF4($NA(PIA),("`"_+IEN),"PARENT FACILITY") ; DBIA# 2171
- S Z=+$O(PIA("P",""))
- BPPARX ;
- Q Z
- ;
- TAX(IBIFN) ; Update default billing provider and service facility taxonomy codes
- ; and billing provider secondary IDs and Qualifiers.
- ; This is called via new style xrefs to update the default value of these fields
- ;
- N BPZ,BPTAX,SFTAX,IENS,IBTAXO,IBU3,IBM1,BPID1,BPQL1,BPID2,BPQL2,BPID3,BPQL3
- N D,D0,DI,DIQ2,X,Y
- ;
- I '$G(IBIFN) G TAXQ
- I $P($G(^DGCR(399,IBIFN,0)),U,13)'=1 G TAXQ ; claim is not editable
- ;
- S BPZ=$$B(IBIFN) ; billing provider/service facility string
- ;
- ; billing provider taxonomy
- S BPTAX=""
- I +BPZ S BPTAX=+$P($$TAXORG^XUSTAX(+BPZ),U,2) ; ien to file 8932.1 for VA billing provider
- I 'BPTAX S BPTAX=""
- ;
- ; service facility taxonomy
- S SFTAX=""
- I $P(BPZ,U,3)=0,+$P(BPZ,U,4) S SFTAX=+$P($$TAXORG^XUSTAX(+$P(BPZ,U,4)),U,2) ; ien to file 8932.1 for VA svc fac
- I $P(BPZ,U,3)=1,+$P(BPZ,U,4) S SFTAX=+$P($$TAXGET^IBCEP81(+$P(BPZ,U,4)),U,2) ; ien to file 8932.1 for non-VA svc fac
- I 'SFTAX S SFTAX=""
- ;
- ; billing provider secondary ID#2 and qualifier#2 for each payer on the claim
- S BPID1=$$PRVNUM^IBCU(IBIFN,,1) ; #122
- S BPQL1=$$PRVQUAL^IBCU(IBIFN,,1) ; #128
- S BPID2=$$PRVNUM^IBCU(IBIFN,,2) ; #123
- S BPQL2=$$PRVQUAL^IBCU(IBIFN,,2) ; #129
- S BPID3=$$PRVNUM^IBCU(IBIFN,,3) ; #124
- S BPQL3=$$PRVQUAL^IBCU(IBIFN,,3) ; #130
- ;
- ; Use FileMan DBS call to update these fields if changes are necessary
- S IENS=IBIFN_","
- S IBU3=$G(^DGCR(399,IBIFN,"U3"))
- S IBM1=$G(^DGCR(399,IBIFN,"M1"))
- I SFTAX'=$P(IBU3,U,2) S IBTAXO(399,IENS,243)=SFTAX ; service facility taxonomy
- I BPTAX'=$P(IBU3,U,11) S IBTAXO(399,IENS,252)=BPTAX ; billing provider taxonomy
- I BPID1'=$P(IBM1,U,2) S IBTAXO(399,IENS,122)=BPID1 ; primary ID
- I BPQL1'=$P(IBM1,U,10) S IBTAXO(399,IENS,128)=BPQL1 ; primary Qual
- I BPID2'=$P(IBM1,U,3) S IBTAXO(399,IENS,123)=BPID2 ; secondary ID
- I BPQL2'=$P(IBM1,U,11) S IBTAXO(399,IENS,129)=BPQL2 ; secondary Qual
- I BPID3'=$P(IBM1,U,4) S IBTAXO(399,IENS,124)=BPID3 ; tertiary ID
- I BPQL3'=$P(IBM1,U,12) S IBTAXO(399,IENS,130)=BPQL3 ; tertiary Qual
- ;
- I '$D(IBTAXO) G TAXQ ; no changes necessary
- ;
- D FILE^DIE(,"IBTAXO") ; update fields
- TAXQ ;
- Q
- ;
- INSFLGS(IBIFN,COB) ; get insurance company flags for a given claim
- ; returns string of flags in the following format:
- ; switchback flag ^ send service facility flag ^ institution file address flag ^ error
- ; switchback flag: field 36/4.11 or 36/4.12, depending on form type. "-1" if error has occurred.
- ; send service facility flag: field 36/4.07, empty if error has occurred or switchback flag is not set.
- ; institution file address flag: field 36/4.13, empty if error has occurred or switchback flag is not set.
- ;
- ; MRD;IB*2.0*516 - The four flag fields described above (File #36,
- ; Field #'s 4.07, 4.11, 4.12, 4.13) are all being marked for
- ; deletion. All references to those fields are being removed
- ; as part of this patch.
- ;
- Q ""
- ;
- ;N FLGS,FT,INSIEN,INS4
- ;S IBIFN=+$G(IBIFN) I 'IBIFN Q "-1^^^Invalid claim."
- ;I '$D(^DGCR(399,IBIFN,0)) Q "-1^^^Claim doesn't exist."
- ;I '$G(COB) S COB=$$COBN^IBCEF(IBIFN) ; current payer sequence default
- ;I '(".1.2.3."[("."_COB_".")) Q "-1^^^Invalid Payer Sequence#: """_COB_"""."
- ;S INSIEN=$$POLICY^IBCEF(IBIFN,1,COB) I 'INSIEN Q "-1^^^No insurance company associated with the claim."
- ;S INS4=$G(^DIC(36,INSIEN,4)),FT=$$FT^IBCEF(IBIFN)
- ;S FLGS=$P(INS4,U,$S(FT=2:11,1:12)) I '+FLGS Q FLGS ; we are done if switchback flag is not set
- ;S $P(FLGS,U,2)=$P(INS4,U,7),$P(FLGS,U,3)=$P(INS4,U,13) ; if switchback is set, get the other 2 flags
- ;Q FLGS
- ;
- GETBP(IBIFN,COB,INST,SUB,IBXSAVE) ; Get billing provider data for claim output
- ; Used to extract billing provider name, address, and phone# for PRV segment and for CMS-1500, Box 33
- ; IBIFN - claim ien required
- ; COB - payer sequence (optional, defaults to current payer seq)
- ; INST - billing provider VA file 4 ien required
- ; SUB - subscript to use in IBXSAVE local array required
- ; IBXSAVE - pass by reference
- ; Returns IBXSAVE(SUB,"NAME")
- ; IBXSAVE(SUB,"ADDR1")
- ; IBXSAVE(SUB,"ADDR2")
- ; IBXSAVE(SUB,"CITY")
- ; IBXSAVE(SUB,"ST")
- ; IBXSAVE(SUB,"ZIP")
- ; IBXSAVE(SUB,"PHONE")
- ;
- ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- ; marked for deletion, to be deleted after 3/15/2018. That flag
- ; will now always be null. Several sections of this procedure have
- ; been commented out because of this. Those sections can be
- ; deleted in the future.
- ;
- NEW IBZ
- K IBXSAVE(SUB)
- I '$G(COB) S COB=$$COBN^IBCEF(IBIFN)
- ;
- ;S INSFLGS=$$INSFLGS(IBIFN,COB) ; all ins co flags
- ;S SWBFLG=(+INSFLGS>0) ; main switchback flag
- ;S (BPTP,MAINPTP)="" ; initialize vars used only in switchback mode
- ;I SWBFLG D
- ;. S BPTP=$$MAINPRV^IBJPS3 ; main division pay-to provider data string
- ;. S MAINPTP=($P(BPTP,U,10)'["IB177") ; flag that says whether main div exists as a pay-to
- ;. Q
- ;
- ; If Switchback is ON and the ins. company parameter Use billing provider VAMC address is not on and
- ; main div pay-to exists, then use the pay-to provider data for the main division in the database.
- ; This is the "normal" switchback data.
- ;I SWBFLG,'$P(INSFLGS,U,3),MAINPTP D G GETBPX ; switchback + billing provider address flag + main ptp exists
- ;. ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- ;. ;S IBXSAVE(SUB,"NAME")=$P(BPTP,U,1)
- ;. S IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- ;. S:IBXSAVE(SUB,"NAME")="" IBXSAVE(SUB,"NAME")=$P(BPTP,U,1)
- ;. S IBXSAVE(SUB,"ADDR1")=$P(BPTP,U,5)
- ;. S IBXSAVE(SUB,"ADDR2")=$P(BPTP,U,6)
- ;. S IBXSAVE(SUB,"CITY")=$P(BPTP,U,7)
- ;. S IBXSAVE(SUB,"ST")=$P(BPTP,U,8)
- ;. S IBXSAVE(SUB,"ZIP")=$P(BPTP,U,9)
- ;. S IBXSAVE(SUB,"PHONE")=$P(BPTP,U,4)
- ;. Q
- ;
- ; Special Case: Switchback is ON, the ins. company parameter Use billing provider VAMC address
- ; is not on, but the main division is NOT defined as a Pay-To provider.
- ; Get the name from the Institution File, but everything else from the claim's Pay-to provider
- ;I SWBFLG,'$P(INSFLGS,U,3),'MAINPTP D G GETBPX
- ;. ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- ;. ;S IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- ;. S IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- ;. S:IBXSAVE(SUB,"NAME")="" IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0) ; Inst name
- ;. S IBZ=$$PRVDATA^IBJPS3(IBIFN)
- ;. S IBXSAVE(SUB,"ADDR1")=$P(IBZ,U,5)
- ;. S IBXSAVE(SUB,"ADDR2")=$P(IBZ,U,6)
- ;. S IBXSAVE(SUB,"CITY")=$P(IBZ,U,7)
- ;. S IBXSAVE(SUB,"ST")=$P(IBZ,U,8)
- ;. S IBXSAVE(SUB,"ZIP")=$P(IBZ,U,9)
- ;. S IBXSAVE(SUB,"PHONE")=$P(IBZ,U,4)
- ;. Q
- ;
- ; At this point, we want to get the billing provider data from the Institution file
- ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- ;S IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- S IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- S:IBXSAVE(SUB,"NAME")="" IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- S IBXSAVE(SUB,"ADDR1")=$$GETFAC^IBCEP8(INST,0,1)
- S IBXSAVE(SUB,"ADDR2")=$$GETFAC^IBCEP8(INST,0,2)
- S IBXSAVE(SUB,"CITY")=$$GETFAC^IBCEP8(INST,0,"3C")
- S IBXSAVE(SUB,"ST")=$$GETFAC^IBCEP8(INST,0,"3S")
- S IBXSAVE(SUB,"ZIP")=$$GETFAC^IBCEP8(INST,0,"3Z")
- S IBXSAVE(SUB,"PHONE")=$$PRVPHONE^IBJPS3(IBIFN) ; pay-to phone for claim
- ;I SWBFLG,MAINPTP S IBXSAVE(SUB,"PHONE")=$P(BPTP,U,4) ; switchback: pay-to phone for main division
- ;
- ; 3/30/09 - new requirement - for locally printed CMS-1500 claims, use the pay-to provider address information - Box 33
- ;I 'SWBFLG,SUB="BOX33" D
- I SUB="BOX33" D
- . S IBZ=$$PRVDATA^IBJPS3(IBIFN)
- . S IBXSAVE(SUB,"ADDR1")=$P(IBZ,U,5)
- . S IBXSAVE(SUB,"ADDR2")=$P(IBZ,U,6)
- . S IBXSAVE(SUB,"CITY")=$P(IBZ,U,7)
- . S IBXSAVE(SUB,"ST")=$P(IBZ,U,8)
- . S IBXSAVE(SUB,"ZIP")=$P(IBZ,U,9)
- . Q
- ;
- GETBPX ;
- Q
- ;
- SENDSF(IBIFN,COB) ; Send service facility information for the EDI claim?
- ; Function value returns 1 (send service facility information) or 0 (don't send it)
- ; The only time this function returns 0 is when the pre-patch 400 switchback flag is set, and
- ; care was provided at the main division (VAMC) in the database, and the 36,4.07 ins. co. flag is set to NO.
- ; This function is used in the EDI claim (segments SUB, SUB2, NPI-16, and NPI-17).
- ; IBIFN required
- ; COB optional, defaults to current payer sequence
- ;
- ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- ; marked for deletion, to be deleted after 3/15/2018. That flag
- ; will now always be null. This function will now always return
- ; '1'.
- ;
- NEW SEND,IBDIV,MAIN
- S SEND=1
- I '$G(COB) S COB=$$COBN^IBCEF(IBIFN) ; current payer sequence default
- ;S INSFLGS=$$INSFLGS(IBIFN,COB) ; all ins co flags
- ;I +INSFLGS'>0 G SENDSFX ; switchback is OFF...get out
- G SENDSFX
- ;
- I $P($G(^DGCR(399,IBIFN,"U2")),U,10) G SENDSFX ; if we have a non-VA facility on the claim, always send it
- ;
- S IBDIV=+$P($G(^DGCR(399,IBIFN,0)),U,22) ; division on claim
- S MAIN=$$MAIN^IBCEP2B() ; main division in database
- I IBDIV'=MAIN G SENDSFX ; care was not provided at the main division - always send it
- ;
- ;I $P(INSFLGS,U,2) G SENDSFX ; ins. co. flag is ON so send it
- ;
- S SEND=0 ; otherwise, do not send service facility data
- ;
- SENDSFX ;
- Q SEND
- ;
- SLPROV(IBXIEN,TYPE) ; return array of service line provider data
- ; IBXIEN - ien in file 399
- ; TYPE: O1 = operating physician, O2 = other operating physician, RE = rendering provider,
- ; P = purchase service provider, S = supervising provider, RF = referring provider
- ;
- ; returns IBXSAVE("SLPRV", counter) = last name ^ first name ^ middle name ^ suffix
- ; ^ taxonomy code ^ primary id ^ secondary id (1) ^ secondary id qualifier (1) ^ ...
- ; ^ secondary id (n) ^ secondary id qualifier (n)
- ; IBXSAVE("SLPRV", counter,"SLC") = service line conter
- ;
- N DATA,IBN,IBX,IENS,MODE,NAME,PRNUM,PRTYPE,OUT,SLC,TMP,IBCNT
- I '+IBXIEN Q
- D ALLIDS^IBCEFP(IBXIEN,.IBX,1)
- S IBCNT=0
- ;
- S SLC="" F S SLC=$O(IBX("L-PROV",IBXIEN,SLC)) Q:'SLC D
- . I '$D(IBX("L-PROV",IBXIEN,SLC,"C",1,TYPE)) Q
- .I TYPE="O1",PRTYPE'=2 Q ; not operating
- .I TYPE="O2",PRTYPE'=9 Q ; not other operating
- .I TYPE="RE",PRTYPE'=3 Q ; not rendering
- .I TYPE="S",PRTYPE'=5 Q ; not supervising
- .I TYPE="RF",PRTYPE'=1 Q ; not referring
- .;
- .S DATA=$G(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE))
- .; name components
- .S IENS=$P($P(DATA,U),";")_","
- .I $P(DATA,U)["VA(200" S NAME=$$GET1^DIQ(200,IENS,.01)
- .I $P(DATA,U)["IBA(355.93" S NAME=$$GET1^DIQ(355.93,IENS,.01)
- .S TMP=$P(NAME,",",2),OUT=$P(NAME,",")_U_$P(TMP," ")_U_$P(TMP," ",2)_U_$P(TMP," ",3)
- .; taxonomy code
- .S $P(OUT,U,5)=$P($$GETTAX^IBCEF73A($P(DATA,U)),U)
- .S IBN="" F S IBN=$O(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE,IBN)) Q:IBN="" D
- ..S DATA=$G(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE,IBN))
- ..; primary id
- ..I IBN=0 S $P(OUT,U,6)=$P(DATA,U,4) Q
- ..;
- ..; secondary ids
- ..S OUT=OUT_U_$P(DATA,U,4)_U_$P(DATA,U,3)
- ..Q
- .Q
- S IBCNT=IBCNT+1
- S IBXSAVE("SLPRV",IBCNT)=OUT
- S IBXSAVE("SLPRV",IBCNT,"SLC")=SLC
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEF79 18406 printed Jan 18, 2025@03:11:34 Page 2
- IBCEF79 ;ALB/ESG - Billing Provider functions ;13-Aug-2008
- +1 ;;2.0;INTEGRATED BILLING;**400,419,432,516**;21-MAR-94;Build 123
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- B(IBIFN,COB) ; Determine Billing Provider and Service Facility information
- +1 ; This function returns a string in the following format:
- +2 ; [1] billing provider Institution file pointer (IEN to file 4) or "0"
- +3 ; if the billing provider cannot be determined
- +4 ; [2] billing provider name (.01 field in file 4) or Error reason why
- +5 ; the billing provider cannot be determined - used when piece [1]=0
- +6 ; [3] 0 if the service facility is a VA institution in file 4
- +7 ; 1 if the service facility is a non-VA facility in file 355.93
- +8 ; "" if the service facility is blank - when there is no service facility
- +9 ; [4] service facility IEN - either an IEN to file 4 or to file 355.93
- +10 ; or "" if the service facility is blank
- +11 ;
- +12 ; Input parameters
- +13 ; IBIFN - claim# required
- +14 ; COB - payer sequence# - optional - defaults to current payer sequence# if not passed in
- +15 ;
- +16 NEW %,Z,IBU2,NVAFAC,BP,IB0,EVDT,IBDIV,BPDIV,BPDIVCHK,RXFLG,D,D0,DI,DIQ2,X,Y
- +17 SET Z=""
- +18 SET IBIFN=+$GET(IBIFN)
- +19 IF 'IBIFN
- SET Z="0^Invalid claim.^^"
- GOTO BX
- +20 IF '$DATA(^DGCR(399,IBIFN,0))
- SET Z="0^Claim doesn't exist.^^"
- GOTO BX
- +21 ; current payer sequence default
- IF '$GET(COB)
- SET COB=$$COBN^IBCEF(IBIFN)
- +22 IF '$FIND(".1.2.3.","."_COB_".")
- SET Z="0^Invalid Payer Sequence#: """_COB_"""^^"
- GOTO BX
- +23 ;
- +24 ; set some initial variables for all claims
- +25 SET IB0=$GET(^DGCR(399,IBIFN,0))
- +26 ; claim event date
- SET EVDT=$PIECE(IB0,U,3)
- +27 ; - default today if undefined
- IF 'EVDT
- SET EVDT=DT
- +28 ; division ptr file 40.8
- SET IBDIV=+$PIECE(IB0,U,22)
- +29 ; - default primary division as of event date
- IF 'IBDIV
- SET IBDIV=$$PRIM^VASITE(EVDT)
- +30 IF IBDIV'>0
- SET $PIECE(Z,U,1,2)="0^Invalid Division for Event Date "_$$FMTE^XLFDT(EVDT,"5Z")_"."
- GOTO BX
- +31 ; division institution ptr file 4
- SET BPDIV=+$$SITE^VASITE(EVDT,IBDIV)
- +32 IF BPDIV'>0
- SET $PIECE(Z,U,1,2)="0^Invalid Institution for Event Date "_$$FMTE^XLFDT(EVDT,"5Z")_"."
- GOTO BX
- +33 ;
- +34 ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- +35 ; marked for deletion, to be deleted after 3/15/2018. That flag
- +36 ; will now always be null. The following section of code was
- +37 ; commented out because of this. This section can be deleted in
- +38 ; the future.
- +39 ;
- +40 ;; check ins co switchback flag
- +41 ;I $$INSFLGS(IBIFN,COB)>0 D G BX
- +42 ;. N IBZ,SVCIEN,SVCTYP
- +43 ;. ; revert billing provider and service facility calculation to pre-patch 400 methods
- +44 ;. ;
- +45 ;. ; service facility is legacy N-RENDERING INSTITUTION data
- +46 ;. D F^IBCEF("N-RENDERING INSTITUTION","IBZ",,IBIFN)
- +47 ;. S SVCIEN=+IBZ ; service facility ien
- +48 ;. S SVCTYP=+$P(IBZ,U,2) ; service facility type - 0=VA inst, 1=non-VA facility
- +49 ;. ;
- +50 ;. I 'SVCIEN S $P(Z,U,3)="",$P(Z,U,4)="" ; no svc fac
- +51 ;. I SVCIEN S $P(Z,U,3)=SVCTYP,$P(Z,U,4)=SVCIEN ; yes svc fac
- +52 ;. ;
- +53 ;. ; billing provider = institution of main division in the database
- +54 ;. S BP=+$$SITE^VASITE
- +55 ;. I BP,$$BPFACTYP(BP) S $P(Z,U,1,2)=$$CHK(BP) Q
- +56 ;. S $P(Z,U,1,2)="0^Facility Type of Main Division Institution is invalid."
- +57 ;. Q
- +58 ;
- +59 SET IBU2=$GET(^DGCR(399,IBIFN,"U2"))
- +60 ; non-VA facility
- SET NVAFAC=+$PIECE(IBU2,U,10)
- +61 IF NVAFAC
- Begin DoDot:1
- +62 ; service facility is the non-VA facility
- SET $PIECE(Z,U,3)=1
- +63 ; ien to file 355.93
- SET $PIECE(Z,U,4)=NVAFAC
- +64 ; institution of division on claim (IB*2*419)
- SET BP=BPDIV
- +65 IF BP
- IF $$BPFACTYP(BP)
- SET $PIECE(Z,U,1,2)=$$CHK(BP)
- QUIT
- +66 SET $PIECE(Z,U,1,2)="0^Facility Type of Claim's Division is invalid for the Billing Provider."
- +67 QUIT
- End DoDot:1
- GOTO BX
- +68 ;
- +69 ; flag indicating if the div inst has been checked
- SET BPDIVCHK=0
- +70 ; pharmacy flag
- SET RXFLG=$$ISRX^IBCEF1(IBIFN)
- +71 ;
- +72 IF RXFLG
- Begin DoDot:1
- +73 ; dispensing pharmacy ien for pharmacy claims
- SET BP=+$$RXSITE^IBCEF73A(IBIFN)
- +74 ; use division institution if pharmacy not found
- IF 'BP
- SET BP=BPDIV
- SET BPDIVCHK=1
- +75 QUIT
- End DoDot:1
- +76 ;
- +77 ; non-Rx claims use division institution
- IF 'RXFLG
- SET BP=BPDIV
- SET BPDIVCHK=1
- +78 ;
- +79 ; billing provider type is valid
- IF BP
- IF $$BPFACTYP(BP)
- Begin DoDot:1
- +80 SET $PIECE(Z,U,1,2)=$$CHK(BP)
- +81 ;
- +82 ; 3/27/09 - Special Case
- +83 ; If we are printing the CMS-1500 claim form, then populate the service facility with the billing provider.
- +84 ; For any other calculation, the service facility is blank here.
- +85 ;
- +86 IF $GET(^TMP("IB 1500 PRINT",$JOB,IBIFN))
- Begin DoDot:2
- +87 ; service facility is in file 4
- SET $PIECE(Z,U,3)=0
- +88 ; move billing provider ien over
- SET $PIECE(Z,U,4)=$PIECE(Z,U,1)
- +89 QUIT
- End DoDot:2
- +90 QUIT
- End DoDot:1
- GOTO BX
- +91 ;
- +92 ; here, the BP has an invalid billing provider facility type
- +93 ; move this BP over to the service facility
- +94 ; service facility is in file 4
- SET $PIECE(Z,U,3)=0
- +95 ; move this BP over to the service facility
- SET $PIECE(Z,U,4)=BP
- +96 ;
- +97 ; the division institution has already been checked...skip down to tag B1 to check the parent
- IF BPDIVCHK
- GOTO B1
- +98 ;
- +99 ; check the division institution
- +100 SET BP=BPDIV
- SET BPDIVCHK=1
- +101 IF BP
- IF $$BPFACTYP(BP)
- SET $PIECE(Z,U,1,2)=$$CHK(BP)
- GOTO BX
- +102 ;
- B1 ;
- +1 ; check the parent
- +2 ; institution of the parent of the division
- SET BP=$$BPPAR(BPDIV)
- +3 IF BP
- IF $$BPFACTYP(BP)
- SET $PIECE(Z,U,1,2)=$$CHK(BP)
- GOTO BX
- +4 ;
- +5 ; here, the facility type of the parent is also not valid, so it is an error
- +6 SET $PIECE(Z,U,1,2)="0^Facility Type of Division and the Division's Parent Institution are Invalid."
- BX ;
- +1 QUIT Z
- +2 ;
- CHK(IEN) ; Perform final billing provider checks on passed in Institution
- +1 ; file pointer - File 4 ien
- +2 ; Function returns final pieces 1 and 2 of $$B function as described above
- +3 NEW BP
- +4 SET IEN=+$GET(IEN)
- +5 IF 'IEN
- SET BP="0^Invalid Institution pointer IEN."
- GOTO CHKX
- +6 IF '$$BPCHKN(IEN)
- SET BP="0^Not a National Institution."
- GOTO CHKX
- +7 IF '$$BPCHKA(IEN)
- SET BP="0^Not an Active Institution."
- GOTO CHKX
- +8 ;
- +9 ; ien^name DBIA# 2171
- SET BP=IEN_U_$PIECE($$NS^XUAF4(IEN),U,1)
- CHKX ;
- +1 QUIT BP
- +2 ;
- BPCHKN(IEN) ; Is this a national Institution?
- +1 NEW Z
- SET Z=0
- +2 ; DBIA# 2171
- IF $$STATUS^XUAF4(+IEN)="N"
- SET Z=1
- BPCHKNX ;
- +1 QUIT Z
- +2 ;
- BPCHKA(IEN) ; Is this an active Institution?
- +1 NEW Z
- SET Z=0
- +2 ; DBIA# 2171
- IF $$ACTIVE^XUAF4(+IEN)
- SET Z=1
- BPCHKAX ;
- +1 QUIT Z
- +2 ;
- BPFACTYP(IEN) ; Is the facility type of this Institution a valid Billing Provider facility type?
- +1 NEW Z
- SET Z=0
- +2 IF $DATA(^IBE(350.9,1,20,"B",+$$GET1^DIQ(4,+IEN_",",13,"I")))
- SET Z=1
- BPFACTPX ;
- +1 QUIT Z
- +2 ;
- BPPAR(IEN) ; Who is the parent for this Institution?
- +1 ; Function returns the IEN to file 4 of the parent institution as defined in File 4
- +2 NEW Z,PIA
- +3 ; DBIA# 2171
- DO PARENT^XUAF4($NAME(PIA),("`"_+IEN),"PARENT FACILITY")
- +4 SET Z=+$ORDER(PIA("P",""))
- BPPARX ;
- +1 QUIT Z
- +2 ;
- TAX(IBIFN) ; Update default billing provider and service facility taxonomy codes
- +1 ; and billing provider secondary IDs and Qualifiers.
- +2 ; This is called via new style xrefs to update the default value of these fields
- +3 ;
- +4 NEW BPZ,BPTAX,SFTAX,IENS,IBTAXO,IBU3,IBM1,BPID1,BPQL1,BPID2,BPQL2,BPID3,BPQL3
- +5 NEW D,D0,DI,DIQ2,X,Y
- +6 ;
- +7 IF '$GET(IBIFN)
- GOTO TAXQ
- +8 ; claim is not editable
- IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'=1
- GOTO TAXQ
- +9 ;
- +10 ; billing provider/service facility string
- SET BPZ=$$B(IBIFN)
- +11 ;
- +12 ; billing provider taxonomy
- +13 SET BPTAX=""
- +14 ; ien to file 8932.1 for VA billing provider
- IF +BPZ
- SET BPTAX=+$PIECE($$TAXORG^XUSTAX(+BPZ),U,2)
- +15 IF 'BPTAX
- SET BPTAX=""
- +16 ;
- +17 ; service facility taxonomy
- +18 SET SFTAX=""
- +19 ; ien to file 8932.1 for VA svc fac
- IF $PIECE(BPZ,U,3)=0
- IF +$PIECE(BPZ,U,4)
- SET SFTAX=+$PIECE($$TAXORG^XUSTAX(+$PIECE(BPZ,U,4)),U,2)
- +20 ; ien to file 8932.1 for non-VA svc fac
- IF $PIECE(BPZ,U,3)=1
- IF +$PIECE(BPZ,U,4)
- SET SFTAX=+$PIECE($$TAXGET^IBCEP81(+$PIECE(BPZ,U,4)),U,2)
- +21 IF 'SFTAX
- SET SFTAX=""
- +22 ;
- +23 ; billing provider secondary ID#2 and qualifier#2 for each payer on the claim
- +24 ; #122
- SET BPID1=$$PRVNUM^IBCU(IBIFN,,1)
- +25 ; #128
- SET BPQL1=$$PRVQUAL^IBCU(IBIFN,,1)
- +26 ; #123
- SET BPID2=$$PRVNUM^IBCU(IBIFN,,2)
- +27 ; #129
- SET BPQL2=$$PRVQUAL^IBCU(IBIFN,,2)
- +28 ; #124
- SET BPID3=$$PRVNUM^IBCU(IBIFN,,3)
- +29 ; #130
- SET BPQL3=$$PRVQUAL^IBCU(IBIFN,,3)
- +30 ;
- +31 ; Use FileMan DBS call to update these fields if changes are necessary
- +32 SET IENS=IBIFN_","
- +33 SET IBU3=$GET(^DGCR(399,IBIFN,"U3"))
- +34 SET IBM1=$GET(^DGCR(399,IBIFN,"M1"))
- +35 ; service facility taxonomy
- IF SFTAX'=$PIECE(IBU3,U,2)
- SET IBTAXO(399,IENS,243)=SFTAX
- +36 ; billing provider taxonomy
- IF BPTAX'=$PIECE(IBU3,U,11)
- SET IBTAXO(399,IENS,252)=BPTAX
- +37 ; primary ID
- IF BPID1'=$PIECE(IBM1,U,2)
- SET IBTAXO(399,IENS,122)=BPID1
- +38 ; primary Qual
- IF BPQL1'=$PIECE(IBM1,U,10)
- SET IBTAXO(399,IENS,128)=BPQL1
- +39 ; secondary ID
- IF BPID2'=$PIECE(IBM1,U,3)
- SET IBTAXO(399,IENS,123)=BPID2
- +40 ; secondary Qual
- IF BPQL2'=$PIECE(IBM1,U,11)
- SET IBTAXO(399,IENS,129)=BPQL2
- +41 ; tertiary ID
- IF BPID3'=$PIECE(IBM1,U,4)
- SET IBTAXO(399,IENS,124)=BPID3
- +42 ; tertiary Qual
- IF BPQL3'=$PIECE(IBM1,U,12)
- SET IBTAXO(399,IENS,130)=BPQL3
- +43 ;
- +44 ; no changes necessary
- IF '$DATA(IBTAXO)
- GOTO TAXQ
- +45 ;
- +46 ; update fields
- DO FILE^DIE(,"IBTAXO")
- TAXQ ;
- +1 QUIT
- +2 ;
- INSFLGS(IBIFN,COB) ; get insurance company flags for a given claim
- +1 ; returns string of flags in the following format:
- +2 ; switchback flag ^ send service facility flag ^ institution file address flag ^ error
- +3 ; switchback flag: field 36/4.11 or 36/4.12, depending on form type. "-1" if error has occurred.
- +4 ; send service facility flag: field 36/4.07, empty if error has occurred or switchback flag is not set.
- +5 ; institution file address flag: field 36/4.13, empty if error has occurred or switchback flag is not set.
- +6 ;
- +7 ; MRD;IB*2.0*516 - The four flag fields described above (File #36,
- +8 ; Field #'s 4.07, 4.11, 4.12, 4.13) are all being marked for
- +9 ; deletion. All references to those fields are being removed
- +10 ; as part of this patch.
- +11 ;
- +12 QUIT ""
- +13 ;
- +14 ;N FLGS,FT,INSIEN,INS4
- +15 ;S IBIFN=+$G(IBIFN) I 'IBIFN Q "-1^^^Invalid claim."
- +16 ;I '$D(^DGCR(399,IBIFN,0)) Q "-1^^^Claim doesn't exist."
- +17 ;I '$G(COB) S COB=$$COBN^IBCEF(IBIFN) ; current payer sequence default
- +18 ;I '(".1.2.3."[("."_COB_".")) Q "-1^^^Invalid Payer Sequence#: """_COB_"""."
- +19 ;S INSIEN=$$POLICY^IBCEF(IBIFN,1,COB) I 'INSIEN Q "-1^^^No insurance company associated with the claim."
- +20 ;S INS4=$G(^DIC(36,INSIEN,4)),FT=$$FT^IBCEF(IBIFN)
- +21 ;S FLGS=$P(INS4,U,$S(FT=2:11,1:12)) I '+FLGS Q FLGS ; we are done if switchback flag is not set
- +22 ;S $P(FLGS,U,2)=$P(INS4,U,7),$P(FLGS,U,3)=$P(INS4,U,13) ; if switchback is set, get the other 2 flags
- +23 ;Q FLGS
- +24 ;
- GETBP(IBIFN,COB,INST,SUB,IBXSAVE) ; Get billing provider data for claim output
- +1 ; Used to extract billing provider name, address, and phone# for PRV segment and for CMS-1500, Box 33
- +2 ; IBIFN - claim ien required
- +3 ; COB - payer sequence (optional, defaults to current payer seq)
- +4 ; INST - billing provider VA file 4 ien required
- +5 ; SUB - subscript to use in IBXSAVE local array required
- +6 ; IBXSAVE - pass by reference
- +7 ; Returns IBXSAVE(SUB,"NAME")
- +8 ; IBXSAVE(SUB,"ADDR1")
- +9 ; IBXSAVE(SUB,"ADDR2")
- +10 ; IBXSAVE(SUB,"CITY")
- +11 ; IBXSAVE(SUB,"ST")
- +12 ; IBXSAVE(SUB,"ZIP")
- +13 ; IBXSAVE(SUB,"PHONE")
- +14 ;
- +15 ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- +16 ; marked for deletion, to be deleted after 3/15/2018. That flag
- +17 ; will now always be null. Several sections of this procedure have
- +18 ; been commented out because of this. Those sections can be
- +19 ; deleted in the future.
- +20 ;
- +21 NEW IBZ
- +22 KILL IBXSAVE(SUB)
- +23 IF '$GET(COB)
- SET COB=$$COBN^IBCEF(IBIFN)
- +24 ;
- +25 ;S INSFLGS=$$INSFLGS(IBIFN,COB) ; all ins co flags
- +26 ;S SWBFLG=(+INSFLGS>0) ; main switchback flag
- +27 ;S (BPTP,MAINPTP)="" ; initialize vars used only in switchback mode
- +28 ;I SWBFLG D
- +29 ;. S BPTP=$$MAINPRV^IBJPS3 ; main division pay-to provider data string
- +30 ;. S MAINPTP=($P(BPTP,U,10)'["IB177") ; flag that says whether main div exists as a pay-to
- +31 ;. Q
- +32 ;
- +33 ; If Switchback is ON and the ins. company parameter Use billing provider VAMC address is not on and
- +34 ; main div pay-to exists, then use the pay-to provider data for the main division in the database.
- +35 ; This is the "normal" switchback data.
- +36 ;I SWBFLG,'$P(INSFLGS,U,3),MAINPTP D G GETBPX ; switchback + billing provider address flag + main ptp exists
- +37 ;. ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- +38 ;. ;S IBXSAVE(SUB,"NAME")=$P(BPTP,U,1)
- +39 ;. S IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- +40 ;. S:IBXSAVE(SUB,"NAME")="" IBXSAVE(SUB,"NAME")=$P(BPTP,U,1)
- +41 ;. S IBXSAVE(SUB,"ADDR1")=$P(BPTP,U,5)
- +42 ;. S IBXSAVE(SUB,"ADDR2")=$P(BPTP,U,6)
- +43 ;. S IBXSAVE(SUB,"CITY")=$P(BPTP,U,7)
- +44 ;. S IBXSAVE(SUB,"ST")=$P(BPTP,U,8)
- +45 ;. S IBXSAVE(SUB,"ZIP")=$P(BPTP,U,9)
- +46 ;. S IBXSAVE(SUB,"PHONE")=$P(BPTP,U,4)
- +47 ;. Q
- +48 ;
- +49 ; Special Case: Switchback is ON, the ins. company parameter Use billing provider VAMC address
- +50 ; is not on, but the main division is NOT defined as a Pay-To provider.
- +51 ; Get the name from the Institution File, but everything else from the claim's Pay-to provider
- +52 ;I SWBFLG,'$P(INSFLGS,U,3),'MAINPTP D G GETBPX
- +53 ;. ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- +54 ;. ;S IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- +55 ;. S IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- +56 ;. S:IBXSAVE(SUB,"NAME")="" IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0) ; Inst name
- +57 ;. S IBZ=$$PRVDATA^IBJPS3(IBIFN)
- +58 ;. S IBXSAVE(SUB,"ADDR1")=$P(IBZ,U,5)
- +59 ;. S IBXSAVE(SUB,"ADDR2")=$P(IBZ,U,6)
- +60 ;. S IBXSAVE(SUB,"CITY")=$P(IBZ,U,7)
- +61 ;. S IBXSAVE(SUB,"ST")=$P(IBZ,U,8)
- +62 ;. S IBXSAVE(SUB,"ZIP")=$P(IBZ,U,9)
- +63 ;. S IBXSAVE(SUB,"PHONE")=$P(IBZ,U,4)
- +64 ;. Q
- +65 ;
- +66 ; At this point, we want to get the billing provider data from the Institution file
- +67 ; IB*2.0*432 - Retrieve the BP name from "gold standard" name field of file #4 and if not populated, retrieve from .01 field - IA#2171
- +68 ;S IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- +69 SET IBXSAVE(SUB,"NAME")=$$BNIEN^XUAF4(INST)
- +70 if IBXSAVE(SUB,"NAME")=""
- SET IBXSAVE(SUB,"NAME")=$$GETFAC^IBCEP8(INST,0,0)
- +71 SET IBXSAVE(SUB,"ADDR1")=$$GETFAC^IBCEP8(INST,0,1)
- +72 SET IBXSAVE(SUB,"ADDR2")=$$GETFAC^IBCEP8(INST,0,2)
- +73 SET IBXSAVE(SUB,"CITY")=$$GETFAC^IBCEP8(INST,0,"3C")
- +74 SET IBXSAVE(SUB,"ST")=$$GETFAC^IBCEP8(INST,0,"3S")
- +75 SET IBXSAVE(SUB,"ZIP")=$$GETFAC^IBCEP8(INST,0,"3Z")
- +76 ; pay-to phone for claim
- SET IBXSAVE(SUB,"PHONE")=$$PRVPHONE^IBJPS3(IBIFN)
- +77 ;I SWBFLG,MAINPTP S IBXSAVE(SUB,"PHONE")=$P(BPTP,U,4) ; switchback: pay-to phone for main division
- +78 ;
- +79 ; 3/30/09 - new requirement - for locally printed CMS-1500 claims, use the pay-to provider address information - Box 33
- +80 ;I 'SWBFLG,SUB="BOX33" D
- +81 IF SUB="BOX33"
- Begin DoDot:1
- +82 SET IBZ=$$PRVDATA^IBJPS3(IBIFN)
- +83 SET IBXSAVE(SUB,"ADDR1")=$PIECE(IBZ,U,5)
- +84 SET IBXSAVE(SUB,"ADDR2")=$PIECE(IBZ,U,6)
- +85 SET IBXSAVE(SUB,"CITY")=$PIECE(IBZ,U,7)
- +86 SET IBXSAVE(SUB,"ST")=$PIECE(IBZ,U,8)
- +87 SET IBXSAVE(SUB,"ZIP")=$PIECE(IBZ,U,9)
- +88 QUIT
- End DoDot:1
- +89 ;
- GETBPX ;
- +1 QUIT
- +2 ;
- SENDSF(IBIFN,COB) ; Send service facility information for the EDI claim?
- +1 ; Function value returns 1 (send service facility information) or 0 (don't send it)
- +2 ; The only time this function returns 0 is when the pre-patch 400 switchback flag is set, and
- +3 ; care was provided at the main division (VAMC) in the database, and the 36,4.07 ins. co. flag is set to NO.
- +4 ; This function is used in the EDI claim (segments SUB, SUB2, NPI-16, and NPI-17).
- +5 ; IBIFN required
- +6 ; COB optional, defaults to current payer sequence
- +7 ;
- +8 ; MRD;IB*2.0*516 - The field used as the switchback flag is being
- +9 ; marked for deletion, to be deleted after 3/15/2018. That flag
- +10 ; will now always be null. This function will now always return
- +11 ; '1'.
- +12 ;
- +13 NEW SEND,IBDIV,MAIN
- +14 SET SEND=1
- +15 ; current payer sequence default
- IF '$GET(COB)
- SET COB=$$COBN^IBCEF(IBIFN)
- +16 ;S INSFLGS=$$INSFLGS(IBIFN,COB) ; all ins co flags
- +17 ;I +INSFLGS'>0 G SENDSFX ; switchback is OFF...get out
- +18 GOTO SENDSFX
- +19 ;
- +20 ; if we have a non-VA facility on the claim, always send it
- IF $PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
- GOTO SENDSFX
- +21 ;
- +22 ; division on claim
- SET IBDIV=+$PIECE($GET(^DGCR(399,IBIFN,0)),U,22)
- +23 ; main division in database
- SET MAIN=$$MAIN^IBCEP2B()
- +24 ; care was not provided at the main division - always send it
- IF IBDIV'=MAIN
- GOTO SENDSFX
- +25 ;
- +26 ;I $P(INSFLGS,U,2) G SENDSFX ; ins. co. flag is ON so send it
- +27 ;
- +28 ; otherwise, do not send service facility data
- SET SEND=0
- +29 ;
- SENDSFX ;
- +1 QUIT SEND
- +2 ;
- SLPROV(IBXIEN,TYPE) ; return array of service line provider data
- +1 ; IBXIEN - ien in file 399
- +2 ; TYPE: O1 = operating physician, O2 = other operating physician, RE = rendering provider,
- +3 ; P = purchase service provider, S = supervising provider, RF = referring provider
- +4 ;
- +5 ; returns IBXSAVE("SLPRV", counter) = last name ^ first name ^ middle name ^ suffix
- +6 ; ^ taxonomy code ^ primary id ^ secondary id (1) ^ secondary id qualifier (1) ^ ...
- +7 ; ^ secondary id (n) ^ secondary id qualifier (n)
- +8 ; IBXSAVE("SLPRV", counter,"SLC") = service line conter
- +9 ;
- +10 NEW DATA,IBN,IBX,IENS,MODE,NAME,PRNUM,PRTYPE,OUT,SLC,TMP,IBCNT
- +11 IF '+IBXIEN
- QUIT
- +12 DO ALLIDS^IBCEFP(IBXIEN,.IBX,1)
- +13 SET IBCNT=0
- +14 ;
- +15 SET SLC=""
- FOR
- SET SLC=$ORDER(IBX("L-PROV",IBXIEN,SLC))
- if 'SLC
- QUIT
- Begin DoDot:1
- +16 IF '$DATA(IBX("L-PROV",IBXIEN,SLC,"C",1,TYPE))
- QUIT
- +17 ; not operating
- IF TYPE="O1"
- IF PRTYPE'=2
- QUIT
- +18 ; not other operating
- IF TYPE="O2"
- IF PRTYPE'=9
- QUIT
- +19 ; not rendering
- IF TYPE="RE"
- IF PRTYPE'=3
- QUIT
- +20 ; not supervising
- IF TYPE="S"
- IF PRTYPE'=5
- QUIT
- +21 ; not referring
- IF TYPE="RF"
- IF PRTYPE'=1
- QUIT
- +22 ;
- +23 SET DATA=$GET(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE))
- +24 ; name components
- +25 SET IENS=$PIECE($PIECE(DATA,U),";")_","
- +26 IF $PIECE(DATA,U)["VA(200"
- SET NAME=$$GET1^DIQ(200,IENS,.01)
- +27 IF $PIECE(DATA,U)["IBA(355.93"
- SET NAME=$$GET1^DIQ(355.93,IENS,.01)
- +28 SET TMP=$PIECE(NAME,",",2)
- SET OUT=$PIECE(NAME,",")_U_$PIECE(TMP," ")_U_$PIECE(TMP," ",2)_U_$PIECE(TMP," ",3)
- +29 ; taxonomy code
- +30 SET $PIECE(OUT,U,5)=$PIECE($$GETTAX^IBCEF73A($PIECE(DATA,U)),U)
- +31 SET IBN=""
- FOR
- SET IBN=$ORDER(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE,IBN))
- if IBN=""
- QUIT
- Begin DoDot:2
- +32 SET DATA=$GET(IBX("L-PROV",IBXIEN,SLC,"C",1,PRTYPE,IBN))
- +33 ; primary id
- +34 IF IBN=0
- SET $PIECE(OUT,U,6)=$PIECE(DATA,U,4)
- QUIT
- +35 ;
- +36 ; secondary ids
- +37 SET OUT=OUT_U_$PIECE(DATA,U,4)_U_$PIECE(DATA,U,3)
- +38 QUIT
- End DoDot:2
- +39 QUIT
- End DoDot:1
- +40 SET IBCNT=IBCNT+1
- +41 SET IBXSAVE("SLPRV",IBCNT)=OUT
- +42 SET IBXSAVE("SLPRV",IBCNT,"SLC")=SLC
- +43 QUIT