- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEF74A.m
r613 r623 1 IBCEF74A ;ALB/ESG - Provider ID maint ?ID continuation ;7 Mar 2006 2 ;;2.0;INTEGRATED BILLING;**320,343,349,395**;21-MAR-94;Build 3 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 EN(IBIFN,IBQUIT) ; Display billing provider and service provider IDs as part 8 ; of the ?ID display/help in the billing screens. 9 ; Called from DISPID^IBCEF74. 10 NEW IBID,IBX,Z,ZI,ZN,SEQ,PSIN,DATA,QUALNM,IDNUM,FACNAME,IBZ,IBXIEN,IBSSFI,ORGNPI 11 ; 12 D ALLIDS^IBCEF75(IBIFN,.IBID) 13 ; 14 ; Re-sort array by insurance sequence (P/S/T) 15 K IBX 16 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 17 . S SEQ=$P($G(IBID(Z,IBIFN,ZI,ZN)),U,1) Q:SEQ="" 18 . S IBX(Z,SEQ,ZI,ZN)="" 19 . Q 20 ; 21 ; Display billing provider secondary ID's (current ins only) 22 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 23 S Z="BILLING PRV" 24 ; PRXM/KJH - Removed "I $D(IBX(Z))" from next line. Caused header to not display even though there would be a "None Found' message. 25 W !!,"Billing Provider Secondary IDs (VistA Record CI1A):" 26 D SECID(Z,.IBQUIT) 27 I IBQUIT G EX 28 ; 29 ; Now display the lab or facility primary and secondary IDs 30 ; This is the service facility information 31 ; 32 ; Facility name, same code as found in SUB-2 33 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 34 W !!,"Service Facility Name and ID Information" 35 S IBXIEN=IBIFN 36 D F^IBCEF("N-RENDERING INSTITUTION","IBZ",,IBIFN) 37 I $$ISRX^IBCEF1(IBIFN) S Z=$$RXSITE^IBCEF73A(IBIFN) I Z S $P(IBZ,"^")=+Z 38 S FACNAME=$$GETFAC^IBCEP8(+IBZ,+$P(IBZ,U,2),0,"SUB") 39 S Z="LAB/FAC" 40 ; 41 ; determine if flag to suppress lab/fac data is set 42 D VAMCFD^IBCEF75(IBIFN,.IBSSFI) 43 I $D(IBSSFI),'$G(IBSSFI("C",1)) D I IBQUIT G EX 44 . I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT 45 . W !!,"Note: Service Facility Data not sent for Current Insurance" 46 . W !," 'Send VA Lab/Facility IDs or Facility Data for VAMC?' is set to NO",! 47 . Q 48 ; 49 ; facility name 50 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 51 I FACNAME="" S FACNAME="n/a" 52 W !,"Facility: ",FACNAME 53 ; 54 ; PRXM/KJH - Add NPI to display for patch 343. 55 S ORGNPI=$$ORGNPI^IBCEF73A(IBIFN) 56 S DATA=$S($$ISRX^IBCEF1(IBIFN):$P(ORGNPI,U,3),$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)) 57 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 58 W !?5,"Lab or Facility NPI:" 59 W !?12,$S(DATA'="":DATA,1:"***MISSING***") 60 ; primary ID 61 S DATA=$G(IBID(Z,IBIFN,"C",1,0)) ; lab/facility current ins primary 62 S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) 63 S IDNUM=$P(DATA,U,2) 64 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 65 W !?5,"Lab or Facility Primary ID (VistA Record SUB):" 66 I DATA'="" W !?8,"(",$P($G(IBID(Z,IBIFN,"C",1)),U,1),") ",QUALNM,?40,IDNUM 67 I DATA="" W !?8,"(-) None Found" 68 ; 69 ; secondary IDs 70 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 71 W !?5,"Lab or Facility Secondary IDs (VistA Records SUB1,SUB2,OP3,OP6,OP7):" 72 D SECID(Z,.IBQUIT) 73 I IBQUIT G EX 74 ; 75 EX ; 76 Q 77 ; 78 QUAL(Z,FORMTYPE) ; turn the qualifier code into a qualifier description 79 NEW QUAL,IEN 80 S QUAL="" 81 I $G(Z)="" G QUALX 82 I Z="1C" D G QUALX ; qualifier for Medicare Part ? 83 . I $G(FORMTYPE)=2 S QUAL="MEDICARE PART B" ; 1500 84 . I $G(FORMTYPE)=3 S QUAL="MEDICARE PART A" ; ub 85 . Q 86 I Z=34 S Z="SY" ; qualifier for SSN 87 S IEN=+$O(^IBE(355.97,"C",Z,"")) I 'IEN G QUALX 88 S QUAL=$P($G(^IBE(355.97,IEN,0)),U,1) 89 QUALX ; 90 Q QUAL 91 ; 92 SECID(Z,IBQUIT) ; Display secondary ID and qualifier information 93 ; Z is the type of IDs passed in; either BILLING PRV or LAB/FAC 94 ; IBQUIT is returned if passed by reference 95 NEW SEQ,ZI,ZN,PSIN,DATA,QUALNM,IDNUM,NODATA 96 S IBQUIT=0,NODATA=1 97 F SEQ="P","S","T" D Q:IBQUIT 98 . ; 99 . ; current ins only for billing provider secondary IDs 100 . I Z="BILLING PRV",SEQ'=$$COB^IBCEF(IBIFN) Q 101 . S ZI="" 102 . F S ZI=$O(IBX(Z,SEQ,ZI)) Q:ZI="" D Q:IBQUIT 103 .. S ZN=0 104 .. F S ZN=$O(IBX(Z,SEQ,ZI,ZN)) Q:'ZN D Q:IBQUIT 105 ... S PSIN=0 ; start at 0 to skip primary IDs 106 ... F S PSIN=$O(IBID(Z,IBIFN,ZI,ZN,PSIN)) Q:PSIN="" D Q:IBQUIT 107 .... S DATA=$G(IBID(Z,IBIFN,ZI,ZN,PSIN)) 108 .... S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) 109 .... S IDNUM=$P(DATA,U,2) 110 .... I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT 111 .... S NODATA=0 112 .... W !?8,"(",SEQ,") ",QUALNM,?40,IDNUM 113 .... I Z="LAB/FAC",$D(^DGCR(399,IBIFN,"I2")),SEQ=$$COB^IBCEF(IBIFN) W ?54,"<<<Current Ins" 114 .... I Z="BILLING PRV",PSIN=1 W ?54,"<<<System Generated ID" 115 .... Q 116 ... Q 117 .. Q 118 . Q 119 I NODATA,'IBQUIT W !?8,"(-) None Found" 120 SECIDX ; 121 Q 122 ; 1 IBCEF74A ;ALB/ESG - Provider ID maint ?ID continuation ;7 Mar 2006 2 ;;2.0;INTEGRATED BILLING;**320,343,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 Q 6 ; 7 EN(IBIFN,IBQUIT) ; Display billing provider and service provider IDs as part 8 ; of the ?ID display/help in the billing screens. 9 ; Called from DISPID^IBCEF74. 10 NEW IBID,IBX,Z,ZI,ZN,SEQ,PSIN,DATA,QUALNM,IDNUM,FACNAME,IBZ,IBXIEN,IBSSFI,ORGNPI 11 ; 12 D ALLIDS^IBCEF75(IBIFN,.IBID) 13 ; 14 ; Re-sort array by insurance sequence (P/S/T) 15 K IBX 16 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 17 . S SEQ=$P($G(IBID(Z,IBIFN,ZI,ZN)),U,1) Q:SEQ="" 18 . S IBX(Z,SEQ,ZI,ZN)="" 19 . Q 20 ; 21 ; Display billing provider secondary ID's (current ins only) 22 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 23 S Z="BILLING PRV" 24 ; PRXM/KJH - Removed "I $D(IBX(Z))" from next line. Caused header to not display even though there would be a "None Found' message. 25 W !!,"Billing Provider Secondary IDs (VistA Record CI1A):" 26 D SECID(Z,.IBQUIT) 27 I IBQUIT G EX 28 ; 29 ; Now display the lab or facility primary and secondary IDs 30 ; This is the service facility information 31 ; 32 ; Facility name, same code as found in SUB-2 33 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 34 W !!,"Service Facility Name and ID Information" 35 S IBXIEN=IBIFN 36 D F^IBCEF("N-RENDERING INSTITUTION","IBZ",,IBIFN) 37 S FACNAME=$$GETFAC^IBCEP8(+IBZ,+$P(IBZ,U,2),0,"SUB") 38 S Z="LAB/FAC" 39 ; 40 ; determine if flag to suppress lab/fac data is set 41 D VAMCFD^IBCEF75(IBIFN,.IBSSFI) 42 I $D(IBSSFI),'$G(IBSSFI("C",1)) D I IBQUIT G EX 43 . I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT 44 . W !!,"Note: Service Facility Data not sent for Current Insurance" 45 . W !," 'Send VA Lab/Facility IDs or Facility Data for VAMC?' is set to NO",! 46 . Q 47 ; 48 ; facility name 49 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 50 I FACNAME="" S FACNAME="n/a" 51 W !,"Facility: ",FACNAME 52 ; 53 ; PRXM/KJH - Add NPI to display for patch 343. 54 S ORGNPI=$$ORGNPI^IBCEF73A(IBIFN) 55 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)) 56 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 57 W !?5,"Lab or Facility NPI:" 58 W !?12,$S(DATA'="":DATA,1:"***MISSING***") 59 ; primary ID 60 S DATA=$G(IBID(Z,IBIFN,"C",1,0)) ; lab/facility current ins primary 61 S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) 62 S IDNUM=$P(DATA,U,2) 63 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 64 W !?5,"Lab or Facility Primary ID (VistA Record SUB):" 65 I DATA'="" W !?8,"(",$P($G(IBID(Z,IBIFN,"C",1)),U,1),") ",QUALNM,?40,IDNUM 66 I DATA="" W !?8,"(-) None Found" 67 ; 68 ; secondary IDs 69 I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() I IBQUIT G EX 70 W !?5,"Lab or Facility Secondary IDs (VistA Records SUB1,SUB2,OP3,OP6,OP7):" 71 D SECID(Z,.IBQUIT) 72 I IBQUIT G EX 73 ; 74 EX ; 75 Q 76 ; 77 QUAL(Z,FORMTYPE) ; turn the qualifier code into a qualifier description 78 NEW QUAL,IEN 79 S QUAL="" 80 I $G(Z)="" G QUALX 81 I Z="1C" D G QUALX ; qualifier for Medicare Part ? 82 . I $G(FORMTYPE)=2 S QUAL="MEDICARE PART B" ; 1500 83 . I $G(FORMTYPE)=3 S QUAL="MEDICARE PART A" ; ub 84 . Q 85 I Z=34 S Z="SY" ; qualifier for SSN 86 S IEN=+$O(^IBE(355.97,"C",Z,"")) I 'IEN G QUALX 87 S QUAL=$P($G(^IBE(355.97,IEN,0)),U,1) 88 QUALX ; 89 Q QUAL 90 ; 91 SECID(Z,IBQUIT) ; Display secondary ID and qualifier information 92 ; Z is the type of IDs passed in; either BILLING PRV or LAB/FAC 93 ; IBQUIT is returned if passed by reference 94 NEW SEQ,ZI,ZN,PSIN,DATA,QUALNM,IDNUM,NODATA 95 S IBQUIT=0,NODATA=1 96 F SEQ="P","S","T" D Q:IBQUIT 97 . ; 98 . ; current ins only for billing provider secondary IDs 99 . I Z="BILLING PRV",SEQ'=$$COB^IBCEF(IBIFN) Q 100 . S ZI="" 101 . F S ZI=$O(IBX(Z,SEQ,ZI)) Q:ZI="" D Q:IBQUIT 102 .. S ZN=0 103 .. F S ZN=$O(IBX(Z,SEQ,ZI,ZN)) Q:'ZN D Q:IBQUIT 104 ... S PSIN=0 ; start at 0 to skip primary IDs 105 ... F S PSIN=$O(IBID(Z,IBIFN,ZI,ZN,PSIN)) Q:PSIN="" D Q:IBQUIT 106 .... S DATA=$G(IBID(Z,IBIFN,ZI,ZN,PSIN)) 107 .... S QUALNM=$$QUAL($P(DATA,U,1),$$FT^IBCEF(IBIFN)) 108 .... S IDNUM=$P(DATA,U,2) 109 .... I ($Y+5)>IOSL S IBQUIT=$$NOMORE^IBCEF74() Q:IBQUIT 110 .... S NODATA=0 111 .... W !?8,"(",SEQ,") ",QUALNM,?40,IDNUM 112 .... I Z="LAB/FAC",$D(^DGCR(399,IBIFN,"I2")),SEQ=$$COB^IBCEF(IBIFN) W ?54,"<<<Current Ins" 113 .... I Z="BILLING PRV",PSIN=1 W ?54,"<<<System Generated ID" 114 .... Q 115 ... Q 116 .. Q 117 . Q 118 I NODATA,'IBQUIT W !?8,"(-) None Found" 119 SECIDX ; 120 Q 121 ;
Note:
See TracChangeset
for help on using the changeset viewer.
