- 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 Jan 18, 2025@03:20 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