Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEF79

IBCEF79.m

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