source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRBEI.m

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1IBCRBEI ;ALB/ARH - RATES: BILL ENTER/EDIT (RS/CS) SCREEN - BI ; 10-OCT-1998
2 ;;2.0;INTEGRATED BILLING;**106**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; this routines is used for those Billing Rates and Charge Setes that have items that are Unassociated.
6 ; this means is no billable item on the bill for the auto calculator to calculate charges for
7 ; the user must select the items they want to bill from the list of Miscellaneous items,
8 ; then the charge will be calculated and added to the bill.
9 ;
10SELITEMS(IBIFN,IBURSARR,IBUCHGAR) ; ask user to select items to bill, only Charges Sets with Billable Item of UNASSOCIATED allowed
11 ; Output: IBUCHGAR(RS,CS,x) = item ptr+ ^ date ^ units ^ division ^ rev code
12 ; returns count of unassociated items selected
13 N IBRS,IBCS,IBCS0,IBBEVNT,IBCNT,IBFND,IBITCHG K IBUCHGAR S (IBFND,IBCNT)=0
14 ;
15 S IBRS=0 F S IBRS=$O(IBURSARR(IBRS)) Q:'IBRS S IBCS=0 F S IBCS=$O(IBURSARR(IBRS,IBCS)) Q:'IBCS D
16 . S IBCS0=$G(^IBE(363.1,+IBCS,0)),IBBEVNT=$$EMUTL^IBCRU1(+$P(IBCS0,U,3))
17 . ;
18 . I IBBEVNT'["UNASSOCIATED" Q
19 . S IBFND=IBFND+1
20 . ;
21 . W @IOF,!!,"Select items from "_$P(IBCS0,U,1)_" to add to the bill's charges:"
22 . W !,"------------------------------------------------------------------------------"
23 . F S IBITCHG=$$ITEM(IBIFN,IBRS,IBCS) Q:IBITCHG<0 D W !
24 .. I +IBITCHG S IBCNT=+$G(IBUCHGAR)+1,IBUCHGAR=IBCNT,IBUCHGAR(IBRS,IBCS,IBCNT)=IBITCHG
25 ;
26 I +IBFND,'$$DISPLAY(.IBUCHGAR) K IBUCHGAR S IBCNT=0
27 Q IBCNT
28 ;
29DISPLAY(IBUCHGAR) ; prints items selected then ask if user wants to add these charges to the bill, return true if yes
30 N IBS,IBI,IBJ,IBK,IBLINE,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBS=0
31 ;
32 I '$G(IBUCHGAR) W @IOF S DIR("A")="No items selected, press return to continue",DIR(0)="E" D ^DIR G DISPQ
33 ;
34 W @IOF,!,"The following items have been selected to add to the bill's charges:"
35 W !!!,?5,"Item",?35,"Date",?48,"Units",?60,"Division"
36 W !,"-------------------------------------------------------------------------------"
37 ;
38 S IBI=0 F S IBI=$O(IBUCHGAR(IBI)) Q:'IBI S IBJ=0 F S IBJ=$O(IBUCHGAR(IBI,IBJ)) Q:'IBJ D
39 . S IBK=0 F S IBK=$O(IBUCHGAR(IBI,IBJ,IBK)) Q:'IBK S IBLINE=$G(IBUCHGAR(IBI,IBJ,IBK)) I IBLINE'="" D
40 .. W !,?3,$$EXPAND^IBCRU1(363.2,.01,$P(IBLINE,U,1)),?35,$$DATE^IBCRU1(+$P(IBLINE,U,2)),?48,$J($P(IBLINE,U,3),4),?60,$P($G(^DG(40.8,+$P(IBLINE,U,4),0)),U,2)
41 ;
42 W !! S DIR(0)="YO",DIR("A")="Add these Charges to the Bill" D ^DIR K DIR S:Y=1 IBS=1 I 'Y!$D(DIRUT) S IBS=0
43 ;
44DISPQ Q IBS
45 ;
46ITEM(IBIFN,IBRS,IBCS) ; ask user for one item to charge from the Charge Set
47 ; returns: item ptr+ ^ date ^ units ^ division ^ rev code, -1 if no item or null if data missing
48 N IBBDIV,IBEVDT,IBBEG,IBEND,IBCS0,IBITEM,IBDT,IBUNITS,IBDV,IBRVCD,IBCOST,IBLINE S IBLINE=""
49 ;
50 S IBBDIV=$G(^DGCR(399,+IBIFN,0)),IBEVDT=$P(IBBDIV,U,3),IBBDIV=$P(IBBDIV,U,22)
51 S IBBEG=$G(^DGCR(399,+IBIFN,"U")),IBEND=$P(IBBEG,U,2),IBBEG=+IBBEG I IBEVDT<IBBEG S IBEVDT=IBBEG
52 S IBCS0=$G(^IBE(363.1,+IBCS,0))
53 ;
54 S IBITEM=$$GETITEM^IBCRU1(IBCS) I IBITEM'>0 S IBLINE=-1 G ITEMQ
55 S IBITEM=+IBITEM_$P(IBITEM,U,3)
56 ;
57 S IBDT=$$GETDT^IBCRU1(IBEVDT,"Service Date",IBBEG,IBEND) G:IBDT'?7N ITEMQ
58 ;
59 S IBUNITS=$$UNITS G:'IBUNITS ITEMQ
60 ;
61 S IBDV="" I +$P(IBCS0,U,7) S IBDV=$$DIV(+$P(IBCS0,U,7),IBBDIV) G:'IBDV ITEMQ
62 ;
63 S IBRVCD=$$RVCD(IBCS,IBITEM,IBDT) G:'IBRVCD ITEMQ
64 ;
65 S IBCOST=+$$ITCOST^IBCRCI(IBRS,IBCS,IBITEM,IBDT,"",IBDV,1) W !,"Charge: ",$J(IBCOST,10,2)
66 ;
67 W !,"Total: ",$J((IBUNITS*IBCOST),10,2)
68 ;
69 S IBLINE=IBITEM_U_IBDT_U_IBUNITS_U_IBDV_U_IBRVCD
70 ;
71ITEMQ Q IBLINE
72 ;
73UNITS() ; ask user for number of units, return number of units or 0
74 N IBUNIT,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBUNIT=0
75 S DIR("?")="Enter the number of units of service (accommodation days, miles, treatments, etc.) rendered to or for this patient for this service."
76 S DIR("?",1)="This is the number times this service was provided to the patient."
77 S DIR("?",2)="This number will be multiplied by the service CHARGE to determine"
78 S DIR("?",3)="the TOTAL charges for this service. Enter a positive whole number.",DIR("?",4)=""
79 ;
80 S DIR("B")=1,DIR("A")="Number of Units: ",DIR(0)="NOA^1::0" D ^DIR S:+Y>0 IBUNIT=+Y I 'Y!$D(DIRUT) S IBUNIT=0
81 Q IBUNIT
82 ;
83DIV(IBCSRG,IBBDIV) ; ask user for division, return Division IFN or 0, only divisions within the CS region allowed
84 N IBDV,IBDDV,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBCSRG=$G(IBCSRG),IBBDIV=$G(IBBDIV),IBDV=0
85 S IBDDV=$G(^DG(40.8,+$G(^IBE(363.31,+IBCSRG,11,1,0)),0))
86 I +IBBDIV S IBBDIV=$G(^DG(40.8,+IBBDIV,0))
87 ;
88 S DIR("?")="Enter the division where this service took place."
89 S DIR("?",1)="This Charge Set has a Billing Region, therefore all services must be"
90 S DIR("?",2)="associated with one of that region's divisions for a charge to be applied.",DIR("?",3)=" "
91 S DIR("?",4)="Only Divisions associated with the Charge Sets Billing Region"
92 S DIR("?",5)=$P($$RGEXT^IBCRU4(+IBCSRG),U,1)_" will be allowed. If the correct division is not in the"
93 S DIR("?",6)="list then this service does not have a charge in this set, enter '^'.",DIR("?",7)=" "
94 I IBBDIV'="" S DIR("?",8)="The bills Default Division is: "_$P(IBBDIV,U,1)_" "_$P(IBBDIV,U,2),DIR("?",9)=" "
95 ;
96 S DIR("B")=$P(IBDDV,U,2),DIR("S")="I $D(^IBE(363.31,"_+IBCSRG_",11,""B"",Y))"
97 S DIR("A")="DIVISION",DIR(0)="PO^40.8:AEMQ" D ^DIR K DIR S:+Y>0 IBDV=+Y I 'Y!$D(DIRUT) S IBDV=0
98 Q IBDV
99 ;
100RVCD(IBCS,IBITEM,IBEFDT) ; ask user for a specific revenue code, return Rev Code IFN or 0
101 N IBCI,IBIDRV,IBSDRV,IBC,IBRVCD,DIR,DIRUT,DTOUT,DUOUT,X,Y S (IBIDRV,IBSDRV)="",(IBRVCD,IBC)=0
102 ;
103 I +$$FNDCI^IBCRU4(+$G(IBCS),+$G(IBITEM),+$G(IBEFDT),.IBCI) S IBCI=$O(IBCI(0))
104 I +$G(IBCI) S IBIDRV=$P(IBCI(IBCI),U,6) I +IBIDRV S IBIDRV=$G(^DGCR(399.2,+IBIDRV,0))
105 I +$G(IBCS) S IBSDRV=$P($G(^IBE(363.1,+$G(IBCS),0)),U,5) I +IBSDRV S IBSDRV=$G(^DGCR(399.2,+IBSDRV,0))
106 ;
107 S DIR("?")="Enter the Revenue Code to associate with this charge on the bill."
108 I +IBSDRV S IBC=IBC+1,DIR("?",IBC)="The Charge Set Default Revenue Code is "_$P(IBSDRV,U,1)_" "_$P(IBSDRV,U,2)
109 I +IBIDRV S IBC=IBC+1,DIR("?",IBC)="The Charge Item Default Revenue Code is "_$P(IBIDRV,U,1)_" "_$P(IBIDRV,U,2)
110 S IBC=IBC+1,DIR("?",IBC)=" "
111 ;
112 S DIR("B")=$S(IBIDRV'="":$P(IBIDRV,U,1),IBSDRV'="":$P(IBSDRV,U,1),1:""),DIR("S")="I +$P(^(0),U,3)"
113 S DIR("A")="Revenue Code",DIR(0)="PO^399.2:AEMQ" D ^DIR K DIR S:+Y>0 IBRVCD=+Y I 'Y!$D(DIRUT) S IBRVCD=0
114 Q IBRVCD
Note: See TracBrowser for help on using the repository browser.