source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNADD.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1IBCNADD ;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 ;
5ADD(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 ;
33MAIN ; -- 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
51MAINQ Q IB02
52 ;
53I ; -- 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 ;
61O ; -- 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 ;
69R ; -- 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
Note: See TracBrowser for help on using the repository browser.