83 lines
2.4 KiB
Mathematica
83 lines
2.4 KiB
Mathematica
|
IBCEP7B ;ALB/TMP - Functions for PROVIDER ID ;1-16-05
|
||
|
|
;;2.0;INTEGRATED BILLING;**320,348,349**;16-JAN-2005;Build 46
|
||
|
|
;;Per VHA Directive 2004-038, 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
|
||
|
|
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
|