source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEP7B.m@ 852

Last change on this file since 852 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1IBCEP7B ;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 ;
6GETID(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
58ATTREND(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.
70SUPPPT(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
Note: See TracBrowser for help on using the repository browser.