Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCRBEI

IBCRBEI.m

Go to the documentation of this file. 
  1. IBCRBEI ;ALB/ARH - RATES: BILL ENTER/EDIT (RS/CS) SCREEN - BI ; 10-OCT-1998
  1.  ;;2.0;INTEGRATED BILLING;**106**;21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1.  ; this routines is used for those Billing Rates and Charge Setes that have items that are Unassociated.
  1.  ; this means is no billable item on the bill for the auto calculator to calculate charges for
  1.  ; the user must select the items they want to bill from the list of Miscellaneous items,
  1.  ; then the charge will be calculated and added to the bill.
  1.  ;
  1. SELITEMS(IBIFN,IBURSARR,IBUCHGAR) ; ask user to select items to bill, only Charges Sets with Billable Item of UNASSOCIATED allowed
  1.  ; Output:  IBUCHGAR(RS,CS,x) = item ptr+ ^ date ^ units ^ division ^ rev code
  1.  ;          returns count of unassociated items selected
  1.  N IBRS,IBCS,IBCS0,IBBEVNT,IBCNT,IBFND,IBITCHG K IBUCHGAR S (IBFND,IBCNT)=0
  1.  ;
  1.  S IBRS=0 F  S IBRS=$O(IBURSARR(IBRS)) Q:'IBRS  S IBCS=0 F  S IBCS=$O(IBURSARR(IBRS,IBCS)) Q:'IBCS  D
  1.  . S IBCS0=$G(^IBE(363.1,+IBCS,0)),IBBEVNT=$$EMUTL^IBCRU1(+$P(IBCS0,U,3))
  1.  . ;
  1.  . I IBBEVNT'["UNASSOCIATED" Q
  1.  . S IBFND=IBFND+1
  1.  . ;
  1.  . W @IOF,!!,"Select items from "_$P(IBCS0,U,1)_" to add to the bill's charges:"
  1.  . W !,"------------------------------------------------------------------------------"
  1.  . F  S IBITCHG=$$ITEM(IBIFN,IBRS,IBCS) Q:IBITCHG<0  D  W !
  1.  .. I +IBITCHG S IBCNT=+$G(IBUCHGAR)+1,IBUCHGAR=IBCNT,IBUCHGAR(IBRS,IBCS,IBCNT)=IBITCHG
  1.  ;
  1.  I +IBFND,'$$DISPLAY(.IBUCHGAR) K IBUCHGAR S IBCNT=0
  1.  Q IBCNT
  1.  ;
  1. DISPLAY(IBUCHGAR) ; prints items selected then ask if user wants to add these charges to the bill, return true if yes
  1.  N IBS,IBI,IBJ,IBK,IBLINE,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBS=0
  1.  ;
  1.  I '$G(IBUCHGAR) W @IOF S DIR("A")="No items selected, press return to continue",DIR(0)="E" D ^DIR G DISPQ
  1.  ;
  1.  W @IOF,!,"The following items have been selected to add to the bill's charges:"
  1.  W !!!,?5,"Item",?35,"Date",?48,"Units",?60,"Division"
  1.  W !,"-------------------------------------------------------------------------------"
  1.  ;
  1.  S IBI=0 F  S IBI=$O(IBUCHGAR(IBI)) Q:'IBI  S IBJ=0 F  S IBJ=$O(IBUCHGAR(IBI,IBJ)) Q:'IBJ  D
  1.  . S IBK=0 F  S IBK=$O(IBUCHGAR(IBI,IBJ,IBK)) Q:'IBK  S IBLINE=$G(IBUCHGAR(IBI,IBJ,IBK)) I IBLINE'=""  D
  1.  .. 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)
  1.  ;
  1.  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
  1.  ;
  1. DISPQ Q IBS
  1.  ;
  1. ITEM(IBIFN,IBRS,IBCS) ; ask user for one item to charge from the Charge Set
  1.  ; returns:  item ptr+ ^ date ^ units ^ division ^ rev code, -1 if no item or null if data missing
  1.  N IBBDIV,IBEVDT,IBBEG,IBEND,IBCS0,IBITEM,IBDT,IBUNITS,IBDV,IBRVCD,IBCOST,IBLINE S IBLINE=""
  1.  ;
  1.  S IBBDIV=$G(^DGCR(399,+IBIFN,0)),IBEVDT=$P(IBBDIV,U,3),IBBDIV=$P(IBBDIV,U,22)
  1.  S IBBEG=$G(^DGCR(399,+IBIFN,"U")),IBEND=$P(IBBEG,U,2),IBBEG=+IBBEG I IBEVDT<IBBEG S IBEVDT=IBBEG
  1.  S IBCS0=$G(^IBE(363.1,+IBCS,0))
  1.  ;
  1.  S IBITEM=$$GETITEM^IBCRU1(IBCS) I IBITEM'>0 S IBLINE=-1 G ITEMQ
  1.  S IBITEM=+IBITEM_$P(IBITEM,U,3)
  1.  ;
  1.  S IBDT=$$GETDT^IBCRU1(IBEVDT,"Service Date",IBBEG,IBEND) G:IBDT'?7N ITEMQ
  1.  ;
  1.  S IBUNITS=$$UNITS G:'IBUNITS ITEMQ
  1.  ;
  1.  S IBDV="" I +$P(IBCS0,U,7) S IBDV=$$DIV(+$P(IBCS0,U,7),IBBDIV) G:'IBDV ITEMQ
  1.  ;
  1.  S IBRVCD=$$RVCD(IBCS,IBITEM,IBDT) G:'IBRVCD ITEMQ
  1.  ;
  1.  S IBCOST=+$$ITCOST^IBCRCI(IBRS,IBCS,IBITEM,IBDT,"",IBDV,1) W !,"Charge: ",$J(IBCOST,10,2)
  1.  ;
  1.  W !,"Total:  ",$J((IBUNITS*IBCOST),10,2)
  1.  ;
  1.  S IBLINE=IBITEM_U_IBDT_U_IBUNITS_U_IBDV_U_IBRVCD
  1.  ;
  1. ITEMQ Q IBLINE
  1.  ;
  1. UNITS() ; ask user for number of units, return number of units or 0
  1.  N IBUNIT,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBUNIT=0
  1.  S DIR("?")="Enter the number of units of service (accommodation days, miles, treatments, etc.) rendered to or for this patient for this service."
  1.  S DIR("?",1)="This is the number times this service was provided to the patient."
  1.  S DIR("?",2)="This number will be multiplied by the service CHARGE to determine"
  1.  S DIR("?",3)="the TOTAL charges for this service.  Enter a positive whole number.",DIR("?",4)=""
  1.  ;
  1.  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
  1.  Q IBUNIT
  1.  ;
  1. DIV(IBCSRG,IBBDIV) ; ask user for division, return Division IFN or 0, only divisions within the CS region allowed
  1.  N IBDV,IBDDV,DIR,DIRUT,DTOUT,DUOUT,X,Y S IBCSRG=$G(IBCSRG),IBBDIV=$G(IBBDIV),IBDV=0
  1.  S IBDDV=$G(^DG(40.8,+$G(^IBE(363.31,+IBCSRG,11,1,0)),0))
  1.  I +IBBDIV S IBBDIV=$G(^DG(40.8,+IBBDIV,0))
  1.  ;
  1.  S DIR("?")="Enter the division where this service took place."
  1.  S DIR("?",1)="This Charge Set has a Billing Region, therefore all services must be"
  1.  S DIR("?",2)="associated with one of that region's divisions for a charge to be applied.",DIR("?",3)=" "
  1.  S DIR("?",4)="Only Divisions associated with the Charge Sets Billing Region"
  1.  S DIR("?",5)=$P($$RGEXT^IBCRU4(+IBCSRG),U,1)_" will be allowed.  If the correct division is not in the"
  1.  S DIR("?",6)="list then this service does not have a charge in this set, enter '^'.",DIR("?",7)=" "
  1.  I IBBDIV'="" S DIR("?",8)="The bills Default Division is: "_$P(IBBDIV,U,1)_"  "_$P(IBBDIV,U,2),DIR("?",9)=" "
  1.  ;
  1.  S DIR("B")=$P(IBDDV,U,2),DIR("S")="I $D(^IBE(363.31,"_+IBCSRG_",11,""B"",Y))"
  1.  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
  1.  Q IBDV
  1.  ;
  1. RVCD(IBCS,IBITEM,IBEFDT) ; ask user for a specific revenue code, return Rev Code IFN or 0
  1.  N IBCI,IBIDRV,IBSDRV,IBC,IBRVCD,DIR,DIRUT,DTOUT,DUOUT,X,Y S (IBIDRV,IBSDRV)="",(IBRVCD,IBC)=0
  1.  ;
  1.  I +$$FNDCI^IBCRU4(+$G(IBCS),+$G(IBITEM),+$G(IBEFDT),.IBCI) S IBCI=$O(IBCI(0))
  1.  I +$G(IBCI) S IBIDRV=$P(IBCI(IBCI),U,6) I +IBIDRV S IBIDRV=$G(^DGCR(399.2,+IBIDRV,0))
  1.  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))
  1.  ;
  1.  S DIR("?")="Enter the Revenue Code to associate with this charge on the bill."
  1.  I +IBSDRV S IBC=IBC+1,DIR("?",IBC)="The Charge Set Default Revenue Code is "_$P(IBSDRV,U,1)_" "_$P(IBSDRV,U,2)
  1.  I +IBIDRV S IBC=IBC+1,DIR("?",IBC)="The Charge Item Default Revenue Code is "_$P(IBIDRV,U,1)_" "_$P(IBIDRV,U,2)
  1.  S IBC=IBC+1,DIR("?",IBC)=" "
  1.  ;
  1.  S DIR("B")=$S(IBIDRV'="":$P(IBIDRV,U,1),IBSDRV'="":$P(IBSDRV,U,1),1:""),DIR("S")="I +$P(^(0),U,3)"
  1.  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
  1.  Q IBRVCD