| 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
|
|---|
