source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF73A.m@ 699

IBCEF73A ;ALB/KJH - FORMATTER AND EXTRACTOR SPECIFIC (NPI) BILL FUNCTIONS ; 30 Aug 2006  10:38 AM
 ;;2.0;INTEGRATED BILLING;**343,374**;21-MAR-94;Build 16
 ;; Per VHA Directive 10-93-142, this routine should not be modified.
 ;
PROVNPI(IBIEN399,IBNONPI) ;
 ;Retrieves NPIs from #200 or 355.93
 ; Input:
 ;       IBIEN399 - IEN of record in BILL/CLAIMS file 399
 ;       IBNONPI - variable to pass info on missing NPI to calling routine.  Pass by reference
 ; Output:
 ;       NPI codes for all providers
 ;       IBNONPI - U-delimited list of provider types with missing NPIs
 N IBRETVAL,IBPTR,IBFT
 S IBRETVAL="",IBNONPI=""
 F IBFT=1:1:9 D
 . S IBPTR=$$PROVPTR^IBCEF7(IBIEN399,IBFT)
 . I IBPTR S $P(IBRETVAL,"^",IBFT)=$$GETNPI(IBPTR)
 Q IBRETVAL
GETNPI(IBPTR) ;look for NPI in #200 or #355.93
 ;Input: IBPTR from 399.0222, field .02
 ;Output: NPI
 ;if in file #200
 N NPI
 S NPI=""
 ;if in 200 then get it from 200
 I $P(IBPTR,";",2)="VA(200," S NPI=$P($$NPI^XUSNPI("Individual_ID",$P(IBPTR,";")),U) S:NPI=-1 NPI=""
 ;if in 355.93 then use 355.93
 I $P(IBPTR,";",2)="IBA(355.93," S NPI=$$NPIGET^IBCEP81($P(IBPTR,";"))
 I NPI="",$D(IBNONPI) S IBNONPI=$S(IBNONPI="":IBFT,1:IBNONPI_U_IBFT)
 Q NPI
 ;
SPECTAX(IBIEN399,IBNOSPEC) ;
 ;Retrieves Specialty Codes from Current Taxonomy entries for a claim from #399
 ; Input:
 ;       IBIEN399 - IEN of record in BILL/CLAIMS file 399
 ;       IBNOSPEC - variable to pass info on missing taxonomies to calling routine.  Pass by reference
 ; Output:
 ;       Taxonomy Specialty Codes for all providers
 ;       IBNOSPEC - U-delimited list of provider types with missing Taxonomy Specialty codes
 N IBRETVAL,IBN,IBFT,IBSPEC,SPEC
 S IBRETVAL="",IBNOSPEC=""
 I $G(IBIEN399)="" Q ""
 F IBFT=1:1:9 D
 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
 . I +IBN=0 Q
 . S IBSPEC=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
 . S SPEC=$$GET1^DIQ(8932.1,IBSPEC,"SPECIALTY CODE")
 . S $P(IBRETVAL,"^",IBFT)=SPEC
 . I SPEC="",$D(IBNOSPEC) S IBNOSPEC=$S(IBNOSPEC="":IBFT,1:IBNOSPEC_U_IBFT)
 Q IBRETVAL
 ;
PROVTAX(IBIEN399,IBNOTAX) ;
 ;Retrieves Current Taxonomy entries for a claim from #399
 ; Input:
 ;       IBIEN399 - IEN of record in BILL/CLAIMS file 399
 ;       IBNOTAX - variable to pass info on missing taxonomies to calling routine.  Pass by reference
 ; Output:
 ;       Taxonomy X12 codes for all providers
 ;       IBNOTAX - U-delimited list of provider types with missing Taxonomy X12 codes
 N IBRETVAL,IBN,IBFT,IBTAX,TAX
 S IBRETVAL="",IBNOTAX=""
 I $G(IBIEN399)="" Q ""
 F IBFT=1:1:9 D
 . S IBN=$O(^DGCR(399,IBIEN399,"PRV","B",IBFT,0))
 . I +IBN=0 Q
 . S IBTAX=$P($G(^DGCR(399,IBIEN399,"PRV",+IBN,0)),"^",15)
 . S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
 . S $P(IBRETVAL,"^",IBFT)=TAX
 . I TAX="",$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":IBFT,1:IBNOTAX_U_IBFT)
 Q IBRETVAL
