| [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 | 
|---|