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

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,"<<<Current Ins"

 .... I Z="BILLING PRV",PSIN=1 W ?54,"<<<System Generated ID"

 .... Q

 ... Q

 .. Q

 . Q

 I NODATA,'IBQUIT W !?8,"(-) None Found"

SECIDX ;

 Q

 ;