GETTAX(IBPTR) ;look for Taxonomy in #200 or #355.93
 ;Input: IBPTR from 399.0222, field .02
 ;Output: Taxonomy X12 code_"^"_IEN
 N TAX
 S TAX="^"
 ;if in 200 then get it from 200
 I $P(IBPTR,";",2)="VA(200," S TAX=$$TAXIND^XUSTAX($P(IBPTR,";"))
 ;if in 355.93 then use 355.93
 I $P(IBPTR,";",2)="IBA(355.93," S TAX=$$TAXGET^IBCEP81($P(IBPTR,";"))
 Q TAX
 ;
ORGNPI(IBIEN399,IBNONPI) ; Extract NPIs for organizations on this claim
 ; Input
 ;       IBIEN399 - Claim IEN in file 399
 ;       IBNONPI - Variable to pass info on missing NPI back to calling routine.  Pass by reference.
 ; Output - NPI codes for facilities
 ;        Piece 1) Division (Responsible Institution) NPI code
 ;        Piece 2) Non-VA Service Facility NPI code
 ;        Piece 3) Billing Provider NPI code (main VA division)
 N IBRETVAL,IBORG,IBEVDT,IBDIV,NPI
 S IBNONPI=""
 I $G(IBIEN399)="" Q ""
 S IBRETVAL=""
 S IBEVDT=$$GET1^DIQ(399,IBIEN399_",",.03,"I")
 I IBEVDT="" S IBEVDT=DT
 S IBDIV=$$GET1^DIQ(399,IBIEN399_",",.22,"I")
 I IBDIV="" S IBDIV=$$PRIM^VASITE(IBEVDT)
 S IBORG=$P($$SITE^VASITE(IBEVDT,IBDIV),U),NPI=""
 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U)=NPI
 I NPI<1,$D(IBNONPI) S IBNONPI=1
 S IBORG=$$GET1^DIQ(399,IBIEN399_",",232,"I")
 I IBORG S NPI=$$NPIGET^IBCEP81(IBORG),$P(IBRETVAL,U,2)=NPI I 'NPI,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":2,1:IBNONPI_U_2)
 S IBORG=$P($$SITE^VASITE,U),NPI=""
 I IBORG S NPI=$P($$NPI^XUSNPI("Organization_ID",IBORG),U) S:NPI'=-1 $P(IBRETVAL,U,3)=NPI
 I NPI<1,$D(IBNONPI) S IBNONPI=$S(IBNONPI="":3,1:IBNONPI_U_3)
 Q IBRETVAL
 ;
ORGTAX(IBIEN399,IBNOTAX) ; Extract Taxonomies for organizations on this claim
 ; Input
 ;       IBIEN399 - Claim IEN in file 399
 ;       IBNOTAX - Variable to pass info on missing taxonomies back to calling routine.  Pass by reference.
 ; Output - Taxonomy X12 codes for facilities
 ;        Piece 1) Division (Responsible Institution) Taxonomy X12 code
 ;        Piece 2) Non-VA Service Facility Taxonomy X12 code
 ;        Piece 3) Billing Provider Taxonomy X12 code (main VA division)
 N IBRETVAL,IBTAX,TAX
 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",243,"I")
 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
 S $P(IBRETVAL,U)=TAX
 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=1
 S IBTAX=$$GET1^DIQ(399,IBIEN399_",",244,"I")
 S TAX=$$GET1^DIQ(8932.1,IBTAX,"X12 CODE")
 S $P(IBRETVAL,U,2)=TAX
 I '$L(TAX),$$GET1^DIQ(399,IBIEN399_",",232,"I"),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":2,1:IBNOTAX_U_2)
 S IBORG=$P($$SITE^VASITE,U)
 S TAX=$P($$TAXORG^XUSTAX(IBORG),U)
 S $P(IBRETVAL,U,3)=TAX
 I '$L(TAX),$D(IBNOTAX) S IBNOTAX=$S(IBNOTAX="":3,1:IBNOTAX_U_3)
 Q IBRETVAL