source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRU2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1IBCRU2 ;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 ;
6FNDBI(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 ;
11BIFILE(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 ;
20ITPTR(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 ;
29ITFILE(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 ;
38ITBICHK(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
Note: See TracBrowser for help on using the repository browser.