| [623] | 1 | IBCNADD ;ALB/AAS - ADDRESS RETRIEVAL ENGINE FOR FILE 399 ; 29-AUG-93
 | 
|---|
 | 2 |  ;;2.0;INTEGRATED BILLING;**52,80**;21-MAR-94
 | 
|---|
 | 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 | ADD(DA) ; -- Retrive correct billing address for a bill, mailing address of Bill Payer
 | 
|---|
 | 6 |  ;    assumes that new policy field points to valid ins. policy
 | 
|---|
 | 7 |  N X,Y,I,J,IB01,IB02,IBTYP,DFN,IBCNS,IBCDFN,IBCNT,IBAGAIN,IBFND,IBBILLTY,IBCHRGTY
 | 
|---|
 | 8 |  S IB02=""
 | 
|---|
 | 9 |  S DFN=$P($G(^DGCR(399,DA,0)),"^",2)
 | 
|---|
 | 10 |  S IBCNS=+$P($G(^DGCR(399,DA,"MP")),U,1) G:'IBCNS MAINQ
 | 
|---|
 | 11 |  S IBCDFN=$P($G(^DGCR(399,DA,"MP")),"^",2) I IBCDFN S IBCNS=+$G(^DPT(+DFN,.312,+IBCDFN,0))
 | 
|---|
 | 12 |  S IBBILLTY=$P($G(^DGCR(399,DA,0)),"^",5),IBCHRGTY=$P($$CHGTYPE^IBCU(DA),"^;",1)
 | 
|---|
 | 13 |  I '$D(^DIC(36,+IBCNS,0)) G MAINQ
 | 
|---|
 | 14 |  ;
 | 
|---|
 | 15 |  ; -- if send bill to employer and state is filled in use this
 | 
|---|
 | 16 |  I +$G(^DPT(DFN,.312,+IBCDFN,2)),+$P(^(2),"^",6) S IB02=$P(^(2),"^",2,99) G MAINQ
 | 
|---|
 | 17 |  ;
 | 
|---|
 | 18 | MAIN ; -- determine address for company for type bill
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 |  ; -- get main address
 | 
|---|
 | 21 |  S IB02=$S($D(^DIC(36,+IBCNS,.11)):^(.11),1:"")
 | 
|---|
 | 22 |  S IBCNT=$G(IBCNT)+1
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 |  ; -- if process the same co. more than once you are in an infinite loop
 | 
|---|
 | 25 |  I $D(IBCNT(IBCNS)) G MAINQ ;already processed this company  use main add
 | 
|---|
 | 26 |  S IBCNT(IBCNS)=""
 | 
|---|
 | 27 |  ;
 | 
|---|
 | 28 |  ; -- type of charges:   Rx charges - if ins company has an rx address use it, otherwise use opt address
 | 
|---|
 | 29 |  I IBCHRGTY=3 S IBTYP="R" D @IBTYP G:$D(IBFND) MAINQ I $D(IBAGAIN) K IBAGAIN G MAIN
 | 
|---|
 | 30 |  ;
 | 
|---|
 | 31 |  ; -- type of bill:   inpatient<3, outpatient>2
 | 
|---|
 | 32 |  S IBTYP=$S(IBBILLTY<3:"I",1:"O")
 | 
|---|
 | 33 |  D @IBTYP I $D(IBAGAIN) K IBAGAIN G MAIN
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 |  ; -- return address
 | 
|---|
 | 36 | MAINQ Q IB02
 | 
|---|
 | 37 |  ;
 | 
|---|
 | 38 | I ; -- see if there is an inpatient address
 | 
|---|
 | 39 |  ; -- use if state is there
 | 
|---|
 | 40 |  I $P($G(^DIC(36,+IBCNS,.12)),"^",5) S IB02=$P($G(^(.12)),"^",1,6)
 | 
|---|
 | 41 |  ;
 | 
|---|
 | 42 |  ; -- if other company processes claims start again
 | 
|---|
 | 43 |  I $P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBAGAIN=1
 | 
|---|
 | 44 |  Q
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 | O ; -- see if there is an outpatient address
 | 
|---|
 | 47 |  ; -- use if state is there
 | 
|---|
 | 48 |  I $P($G(^DIC(36,+IBCNS,.16)),"^",5) S IB02=$P($G(^(.16)),"^",1,6)
 | 
|---|
 | 49 |  ;
 | 
|---|
 | 50 |  ; -- if other company processes claims start again
 | 
|---|
 | 51 |  I $P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBAGAIN=1
 | 
|---|
 | 52 |  Q
 | 
|---|
 | 53 |  ;
 | 
|---|
 | 54 | R ; -- see if there is an Rx address
 | 
|---|
 | 55 |  ; -- use if state is there
 | 
|---|
 | 56 |  I $P($G(^DIC(36,+IBCNS,.18)),"^",5) S IB02=$P($G(^(.18)),"^",1,6) S IBFND=1
 | 
|---|
 | 57 |  ;
 | 
|---|
 | 58 |  ; -- if other company processes claims start again
 | 
|---|
 | 59 |  I $P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBAGAIN=1 K IBFND
 | 
|---|
 | 60 |  Q
 | 
|---|