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

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

revised back to 6/30/08 version

File size: 2.4 KB
RevLine 
[623]1IBCNADD ;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 ;
5ADD(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 ;
18MAIN ; -- 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
36MAINQ Q IB02
37 ;
38I ; -- 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 ;
46O ; -- 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 ;
54R ; -- 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 TracBrowser for help on using the repository browser.