1 | IBJTU31 ;ALB/ARH - TPI UTILITIES - INS ; 2/14/95
|
---|
2 | ;;2.0;INTEGRATED BILLING;**39,61**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | BPP(IBIFN,ARRAY) ; returns array of patient policy info on all of a bill's carriers
|
---|
6 | ; returns PPIFN ^ p/s/t ^ policy node from patient insurance record (2,.312), also adds correct group #/name
|
---|
7 | N DFN,IBDM,IBI,IBDFN,IBCDFN,IBGRP K ARRAY S ARRAY=0
|
---|
8 | S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) I 'DFN G BPPQ
|
---|
9 | S IBDM=$G(^DGCR(399,IBIFN,"M")) I 'IBDM G BPPQ
|
---|
10 | ;
|
---|
11 | F IBI=1,2,3 S IBCDFN="" D I +IBCDFN S ARRAY(IBI)=IBDFN_U_IBI_U_IBCDFN,ARRAY=IBI
|
---|
12 | . S IBDFN=$P(IBDM,U,(IBI+11)) I 'IBDFN,+$P(IBDM,U,IBI) S IBDFN=$O(^DPT(DFN,.312,"B",+$P(IBDM,U,IBI),0))
|
---|
13 | . Q:'IBDFN S IBCDFN=$G(^DPT(DFN,.312,+IBDFN,0)) I 'IBCDFN Q
|
---|
14 | . S IBGRP=$G(^IBA(355.3,+$P(IBCDFN,U,18),0)) S:IBGRP'="" $P(IBCDFN,U,3)=$P(IBGRP,U,4),$P(IBCDFN,U,15)=$P(IBGRP,U,3)
|
---|
15 | BPPQ Q
|
---|
16 | ;
|
---|
17 | PST(IBIFN) ; called by insurance screens ACTION PROTOCOL ENTRY ACTION code, allow user to choose which policy
|
---|
18 | ; to display ins screens for default will be either the primary or last viewed
|
---|
19 | ; IBPOLICY used by this procedure to define last viewed, must be killed when exiting primary screen (CI)
|
---|
20 | ;
|
---|
21 | N IBY,IBX,X,Y S IBY=0
|
---|
22 | D BPP(IBIFN,.IBX)
|
---|
23 | I IBX<1 S IBY=-1 G PSTQ ; bill has no policies
|
---|
24 | I IBX=1 S IBY=$O(IBX(0)),IBY=IBX(IBY) G PSTQ ; bill has only primary policy
|
---|
25 | S IBPOLICY=$S($G(IBPOLICY):IBPOLICY,1:$O(IBX(0))) I 'IBPOLICY G PSTQ
|
---|
26 | W ! D DBPOL(.IBX)
|
---|
27 | S DIR("?")="Only policies associated with this bill may be chosen: Primary, Secondary, or Tertiary."
|
---|
28 | S DIR(0)="SOB^P:Primary;S:Secondary;T:Tertiary",DIR(0)=$P(DIR(0),";",1,IBX)
|
---|
29 | S DIR("A")="Select Policy",DIR("B")=$S(IBPOLICY=2:"S",IBPOLICY=3:"T",1:"P") D ^DIR K DIR
|
---|
30 | I Y?1U S IBY=$S(Y="P":1,Y="S":2,Y="T":3,1:0),IBPOLICY=IBY,IBY=$G(IBX(IBY))
|
---|
31 | PSTQ Q IBY
|
---|
32 | ;
|
---|
33 | DBPOL(IBINS) ; display patient policy info for all carriers of a bill, input array from BPP
|
---|
34 | ;
|
---|
35 | N IBI,IBCDFN,IBCNS0
|
---|
36 | W !,?12,"Carrier",?39,"Subscriber ID",?62,"Group #",!,?12,"--------------------------------------------------------------------"
|
---|
37 | ;
|
---|
38 | S IBI=0 F S IBI=$O(IBINS(IBI)) Q:'IBI D
|
---|
39 | . S IBCDFN=$P(IBINS(IBI),U,3,99),IBCNS0=$G(^DIC(36,+IBCDFN,0))
|
---|
40 | . W !,$S(IBI=2:"Secondary",IBI=3:"Tertiary",1:"Primary")_": ",?12,$E($P(IBCNS0,U,1),1,25),?39,$P(IBCDFN,U,2),?62,$P(IBCDFN,U,3)
|
---|
41 | W !
|
---|
42 | DBPOLQ Q
|
---|
43 | ;
|
---|
44 | MINS(IBIFN) ;Called by IBJT LIST TEMPLATE screens and RCRC LIST TEMPLATES
|
---|
45 | ; Return true if Bill has multiple Insurance Policies
|
---|
46 | N IBDM,IBY S IBY=0
|
---|
47 | S IBDM=$G(^DGCR(399,IBIFN,"M"))
|
---|
48 | S IBY=$S(+$P(IBDM,U,13):1,+$P(IBDM,U,14):1,1:0)
|
---|
49 | MINSQ Q IBY
|
---|
50 | ;
|
---|
51 | REF(IBIFN) ;Called by IBJT LIST TEMPLATE screens
|
---|
52 | ;Return Referral Date if Bill is Referred
|
---|
53 | N IBRDT,X
|
---|
54 | S IBRDT="IBRDT"
|
---|
55 | D DIQ^RCJIBFN2(IBIFN,64,.IBRDT)
|
---|
56 | REFQ Q +$G(IBRDT(430,IBIFN,64,"I"))
|
---|
57 | ;IBJTU31
|
---|