| 1 | IBCRU2 ;ALB/ARH - RATES: UTILITIES (CI DEFINITIONS) ; 22-MAY-1996
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,106,138,210**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | FNDBI(T,N) ; returns IFN of Billing Items entry (363.21) if Name N is found and of Type T
|
|---|
| 7 | N X,I,Y S X=0,T=$G(T),T=$S(T["NDC":1,T["MISCELLANEOUS":9,1:T)
|
|---|
| 8 | I +T,$G(N)'="" S I=0 F S I=$O(^IBA(363.21,"B",$E(N,1,30),I)) Q:'I S Y=$G(^IBA(363.21,I,0)) I +$P(Y,U,2)=T,$P(Y,U,1)=N S X=I Q
|
|---|
| 9 | Q X
|
|---|
| 10 | ;
|
|---|
| 11 | BIFILE(BI) ; returns the source file reference for a billable item (363.3,.04)
|
|---|
| 12 | N IBX S IBX="",BI=+$G(BI)
|
|---|
| 13 | I BI=1 S IBX=";DGCR(399.1,^399.1" ; billable bedsections
|
|---|
| 14 | I BI=2 S IBX=";ICPT(^81" ; CPT procedures
|
|---|
| 15 | I BI=3 S IBX=";IBA(363.21,^363.21" ; NDC numbers
|
|---|
| 16 | I BI=4 S IBX=";ICD(^80.2" ; DRG codes
|
|---|
| 17 | I BI=9 S IBX=";IBA(363.21,^363.21" ; Miscellaneous
|
|---|
| 18 | Q IBX
|
|---|
| 19 | ;
|
|---|
| 20 | ITPTR(BI,NAME) ; returns pointer to item in source file if found for this billable item type
|
|---|
| 21 | N IBX S IBX=0 S BI=+$G(BI),NAME=$G(NAME)
|
|---|
| 22 | I BI=1,NAME'="" S IBX=$$MCCRUTL^IBCRU1(NAME,5)
|
|---|
| 23 | I BI=2,NAME'="" S IBX=$$CPTIEN^IBACSV(NAME)
|
|---|
| 24 | I BI=3,NAME'="" S IBX=$$FNDBI("NDC",NAME)
|
|---|
| 25 | I BI=4,NAME'="" S IBX=$$DRGIEN^IBACSV(NAME)
|
|---|
| 26 | I BI=9,NAME'="" S IBX=$$FNDBI("MISCELLANEOUS",NAME)
|
|---|
| 27 | Q +IBX
|
|---|
| 28 | ;
|
|---|
| 29 | ITFILE(BI,ITEM,EFFDT) ; returns source item pointer (true) if the item is an active source entry for this billable item type
|
|---|
| 30 | N IBX,IBY S IBX=0,BI=+$G(BI),ITEM=+$G(ITEM),EFFDT=$G(EFFDT) I 'EFFDT S EFFDT=DT
|
|---|
| 31 | I BI=1,+ITEM S IBY=$G(^DGCR(399.1,ITEM,0)) I IBY'="",+$P(IBY,U,5) S IBX=ITEM
|
|---|
| 32 | I BI=2,+ITEM,$$CPTACT^IBACSV(ITEM,EFFDT) S IBX=ITEM
|
|---|
| 33 | I BI=3,+ITEM S IBY=$G(^IBA(363.21,ITEM,0)) I IBY'="",+$P(IBY,U,2)=1 S IBX=ITEM
|
|---|
| 34 | I BI=4,+ITEM,$$DRGACT^IBACSV(ITEM,EFFDT) S IBX=ITEM
|
|---|
| 35 | I BI=9,+ITEM S IBY=$G(^IBA(363.21,ITEM,0)) I IBY'="",+$P(IBY,U,2)=9 S IBX=ITEM
|
|---|
| 36 | Q IBX
|
|---|
| 37 | ;
|
|---|
| 38 | ITBICHK(CS,ITEM,NAME) ; returns source item pointer (true) if the item is a valid active item for the Charge Set
|
|---|
| 39 | N IBX,IBBI,IBITEM S IBX=0
|
|---|
| 40 | S IBBI=$$CSBI^IBCRU3($G(CS))
|
|---|
| 41 | S IBITEM=$G(ITEM) I 'IBITEM,$G(NAME)'="" S IBITEM=$$ITPTR(IBBI,NAME)
|
|---|
| 42 | I +IBBI,+IBITEM S IBX=$$ITFILE(+IBBI,+IBITEM)
|
|---|
| 43 | Q IBX
|
|---|
