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