IBCNADD ;ALB/AAS - ADDRESS RETRIEVAL ENGINE FOR FILE 399 ; 29-AUG-93
;;2.0;INTEGRATED BILLING;**52,80,377,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
ADD(DA,IBCOB) ; -- Retrieve correct billing address for a bill, mailing address of Bill Payer
; assumes that new policy field points to valid ins. policy
; DA = ien to file 399
; IBCOB = payer sequence PST or 123 (optional)
;
N X,Y,I,J,IB01,IB02,IBTYP,DFN,IBCNS,IBCDFN,IBCNT,IBAGAIN,IBFND,IBBILLTY,IBCHRGTY
S IB02=""
S DFN=$P($G(^DGCR(399,DA,0)),"^",2)
S IBBILLTY=$P($G(^DGCR(399,DA,0)),"^",5),IBCHRGTY=$P($$CHGTYPE^IBCU(DA),"^;",1)
;
S IBCNS=+$P($G(^DGCR(399,DA,"MP")),U,1)
S IBCDFN=$P($G(^DGCR(399,DA,"MP")),U,2)
;
; If a specific payer sequence was passed in, get the ins. company and the policy ptr
; No address returned for Medicare
I $G(IBCOB)'="" D I $$MCRWNR^IBEFUNC(IBCNS) G MAINQ
. S IBCOB=$TR(IBCOB,"PST","123")
. S IBCNS=+$P($G(^DGCR(399,DA,"I"_IBCOB)),U,1)
. S IBCDFN=+$P($G(^DGCR(399,DA,"M")),U,IBCOB+11)
. Q
;
I 'IBCNS G MAINQ
I IBCDFN S IBCNS=+$G(^DPT(+DFN,.312,+IBCDFN,0))
I '$D(^DIC(36,+IBCNS,0)) G MAINQ
;
; -- if send bill to employer and state is filled in use this
I +$G(^DPT(DFN,.312,+IBCDFN,2)),+$P(^(2),"^",6) S IB02=$P(^(2),"^",2,99) G MAINQ
;
MAIN ; -- determine address for company for type bill
;
; -- get main address
S IB02=$S($D(^DIC(36,+IBCNS,.11)):^(.11),1:"")
S IBCNT=$G(IBCNT)+1
;
; -- if process the same co. more than once you are in an infinite loop
I $D(IBCNT(IBCNS)) G MAINQ ;already processed this company use main add
S IBCNT(IBCNS)=""
;
; -- type of charges: Rx charges - if ins company has an rx address use it, otherwise use opt address
I IBCHRGTY=3 S IBTYP="R" D @IBTYP G:$D(IBFND) MAINQ I $D(IBAGAIN) K IBAGAIN G MAIN
;
; -- type of bill: inpatient<3, outpatient>2
S IBTYP=$S(IBBILLTY<3:"I",1:"O")
D @IBTYP I $D(IBAGAIN) K IBAGAIN G MAIN
;
; -- return address
MAINQ Q IB02
;
I ; -- see if there is an inpatient address
; -- use if state is there
I $P($G(^DIC(36,+IBCNS,.12)),"^",5) S IB02=$P($G(^(.12)),"^",1,6)
;
; -- if other company processes claims start again
I $P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.12)),"^",7) S IBAGAIN=1
Q
;
O ; -- see if there is an outpatient address
; -- use if state is there
;JWS;IB*2.0*592;Dental Insurance mailing address
;IA# 5292
I $$FT^IBCEF(DA)=7 D Q
. I $P($G(^DIC(36,+IBCNS,.19)),"^",5) S IB02=$P(^(.19),"^",1,6)
. I $P($G(^DIC(36,+IBCNS,.19)),"^",7) S IBCNS=$P(^(.19),"^",7) S IBAGAIN=1
;
I $P($G(^DIC(36,+IBCNS,.16)),"^",5) S IB02=$P($G(^(.16)),"^",1,6)
;
; -- if other company processes claims start again
I $P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.16)),"^",7) S IBAGAIN=1
Q
;
R ; -- see if there is an Rx address
; -- use if state is there
I $P($G(^DIC(36,+IBCNS,.18)),"^",5) S IB02=$P($G(^(.18)),"^",1,6) S IBFND=1
;
; -- if other company processes claims start again
I $P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBCNS=$P($G(^DIC(36,+IBCNS,.18)),"^",7) S IBAGAIN=1 K IBFND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNADD 3174 printed Dec 13, 2024@02:13:40 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
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
+2 ; DA = ien to file 399
+3 ; IBCOB = payer sequence PST or 123 (optional)
+4 ;
+5 NEW X,Y,I,J,IB01,IB02,IBTYP,DFN,IBCNS,IBCDFN,IBCNT,IBAGAIN,IBFND,IBBILLTY,IBCHRGTY
+6 SET IB02=""
+7 SET DFN=$PIECE($GET(^DGCR(399,DA,0)),"^",2)
+8 SET IBBILLTY=$PIECE($GET(^DGCR(399,DA,0)),"^",5)
SET IBCHRGTY=$PIECE($$CHGTYPE^IBCU(DA),"^;",1)
+9 ;
+10 SET IBCNS=+$PIECE($GET(^DGCR(399,DA,"MP")),U,1)
+11 SET IBCDFN=$PIECE($GET(^DGCR(399,DA,"MP")),U,2)
+12 ;
+13 ; If a specific payer sequence was passed in, get the ins. company and the policy ptr
+14 ; No address returned for Medicare
+15 IF $GET(IBCOB)'=""
Begin DoDot:1
+16 SET IBCOB=$TRANSLATE(IBCOB,"PST","123")
+17 SET IBCNS=+$PIECE($GET(^DGCR(399,DA,"I"_IBCOB)),U,1)
+18 SET IBCDFN=+$PIECE($GET(^DGCR(399,DA,"M")),U,IBCOB+11)
+19 QUIT
End DoDot:1
IF $$MCRWNR^IBEFUNC(IBCNS)
GOTO MAINQ
+20 ;
+21 IF 'IBCNS
GOTO MAINQ
+22 IF IBCDFN
SET IBCNS=+$GET(^DPT(+DFN,.312,+IBCDFN,0))
+23 IF '$DATA(^DIC(36,+IBCNS,0))
GOTO MAINQ
+24 ;
+25 ; -- if send bill to employer and state is filled in use this
+26 IF +$GET(^DPT(DFN,.312,+IBCDFN,2))
IF +$PIECE(^(2),"^",6)
SET IB02=$PIECE(^(2),"^",2,99)
GOTO MAINQ
+27 ;
MAIN ; -- determine address for company for type bill
+1 ;
+2 ; -- get main address
+3 SET IB02=$SELECT($DATA(^DIC(36,+IBCNS,.11)):^(.11),1:"")
+4 SET IBCNT=$GET(IBCNT)+1
+5 ;
+6 ; -- if process the same co. more than once you are in an infinite loop
+7 ;already processed this company use main add
IF $DATA(IBCNT(IBCNS))
GOTO MAINQ
+8 SET IBCNT(IBCNS)=""
+9 ;
+10 ; -- type of charges: Rx charges - if ins company has an rx address use it, otherwise use opt address
+11 IF IBCHRGTY=3
SET IBTYP="R"
DO @IBTYP
if $DATA(IBFND)
GOTO MAINQ
IF $DATA(IBAGAIN)
KILL IBAGAIN
GOTO MAIN
+12 ;
+13 ; -- type of bill: inpatient<3, outpatient>2
+14 SET IBTYP=$SELECT(IBBILLTY<3:"I",1:"O")
+15 DO @IBTYP
IF $DATA(IBAGAIN)
KILL IBAGAIN
GOTO MAIN
+16 ;
+17 ; -- return address
MAINQ QUIT IB02
+1 ;
I ; -- see if there is an inpatient address
+1 ; -- use if state is there
+2 IF $PIECE($GET(^DIC(36,+IBCNS,.12)),"^",5)
SET IB02=$PIECE($GET(^(.12)),"^",1,6)
+3 ;
+4 ; -- if other company processes claims start again
+5 IF $PIECE($GET(^DIC(36,+IBCNS,.12)),"^",7)
SET IBCNS=$PIECE($GET(^DIC(36,+IBCNS,.12)),"^",7)
SET IBAGAIN=1
+6 QUIT
+7 ;
O ; -- see if there is an outpatient address
+1 ; -- use if state is there
+2 ;JWS;IB*2.0*592;Dental Insurance mailing address
+3 ;IA# 5292
+4 IF $$FT^IBCEF(DA)=7
Begin DoDot:1
+5 IF $PIECE($GET(^DIC(36,+IBCNS,.19)),"^",5)
SET IB02=$PIECE(^(.19),"^",1,6)
+6 IF $PIECE($GET(^DIC(36,+IBCNS,.19)),"^",7)
SET IBCNS=$PIECE(^(.19),"^",7)
SET IBAGAIN=1
End DoDot:1
QUIT
+7 ;
+8 IF $PIECE($GET(^DIC(36,+IBCNS,.16)),"^",5)
SET IB02=$PIECE($GET(^(.16)),"^",1,6)
+9 ;
+10 ; -- if other company processes claims start again
+11 IF $PIECE($GET(^DIC(36,+IBCNS,.16)),"^",7)
SET IBCNS=$PIECE($GET(^DIC(36,+IBCNS,.16)),"^",7)
SET IBAGAIN=1
+12 QUIT
+13 ;
R ; -- see if there is an Rx address
+1 ; -- use if state is there
+2 IF $PIECE($GET(^DIC(36,+IBCNS,.18)),"^",5)
SET IB02=$PIECE($GET(^(.18)),"^",1,6)
SET IBFND=1
+3 ;
+4 ; -- if other company processes claims start again
+5 IF $PIECE($GET(^DIC(36,+IBCNS,.18)),"^",7)
SET IBCNS=$PIECE($GET(^DIC(36,+IBCNS,.18)),"^",7)
SET IBAGAIN=1
KILL IBFND
+6 QUIT
