- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNADD.m
r613 r623 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 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
Note:
See TracChangeset
for help on using the changeset viewer.
