| 1 | IBCRBEI ;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 | ;
|
|---|
| 10 | SELITEMS(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 | ;
|
|---|
| 29 | DISPLAY(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 | ;
|
|---|
| 44 | DISPQ Q IBS
|
|---|
| 45 | ;
|
|---|
| 46 | ITEM(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 | ;
|
|---|
| 71 | ITEMQ Q IBLINE
|
|---|
| 72 | ;
|
|---|
| 73 | UNITS() ; 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 | ;
|
|---|
| 83 | DIV(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 | ;
|
|---|
| 100 | RVCD(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
|
|---|
