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