| 1 | IBOLK1 ;ALB/CPM - DISPLAY BY BILL NUMBER, ADDRESS INQUIRY ; 28-JAN-92
 | 
|---|
| 2 |  ;;2.0;INTEGRATED BILLING;**80**;21-MAR-94
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Input:     DFN  --  pointer to patient in File #2
 | 
|---|
| 5 |  ;        IBIFN  --  pointer to a bill in File #399
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  D @("HDR1^"_$S(IBIFN:"IBCNQ",1:"IBOLK"))
 | 
|---|
| 8 |  W !!?25,"*** ADDRESS INFORMATION ***"
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ; - display patient address
 | 
|---|
| 11 |  D ADD^VADPT
 | 
|---|
| 12 |  W !!,"Patient Address:  ",VAPA(1)
 | 
|---|
| 13 |  W:VAPA(2)]"" !?18,VAPA(2) W:VAPA(3)]"" !?18,VAPA(3)
 | 
|---|
| 14 |  W:VAPA(4)]""!(VAPA(5)]"")!(VAPA(6)]"") !?18
 | 
|---|
| 15 |  W VAPA(4) W:VAPA(4)]""&(VAPA(5)]"") ", " W $P(VAPA(5),"^",2)
 | 
|---|
| 16 |  W:VAPA(6)]""&(VAPA(4)]""!(VAPA(5)]"")) "   " W VAPA(6)
 | 
|---|
| 17 |  W:VAPA(8)]"" !?18,VAPA(8)
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 |  ; - display mailing address for a UB-82
 | 
|---|
| 20 |  I IBIFN S IBM=$P($G(^DGCR(399,IBIFN,"M")),"^",4,9),IBM1=$G(^("M1")) D
 | 
|---|
| 21 |  . Q:IBM=""&(IBM1="")  W !!,"Mailing Address:  " D ADDR
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  ; - display Insurance Company or Institution addresses for UB-82's
 | 
|---|
| 24 |  I IBIFN S X=$P($G(^DGCR(399.3,+$P($G(^DGCR(399,IBIFN,0)),"^",7),0)),"^",7) D:X["i"!(X["o")
 | 
|---|
| 25 |  . I X["i" S Y=+$G(^DGCR(399,IBIFN,"MP")) Q:'$D(^DIC(36,Y,0))  D
 | 
|---|
| 26 |  ..  S IBM=$P(^DIC(36,Y,0),"^")_"^"_$G(^(.11)),IBPHONE=$P($G(^(.13)),"^")
 | 
|---|
| 27 |  ..  S IBM1=$P(IBM,"^",4),$P(IBM,"^",4,6)=$P(IBM,"^",5,7)
 | 
|---|
| 28 |  . I X["o" S Y=+$P($G(^DGCR(399,IBIFN,"M")),"^",11) Q:'$D(^DIC(4,Y,0))  D
 | 
|---|
| 29 |  ..  S IBM=$P(^DIC(4,Y,0),"^",1,2)_"^"_$G(^(1)),IBPHONE="",IBM1=""
 | 
|---|
| 30 |  ..  S Z=$P(IBM,"^",2),$P(IBM,"^",2,4)=$P(IBM,"^",3,5),$P(IBM,"^",5)=Z
 | 
|---|
| 31 |  . W !!,$S(X["i":"Ins Co.",1:"Instit.")," Address:  " D ADDR
 | 
|---|
| 32 |  . W:IBPHONE]"" !?18,$P(IBPHONE,"^")
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  D PAUSE^IBOLK
 | 
|---|
| 35 |  K IBM,IBM1,IBPHONE,VA,VAERR,VAPA,X,Y,Z Q
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 | ADDR ; Print mailing addresses for Insurance Companies and Institutions.
 | 
|---|
| 38 |  W $P(IBM,"^") W:$P(IBM,"^",2)]"" !?18,$P(IBM,"^",2)
 | 
|---|
| 39 |  W:$P(IBM,"^",3)]"" !?18,$P(IBM,"^",3) W:$P(IBM1,"^")]"" !?18,$P(IBM1,"^")
 | 
|---|
| 40 |  W:$P(IBM,"^",4)]""!($P(IBM,"^",5)]"")!($P(IBM,"^",6)]"") !?18
 | 
|---|
| 41 |  W $P(IBM,"^",4) W:$P(IBM,"^",4)]""&($P(IBM,"^",5)]"") ", "
 | 
|---|
| 42 |  W $P($G(^DIC(5,+$P(IBM,"^",5),0)),"^")
 | 
|---|
| 43 |  W:$P(IBM,"^",6)]""&($P(IBM,"^",4)]""!($P(IBM,"^",5)]"")) "   "
 | 
|---|
| 44 |  W $P(IBM,"^",6)
 | 
|---|
| 45 |  Q
 | 
|---|