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

IBCRU3 ;ALB/ARH - RATES: UTILITIES (CS/BR) ;22-MAY-1996

 ;;2.0;INTEGRATED BILLING;**52,106,223**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

CSN(N) ; returns the IFN of the Charge Set name passed in

 N X S X="" I $G(N)'="" S X=$O(^IBE(363.1,"B",N,0))

 Q X

 ;

CSBI(CS) ; returns a Charge Set rates Billable Item (363.3,.04): 0 or BI ^ bi name

 N IBX,IBCS0,IBBI S IBX=0

 S IBCS0=$G(^IBE(363.1,+$G(CS),0)),IBBI=$P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4)

 I +IBBI S IBX=IBBI_U_$$EXPAND^IBCRU1(363.3,.04,IBBI)

 Q IBX

 ;

CSBR(CS) ; return data on a charge set: billable event ^ BE IFN ^ billing rate IFN ^ billable item ^ charge method

 N IBBRFN,IBBEVNT,IBLN1,IBLN,IBX S IBX=""

 S IBLN=$G(^IBE(363.1,+$G(CS),0)),IBBRFN=+$P(IBLN,U,2),IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3))

 S IBLN1=$G(^IBE(363.3,IBBRFN,0))

 I IBLN'="" S IBX=IBBEVNT_U_$P(IBLN,U,3)_U_IBBRFN_U_$P(IBLN1,U,4)_U_$P(IBLN1,U,5)

 Q IBX

 ;

CSDV(CS,DIV,DDIV) ; check if the division is covered by this charge set

 ; ""  if - Charge Set has no region defined (ie. covers all divisions)

 ; div if - division passed in and it is one of the divisions of the region defined for the Charge Set

 ;        - no division but default division is one of the divisions of the region defined for the Set

 ; -1     - otherwise:  division not covered by CS

 ;

 N IBX,IBCS0,IBRGFN S IBX=-1,DIV=$G(DIV),DDIV=$G(DDIV)

 S IBCS0=$G(^IBE(363.1,+$G(CS),0)),IBRGFN=$P(IBCS0,U,7) I IBCS0="" G CSDVQ

 ;

 I 'IBRGFN S IBX="" G CSDVQ

 I +IBRGFN,+DIV,$D(^IBE(363.31,+IBRGFN,11,"B",DIV)) S IBX=DIV G CSDVQ

 I +IBRGFN,'DIV,+DDIV,$D(^IBE(363.31,+IBRGFN,11,"B",DDIV)) S IBX=DDIV G CSDVQ

 ;

CSDVQ Q IBX

 ;

RT(RT,BT,EFDT,ARR,BE,CT) ; return array of all rate schedules and charge sets for a rate type and bill type and date

 ; EFDT may be passed as 'begin dt^end dt' to get CSs active within a date range, like a bill's date range

 ; output ARR = number of rate schedule-charge set combinations found

 ;        ARR(rate sched IFN,charge set IFN) = 1 if charges for set are auto added

 N IBBEG,IBEND,IBRSFN,IBRS0,IBCSI,IBBE,IBLN,IBAA K ARR S ARR=0,IBBE=""

 S RT=$G(RT),BT=$G(BT),EFDT=$G(EFDT),CT=$G(CT) I +BT S BT=$S(BT<3:1,1:3)

 S (IBBEG,IBEND)="" S IBBEG=+EFDT,IBEND=$S(+$P(EFDT,U,2):+$P(EFDT,U,2),1:IBBEG)

 I $G(BE)'="" S:+BE BE=$$EMUTL^IBCRU1(BE) S IBBE=$$MCCRUTL^IBCRU1(BE,14)

 I IBBE'=0 S IBRSFN=0 F  S IBRSFN=$O(^IBE(363,"ARB",+RT,+BT,IBRSFN)) Q:'IBRSFN  D

 . 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

 . S IBCSI=0 F  S IBCSI=$O(^IBE(363,IBRSFN,11,IBCSI)) Q:'IBCSI  D

 .. S IBLN=$G(^IBE(363,IBRSFN,11,IBCSI,0)) Q:'IBLN

 .. S IBAA=$P(IBLN,U,2)

 .. I +IBBE,+$P($G(^IBE(363.1,+IBLN,0)),U,3)'=IBBE Q

 .. I +CT,+$P($G(^IBE(363.1,+IBLN,0)),U,4)'=CT S IBAA=""

 .. S ARR=ARR+1,ARR(IBRSFN,+IBLN)=IBAA

 Q

 ;

