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

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

initial load of FOIAVistA 6/30/08 version

File size: 6.2 KB
Line 
1IBCRLI ;ALB/ARH - RATES: DISPLAY CHARGE ITEMS ; 16-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,106,245**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; if Charge Set/Rates Billable Item is Bedsection then default display is current charge for all items
6 ; all other Charge Sets display all charges for a user selected item
7 ; this is due to unknown number of possible entries, for example a CPT set may have thousands of current charges
8 ;
9EN ; -- main entry point for IBCR CHARGE ITEM
10 D EN^VALM("IBCR CHARGE ITEM")
11 Q
12 ;
13HDR ; -- header code
14 N IBY,IBX,IBZ,IBI,IBK S IBI=1,(IBX,IBY,IBZ,IBK,VALMHDR(1),VALMHDR(2))=""
15 ;
16 I +$P(IBCS0,U,5) S IBK="Default Revenue Code: "_$P($G(^DGCR(399.2,+$P(IBCS0,U,5),0)),U,1)
17 ;
18 S IBZ=IBBRBIN_$S(+IBSRNITM:" ",1:"")_$P(IBSRNITM,U,2)_" items billable to Charge Set "
19 ;
20 S IBX=$P(IBCS0,U,1) I +$G(IBSRNBDT)!(+$G(IBSRNEDT)) D
21 . I IBSRNBDT=IBSRNEDT S IBX=$E(IBX,1,28),IBY=" on "_$$DATE(IBSRNBDT) Q
22 . I 'IBSRNBDT S IBY=" on or before "_$$DATE(IBSRNEDT) Q
23 . I 'IBSRNEDT S IBY=" on or after "_$$DATE(IBSRNBDT) Q
24 . I IBSRNBDT'=IBSRNEDT S IBY=" between "_$$DATE(IBSRNBDT)_" and "_$$DATE(IBSRNEDT)
25 ;
26 S VALMHDR(1)=IBZ_IBX
27 I ($L(IBZ)+$L(IBX)+$L(IBY))<80 S VALMHDR(1)=VALMHDR(1)_IBY,IBY=""
28 S VALMHDR(2)=IBK_$J("",(80-($L(IBK)+$L(IBY))))_IBY
29 Q
30 ;
31INIT ; -- init variables and list array IBCSFN required
32 K ^TMP("IBCRLI",$J)
33 I '$G(IBCSFN) S IBCSFN=$$GETCS^IBCRU1 I IBCSFN'>0 S VALMQUIT="" Q
34 I $$GET(IBCSFN)<0 S VALMQUIT="" Q
35 D BLD
36 Q
37 ;
38HELP ; -- help code
39 S X="?" D DISP^XQORM1 W !!
40 Q
41 ;
42EXIT ; -- exit code
43 K ^TMP("IBCRLI",$J),IBCS0,IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT
44 D CLEAR^VALM1,CLEAN^VALM10
45 Q
46 ;
47BLD ; build array for display for Charge Item display: charge set required
48 N IBITEM,IBDT1,IBCIFN,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCI")
49 S IBSRNITM=$G(IBSRNITM),IBSRNBDT=$G(IBSRNBDT),IBSRNEDT=$G(IBSRNEDT)
50 ;
51 I (IBBRBI=1)!(+IBSRNITM) D SORTCI(IBCSFN,$G(IBSRNITM),$G(IBSRNBDT),$G(IBSRNEDT))
52 ;
53 ; create LM diplay array of charge items
54 S IBITEM="" F S IBITEM=$O(^TMP($J,"IBCRCI",IBITEM)) Q:IBITEM="" D
55 . S IBDT1="" F S IBDT1=$O(^TMP($J,"IBCRCI",IBITEM,IBDT1)) Q:IBDT1="" D
56 .. S IBCIFN=0 F S IBCIFN=$O(^TMP($J,"IBCRCI",IBITEM,IBDT1,IBCIFN)) Q:'IBCIFN D
57 ... ;
58 ... S IBLN=$G(^IBA(363.2,IBCIFN,0)),IBY=""
59 ... S IBX=$$EXPAND^IBCRU1(363.2,.01,$P(IBLN,U,1))
60 ... I +$P(IBLN,U,7) S IBX=IBX_" - "_$$EXPAND^IBCRU1(363.2,.07,+$P(IBLN,U,7))
61 ... S IBY=$$SETFLD^VALM1(IBX,IBY,"ITEM")
62 ... S IBX=$J($P(IBLN,U,5),8,2),IBY=$$SETFLD^VALM1(IBX,IBY,"UCHG")
63 ... S IBX=$J($P(IBLN,U,8),8,2),IBY=$$SETFLD^VALM1(IBX,IBY,"BCHG")
64 ... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,6),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RVCD")
65 ... S IBX=$$DATE($P(IBLN,U,3)),IBY=$$SETFLD^VALM1(IBX,IBY,"EFFDT")
66 ... S IBX=$P(IBLN,U,4)
67 ... I +IBX S IBY=$$SETFLD^VALM1("-",IBY,"DS"),IBX=$$DATE(IBX),IBY=$$SETFLD^VALM1(IBX,IBY,"INADT")
68 ... D SET(IBY)
69 ;
70 I VALMCNT=0 D SET(" ") D
71 . I 'IBBRBI D SET("The Billing Rate of this Set has no Billable Item defined, therefore no"),SET("Charge Items may be defined for it. (The charges may be calculated amounts.)") Q
72 . I '$D(^IBA(363.2,"AIVDTS"_+$G(IBCSFN))) D SET("No Charge Items defined for this Set.") Q
73 . I +IBSRNITM,'$D(^IBA(363.2,"AIVDTS"_+$G(IBCSFN),+IBSRNITM)) D SET(IBBRBIN_" "_$P(IBSRNITM,U,2)_" has no charges for this set.") Q
74 . I 'IBSRNITM,IBBRBI'=1 D SET("No Charge Item chosen for display:"),SET(" - Non-bedsection type Items must be specifically chosen for display."),SET(" - Use the CI action and select an item to display.") Q
75 . I 'IBSRNITM D SET("This set has no charges in this date range.") Q
76 . D SET(IBBRBIN_" "_$P(IBSRNITM,U,2)_" has no charges for this set in this date range.")
77 ;
78 K ^TMP($J,"IBCRCI")
79 Q
80 ;
81DATE(X) ; date in external format
82 N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
83 Q Y
84 ;
85SET(X) ; set up list manager screen array
86 S VALMCNT=VALMCNT+1
87 S ^TMP("IBCRLI",$J,VALMCNT,0)=X
88 Q
89 ;
90 ;
91SORTCI(IBCSFN,IBITM,IBDT1,IBDT2) ; sort a charge sets items by item name and inverse effective date
92 ; if ITEM is not defined than dates should be, if ITEM or dates not defined then assumes all should be included
93 ; ^TMP("IBCRCI",$J, item name, - effective date, ITEM IFN)=""
94 ;
95 N IBXRF,IBBITM,IBEITM,IBITEM,IBBDT,IBEDT,IBEFDT,IBCIFN,IBLN,IBITEMN
96 ;
97 S IBXRF="AIVDTS"_+$G(IBCSFN)
98 S IBBITM=+$G(IBITM)-.0001,IBEITM=$S(+$G(IBITM):IBITM,1:9999999999)
99 S IBBDT=$S(+$G(IBDT1):-IBDT1,1:-1000000),IBEDT=$S(+$G(IBDT2):-(IBDT2+.01),1:-9999999) Q:IBBDT<IBEDT
100 ;
101 S IBITEM=IBBITM F S IBITEM=$O(^IBA(363.2,IBXRF,IBITEM)) Q:'IBITEM!(IBITEM>IBEITM) D
102 . S IBEFDT=IBEDT F S IBEFDT=$O(^IBA(363.2,IBXRF,IBITEM,IBEFDT)) Q:'IBEFDT D Q:(IBEFDT'<IBBDT)
103 .. S IBCIFN=0 F S IBCIFN=$O(^IBA(363.2,IBXRF,IBITEM,IBEFDT,IBCIFN)) Q:'IBCIFN D
104 ... S IBLN=$G(^IBA(363.2,IBCIFN,0)),IBITEMN=$$EXPAND^IBCRU1(363.2,.01,$P(IBLN,U,1))_" - "
105 ... I +$P(IBLN,U,7) S IBITEMN=IBITEMN_$$EXPAND^IBCRU1(363.2,.07,+$P(IBLN,U,7))
106 ... I $P(IBLN,U,4),+$P(IBLN,U,4)<-IBBDT Q
107 ... S ^TMP($J,"IBCRCI",IBITEMN,IBEFDT,IBCIFN)=""
108 Q
109 ;
110GET(IBCSFN) ; get item to display on screen for specific charge set, set up general variables required
111 ; (returns 0 if error, -1 if ^) all active bedsections or all entries for a specific CPT or NDC #
112 ;
113 ; returns general data on the Charge set to be diplayed, may ask user for a specific item
114 ; variables defined on exit: IBCS0,IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT
115 ; if billable item is bedsection returns current date but no item
116 ; if billable item is anything else asks user for specific item but returns no date
117 ;
118 N IBX S IBX=1,(IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT)=""
119 S IBCS0=$G(^IBE(363.1,+$G(IBCSFN),0)) I IBCS0="" S IBX=0 G GETQ
120 S IBBRBI=$P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4) I 'IBBRBI S IBX=0 G GETQ
121 S IBBRBIN=$$EXPAND^IBCRU1(363.3,.04,IBBRBI)
122 I IBBRBI>1 W !!,"Select a billable ",IBBRBIN," to display for Charge Set ",$P(IBCS0,U,1),!
123 ;
124 I IBBRBI=1 S (IBSRNBDT,IBSRNEDT)=DT ; all currently active charges (bedsection)
125 I IBBRBI=2 S (IBX,IBSRNITM)=$$GETCPT^IBCRU1("",1) ; all charges for a specific CPT
126 I IBBRBI=3 S (IBX,IBSRNITM)=$$GETNDC^IBCRU1 ; all charges for a specific NDC #
127 I IBBRBI=4 S (IBX,IBSRNITM)=$$GETDRG^IBCRU1 ; all charges for a specific DRG
128 I IBBRBI=9 S (IBX,IBSRNITM)=$$GETMISC^IBCRU1 ; all charges for a specific MISCELLANEOUS item
129GETQ Q IBX
Note: See TracBrowser for help on using the repository browser.