IBJTU3.m

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 ---IBJTU3   4244     printed  Mar 13, 2025@21:29:12                                                                                                                                                                                                      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