IBJTU3 ;ALB/ARH - TPI UTILITIES - INS ADDRESS ; 2/14/95
;;2.0;INTEGRATED BILLING;**39,80,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
BADD(IBIFN) ; returns mailing address for bill
; returns: COMPANY NAME ^ PHONE NUMBER ^ STR 1 ^ STR 2 ^ STR 3 ^ CITY ^ STATE ^ ZIP ^ ^ FAX #
N DFN,IBX,IBCNS,IBCDFN,IBTYP
;
S IBX="",DFN=$G(^DGCR(399,+$G(IBIFN),0))
S IBTYP=$P(DFN,U,5),DFN=+$P(DFN,U,2) I 'DFN G BADDQ
S IBCNS=$G(^DGCR(399,+IBIFN,"MP")) I 'IBCNS G BADDQ
S IBCDFN=$P(IBCNS,U,2) I +IBCDFN S IBCNS=+$G(^DPT(DFN,.312,+IBCDFN,0))
;
; -- if send to employer and state defined, return employer address
I +IBCDFN S IBCDFN=$G(^DPT(DFN,.312,+IBCDFN,2)) I +IBCDFN,+$P(IBCDFN,U,6) D G BADDQ
. S IBX=$P(IBCDFN,U,9)_U_$P(IBCDFN,U,8)_U_$P(IBCDFN,U,2,7)
;
S IBTYP=$S(IBTYP<3:"INP",1:"OPT")
S IBX=$$INSADD(+IBCNS,IBTYP)
;
BADDQ Q IBX
;
;
INSADD(IBCNS,IBATYP) ; returns specific type of address/phone # for an insurance company, follows ptrs to company responsible
; returns: COMPANY NAME ^ PHONE NUMBER ^ STR 1 ^ STR 2 ^ STR 3 ^ CITY ^ STATE ^ ZIP ^ ^ FAX #
; if type does not have an address or phone number then main mailing addr/ph # is returned
;
N IBD0,IBD13,IBADD,IBNM,IBPH,IBDN,IBCNT,IBAGAIN
S (IBADD,IBNM,IBPH)=""
;
MAIN ; -- determine address for company for type bill
;
S IBD0=$G(^DIC(36,+$G(IBCNS),0)) I IBD0="" G MAINQ
S IBD13=$G(^DIC(36,IBCNS,.13))
;
; -- get name, main address, phone number
S IBNM=$P(IBD0,U,1),IBPH=$P(IBD13,U,1),IBADD=$G(^DIC(36,+IBCNS,.11))
;
; -- if process the same co. more than once you are in an infinate loop
I $D(IBCNT(IBCNS)) G MAINQ ;already processed this company use main add
S IBCNT(IBCNS)=""
;
; -- type of bill
I $G(IBATYP)'="",$T(@IBATYP)'="" D @IBATYP I $D(IBAGAIN) K IBAGAIN G MAIN
;
; -- return address
MAINQ S IBNM=IBNM_U_IBPH_U_IBADD
Q IBNM
;
VER ; -- verification phone number
I $P(IBD13,U,4)'="" S IBPH=$P(IBD13,U,4)
Q
;
BILL ; -- billing phone number
I $P(IBD13,U,2)'="" S IBPH=$P(IBD13,U,2)
Q
;
PCERT ; -- precertification phone number
I $P(IBD13,U,3)'="" S IBPH=$P(IBD13,U,3)
;
; -- if other company processes precerts start again
I $P(IBD13,"^",9) S IBCNS=$P(IBD13,"^",9) S IBAGAIN=1
Q
;
INP ; -- inpatient phone number
I $P(IBD13,U,5)'="" S IBPH=$P(IBD13,U,5)
;
; -- see if there is an inpatient address, use if state is there
S IBDN=$G(^DIC(36,+IBCNS,.12)) I $P(IBDN,"^",5) S IBADD=IBDN
;
; -- if other company processes claims start again
I $P(IBDN,"^",7) S IBCNS=$P(IBDN,"^",7) S IBAGAIN=1
Q
;
OPT ; -- outpatient phone number
;JWS;IB*2.0*592;Dental Insurance mailing address
;IA# 5292
I $$FT^IBCEF(IBIFN)=7 D Q
. I $P($G(^DIC(36,+IBCNS,.19)),"^",11)'="" S IBPH=$P(^(.19),"^",11)
. I $P($G(^DIC(36,+IBCNS,.19)),"^",5) S IBADD=$P(^(.19),"^",1,6)
. I $P($G(^DIC(36,+IBCNS,.19)),"^",7) S IBCNS=$P(^(.19),"^",7) S IBAGAIN=1
I $P(IBD13,U,6)'="" S IBPH=$P(IBD13,U,6)
;
; -- see if there is an outpatient address, use if state is there
S IBDN=$G(^DIC(36,+IBCNS,.16)) I $P(IBDN,"^",5) S IBADD=IBDN
;
; -- if other company processes claims start again
I $P(IBDN,"^",7) S IBCNS=$P(IBDN,"^",7) S IBAGAIN=1
Q
;
RX ; -- prescription phone number
I $P(IBD13,U,11)'="" S IBPH=$P(IBD13,U,11)
;
; -- see if there is an prescription address, use if state is there
S IBDN=$G(^DIC(36,+IBCNS,.18)) I $P(IBDN,"^",5) S IBADD=IBDN
;
; -- if other company processes claims start again
I $P(IBDN,"^",7) S IBCNS=$P(IBDN,"^",7) S IBAGAIN=1
Q
;
APL ; -- appeals phone number
I $P(IBD13,U,7)'="" S IBPH=$P(IBD13,U,7)
;
; -- see if there is an appeals address, use if state is there
S IBDN=$G(^DIC(36,+IBCNS,.14)) I $P(IBDN,"^",5) S IBADD=IBDN
;
; -- if other company processes claims start again
I $P(IBDN,"^",7) S IBCNS=$P(IBDN,"^",7) S IBAGAIN=1
Q
;
INQ ; -- inquiry phone number
I $P(IBD13,U,8)'="" S IBPH=$P(IBD13,U,8)
;
; -- see if there is an outpatient address, use if state is there
S IBDN=$G(^DIC(36,+IBCNS,.15)) I $P(IBDN,"^",5) S IBADD=IBDN
;
; -- if other company processes claims start again
I $P(IBDN,"^",7) S IBCNS=$P(IBDN,"^",7) S IBAGAIN=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBJTU3 4244 printed Oct 16, 2024@18:24:52 Page 2
IBJTU3 ;ALB/ARH - TPI UTILITIES - INS ADDRESS ; 2/14/95
+1 ;;2.0;INTEGRATED BILLING;**39,80,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
BADD(IBIFN) ; returns mailing address for bill
+1 ; returns: COMPANY NAME ^ PHONE NUMBER ^ STR 1 ^ STR 2 ^ STR 3 ^ CITY ^ STATE ^ ZIP ^ ^ FAX #
+2 NEW DFN,IBX,IBCNS,IBCDFN,IBTYP
+3 ;
+4 SET IBX=""
SET DFN=$GET(^DGCR(399,+$GET(IBIFN),0))
+5 SET IBTYP=$PIECE(DFN,U,5)
SET DFN=+$PIECE(DFN,U,2)
IF 'DFN
GOTO BADDQ
+6 SET IBCNS=$GET(^DGCR(399,+IBIFN,"MP"))
IF 'IBCNS
GOTO BADDQ
+7 SET IBCDFN=$PIECE(IBCNS,U,2)
IF +IBCDFN
SET IBCNS=+$GET(^DPT(DFN,.312,+IBCDFN,0))
+8 ;
+9 ; -- if send to employer and state defined, return employer address
+10 IF +IBCDFN
SET IBCDFN=$GET(^DPT(DFN,.312,+IBCDFN,2))
IF +IBCDFN
IF +$PIECE(IBCDFN,U,6)
Begin DoDot:1
+11 SET IBX=$PIECE(IBCDFN,U,9)_U_$PIECE(IBCDFN,U,8)_U_$PIECE(IBCDFN,U,2,7)
End DoDot:1
GOTO BADDQ
+12 ;
+13 SET IBTYP=$SELECT(IBTYP<3:"INP",1:"OPT")
+14 SET IBX=$$INSADD(+IBCNS,IBTYP)
+15 ;
BADDQ QUIT IBX
+1 ;
+2 ;
INSADD(IBCNS,IBATYP) ; returns specific type of address/phone # for an insurance company, follows ptrs to company responsible
+1 ; returns: COMPANY NAME ^ PHONE NUMBER ^ STR 1 ^ STR 2 ^ STR 3 ^ CITY ^ STATE ^ ZIP ^ ^ FAX #
+2 ; if type does not have an address or phone number then main mailing addr/ph # is returned
+3 ;
+4 NEW IBD0,IBD13,IBADD,IBNM,IBPH,IBDN,IBCNT,IBAGAIN
+5 SET (IBADD,IBNM,IBPH)=""
+6 ;
MAIN ; -- determine address for company for type bill
+1 ;
+2 SET IBD0=$GET(^DIC(36,+$GET(IBCNS),0))
IF IBD0=""
GOTO MAINQ
+3 SET IBD13=$GET(^DIC(36,IBCNS,.13))
+4 ;
+5 ; -- get name, main address, phone number
+6 SET IBNM=$PIECE(IBD0,U,1)
SET IBPH=$PIECE(IBD13,U,1)
SET IBADD=$GET(^DIC(36,+IBCNS,.11))
+7 ;
+8 ; -- if process the same co. more than once you are in an infinate loop
+9 ;already processed this company use main add
IF $DATA(IBCNT(IBCNS))
GOTO MAINQ
+10 SET IBCNT(IBCNS)=""
+11 ;
+12 ; -- type of bill
+13 IF $GET(IBATYP)'=""
IF $TEXT(@IBATYP)'=""
DO @IBATYP
IF $DATA(IBAGAIN)
KILL IBAGAIN
GOTO MAIN
+14 ;
+15 ; -- return address
MAINQ SET IBNM=IBNM_U_IBPH_U_IBADD
+1 QUIT IBNM
+2 ;
VER ; -- verification phone number
+1 IF $PIECE(IBD13,U,4)'=""
SET IBPH=$PIECE(IBD13,U,4)
+2 QUIT
+3 ;
BILL ; -- billing phone number
+1 IF $PIECE(IBD13,U,2)'=""
SET IBPH=$PIECE(IBD13,U,2)
+2 QUIT
+3 ;
PCERT ; -- precertification phone number
+1 IF $PIECE(IBD13,U,3)'=""
SET IBPH=$PIECE(IBD13,U,3)
+2 ;
+3 ; -- if other company processes precerts start again
+4 IF $PIECE(IBD13,"^",9)
SET IBCNS=$PIECE(IBD13,"^",9)
SET IBAGAIN=1
+5 QUIT
+6 ;
INP ; -- inpatient phone number
+1 IF $PIECE(IBD13,U,5)'=""
SET IBPH=$PIECE(IBD13,U,5)
+2 ;
+3 ; -- see if there is an inpatient address, use if state is there
+4 SET IBDN=$GET(^DIC(36,+IBCNS,.12))
IF $PIECE(IBDN,"^",5)
SET IBADD=IBDN
+5 ;
+6 ; -- if other company processes claims start again
+7 IF $PIECE(IBDN,"^",7)
SET IBCNS=$PIECE(IBDN,"^",7)
SET IBAGAIN=1
+8 QUIT
+9 ;
OPT ; -- outpatient phone number
+1 ;JWS;IB*2.0*592;Dental Insurance mailing address
+2 ;IA# 5292
+3 IF $$FT^IBCEF(IBIFN)=7
Begin DoDot:1
+4 IF $PIECE($GET(^DIC(36,+IBCNS,.19)),"^",11)'=""
SET IBPH=$PIECE(^(.19),"^",11)
+5 IF $PIECE($GET(^DIC(36,+IBCNS,.19)),"^",5)
SET IBADD=$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 IF $PIECE(IBD13,U,6)'=""
SET IBPH=$PIECE(IBD13,U,6)
+8 ;
+9 ; -- see if there is an outpatient address, use if state is there
+10 SET IBDN=$GET(^DIC(36,+IBCNS,.16))
IF $PIECE(IBDN,"^",5)
SET IBADD=IBDN
+11 ;
+12 ; -- if other company processes claims start again
+13 IF $PIECE(IBDN,"^",7)
SET IBCNS=$PIECE(IBDN,"^",7)
SET IBAGAIN=1
+14 QUIT
+15 ;
RX ; -- prescription phone number
+1 IF $PIECE(IBD13,U,11)'=""
SET IBPH=$PIECE(IBD13,U,11)
+2 ;
+3 ; -- see if there is an prescription address, use if state is there
+4 SET IBDN=$GET(^DIC(36,+IBCNS,.18))
IF $PIECE(IBDN,"^",5)
SET IBADD=IBDN
+5 ;
+6 ; -- if other company processes claims start again
+7 IF $PIECE(IBDN,"^",7)
SET IBCNS=$PIECE(IBDN,"^",7)
SET IBAGAIN=1
+8 QUIT
+9 ;
APL ; -- appeals phone number
+1 IF $PIECE(IBD13,U,7)'=""
SET IBPH=$PIECE(IBD13,U,7)
+2 ;
+3 ; -- see if there is an appeals address, use if state is there
+4 SET IBDN=$GET(^DIC(36,+IBCNS,.14))
IF $PIECE(IBDN,"^",5)
SET IBADD=IBDN
+5 ;
+6 ; -- if other company processes claims start again
+7 IF $PIECE(IBDN,"^",7)
SET IBCNS=$PIECE(IBDN,"^",7)
SET IBAGAIN=1
+8 QUIT
+9 ;
INQ ; -- inquiry phone number
+1 IF $PIECE(IBD13,U,8)'=""
SET IBPH=$PIECE(IBD13,U,8)
+2 ;
+3 ; -- see if there is an outpatient address, use if state is there
+4 SET IBDN=$GET(^DIC(36,+IBCNS,.15))
IF $PIECE(IBDN,"^",5)
SET IBADD=IBDN
+5 ;
+6 ; -- if other company processes claims start again
+7 IF $PIECE(IBDN,"^",7)
SET IBCNS=$PIECE(IBDN,"^",7)
SET IBAGAIN=1
+8 QUIT
