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

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1IBCEF74A ;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 ;
7EN(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 ;
75EX ;
76 Q
77 ;
78QUAL(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)
89QUALX ;
90 Q QUAL
91 ;
92SECID(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"
120SECIDX ;
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.