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

IBCEF73A.m

Go to the documentation of this file.
  1. IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ;30 Aug 2006 10:38 AM
  1. ;;2.0;INTEGRATED BILLING;**343,374,395,391,400,432,516,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. PROVNPI(IBIEN399,IBNONPI) ;
  1. ;Retrieves NPIs from #200 or 355.93
  1. ; Input:
  1. ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
  1. ; IBNONPI - variable to pass info on missing NPI to calling routine. Pass by reference
  1. ; Output:
  1. ; NPI codes for all providers
  1. ; IBNONPI - U-delimited list of provider types with missing NPIs
  1. N IBRETVAL,IBPTR,IBFT
  1. S IBRETVAL="",IBNONPI=""
  1. F IBFT=1:1:9 D
  1. . S IBPTR=$$PROVPTR^IBCEF7(IBIEN399,IBFT)
  1. . I IBPTR S $P(IBRETVAL,"^",IBFT)=$$GETNPI(IBPTR)
  1. Q IBRETVAL
  1. GETNPI(IBPTR) ;look for NPI in #200 or #355.93
  1. ;Input: IBPTR from 399.0222, field .02
  1. ;Output: NPI
  1. ;if in file #200
  1. N NPI
  1. S NPI=""
  1. ;if in 200 then get it from 200
  1. I $P(IBPTR,";",2)="VA(200," S NPI=$P($$NPI^XUSNPI("Individual_ID",$P(IBPTR,";")),U) S:NPI<1 NPI=""
  1. ;if in 355.93 then use 355.93
  1. I $P(IBPTR,";",2)="IBA(355.93," S NPI=$$NPIGET^IBCEP81($P(IBPTR,";"))
  1. I NPI="",$D(IBNONPI) S IBNONPI=$S(IBNONPI="":IBFT,1:IBNONPI_U_IBFT)
  1. Q NPI
  1. ;
  1. SPECTAX(IBIEN399,IBNOSPEC) ;
  1. ;Retrieves Specialty Codes from Current Taxonomy entries for a claim from #399
  1. ; Input:
  1. ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
  1. ; IBNOSPEC - variable to pass info on missing taxonomies to calling routine. Pass by reference
  1. ; Output:
  1. ; Taxonomy Specialty Codes for all providers
  1. ; IBNOSPEC - U-delimited list of provider types with missing Taxonomy Specialty codes
  1. N IBRETVAL,IBN,IBFT,IBSPEC,SPEC
  1. S IBRETVAL="",IBNOSPEC=""
  1. I $G(IBIEN399)="" Q ""
  1. F IBFT=1:1:9 D
  1. . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
  1. . I +IBN=0 Q
  1. . S IBSPEC=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
  1. . S SPEC=$$GET1^DIQ(8932.1,IBSPEC,"SPECIALTY CODE")
  1. . S $P(IBRETVAL,"^",IBFT)=SPEC
  1. . I SPEC="",$D(IBNOSPEC) S IBNOSPEC=$S(IBNOSPEC="":IBFT,1:IBNOSPEC_U_IBFT)
  1. Q IBRETVAL
  1. ;
  1. PROVTAX(IBIEN399,IBNOTAX) ;
  1. ;Retrieves Current Taxonomy entries for a claim from #399
  1. ; Input:
  1. ; IBIEN399 - IEN of record in BILL/CLAIMS file 399
  1. ; IBNOTAX - variable to pass info on missing taxonomies to calling routine. Pass by reference
  1. ; Output:
  1. ; Taxonomy X12 codes for all providers
  1. ; IBNOTAX - U-delimited list of provider types with missing Taxonomy X12 codes
  1. N IBRETVAL,IBN,IBFT,IBTAX,TAX
  1. S IBRETVAL="",IBNOTAX=""
  1. I $G(IBIEN399)="" Q ""
  1. F IBFT=1:1:9 D
  1. . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
  1. . I +IBN=0 Q
  1. . S IBTAX=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
  1. . S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
  1. . S $P(IBRETVAL,"^",IBFT)=TAX
  1. . I TAX="",$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":IBFT,1:IBNOTAX_U_IBFT)
  1. Q IBRETVAL
  1. GETTAX(IBPTR,IBDTEV) ;look for Taxonomy in #200 or #355.93
  1. ;Input: IBPTR from 399.0222, field .02, IBDTEV from 399, field .03
  1. ; IBPTR can be from 399.0404, field .02, as well (DEM;432)
  1. ;Output: Taxonomy X12 code_"^"_IEN
  1. N TAX,IBX12
  1. S TAX="^",IBX12=""
  1. S:'$G(IBDTEV) IBDTEV=DT
  1. ;if in 200 then get it from 200
  1. I $P(IBPTR,";",2)="VA(200," S IBX12=$P($$GET^XUA4A72($P(IBPTR,";"),IBDTEV),U,1),TAX=$S(IBX12'>0:TAX,1:$$GET1^DIQ(8932.1,IBX12,6)_U_IBX12)
  1. ;if in 355.93 then use 355.93
  1. I $P(IBPTR,";",2)="IBA(355.93," S TAX=$$TAXGET^IBCEP81($P(IBPTR,";"))
  1. Q TAX
  1. ;
  1. ORGNPI(IBIEN399,IBNONPI) ; Extract NPIs for organizations on this claim
  1. ; Input
  1. ; IBIEN399 - Claim IEN in file 399
  1. ; IBNONPI - Variable to pass info on missing NPI back to calling routine. Pass by reference.
  1. ; Output - NPI codes for facilities
  1. ; Piece 1) Service Facility NPI code (with IB patch 400, a claim may not have a service facility)
  1. ; Piece 2) Non-VA Service Facility NPI code
  1. ; Piece 3) Billing Provider NPI code (IB patch 400 definition)
  1. ;
  1. N IBRETVAL,IBORG,IBEVDT,IBDIV,NPI,BSZ
  1. S IBNONPI=""
  1. I $G(IBIEN399)="" Q ""
  1. S IBRETVAL=""
  1. S BSZ=$$B^IBCEF79(IBIEN399) ; get billing provider/service facility information
  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. ;S SWBCK=(+$$INSFLGS^IBCEF79(IBIEN399)>0) ; pre-patch 400 switchback flag & processing
  1. ;I SWBCK D G ORGNPIX
  1. ;. N PHARM,DPORG,PHARMNPI
  1. ;. S PHARM=+$$ISRX^IBCEF1(IBIEN399) ; pharmacy claim flag switchback
  1. ;. S PHARMNPI=""
  1. ;. I PHARM S DPORG=$$RXSITE(IBIEN399) I DPORG S PHARMNPI=$P($$NPI^XUSNPI("Organization_ID",DPORG),U,1)
  1. ;. ;
  1. ;. ; service facility NPI switchback
  1. ;. S NPI=""
  1. ;. S IBORG=+$P(BSZ,U,4) ; service facility ien (either ptr file 4 or 355.93)
  1. ;. I $P(BSZ,U,3)=0,IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U,1) ; file 4
  1. ;. I $P(BSZ,U,3)=1,IBORG S NPI=$$NPIGET^IBCEP81(IBORG) ; file 355.93
  1. ;. I PHARM S NPI=PHARMNPI ; in switchback mode for pharmacy claims, use the pharmacy NPI
  1. ;. I NPI>0 S $P(IBRETVAL,U,1)=NPI
  1. ;. I NPI<1 S IBNONPI=1
  1. ;. ;
  1. ;. ; non-VA facility NPI switchback
  1. ;. S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I")
  1. ;. I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI S IBNONPI=$S(IBNONPI="":2,1:IBNONPI_U_2)
  1. ;. ;
  1. ;. ; billing provider NPI switchback
  1. ;. S IBORG=+$P(BSZ,U,1),NPI=""
  1. ;. I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U,1)
  1. ;. I PHARM S NPI=PHARMNPI ; in switchback mode for pharmacy claims, use the pharmacy NPI
  1. ;. I NPI>0 S $P(IBRETVAL,U,3)=NPI
  1. ;. I NPI<1 S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3)
  1. ;. ;
  1. ;. Q
  1. ;
  1. ; service facility NPI regular
  1. S NPI=""
  1. S IBORG=+$P(BSZ,U,4) ; service facility ien (either ptr file 4 or 355.93)
  1. I $P(BSZ,U,3)=0,IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U,1) ; file 4
  1. I $P(BSZ,U,3)=1,IBORG S NPI=$$NPIGET^IBCEP81(IBORG) ; file 355.93
  1. I NPI>0 S $P(IBRETVAL,U,1)=NPI
  1. I NPI<1,$P(BSZ,U,3)=1 S IBNONPI=1 ; only report missing service facility NPI for non-VA facilities
  1. ;
  1. ; non-VA facility NPI regular
  1. S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I")
  1. ; Let this one (#2) override #1 if both #1 and #2 are missing
  1. I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI S IBNONPI=2
  1. ;
  1. ; billing provider NPI regular
  1. S IBORG=+$P(BSZ,U,1),NPI=""
  1. I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U,1) S:NPI>0 $P(IBRETVAL,U,3)=NPI
  1. I NPI<1 S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3)
  1. ;
  1. ;ORGNPIX ; MRD;IB*2.0*516 - Delete this label when deleting
  1. ; above code commented out.
  1. ;
  1. Q IBRETVAL
  1. ;
  1. ORGTAX(IBIEN399,IBNOTAX) ; Extract Taxonomies for organizations on this claim
  1. ; Input
  1. ; IBIEN399 - Claim IEN in file 399
  1. ; IBNOTAX - Variable to pass info on missing taxonomies back to calling routine. Pass by reference.
  1. ; Output - Taxonomy X12 codes for facilities
  1. ; Piece 1) Service Facility Taxonomy X12 code (with IB patch 400, a claim may not have a service facility)
  1. ; Piece 2) Non-VA Service Facility Taxonomy X12 code
  1. ; Piece 3) Billing Provider Taxonomy X12 code (IB patch 400 definition)
  1. N IBRETVAL,IBTAX,TAX,BSZ
  1. ;
  1. S BSZ=$$B^IBCEF79(IBIEN399) ; get billing provider/service facility information
  1. ;
  1. ; claim field# 243 - service facility taxonomy code
  1. I $P(BSZ,U,3)="" S (IBTAX,TAX)="" ; no service facility
  1. I $P(BSZ,U,3)'="" S IBTAX=$$GET1^DIQ(399,IBIEN399_",",243,"I"),TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
  1. S $P(IBRETVAL,U,1)=TAX
  1. ; only record service facility taxonomy code missing if there is a service facility
  1. I '$L(TAX),$D(IBNOTAX),$P(BSZ,U,3)'="" S IBNOTAX=1
  1. ;
  1. ; claim field# 244 - non-VA facility taxonomy code
  1. S IBTAX=$$GET1^DIQ(399,IBIEN399_",",244,"I")
  1. S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
  1. S $P(IBRETVAL,U,2)=TAX
  1. I '$L(TAX),$$GET1^DIQ(399,IBIEN399_",",232,"I"),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":2,1:IBNOTAX_U_2)
  1. ;
  1. ; claim field# 252 - billing provider taxonomy code
  1. S IBTAX=$$GET1^DIQ(399,IBIEN399_",",252,"I")
  1. S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
  1. ;JWS;IB*2.0*592; if a Dental Claim, never send Billing Provider Taxonomy, since different from Rendering/Assistant Surgeon
  1. I $$FT^IBCEF(IBIEN399)=7 S TAX=""
  1. S $P(IBRETVAL,U,3)=TAX
  1. I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3)
  1. ;JWS;IB*2.0*592; if a Dental Claim, never send Billing Provider Taxonomy, since different from Rendering/Assistant Surgeon
  1. I $$FT^IBCEF(IBIEN399)=7 S IBNOTAX=""
  1. Q IBRETVAL
  1. ;
  1. RXSITE(IBIEN399,IBLIST) ; returns prescription organization (file 4) pointer
  1. ; for the given bill. If IBLIST passed by reference, then a list of
  1. ; the possible organizations are returned for a bill, since a bill may
  1. ; have more than one prescription. If more than one rx on the bill, the
  1. ; $$ return is the pointer of the last prescription found.
  1. ; IBLIST(rx ien,fill date)=ORGINATION (file 4 pointer)
  1. ;
  1. N IBX,IBDATA,IBORG,IBRX,IBDT,IBY,IBRXN,DFN
  1. K ^TMP($J,"IBCEF73A")
  1. S IBORG=0,DFN=$P($G(^DGCR(399,IBIEN399,0)),"^",2),IBLIST="IBCEF73A"
  1. S IBRXN=0 F S IBRXN=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN)) Q:'IBRXN S IBX=0 F S IBX=$O(^IBA(362.4,"AIFN"_IBIEN399,IBRXN,IBX)) Q:'IBX D
  1. . S IBDATA=$G(^IBA(362.4,IBX,0))
  1. . S IBRX=$P(IBDATA,"^",5),IBDT=$P(IBDATA,"^",3) Q:'IBRX!('IBDT)
  1. . D RX^PSO52API(DFN,IBLIST,IBRX,,"0,2,R")
  1. . I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,22)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,20))) Q
  1. . S IBY=0 F S IBY=$O(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY)) Q:'IBY I IBDT=+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,.01)) S (IBORG,IBLIST(IBRX,IBDT))=$$PSONPI(+$G(^TMP($J,"IBCEF73A",DFN,IBRX,"RF",IBY,8))) Q
  1. K ^TMP($J,"IBCEF73A")
  1. Q IBORG
  1. ;
  1. PSONPI(IB59IEN) ; returns institution ien for a file 59 ien
  1. N IB4IEN
  1. K ^TMP($J,"IBCEF59")
  1. D PSS^PSO59(IB59IEN,,"IBCEF59")
  1. S IB4IEN=+$G(^TMP($J,"IBCEF59",IB59IEN,101))
  1. K ^TMP($J,"IBCEF59")
  1. Q IB4IEN