Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNADD

IBCNADD.m

Go to the documentation of this file.
  1. IBCNADD ;ALB/AAS - ADDRESS RETRIEVAL ENGINE FOR FILE 399 ; 29-AUG-93
  1. ;;2.0;INTEGRATED BILLING;**52,80,377,592**;21-MAR-94;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ADD(DA,IBCOB) ; -- Retrieve correct billing address for a bill, mailing address of Bill Payer
  1. ; assumes that new policy field points to valid ins. policy
  1. ; DA = ien to file 399
  1. ; IBCOB = payer sequence PST or 123 (optional)
  1. ;
  1. N X,Y,I,J,IB01,IB02,IBTYP,DFN,IBCNS,IBCDFN,IBCNT,IBAGAIN,IBFND,IBBILLTY,IBCHRGTY
  1. S IB02=""
  1. S DFN=$P($G(^DGCR(399,DA,0)),"^",2)
  1. S IBBILLTY=$P($G(^DGCR(399,DA,0)),"^",5),IBCHRGTY=$P($$CHGTYPE^IBCU(DA),"^;",1)
  1. ;
  1. S IBCNS=+$P($G(^DGCR(399,DA,"MP")),U,1)
  1. S IBCDFN=$P($G(^DGCR(399,DA,"MP")),U,2)
  1. ;
  1. ; If a specific payer sequence was passed in, get the ins. company and the policy ptr
  1. ; No address returned for Medicare
  1. I $G(IBCOB)'="" D I $$MCRWNR^IBEFUNC(IBCNS) G MAINQ
  1. . S IBCOB=$TR(IBCOB,"PST","123")
  1. . S IBCNS=+$P($G(^DGCR(399,DA,"I"_IBCOB)),U,1)
  1. . S IBCDFN=+$P($G(^DGCR(399,DA,"M")),U,IBCOB+11)
  1. . Q
  1. ;
  1. I 'IBCNS G MAINQ
  1. I IBCDFN S IBCNS=+$G(^DPT(+DFN,.312,+IBCDFN,0))
  1. I '$D(^DIC(36,+IBCNS,0)) G MAINQ
  1. ;
  1. ; -- if send bill to employer and state is filled in use this
  1. I +$G(^DPT(DFN,.312,+IBCDFN,2)),+$P(^(2),"^",6) S IB02=$P(^(2),"^",2,99) G MAINQ
  1. ;
  1. MAIN ; -- determine address for company for type bill
  1. ;
  1. ; -- get main address
  1. S IB02=$S($D(^DIC(36,+IBCNS,.11)):^(.11),1:"")
  1. S IBCNT=$G(IBCNT)+1
  1. ;
  1. ; -- if process the same co. more than once you are in an infinite loop
  1. I $D(IBCNT(IBCNS)) G MAINQ ;already processed this company use main add
  1. S IBCNT(IBCNS)=""
  1. ;
  1. ; -- type of charges: Rx charges - if ins company has an rx address use it, otherwise use opt address
  1. I IBCHRGTY=3 S IBTYP="R" D @IBTYP G:$D(IBFND) MAINQ I $D(IBAGAIN) K IBAGAIN G MAIN
  1. ;
  1. ; -- type of bill: inpatient<3, outpatient>2
  1. S IBTYP=$S(IBBILLTY<3:"I",1:"O")
  1. D @IBTYP I $D(IBAGAIN) K IBAGAIN G MAIN
  1. ;
  1. ; -- return address
  1. MAINQ Q IB02
  1. ;
  1. I ; -- see if there is an inpatient address
  1. ; -- use if state is there
  1. I $P($G(^DIC(36,+IBCNS,.12)),"^",5) S IB02=$P($G(^(.12)),"^",1,6)
  1. ;
  1. ; -- if other company processes claims start again
  1. I $P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBAGAIN=1
  1. Q
  1. ;
  1. O ; -- see if there is an outpatient address
  1. ; -- use if state is there
  1. ;JWS;IB*2.0*592;Dental Insurance mailing address
  1. ;IA# 5292
  1. I $$FT^IBCEF(DA)=7 D Q
  1. . I $P($G(^DIC(36,+IBCNS,.19)),"^",5) S IB02=$P(^(.19),"^",1,6)
  1. . I $P($G(^DIC(36,+IBCNS,.19)),"^",7) S IBCNS=$P(^(.19),"^",7) S IBAGAIN=1
  1. ;
  1. I $P($G(^DIC(36,+IBCNS,.16)),"^",5) S IB02=$P($G(^(.16)),"^",1,6)
  1. ;
  1. ; -- if other company processes claims start again
  1. I $P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBAGAIN=1
  1. Q
  1. ;
  1. R ; -- see if there is an Rx address
  1. ; -- use if state is there
  1. I $P($G(^DIC(36,+IBCNS,.18)),"^",5) S IB02=$P($G(^(.18)),"^",1,6) S IBFND=1
  1. ;
  1. ; -- if other company processes claims start again
  1. I $P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBAGAIN=1 K IBFND
  1. Q