IBCEF74A ;ALB/ESG - Provider ID maint ?ID continuation ;7 Mar 2006 ;;2.0;INTEGRATED BILLING;**320,343,349**;21-MAR-94;Build 46 ;;Per VHA Directive 2004-038, this routine should not be modified. ; Q ; EN(IBIFN,IBQUIT) ; Display billing provider and service provider IDs as part ; of the ?ID display/help in the billing screens. ; Called from DISPID^IBCEF74. NEW IBID,IBX,Z,ZI,ZN,SEQ,PSIN,DATA,QUALNM,IDNUM,FACNAME,IBZ,IBXIEN,IBSSFI,ORGNPI ; D ALLIDS^IBCEF75(IBIFN,.IBID) ; ; Re-sort array by insurance sequence (P/S/T) K IBX F Z="BILLING PRV","LAB/FAC" F ZI="C","O" S ZN=0 F S ZN=$O(IBID(Z,IBIFN,ZI,ZN)) Q:'ZN D . S SEQ=$P($G(IBID(Z,IBIFN,ZI,ZN)),U,1) Q:SEQ="" . S IBX(Z,SEQ,ZI,ZN)="" . Q ; ; Display billing provider secondary ID's (current ins only) I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX S Z="BILLING PRV" ; PRXM/KJH - Removed "I $D(IBX(Z))" from next line. Caused header to not display even though there would be a "None Found' message. W !!,"Billing Provider Secondary IDs (VistA Record CI1A):" D SECID(Z,.IBQUIT) I IBQUIT G EX ; ; Now display the lab or facility primary and secondary IDs ; This is the service facility information ; ; Facility name, same code as found in SUB-2 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX W !!,"Service Facility Name and ID Information" S IBXIEN=IBIFN D F^IBCEF("N-RENDERING INSTITUTION","IBZ",,IBIFN) S FACNAME=$$GETFAC^IBCEP8(+IBZ,+$P(IBZ,U,2),0,"SUB") S Z="LAB/FAC" ; ; determine if flag to suppress lab/fac data is set D VAMCFD^IBCEF75(IBIFN,.IBSSFI) I $D(IBSSFI),'$G(IBSSFI("C",1)) D I IBQUIT G EX . I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT . W !!,"Note: Service Facility Data not sent for Current Insurance" . W !," 'Send VA Lab/Facility IDs or Facility Data for VAMC?' is set to NO",! . Q ; ; facility name I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX I FACNAME="" S FACNAME="n/a" W !,"Facility: ",FACNAME ; ; PRXM/KJH - Add NPI to display for patch 343. S ORGNPI=$$ORGNPI^IBCEF73A(IBIFN) S DATA=$S($P($G(IBZ),U,2)=1:$P(ORGNPI,U,2),$P($G(IBZ),U,2)=0:$P(ORGNPI,U,1),1:$P(ORGNPI,U,3)) I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX W !?5,"Lab or Facility NPI:" W !?12,$S(DATA'="":DATA,1:"***MISSING***") ; primary ID S DATA=$G(IBID(Z,IBIFN,"C",1,0)) ; lab/facility current ins primary S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) S IDNUM=$P(DATA,U,2) I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX W !?5,"Lab or Facility Primary ID (VistA Record SUB):" I DATA'="" W !?8,"(",$P($G(IBID(Z,IBIFN,"C",1)),U,1),") ",QUALNM,?40,IDNUM I DATA="" W !?8,"(-) None Found" ; ; secondary IDs I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX W !?5,"Lab or Facility Secondary IDs (VistA Records SUB1,SUB2,OP3,OP6,OP7):" D SECID(Z,.IBQUIT) I IBQUIT G EX ; EX ; Q ; QUAL(Z,FORMTYPE) ; turn the qualifier code into a qualifier description NEW QUAL,IEN S QUAL="" I $G(Z)="" G QUALX I Z="1C" D G QUALX ; qualifier for Medicare Part ? . I $G(FORMTYPE)=2 S QUAL="MEDICARE PART B" ; 1500 . I $G(FORMTYPE)=3 S QUAL="MEDICARE PART A" ; ub . Q I Z=34 S Z="SY" ; qualifier for SSN S IEN=+$O(^IBE(355.97,"C",Z,"")) I 'IEN G QUALX S QUAL=$P($G(^IBE(355.97,IEN,0)),U,1) QUALX ; Q QUAL ; SECID(Z,IBQUIT) ; Display secondary ID and qualifier information ; Z is the type of IDs passed in; either BILLING PRV or LAB/FAC ; IBQUIT is returned if passed by reference NEW SEQ,ZI,ZN,PSIN,DATA,QUALNM,IDNUM,NODATA S IBQUIT=0,NODATA=1 F SEQ="P","S","T" D Q:IBQUIT . ; . ; current ins only for billing provider secondary IDs . I Z="BILLING PRV",SEQ'=$$COB^IBCEF(IBIFN) Q . S ZI="" . F S ZI=$O(IBX(Z,SEQ,ZI)) Q:ZI="" D Q:IBQUIT .. S ZN=0 .. F S ZN=$O(IBX(Z,SEQ,ZI,ZN)) Q:'ZN D Q:IBQUIT ... S PSIN=0 ; start at 0 to skip primary IDs ... F S PSIN=$O(IBID(Z,IBIFN,ZI,ZN,PSIN)) Q:PSIN="" D Q:IBQUIT .... S DATA=$G(IBID(Z,IBIFN,ZI,ZN,PSIN)) .... S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) .... S IDNUM=$P(DATA,U,2) .... I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT .... S NODATA=0 .... W !?8,"(",SEQ,") ",QUALNM,?40,IDNUM .... I Z="LAB/FAC",$D(^DGCR(399,IBIFN,"I2")),SEQ=$$COB^IBCEF(IBIFN) W ?54,"<<