- 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 Feb 18, 2025@23:40:04 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