source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBEFURT.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1IBEFURT ;ALB/ARH - UTILITY: FIND RELATED THIRD PARTY BILLS ; 3/7/00
2 ;;2.0;INTEGRATED BILLING;**130**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; the following procedures search for Third Party bills with specific data defined, matchs are returned in ^TMP
6 ;
7 ; ^TMP("IBRBT", $J, XRF, matching bill ifn) =
8 ; BILL FROM ^ BILL TO ^ CANCELLED (0/1) ^ AR BILL NUMBER ^
9 ; PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME
10 ;
11TPEVDT(DFN,EVDT,XRF) ; find all bills for a patient with a specific Event Date (399,.03)
12 N IBIFN,IBDT
13 I +$G(DFN),+$G(EVDT) S IBDT=(EVDT\1)-.001 F S IBDT=$O(^DGCR(399,"D",IBDT)) Q:'IBDT!((IBDT\1)>(EVDT\1)) D
14 . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"D",IBDT,IBIFN)) Q:'IBIFN D
15 .. ;
16 .. I DFN=$P($G(^DGCR(399,IBIFN,0)),U,2) D SAVELN2(IBIFN,$G(XRF))
17 Q
18 ;
19TPPTF(PTF,XRF) ; find all bills for a specific PTF number (399,.08)
20 N IBIFN
21 I +$G(PTF) S IBIFN=0 F S IBIFN=$O(^DGCR(399,"APTF",PTF,IBIFN)) Q:'IBIFN D SAVELN2(IBIFN,$G(XRF))
22 Q
23 ;
24TPOPV(DFN,DT1,DT2,XRF) ; find all bills for a patient with any Opt Visit Dates within a range (399,43)
25 N IBIFN,IBOPV I '$G(DT2) S DT2=+$G(DT1)
26 I +$G(DFN),+$G(DT1) S IBOPV=DT1-1 F S IBOPV=$O(^DGCR(399,"AOPV",DFN,IBOPV)) Q:'IBOPV!(IBOPV>DT2) D
27 . ;
28 . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AOPV",DFN,IBOPV,IBIFN)) Q:'IBIFN D SAVELN2(IBIFN,$G(XRF))
29 Q
30 ;
31TPRX(DFN,RXN,RXDT,XRF) ; find all bills for a patient with a specific Rx fill (Rx number and fill date) (362.4,.01,.03)
32 N IBX,IBX0,IBIFN,IBRXDT S RXDT=$G(RXDT) ; if either fill date not set then take all fills for rx
33 I +$G(DFN),$G(RXN)'="" S IBX="" F S IBX=$O(^IBA(362.4,"B",RXN,IBX)) Q:'IBX D
34 . S IBX0=$G(^IBA(362.4,IBX,0)),IBIFN=$P(IBX0,U,2),IBRXDT=$P(IBX0,U,3)
35 . ;
36 . I +RXDT,+IBRXDT,RXDT'=IBRXDT Q
37 . I DFN=$P($G(^DGCR(399,+IBIFN,0)),U,2) D SAVELN2(IBIFN,$G(XRF))
38 Q
39 ;
40 ; ==============================================================================================================
41 ;
42SAVELN1(XRF,DATA) ; set bill into array: ^TMP("IBRBT",$J,XRF) = DATA (from $$LN1)
43 S XRF=$S($G(XRF)="":"TP",1:XRF) S ^TMP("IBRBT",$J,XRF)=$G(DATA)
44 Q
45 ;
46SAVELN2(IBIFN,XRF) ; set bills found into array: ^TMP("IBRBT",$J,XRF,IBIFN)= BILL FROM ^ BILL TO ^ CANCELLED (0/1) ^ AR BILL NUMBER ^ PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME
47 I +$G(IBIFN),$D(^DGCR(399,IBIFN,0)) S XRF=$S($G(XRF)="":"TP",1:XRF),^TMP("IBRBT",$J,XRF,IBIFN)=$$LN2(IBIFN)
48 Q
49 ;
50LN1(IBIFN) ; based on the bill passed in returns: PATIENT HAS ANY RX COVERAGE ON FROM DATE OF BILL (0/1)
51 N IBX,IBY,IB0,DFN S IBX="",IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" G LN1Q
52 S DFN=$P(IB0,U,2),IBY=+$G(^DGCR(399,+IBIFN,"U")) S IBX=$$PTCOV^IBCNSU3(+DFN,+IBY,"PHARMACY")
53LN1Q Q IBX
54 ;
55LN2(IBIFN) ; based on the bill passed in returns:
56 ; BILL FROM ^ BILL TO ^ CANCELLED (0/1) ^ AR BILL NUMBER ^ PAYER SEQUENCE ^ PAYER IS MEDICARE SUPPLEMENTAL (0/1) ^ PAYER NAME
57 N IBX,IBY,IB0,IBU,IBMP S IBX="",IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" G LN2Q
58 S IBU=$G(^DGCR(399,+IBIFN,"U")),IBMP=$G(^DGCR(399,+IBIFN,"MP"))
59 S $P(IBX,U,1)=$P(IBU,U,1)
60 S $P(IBX,U,2)=$P(IBU,U,2)
61 S $P(IBX,U,3)=$S($P(IB0,U,13)=7:1,1:"")
62 S $P(IBX,U,4)=$$BN1^PRCAFN(IBIFN)
63 S $P(IBX,U,5)=$P(IB0,U,21)
64 S $P(IBX,U,6)=$$TPLAN(IBIFN)
65 S $P(IBX,U,7)=$P($G(^DIC(36,+IBMP,0)),U,1)
66LN2Q Q IBX
67 ;
68 ; ==============================================================================================================
69 ;
70 ; the following procedures return Third Party bill specific data and status
71 ;
72TPLAN(IBIFN) ; check if bills payer policy is a Med Supp or whatever type requires Third Party reimbursment to be applied to First Party charges on a 1-1 basis
73 ; returns true if Bill Payer Policy's Type of Plan is Med Supp (399,136 > 2.312,18 > 355.3,.09 > 355.1,.03)
74 N IBX,IBY,DFN,PLAN S IBX="" I '$G(IBIFN) G TPLANQ
75 S DFN=+$P($G(^DGCR(399,+IBIFN,0)),U,2),PLAN=+$P($G(^DGCR(399,+IBIFN,"MP")),U,2) I 'PLAN G TPLANQ
76 S IBY=+$P($G(^DPT(DFN,.312,PLAN,0)),U,18) I 'IBY G TPLANQ
77 S IBY=+$P($G(^IBA(355.3,IBY,0)),U,9),IBY=$G(^IBE(355.1,+IBY,0)) I $P(IBY,U,3)=11 S IBX=1
78TPLANQ Q IBX
79 ;
80RXTP(DFN,RXN,RXDT,SAVE) ; check if a particular Prescription fill has been billed on a Third Party bill, Rx # and fill date
81 ; if SAVE is passed in then the list of bills for the Rx is returned in ^TMP("IBRBT",$J,SAVE,IBIFN)=data
82 N IBX,XRF,XRF1 S IBX="",XRF="IBRBT",XRF1=$G(SAVE) I XRF1="" S XRF1="TEMP"_$J
83 I +$G(DFN),$G(RXN)'="",+$G(RXDT) K ^TMP(XRF,$J,XRF1) D TPRX(DFN,RXN,RXDT,XRF1) I $D(^TMP(XRF,$J,XRF1)) S IBX=1
84 I $G(SAVE)="" K ^TMP(XRF,$J,XRF1)
85 Q IBX
Note: See TracBrowser for help on using the repository browser.