IBCEP7B ;ALB/TMP - Functions for PROVIDER ID ;1-16-05
;;2.0;INTEGRATED BILLING;**320,348,349,592**;16-JAN-2005;Build 58
;;Per VA Directive 6402, this routine should not be modified.
Q
;
GETID(CLAIM,COB) ;
N DIR,X,Y,DTOUT,DUOUT,WHICH,ID,IBMAIN,IBDIV,DIC,IBINS,DA,DIC,Z,Z0,IBCU,OK,IBCU
;
S ID=""
S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
I IBINS="" Q ID
;
; Make sure they have careunits IDS defined for this insurance company before we bother asking
S OK=0
S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D Q:OK
. S Z0=$G(^IBA(355.92,Z,0))
. Q:$P(Z0,U,8)'="E"
. Q:$P(Z0,U,3)=""
. S OK=1
I 'OK Q ID
;
S WHICH=$S(COB=1:"Primary",COB=2:"Secondary",1:"Tertiary")
S DIR("A")="Define "_WHICH_" Payer ID by Care Unit? "
S DIR("B")="No"
S DIR(0)="YA"
S DIR("?",1)="Enter No to select "_WHICH_" Provider # by Division."
S DIR("?")="Enter Yes to select "_WHICH_" Provider # for a specific Care Unit."
D ^DIR
I Y'=1 Q ID
;
; Get the Division
S IBMAIN=$$MAIN^IBCEP2B()
S IBDIV=$$EXTERNAL^DILFD(399,.22,"",$P($G(^DGCR(399,CLAIM,0)),U,22))
S DIR("A")="Division: ",DIR(0)="355.92,.05AOr"
; Default Division
S DIR("B")=$S(IBDIV]"":IBDIV,1:IBMAIN)
D ^DIR K DIR
S IBDIV=+$S(Y>0:+Y,1:0)
I Y<0 Q ID
;
; Get the Care Unit
S DIC("A")="Care Unit: "
S DIC("W")="W "" "",$P(^(0),U,2)"
S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
D ^DIC
I Y<0 Q ID
S IBCU=+Y
;
; Compile the appropriate list of IDs
S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D Q:ID]""
. S Z0=$G(^IBA(355.92,Z,0))
. Q:$P(Z0,U,8)'="E"
. Q:$P(Z0,U,3)'=IBCU
. S ID=$P(Z0,U,7)_U_$P(Z0,U,6)
Q ID
;
; See if the insurance company flag is set to send the ATT/REND ID as the Billing Provider
ATTREND(CLAIM,COB) ;
N ID,IBINS
S ID=""
S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
I IBINS="" Q 0
I $$FT^IBCEF(CLAIM)=2,$$GET1^DIQ(36,IBINS,4.06,"I") Q 1 ; 1500
;IA# 2056;IB*2.0*592
I $$FT^IBCEF(CLAIM)=3,$$GET1^DIQ(36,IBINS,4.08,"I") Q 1 ; ub
Q 0
;
; Get a list of the plan types that supress Billing Provider Secondary IDs for this Insurance Co
; and see if the current plan type is one of them.
SUPPPT(CLAIM,COB) ;
N IBINS,SUPPFL
S SUPPFL=0
S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
I IBINS="" Q SUPPFL
;
I $D(^DIC(36,IBINS,13)) D
. N PLAN,PLANTYPE
. S PLAN=$P($G(^DGCR(399,CLAIM,"I"_COB)),U,18) Q:'PLAN
. S PLANTYPE=$P($G(^IBA(355.3,PLAN,0)),U,15) Q:PLANTYPE=""
. Q:'$D(^DIC(36,IBINS,13,"B",PLANTYPE))
. S SUPPFL=1
Q SUPPFL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEP7B 2567 printed Dec 13, 2024@02:11:45 Page 2
IBCEP7B ;ALB/TMP - Functions for PROVIDER ID ;1-16-05
+1 ;;2.0;INTEGRATED BILLING;**320,348,349,592**;16-JAN-2005;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
GETID(CLAIM,COB) ;
+1 NEW DIR,X,Y,DTOUT,DUOUT,WHICH,ID,IBMAIN,IBDIV,DIC,IBINS,DA,DIC,Z,Z0,IBCU,OK,IBCU
+2 ;
+3 SET ID=""
+4 SET IBINS=$PIECE($GET(^DGCR(399,CLAIM,"I"_COB)),U)
+5 IF IBINS=""
QUIT ID
+6 ;
+7 ; Make sure they have careunits IDS defined for this insurance company before we bother asking
+8 SET OK=0
+9 SET Z=0
FOR
SET Z=$ORDER(^IBA(355.92,"B",IBINS,Z))
if 'Z
QUIT
Begin DoDot:1
+10 SET Z0=$GET(^IBA(355.92,Z,0))
+11 if $PIECE(Z0,U,8)'="E"
QUIT
+12 if $PIECE(Z0,U,3)=""
QUIT
+13 SET OK=1
End DoDot:1
if OK
QUIT
+14 IF 'OK
QUIT ID
+15 ;
+16 SET WHICH=$SELECT(COB=1:"Primary",COB=2:"Secondary",1:"Tertiary")
+17 SET DIR("A")="Define "_WHICH_" Payer ID by Care Unit? "
+18 SET DIR("B")="No"
+19 SET DIR(0)="YA"
+20 SET DIR("?",1)="Enter No to select "_WHICH_" Provider # by Division."
+21 SET DIR("?")="Enter Yes to select "_WHICH_" Provider # for a specific Care Unit."
+22 DO ^DIR
+23 IF Y'=1
QUIT ID
+24 ;
+25 ; Get the Division
+26 SET IBMAIN=$$MAIN^IBCEP2B()
+27 SET IBDIV=$$EXTERNAL^DILFD(399,.22,"",$PIECE($GET(^DGCR(399,CLAIM,0)),U,22))
+28 SET DIR("A")="Division: "
SET DIR(0)="355.92,.05AOr"
+29 ; Default Division
+30 SET DIR("B")=$SELECT(IBDIV]"":IBDIV,1:IBMAIN)
+31 DO ^DIR
KILL DIR
+32 SET IBDIV=+$SELECT(Y>0:+Y,1:0)
+33 IF Y<0
QUIT ID
+34 ;
+35 ; Get the Care Unit
+36 SET DIC("A")="Care Unit: "
+37 SET DIC("W")="W "" "",$P(^(0),U,2)"
+38 SET DIC=355.95
SET DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)"
SET DIC(0)="AEMQ"
+39 DO ^DIC
+40 IF Y<0
QUIT ID
+41 SET IBCU=+Y
+42 ;
+43 ; Compile the appropriate list of IDs
+44 SET Z=0
FOR
SET Z=$ORDER(^IBA(355.92,"B",IBINS,Z))
if 'Z
QUIT
Begin DoDot:1
+45 SET Z0=$GET(^IBA(355.92,Z,0))
+46 if $PIECE(Z0,U,8)'="E"
QUIT
+47 if $PIECE(Z0,U,3)'=IBCU
QUIT
+48 SET ID=$PIECE(Z0,U,7)_U_$PIECE(Z0,U,6)
End DoDot:1
if ID]""
QUIT
+49 QUIT ID
+50 ;
+51 ; See if the insurance company flag is set to send the ATT/REND ID as the Billing Provider
ATTREND(CLAIM,COB) ;
+1 NEW ID,IBINS
+2 SET ID=""
+3 SET IBINS=$PIECE($GET(^DGCR(399,CLAIM,"I"_COB)),U)
+4 IF IBINS=""
QUIT 0
+5 ; 1500
IF $$FT^IBCEF(CLAIM)=2
IF $$GET1^DIQ(36,IBINS,4.06,"I")
QUIT 1
+6 ;IA# 2056;IB*2.0*592
+7 ; ub
IF $$FT^IBCEF(CLAIM)=3
IF $$GET1^DIQ(36,IBINS,4.08,"I")
QUIT 1
+8 QUIT 0
+9 ;
+10 ; Get a list of the plan types that supress Billing Provider Secondary IDs for this Insurance Co
+11 ; and see if the current plan type is one of them.
SUPPPT(CLAIM,COB) ;
+1 NEW IBINS,SUPPFL
+2 SET SUPPFL=0
+3 SET IBINS=$PIECE($GET(^DGCR(399,CLAIM,"I"_COB)),U)
+4 IF IBINS=""
QUIT SUPPFL
+5 ;
+6 IF $DATA(^DIC(36,IBINS,13))
Begin DoDot:1
+7 NEW PLAN,PLANTYPE
+8 SET PLAN=$PIECE($GET(^DGCR(399,CLAIM,"I"_COB)),U,18)
if 'PLAN
QUIT
+9 SET PLANTYPE=$PIECE($GET(^IBA(355.3,PLAN,0)),U,15)
if PLANTYPE=""
QUIT
+10 if '$DATA(^DIC(36,IBINS,13,"B",PLANTYPE))
QUIT
+11 SET SUPPFL=1
End DoDot:1
+12 QUIT SUPPFL