BILLRATE(RT,BT,EVDT,FNDRATE) ; return true if the bill is a FND rate bill

 ;  - one of the auto add Charge Sets must be a FND Billing Rate

 N IBRS,IBCS,IBCS0,IBBR0,IBFND,IBRSARR S IBFND=0

 ;

 D RT(+$G(RT),+$G(BT),$G(EVDT),.IBRSARR)

 ;

 I $G(FNDRATE)'="" S IBRS=0 F  S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS  D  Q:IBFND

 . S IBCS=0 F  S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS  I +IBRSARR(IBRS,IBCS) D  Q:IBFND

 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0))

 .. I $P(IBBR0,U,1)[FNDRATE S IBFND=1

 ;

 Q IBFND

 ;

PERDIEM(RT,BT,EVDT) ; return true (BR ifn) if the charges for the rate and bill type are perdiem charges

 ; - one of the auto add Charge Sets (except RX or Pros) must be either Tort Liable or Interagency

 N IBRS,IBCS,IBCS0,IBBEVNT,IBBR,IBBRN,IBFND,IBRSARR S IBFND=0

 ;

 D RT(+$G(RT),+$G(BT),$G(EVDT),.IBRSARR)

 ;

 S IBRS=0 F  S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS  D  Q:IBFND

 . S IBCS=0 F  S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS  I +IBRSARR(IBRS,IBCS) D  Q:IBFND

 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR=+$P(IBCS0,U,2),IBBRN=$P($G(^IBE(363.3,+IBBR,0)),U,1)

 .. S IBBEVNT=$$EMUTL^IBCRU1(+$P(IBCS0,U,3)) I (IBBEVNT["PRESCRIPTION")!(IBBEVNT["PROSTHETICS") Q

 .. I (IBBRN["TORTIOUSLY LIABLE")!(IBBRN["INTERAGENCY") S IBFND=IBBR

 ;

 Q IBFND

 ;

EVNTITM(RT,BT,BE,EFDT,ARR) ; return the billable item (363.3, .04) for a particular Rate Type and Billable Event (399.1) auto added

 ; EFDT may be passed as 'begin dt^end dt' to get CSs active within a date range, like a bill's date range

 ; returns:  string of billing items (code;name;quantity) separated by ^ (3;NDC #;3^1;BEDSECTION;1)

 ;           for VA Cost, code = 'VA COST' so returns 'VA COST;VA COST;2'

 ; output (if ARR passed by reference):  ARR(billable item code, rate sched IFN, charge set IFN)="" 

 N IBRS,IBCS,IBRSARR,IBCS0,IBBR0,IBBI,IBFND K ARR S IBFND=""

 ;

 I $G(BE)'="" D RT(+$G(RT),+$G(BT),$G(EFDT),.IBRSARR,$G(BE))

 ;

 S IBRS=0 F  S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS  D

 . S IBCS=0 F  S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS  I +IBRSARR(IBRS,IBCS) D

 .. S IBCS0=$G(^IBE(363.1,IBCS,0)),IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0))

 .. S IBBI=$P(IBBR0,U,4) I IBBI="",$P(IBBR0,U,5)=2 S IBBI=$P(IBBR0,U,1)

 .. I IBBI'="" S IBFND=IBFND_IBBI_";"_$$EXPAND^IBCRU1(363.3,.04,IBBI)_";"_$P(IBBR0,U,5)_U,ARR(IBBI,IBRS,IBCS)=""

 Q IBFND