IBCRBE ;ALB/ARH - RATES: BILL ENTER/EDIT (RS/CS) SCREEN ; 22-MAY-1996
;;2.0;INTEGRATED BILLING;**52,106,245,287,447**;21-MAR-94;Build 80
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EDIT(IBIFN) ; ENTRY POINT from Enter/Edit a Bill option:
; display available Schedules/Sets for a bill, allow the user to choose the ones to use,
; then recalculate the bills charges
;
N IBSRTARR,IBCHGARR,IBUCHGAR I '$G(IBIFN) G EDITQ
;
I '$$DISPLAY(IBIFN,.IBSRTARR) G EDITQ
;
I '$$SELCT(IBIFN,.IBSRTARR,.IBCHGARR) G EDITQ
;
I $O(IBCHGARR(0)) D BILL^IBCRBC(IBIFN,.IBCHGARR)
;
I $O(IBCHGARR(0)),$$SELITEMS^IBCRBEI(IBIFN,.IBCHGARR,.IBUCHGAR) D BILLITEM^IBCRBC(IBIFN,.IBUCHGAR)
;
EDITQ Q
;
DISPLAY(IBIFN,IBSRTARR) ; get list of all RS/CS combinations available for use on the bill
; sort them in name order then display the results to the screen, returns 1 if some found
N IB0,IBU,IBC,IBRSARR K IBSRTARR S IBC=1
;
S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" S IBC=0 G DISPQ
S IBU=$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBU S IBC=0 G DISPQ
D RT^IBCRU3($P(IB0,U,7),+$P(IB0,U,5),$P(IBU,U,1,2),.IBRSARR)
;
I 'IBRSARR D NONE($P(IB0,U,1),$P(IB0,U,7),+$P(IB0,U,5),$P(IB0,U,3)),WAIT S IBC=0 G DISPQ
;
D SORTBRS(.IBRSARR,.IBSRTARR,$P(IB0,U,27)),DISPRS($P(IB0,U,7),$P(IB0,U,5),.IBSRTARR)
;
DISPQ Q IBC
;
SORTBRS(IBRSARR,IBSRTARR,IBBCT) ; return array in rs name, cs name sorted order with external form of data
; input: IBRSARR(rate sched IFN,charge set IFN) = true if auto add
; output: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ auto add ^ unassoc event ^ chg type ^ disp set
;
N IBRS,IBCS,IBRSN,IBCSN,IBAA,IBUA,IBCT,IBTCNT,IBACNT,IBLN,IBS,ARRX K IBSRTARR S IBBCT=+$G(IBBCT)
S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D
. S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS D
.. S IBAA=IBRSARR(IBRS,IBCS),IBRSN=$P($G(^IBE(363,+IBRS,0)),U,1),IBCSN=$P($G(^IBE(363.1,+IBCS,0)),U,1)
.. S IBUA=$S($$CSBR^IBCRU3(IBCS)["UNASSOCIATE":1,1:0),IBCT=$P($G(^IBE(363.1,+IBCS,0)),U,4)
.. S IBS=$S('IBAA:2,(+IBBCT&(IBBCT'=IBCT)):1,1:" ")_$S(IBCT=1:"I",IBCT=2:"P",1:" ")
.. I IBRSN'="",IBCSN'="" S ARRX(IBS_IBRSN_IBRS_IBCS,IBCSN)=IBRS_U_IBCS_U_IBRSN_U_IBCSN_U_IBAA_U_IBUA_U_IBCT_U_IBS
;
S (IBTCNT,IBACNT)=0,IBRSN="" F S IBRSN=$O(ARRX(IBRSN)) Q:IBRSN="" D
. S IBCSN="" F S IBCSN=$O(ARRX(IBRSN,IBCSN)) Q:IBCSN="" D
.. S IBLN=ARRX(IBRSN,IBCSN),IBTCNT=IBTCNT+1 I 'IBRSN S IBACNT=IBACNT+1
.. S IBSRTARR(IBTCNT)=IBLN
S IBSRTARR=IBACNT_U_IBTCNT
Q
;
DISPRS(RT,BT,IBSRTARR) ; display available rate schedules and charge sets for a bill
N RTN,IBCNT,IBLN,IBLAST S RTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1),BT=$G(BT)
W @IOF,!?5,"Rate Schedules available for an "_$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:"")_$E(RTN,1,27)_" bill"
W !,"------------------------------------------------------------------------------"
;
S IBCNT=0 F S IBCNT=$O(IBSRTARR(IBCNT)) Q:'IBCNT D
. S IBLN=$G(IBSRTARR(IBCNT)) I +$P(IBLN,U,8)'=+$G(IBLAST) W ! S IBLAST=+$P(IBLN,U,8)
. W !,?3,IBCNT,")",?8,$P(IBLN,U,3),?31,$P(IBLN,U,4),?69,$S(+$P(IBLN,U,7)=1:"INST",$P(IBLN,U,7)=2:"PROF",1:""),?75,$S(+$P(IBLN,U,6):"s",1:""),?77,$S('$P(IBLN,U,5):"*",1:"")
;
Q
;
SELCT(IBIFN,IBSRTARR,IBCHGARR) ; get the user selection of rs/cs charges to add to the bill
; input: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ Auto Add ^ unassoc event ^ chg type ^ disp set
; output: IBCHGARR(rate sched IFN,charge set IFN) = 1 - add charges for rs/cs
;
N IBCHNG,IBSEL,IBI,IBS,IBX,IBLN,DIR,DIRUT,DUOUT,DTOUT,X,Y K IBCHGARR S IBCHNG=0 I '$G(IBIFN) G SELCTQ
I '$O(IBSRTARR(0)) G SELCTQ
;
S DIR("?")="Enter the number (1-"_+$P(IBSRTARR,U,2)_") preceding the Rate Schedule/Charge Sets that apply to this bill. All associated charges will be added to the bill."
S DIR("?",1)="* - these charges are available to be added to this bill if selected here,"
S DIR("?",2)=" but will not be added when the bills charges are automatically calculated."
S DIR("?",3)="s - the items these charges are associated with must be specifically"
S DIR("?",4)=" selected here, they do not relate to any item on the bill.",DIR("?",5)=" "
S DIR("?",6)="If the bill's charge type is exclusively institutional or professional then"
S DIR("?",7)="only sets of charges with a corresponding type will be added when the bills"
S DIR("?",8)="charges are automatically calculated. On this screen, these charges will be"
S DIR("?",9)="displayed in the first set and used as the selection default.",DIR("?",10)=" "
S DIR("??")="^D HELP^IBCRBE("_IBIFN_")"
S DIR("A")="Select Schedule Charges to ADD to the bill: " I +IBSRTARR S DIR("B")="1-"_+IBSRTARR
;
; Clear the manually edited flag. IB*2.0*447 BI
D CMAEDALL^IBCU9(IBIFN)
;
W !! S DIR(0)="LOA^1:"_+$P(IBSRTARR,U,2) D ^DIR K DIR I 'Y!$D(DIRUT) G SELCTQ
;
S IBX="" F S IBX=$O(Y(IBX)) Q:IBX="" D
. S IBSEL=Y(IBX) F IBI=1:1:100 S IBS=$P(IBSEL,",",IBI) Q:'IBS D
.. I $D(IBSRTARR(IBS)) S IBCHNG=1,IBLN=IBSRTARR(IBS),IBCHGARR(+IBLN,$P(IBLN,U,2))=1
;
SELCTQ Q IBCHNG
;
NONE(IBBN,RT,BT,EVDT) ; write message indicating no rate schedules defined for this bill
N IBRTN S BT=+$G(BT),EVDT=$G(EVDT),IBRTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1)
W !,?7 I +EVDT W !,?7,"On ",$$DATE^IBCRU1(+EVDT),", there are "
W "No Rate Schedules with charges defined "
I IBRTN'="" W:+EVDT !,?20 W "for ",$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:""),IBRTN
I $G(IBBN)'="" W !!,?7,"Therefore, charges can not be calculated for this bill (",IBBN,") "
W !
Q
;
WAIT N DIR,DIRUT,DUOUT,DTOUT,Y,X S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
Q
;
HELP(IBIFN) ; display rs/cs for the bill - used as help text
N IBX I +$G(IBIFN) S IBX=$$DISPLAY(IBIFN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRBE 5934 printed Dec 13, 2024@02:18:48 Page 2
IBCRBE ;ALB/ARH - RATES: BILL ENTER/EDIT (RS/CS) SCREEN ; 22-MAY-1996
+1 ;;2.0;INTEGRATED BILLING;**52,106,245,287,447**;21-MAR-94;Build 80
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
EDIT(IBIFN) ; ENTRY POINT from Enter/Edit a Bill option:
+1 ; display available Schedules/Sets for a bill, allow the user to choose the ones to use,
+2 ; then recalculate the bills charges
+3 ;
+4 NEW IBSRTARR,IBCHGARR,IBUCHGAR
IF '$GET(IBIFN)
GOTO EDITQ
+5 ;
+6 IF '$$DISPLAY(IBIFN,.IBSRTARR)
GOTO EDITQ
+7 ;
+8 IF '$$SELCT(IBIFN,.IBSRTARR,.IBCHGARR)
GOTO EDITQ
+9 ;
+10 IF $ORDER(IBCHGARR(0))
DO BILL^IBCRBC(IBIFN,.IBCHGARR)
+11 ;
+12 IF $ORDER(IBCHGARR(0))
IF $$SELITEMS^IBCRBEI(IBIFN,.IBCHGARR,.IBUCHGAR)
DO BILLITEM^IBCRBC(IBIFN,.IBUCHGAR)
+13 ;
EDITQ QUIT
+1 ;
DISPLAY(IBIFN,IBSRTARR) ; get list of all RS/CS combinations available for use on the bill
+1 ; sort them in name order then display the results to the screen, returns 1 if some found
+2 NEW IB0,IBU,IBC,IBRSARR
KILL IBSRTARR
SET IBC=1
+3 ;
+4 SET IB0=$GET(^DGCR(399,+$GET(IBIFN),0))
IF IB0=""
SET IBC=0
GOTO DISPQ
+5 SET IBU=$GET(^DGCR(399,+$GET(IBIFN),"U"))
IF 'IBU
SET IBC=0
GOTO DISPQ
+6 DO RT^IBCRU3($PIECE(IB0,U,7),+$PIECE(IB0,U,5),$PIECE(IBU,U,1,2),.IBRSARR)
+7 ;
+8 IF 'IBRSARR
DO NONE($PIECE(IB0,U,1),$PIECE(IB0,U,7),+$PIECE(IB0,U,5),$PIECE(IB0,U,3))
DO WAIT
SET IBC=0
GOTO DISPQ
+9 ;
+10 DO SORTBRS(.IBRSARR,.IBSRTARR,$PIECE(IB0,U,27))
DO DISPRS($PIECE(IB0,U,7),$PIECE(IB0,U,5),.IBSRTARR)
+11 ;
DISPQ QUIT IBC
+1 ;
SORTBRS(IBRSARR,IBSRTARR,IBBCT) ; return array in rs name, cs name sorted order with external form of data
+1 ; input: IBRSARR(rate sched IFN,charge set IFN) = true if auto add
+2 ; output: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
+3 ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ auto add ^ unassoc event ^ chg type ^ disp set
+4 ;
+5 NEW IBRS,IBCS,IBRSN,IBCSN,IBAA,IBUA,IBCT,IBTCNT,IBACNT,IBLN,IBS,ARRX
KILL IBSRTARR
SET IBBCT=+$GET(IBBCT)
+6 SET IBRS=0
FOR
SET IBRS=$ORDER(IBRSARR(IBRS))
if 'IBRS
QUIT
Begin DoDot:1
+7 SET IBCS=0
FOR
SET IBCS=$ORDER(IBRSARR(IBRS,IBCS))
if 'IBCS
QUIT
Begin DoDot:2
+8 SET IBAA=IBRSARR(IBRS,IBCS)
SET IBRSN=$PIECE($GET(^IBE(363,+IBRS,0)),U,1)
SET IBCSN=$PIECE($GET(^IBE(363.1,+IBCS,0)),U,1)
+9 SET IBUA=$SELECT($$CSBR^IBCRU3(IBCS)["UNASSOCIATE":1,1:0)
SET IBCT=$PIECE($GET(^IBE(363.1,+IBCS,0)),U,4)
+10 SET IBS=$SELECT('IBAA:2,(+IBBCT&(IBBCT'=IBCT)):1,1:" ")_$SELECT(IBCT=1:"I",IBCT=2:"P",1:" ")
+11 IF IBRSN'=""
IF IBCSN'=""
SET ARRX(IBS_IBRSN_IBRS_IBCS,IBCSN)=IBRS_U_IBCS_U_IBRSN_U_IBCSN_U_IBAA_U_IBUA_U_IBCT_U_IBS
End DoDot:2
End DoDot:1
+12 ;
+13 SET (IBTCNT,IBACNT)=0
SET IBRSN=""
FOR
SET IBRSN=$ORDER(ARRX(IBRSN))
if IBRSN=""
QUIT
Begin DoDot:1
+14 SET IBCSN=""
FOR
SET IBCSN=$ORDER(ARRX(IBRSN,IBCSN))
if IBCSN=""
QUIT
Begin DoDot:2
+15 SET IBLN=ARRX(IBRSN,IBCSN)
SET IBTCNT=IBTCNT+1
IF 'IBRSN
SET IBACNT=IBACNT+1
+16 SET IBSRTARR(IBTCNT)=IBLN
End DoDot:2
End DoDot:1
+17 SET IBSRTARR=IBACNT_U_IBTCNT
+18 QUIT
+19 ;
DISPRS(RT,BT,IBSRTARR) ; display available rate schedules and charge sets for a bill
+1 NEW RTN,IBCNT,IBLN,IBLAST
SET RTN=$PIECE($GET(^DGCR(399.3,+$GET(RT),0)),U,1)
SET BT=$GET(BT)
+2 WRITE @IOF,!?5,"Rate Schedules available for an "_$SELECT(BT>2:"Outpatient ",BT>0:"Inpatient ",1:"")_$EXTRACT(RTN,1,27)_" bill"
+3 WRITE !,"------------------------------------------------------------------------------"
+4 ;
+5 SET IBCNT=0
FOR
SET IBCNT=$ORDER(IBSRTARR(IBCNT))
if 'IBCNT
QUIT
Begin DoDot:1
+6 SET IBLN=$GET(IBSRTARR(IBCNT))
IF +$PIECE(IBLN,U,8)'=+$GET(IBLAST)
WRITE !
SET IBLAST=+$PIECE(IBLN,U,8)
+7 WRITE !,?3,IBCNT,")",?8,$PIECE(IBLN,U,3),?31,$PIECE(IBLN,U,4),?69,$SELECT(+$PIECE(IBLN,U,7)=1:"INST",$PIECE(IBLN,U,7)=2:"PROF",1:""),?75,$SELECT(+$PIECE(IBLN,U,6):"s",1:""),?77,$SELECT('$PIECE(IBLN,U,5):"*",1:"")
End DoDot:1
+8 ;
+9 QUIT
+10 ;
SELCT(IBIFN,IBSRTARR,IBCHGARR) ; get the user selection of rs/cs charges to add to the bill
+1 ; input: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
+2 ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ Auto Add ^ unassoc event ^ chg type ^ disp set
+3 ; output: IBCHGARR(rate sched IFN,charge set IFN) = 1 - add charges for rs/cs
+4 ;
+5 NEW IBCHNG,IBSEL,IBI,IBS,IBX,IBLN,DIR,DIRUT,DUOUT,DTOUT,X,Y
KILL IBCHGARR
SET IBCHNG=0
IF '$GET(IBIFN)
GOTO SELCTQ
+6 IF '$ORDER(IBSRTARR(0))
GOTO SELCTQ
+7 ;
+8 SET DIR("?")="Enter the number (1-"_+$PIECE(IBSRTARR,U,2)_") preceding the Rate Schedule/Charge Sets that apply to this bill. All associated charges will be added to the bill."
+9 SET DIR("?",1)="* - these charges are available to be added to this bill if selected here,"
+10 SET DIR("?",2)=" but will not be added when the bills charges are automatically calculated."
+11 SET DIR("?",3)="s - the items these charges are associated with must be specifically"
+12 SET DIR("?",4)=" selected here, they do not relate to any item on the bill."
SET DIR("?",5)=" "
+13 SET DIR("?",6)="If the bill's charge type is exclusively institutional or professional then"
+14 SET DIR("?",7)="only sets of charges with a corresponding type will be added when the bills"
+15 SET DIR("?",8)="charges are automatically calculated. On this screen, these charges will be"
+16 SET DIR("?",9)="displayed in the first set and used as the selection default."
SET DIR("?",10)=" "
+17 SET DIR("??")="^D HELP^IBCRBE("_IBIFN_")"
+18 SET DIR("A")="Select Schedule Charges to ADD to the bill: "
IF +IBSRTARR
SET DIR("B")="1-"_+IBSRTARR
+19 ;
+20 ; Clear the manually edited flag. IB*2.0*447 BI
+21 DO CMAEDALL^IBCU9(IBIFN)
+22 ;
+23 WRITE !!
SET DIR(0)="LOA^1:"_+$PIECE(IBSRTARR,U,2)
DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
GOTO SELCTQ
+24 ;
+25 SET IBX=""
FOR
SET IBX=$ORDER(Y(IBX))
if IBX=""
QUIT
Begin DoDot:1
+26 SET IBSEL=Y(IBX)
FOR IBI=1:1:100
SET IBS=$PIECE(IBSEL,",",IBI)
if 'IBS
QUIT
Begin DoDot:2
+27 IF $DATA(IBSRTARR(IBS))
SET IBCHNG=1
SET IBLN=IBSRTARR(IBS)
SET IBCHGARR(+IBLN,$PIECE(IBLN,U,2))=1
End DoDot:2
End DoDot:1
+28 ;
SELCTQ QUIT IBCHNG
+1 ;
NONE(IBBN,RT,BT,EVDT) ; write message indicating no rate schedules defined for this bill
+1 NEW IBRTN
SET BT=+$GET(BT)
SET EVDT=$GET(EVDT)
SET IBRTN=$PIECE($GET(^DGCR(399.3,+$GET(RT),0)),U,1)
+2 WRITE !,?7
IF +EVDT
WRITE !,?7,"On ",$$DATE^IBCRU1(+EVDT),", there are "
+3 WRITE "No Rate Schedules with charges defined "
+4 IF IBRTN'=""
if +EVDT
WRITE !,?20
WRITE "for ",$SELECT(BT>2:"Outpatient ",BT>0:"Inpatient ",1:""),IBRTN
+5 IF $GET(IBBN)'=""
WRITE !!,?7,"Therefore, charges can not be calculated for this bill (",IBBN,") "
+6 WRITE !
+7 QUIT
+8 ;
WAIT NEW DIR,DIRUT,DUOUT,DTOUT,Y,X
SET DIR("A")="Press RETURN to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+1 QUIT
+2 ;
HELP(IBIFN) ; display rs/cs for the bill - used as help text
+1 NEW IBX
IF +$GET(IBIFN)
SET IBX=$$DISPLAY(IBIFN)
+2 QUIT
