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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1IBJTU31 ;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 ;
5BPP(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)
15BPPQ Q
16 ;
17PST(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))
31PSTQ Q IBY
32 ;
33DBPOL(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 !
42DBPOLQ Q
43 ;
44MINS(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)
49MINSQ Q IBY
50 ;
51REF(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)
56REFQ Q +$G(IBRDT(430,IBIFN,64,"I"))
57 ;IBJTU31
Note: See TracBrowser for help on using the repository browser.