| 1 | IBCEP7B ;ALB/TMP - Functions for PROVIDER ID ;1-16-05
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**320,348,349**;16-JAN-2005;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | GETID(CLAIM,COB) ;
|
|---|
| 7 | N DIR,X,Y,DTOUT,DUOUT,WHICH,ID,IBMAIN,IBDIV,DIC,IBINS,DA,DIC,Z,Z0,IBCU,OK,IBCU
|
|---|
| 8 | ;
|
|---|
| 9 | S ID=""
|
|---|
| 10 | S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
|
|---|
| 11 | I IBINS="" Q ID
|
|---|
| 12 | ;
|
|---|
| 13 | ; Make sure they have careunits IDS defined for this insurance company before we bother asking
|
|---|
| 14 | S OK=0
|
|---|
| 15 | S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D Q:OK
|
|---|
| 16 | . S Z0=$G(^IBA(355.92,Z,0))
|
|---|
| 17 | . Q:$P(Z0,U,8)'="E"
|
|---|
| 18 | . Q:$P(Z0,U,3)=""
|
|---|
| 19 | . S OK=1
|
|---|
| 20 | I 'OK Q ID
|
|---|
| 21 | ;
|
|---|
| 22 | S WHICH=$S(COB=1:"Primary",COB=2:"Secondary",1:"Tertiary")
|
|---|
| 23 | S DIR("A")="Define "_WHICH_" Payer ID by Care Unit? "
|
|---|
| 24 | S DIR("B")="No"
|
|---|
| 25 | S DIR(0)="YA"
|
|---|
| 26 | S DIR("?",1)="Enter No to select "_WHICH_" Provider # by Division."
|
|---|
| 27 | S DIR("?")="Enter Yes to select "_WHICH_" Provider # for a specific Care Unit."
|
|---|
| 28 | D ^DIR
|
|---|
| 29 | I Y'=1 Q ID
|
|---|
| 30 | ;
|
|---|
| 31 | ; Get the Division
|
|---|
| 32 | S IBMAIN=$$MAIN^IBCEP2B()
|
|---|
| 33 | S IBDIV=$$EXTERNAL^DILFD(399,.22,"",$P($G(^DGCR(399,CLAIM,0)),U,22))
|
|---|
| 34 | S DIR("A")="Division: ",DIR(0)="355.92,.05AOr"
|
|---|
| 35 | ; Default Division
|
|---|
| 36 | S DIR("B")=$S(IBDIV]"":IBDIV,1:IBMAIN)
|
|---|
| 37 | D ^DIR K DIR
|
|---|
| 38 | S IBDIV=+$S(Y>0:+Y,1:0)
|
|---|
| 39 | I Y<0 Q ID
|
|---|
| 40 | ;
|
|---|
| 41 | ; Get the Care Unit
|
|---|
| 42 | S DIC("A")="Care Unit: "
|
|---|
| 43 | S DIC("W")="W "" "",$P(^(0),U,2)"
|
|---|
| 44 | S DIC=355.95,DIC("S")="I $P(^(0),U,3)=+$G(IBINS),$P(^(0),U,4)=+$G(IBDIV)",DIC(0)="AEMQ"
|
|---|
| 45 | D ^DIC
|
|---|
| 46 | I Y<0 Q ID
|
|---|
| 47 | S IBCU=+Y
|
|---|
| 48 | ;
|
|---|
| 49 | ; Compile the appropriate list of IDs
|
|---|
| 50 | S Z=0 F S Z=$O(^IBA(355.92,"B",IBINS,Z)) Q:'Z D Q:ID]""
|
|---|
| 51 | . S Z0=$G(^IBA(355.92,Z,0))
|
|---|
| 52 | . Q:$P(Z0,U,8)'="E"
|
|---|
| 53 | . Q:$P(Z0,U,3)'=IBCU
|
|---|
| 54 | . S ID=$P(Z0,U,7)_U_$P(Z0,U,6)
|
|---|
| 55 | Q ID
|
|---|
| 56 | ;
|
|---|
| 57 | ; See if the insurance company flag is set to send the ATT/REND ID as the Billing Provider
|
|---|
| 58 | ATTREND(CLAIM,COB) ;
|
|---|
| 59 | N ID,IBINS
|
|---|
| 60 | S ID=""
|
|---|
| 61 | S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
|
|---|
| 62 | I IBINS="" Q 0
|
|---|
| 63 | ;
|
|---|
| 64 | I $$FT^IBCEF(CLAIM)=2,$$GET1^DIQ(36,IBINS,4.06,"I") Q 1 ; 1500
|
|---|
| 65 | I $$FT^IBCEF(CLAIM)=3,$$GET1^DIQ(36,IBINS,4.08,"I") Q 1 ; ub
|
|---|
| 66 | Q 0
|
|---|
| 67 | ;
|
|---|
| 68 | ; Get a list of the plan types that supress Billing Provider Secondary IDs for this Insurance Co
|
|---|
| 69 | ; and see if the current plan type is one of them.
|
|---|
| 70 | SUPPPT(CLAIM,COB) ;
|
|---|
| 71 | N IBINS,SUPPFL
|
|---|
| 72 | S SUPPFL=0
|
|---|
| 73 | S IBINS=$P($G(^DGCR(399,CLAIM,"I"_COB)),U)
|
|---|
| 74 | I IBINS="" Q SUPPFL
|
|---|
| 75 | ;
|
|---|
| 76 | I $D(^DIC(36,IBINS,13)) D
|
|---|
| 77 | . N PLAN,PLANTYPE
|
|---|
| 78 | . S PLAN=$P($G(^DGCR(399,CLAIM,"I"_COB)),U,18) Q:'PLAN
|
|---|
| 79 | . S PLANTYPE=$P($G(^IBA(355.3,PLAN,0)),U,15) Q:PLANTYPE=""
|
|---|
| 80 | . Q:'$D(^DIC(36,IBINS,13,"B",PLANTYPE))
|
|---|
| 81 | . S SUPPFL=1
|
|---|
| 82 | Q SUPPFL
|
|---|
