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

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

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1IBCRU3 ;ALB/ARH - RATES: UTILITIES (CS/BR) ;22-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,223**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CSN(N) ; returns the IFN of the Charge Set name passed in
6 N X S X="" I $G(N)'="" S X=$O(^IBE(363.1,"B",N,0))
7 Q X
8 ;
9CSBI(CS) ; returns a Charge Set rates Billable Item (363.3,.04): 0 or BI ^ bi name
10 N IBX,IBCS0,IBBI S IBX=0
11 S IBCS0=$G(^IBE(363.1,+$G(CS),0)),IBBI=$P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4)
12 I +IBBI S IBX=IBBI_U_$$EXPAND^IBCRU1(363.3,.04,IBBI)
13 Q IBX
14 ;
15CSBR(CS) ; return data on a charge set: billable event ^ BE IFN ^ billing rate IFN ^ billable item ^ charge method
16 N IBBRFN,IBBEVNT,IBLN1,IBLN,IBX S IBX=""
17 S IBLN=$G(^IBE(363.1,+$G(CS),0)),IBBRFN=+$P(IBLN,U,2),IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3))
18 S IBLN1=$G(^IBE(363.3,IBBRFN,0))
19 I IBLN'="" S IBX=IBBEVNT_U_$P(IBLN,U,3)_U_IBBRFN_U_$P(IBLN1,U,4)_U_$P(IBLN1,U,5)
20 Q IBX
21 ;
22CSDV(CS,DIV,DDIV) ; check if the division is covered by this charge set
23 ; "" if - Charge Set has no region defined (ie. covers all divisions)
24 ; div if - division passed in and it is one of the divisions of the region defined for the Charge Set
25 ; - no division but default division is one of the divisions of the region defined for the Set
26 ; -1 - otherwise: division not covered by CS
27 ;
28 N IBX,IBCS0,IBRGFN S IBX=-1,DIV=$G(DIV),DDIV=$G(DDIV)
29 S IBCS0=$G(^IBE(363.1,+$G(CS),0)),IBRGFN=$P(IBCS0,U,7) I IBCS0="" G CSDVQ
30 ;
31 I 'IBRGFN S IBX="" G CSDVQ
32 I +IBRGFN,+DIV,$D(^IBE(363.31,+IBRGFN,11,"B",DIV)) S IBX=DIV G CSDVQ
33 I +IBRGFN,'DIV,+DDIV,$D(^IBE(363.31,+IBRGFN,11,"B",DDIV)) S IBX=DDIV G CSDVQ
34 ;
35CSDVQ Q IBX
36 ;
37RT(RT,BT,EFDT,ARR,BE,CT) ; return array of all rate schedules and charge sets for a rate type and bill type and date
38 ; EFDT may be passed as 'begin dt^end dt' to get CSs active within a date range, like a bill's date range
39 ; output ARR = number of rate schedule-charge set combinations found
40 ; ARR(rate sched IFN,charge set IFN) = 1 if charges for set are auto added
41 N IBBEG,IBEND,IBRSFN,IBRS0,IBCSI,IBBE,IBLN,IBAA K ARR S ARR=0,IBBE=""
42 S RT=$G(RT),BT=$G(BT),EFDT=$G(EFDT),CT=$G(CT) I +BT S BT=$S(BT<3:1,1:3)
43 S (IBBEG,IBEND)="" S IBBEG=+EFDT,IBEND=$S(+$P(EFDT,U,2):+$P(EFDT,U,2),1:IBBEG)
44 I $G(BE)'="" S:+BE BE=$$EMUTL^IBCRU1(BE) S IBBE=$$MCCRUTL^IBCRU1(BE,14)
45 I IBBE'=0 S IBRSFN=0 F S IBRSFN=$O(^IBE(363,"ARB",+RT,+BT,IBRSFN)) Q:'IBRSFN D
46 . S IBRS0=$G(^IBE(363,+IBRSFN,0)) I +EFDT I (+$P(IBRS0,U,5)>IBEND)!(+$P(IBRS0,U,6)&(+$P(IBRS0,U,6)<IBBEG)) Q
47 . S IBCSI=0 F S IBCSI=$O(^IBE(363,IBRSFN,11,IBCSI)) Q:'IBCSI D
48 .. S IBLN=$G(^IBE(363,IBRSFN,11,IBCSI,0)) Q:'IBLN
49 .. S IBAA=$P(IBLN,U,2)
50 .. I +IBBE,+$P($G(^IBE(363.1,+IBLN,0)),U,3)'=IBBE Q
51 .. I +CT,+$P($G(^IBE(363.1,+IBLN,0)),U,4)'=CT S IBAA=""
52 .. S ARR=ARR+1,ARR(IBRSFN,+IBLN)=IBAA
53 Q
54 ;
55BILLRATE(RT,BT,EVDT,FNDRATE) ; return true if the bill is a FND rate bill
56 ; - one of the auto add Charge Sets must be a FND Billing Rate
57 N IBRS,IBCS,IBCS0,IBBR0,IBFND,IBRSARR S IBFND=0
58 ;
59 D RT(+$G(RT),+$G(BT),$G(EVDT),.IBRSARR)
60 ;
61 I $G(FNDRATE)'="" S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D Q:IBFND
62 . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS I +IBRSARR(IBRS,IBCS) D Q:IBFND
63 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0))
64 .. I $P(IBBR0,U,1)[FNDRATE S IBFND=1
65 ;
66 Q IBFND
67 ;
68PERDIEM(RT,BT,EVDT) ; return true (BR ifn) if the charges for the rate and bill type are perdiem charges
69 ; - one of the auto add Charge Sets (except RX or Pros) must be either Tort Liable or Interagency
70 N IBRS,IBCS,IBCS0,IBBEVNT,IBBR,IBBRN,IBFND,IBRSARR S IBFND=0
71 ;
72 D RT(+$G(RT),+$G(BT),$G(EVDT),.IBRSARR)
73 ;
74 S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D Q:IBFND
75 . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS I +IBRSARR(IBRS,IBCS) D Q:IBFND
76 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR=+$P(IBCS0,U,2),IBBRN=$P($G(^IBE(363.3,+IBBR,0)),U,1)
77 .. S IBBEVNT=$$EMUTL^IBCRU1(+$P(IBCS0,U,3)) I (IBBEVNT["PRESCRIPTION")!(IBBEVNT["PROSTHETICS") Q
78 .. I (IBBRN["TORTIOUSLY LIABLE")!(IBBRN["INTERAGENCY") S IBFND=IBBR
79 ;
80 Q IBFND
81 ;
82EVNTITM(RT,BT,BE,EFDT,ARR) ; return the billable item (363.3, .04) for a particular Rate Type and Billable Event (399.1) auto added
83 ; EFDT may be passed as 'begin dt^end dt' to get CSs active within a date range, like a bill's date range
84 ; returns: string of billing items (code;name;quantity) separated by ^ (3;NDC #;3^1;BEDSECTION;1)
85 ; for VA Cost, code = 'VA COST' so returns 'VA COST;VA COST;2'
86 ; output (if ARR passed by reference): ARR(billable item code, rate sched IFN, charge set IFN)=""
87 N IBRS,IBCS,IBRSARR,IBCS0,IBBR0,IBBI,IBFND K ARR S IBFND=""
88 ;
89 I $G(BE)'="" D RT(+$G(RT),+$G(BT),$G(EFDT),.IBRSARR,$G(BE))
90 ;
91 S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D
92 . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS I +IBRSARR(IBRS,IBCS) D
93 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0))
94 .. S IBBI=$P(IBBR0,U,4) I IBBI="",$P(IBBR0,U,5)=2 S IBBI=$P(IBBR0,U,1)
95 .. I IBBI'="" S IBFND=IBFND_IBBI_";"_$$EXPAND^IBCRU1(363.3,.04,IBBI)_";"_$P(IBBR0,U,5)_U,ARR(IBBI,IBRS,IBCS)=""
96 Q IBFND
Note: See TracBrowser for help on using the repository browser.