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

IBCRBE.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. 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,
  1. ; then recalculate the bills charges
  1. ;
  1. N IBSRTARR,IBCHGARR,IBUCHGAR I '$G(IBIFN) G EDITQ
  1. ;
  1. I '$$DISPLAY(IBIFN,.IBSRTARR) G EDITQ
  1. ;
  1. I '$$SELCT(IBIFN,.IBSRTARR,.IBCHGARR) G EDITQ
  1. ;
  1. I $O(IBCHGARR(0)) D BILL^IBCRBC(IBIFN,.IBCHGARR)
  1. ;
  1. I $O(IBCHGARR(0)),$$SELITEMS^IBCRBEI(IBIFN,.IBCHGARR,.IBUCHGAR) D BILLITEM^IBCRBC(IBIFN,.IBUCHGAR)
  1. ;
  1. EDITQ Q
  1. ;
  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
  1. N IB0,IBU,IBC,IBRSARR K IBSRTARR S IBC=1
  1. ;
  1. S IB0=$G(^DGCR(399,+$G(IBIFN),0)) I IB0="" S IBC=0 G DISPQ
  1. S IBU=$G(^DGCR(399,+$G(IBIFN),"U")) I 'IBU S IBC=0 G DISPQ
  1. D RT^IBCRU3($P(IB0,U,7),+$P(IB0,U,5),$P(IBU,U,1,2),.IBRSARR)
  1. ;
  1. 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
  1. ;
  1. D SORTBRS(.IBRSARR,.IBSRTARR,$P(IB0,U,27)),DISPRS($P(IB0,U,7),$P(IB0,U,5),.IBSRTARR)
  1. ;
  1. DISPQ Q IBC
  1. ;
  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
  1. ; output: IBSRTARR = CNT of RS/CS to be auto added ^ total CNT
  1. ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ auto add ^ unassoc event ^ chg type ^ disp set
  1. ;
  1. N IBRS,IBCS,IBRSN,IBCSN,IBAA,IBUA,IBCT,IBTCNT,IBACNT,IBLN,IBS,ARRX K IBSRTARR S IBBCT=+$G(IBBCT)
  1. S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D
  1. . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS D
  1. .. S IBAA=IBRSARR(IBRS,IBCS),IBRSN=$P($G(^IBE(363,+IBRS,0)),U,1),IBCSN=$P($G(^IBE(363.1,+IBCS,0)),U,1)
  1. .. S IBUA=$S($$CSBR^IBCRU3(IBCS)["UNASSOCIATE":1,1:0),IBCT=$P($G(^IBE(363.1,+IBCS,0)),U,4)
  1. .. S IBS=$S('IBAA:2,(+IBBCT&(IBBCT'=IBCT)):1,1:" ")_$S(IBCT=1:"I",IBCT=2:"P",1:" ")
  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
  1. ;
  1. S (IBTCNT,IBACNT)=0,IBRSN="" F S IBRSN=$O(ARRX(IBRSN)) Q:IBRSN="" D
  1. . S IBCSN="" F S IBCSN=$O(ARRX(IBRSN,IBCSN)) Q:IBCSN="" D
  1. .. S IBLN=ARRX(IBRSN,IBCSN),IBTCNT=IBTCNT+1 I 'IBRSN S IBACNT=IBACNT+1
  1. .. S IBSRTARR(IBTCNT)=IBLN
  1. S IBSRTARR=IBACNT_U_IBTCNT
  1. Q
  1. ;
  1. DISPRS(RT,BT,IBSRTARR) ; display available rate schedules and charge sets for a bill
  1. N RTN,IBCNT,IBLN,IBLAST S RTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1),BT=$G(BT)
  1. W @IOF,!?5,"Rate Schedules available for an "_$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:"")_$E(RTN,1,27)_" bill"
  1. W !,"------------------------------------------------------------------------------"
  1. ;
  1. S IBCNT=0 F S IBCNT=$O(IBSRTARR(IBCNT)) Q:'IBCNT D
  1. . S IBLN=$G(IBSRTARR(IBCNT)) I +$P(IBLN,U,8)'=+$G(IBLAST) W ! S IBLAST=+$P(IBLN,U,8)
  1. . 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:"")
  1. ;
  1. Q
  1. ;
  1. 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
  1. ; IBSRTARR(CNT) = rs IFN ^ cs IFN ^ rs name ^ cs name ^ Auto Add ^ unassoc event ^ chg type ^ disp set
  1. ; output: IBCHGARR(rate sched IFN,charge set IFN) = 1 - add charges for rs/cs
  1. ;
  1. N IBCHNG,IBSEL,IBI,IBS,IBX,IBLN,DIR,DIRUT,DUOUT,DTOUT,X,Y K IBCHGARR S IBCHNG=0 I '$G(IBIFN) G SELCTQ
  1. I '$O(IBSRTARR(0)) G SELCTQ
  1. ;
  1. 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."
  1. S DIR("?",1)="* - these charges are available to be added to this bill if selected here,"
  1. S DIR("?",2)=" but will not be added when the bills charges are automatically calculated."
  1. S DIR("?",3)="s - the items these charges are associated with must be specifically"
  1. S DIR("?",4)=" selected here, they do not relate to any item on the bill.",DIR("?",5)=" "
  1. S DIR("?",6)="If the bill's charge type is exclusively institutional or professional then"
  1. S DIR("?",7)="only sets of charges with a corresponding type will be added when the bills"
  1. S DIR("?",8)="charges are automatically calculated. On this screen, these charges will be"
  1. S DIR("?",9)="displayed in the first set and used as the selection default.",DIR("?",10)=" "
  1. S DIR("??")="^D HELP^IBCRBE("_IBIFN_")"
  1. S DIR("A")="Select Schedule Charges to ADD to the bill: " I +IBSRTARR S DIR("B")="1-"_+IBSRTARR
  1. ;
  1. ; Clear the manually edited flag. IB*2.0*447 BI
  1. D CMAEDALL^IBCU9(IBIFN)
  1. ;
  1. W !! S DIR(0)="LOA^1:"_+$P(IBSRTARR,U,2) D ^DIR K DIR I 'Y!$D(DIRUT) G SELCTQ
  1. ;
  1. S IBX="" F S IBX=$O(Y(IBX)) Q:IBX="" D
  1. . S IBSEL=Y(IBX) F IBI=1:1:100 S IBS=$P(IBSEL,",",IBI) Q:'IBS D
  1. .. I $D(IBSRTARR(IBS)) S IBCHNG=1,IBLN=IBSRTARR(IBS),IBCHGARR(+IBLN,$P(IBLN,U,2))=1
  1. ;
  1. SELCTQ Q IBCHNG
  1. ;
  1. NONE(IBBN,RT,BT,EVDT) ; write message indicating no rate schedules defined for this bill
  1. N IBRTN S BT=+$G(BT),EVDT=$G(EVDT),IBRTN=$P($G(^DGCR(399.3,+$G(RT),0)),U,1)
  1. W !,?7 I +EVDT W !,?7,"On ",$$DATE^IBCRU1(+EVDT),", there are "
  1. W "No Rate Schedules with charges defined "
  1. I IBRTN'="" W:+EVDT !,?20 W "for ",$S(BT>2:"Outpatient ",BT>0:"Inpatient ",1:""),IBRTN
  1. I $G(IBBN)'="" W !!,?7,"Therefore, charges can not be calculated for this bill (",IBBN,") "
  1. W !
  1. Q
  1. ;
  1. WAIT N DIR,DIRUT,DUOUT,DTOUT,Y,X S DIR("A")="Press RETURN to continue",DIR(0)="E" D ^DIR K DIR
  1. Q
  1. ;
  1. HELP(IBIFN) ; display rs/cs for the bill - used as help text
  1. N IBX I +$G(IBIFN) S IBX=$$DISPLAY(IBIFN)
  1. Q