| [623] | 1 | IBCRBH1 ;ALB/ARH - RATES: BILL HELP DISPLAYS - CHARGES ; 10-OCT-1998
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**106,245**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DISPCHG(IBIFN) ; display a bills items and their charges, display only, does not change the charges on the bill
|
|---|
| 6 | ;
|
|---|
| 7 | D BILL(IBIFN,1),SORTCI(IBIFN),DSPCHRG(1) ; display auto add charges
|
|---|
| 8 | K ^TMP($J,"IBCRCC"),^TMP($J,"IBCRCSX"),^TMP($J,"IBCRCSXR"),^TMP($J,"IBCRCSXN")
|
|---|
| 9 | D BILL(IBIFN,""),SORTCI(IBIFN),DSPCHRG("") ; display non-auto add charges
|
|---|
| 10 | K ^TMP($J,"IBCRCC"),^TMP($J,"IBCRCSX"),^TMP($J,"IBCRCSXR"),^TMP($J,"IBCRCSXN")
|
|---|
| 11 | D NOTES(IBIFN,1)
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | BILL(IBIFN,IBAA,IBRSARR) ; given a bill number calculate charges using schedules that match the auto add flag
|
|---|
| 15 | ; if IBRSARR is defined it will be used to create charges rather than the standard set for the bills Rate Type
|
|---|
| 16 | ; Output: ^TMP($J,"IBCRCC" - same as would be calculated if the charges were being added to bill
|
|---|
| 17 | ;
|
|---|
| 18 | N IB0,IBU,IBBRT,IBBTYPE,IBCTYPE,IBRS,IBCS,IBBEVNT Q:'$G(IBIFN)
|
|---|
| 19 | K ^TMP($J,"IBCRCC")
|
|---|
| 20 | ;
|
|---|
| 21 | S IB0=$G(^DGCR(399,+IBIFN,0)) Q:IB0="" S IBU=$G(^DGCR(399,+IBIFN,"U")) Q:'IBU
|
|---|
| 22 | S IBBRT=+$P(IB0,U,7),IBBTYPE=$S($P(IB0,U,5)<3:1,1:3),IBCTYPE=+$P(IB0,U,27)
|
|---|
| 23 | ;
|
|---|
| 24 | ; get standard set of all rate schedules and charge sets available for the bill
|
|---|
| 25 | I '$D(IBRSARR) D RT^IBCRU3(IBBRT,IBBTYPE,$P(IBU,U,1,2),.IBRSARR,"",IBCTYPE) I 'IBRSARR G END
|
|---|
| 26 | ;
|
|---|
| 27 | ; process charge sets - set all charges for the bill into array
|
|---|
| 28 | S IBRS=0 F S IBRS=$O(IBRSARR(IBRS)) Q:'IBRS D
|
|---|
| 29 | . S IBCS=0 F S IBCS=$O(IBRSARR(IBRS,IBCS)) Q:'IBCS I IBRSARR(IBRS,IBCS)=IBAA D
|
|---|
| 30 | .. S IBBEVNT=+$P($G(^IBE(363.1,+IBCS,0)),U,3) Q:'IBBEVNT S IBBEVNT=$$EMUTL^IBCRU1(IBBEVNT) Q:IBBEVNT=""
|
|---|
| 31 | .. ;
|
|---|
| 32 | .. I IBBEVNT["INPATIENT BEDSECTION STAY" D INPTBS^IBCRBC1(IBIFN,IBRS,IBCS)
|
|---|
| 33 | .. I IBBEVNT["INPATIENT DRG" D INPTDRG^IBCRBC11(IBIFN,IBRS,IBCS)
|
|---|
| 34 | .. I IBBEVNT["OUTPATIENT VISIT DATE" D OPTVST^IBCRBC1(IBIFN,IBRS,IBCS)
|
|---|
| 35 | .. I IBBEVNT["PRESCRIPTION" D RX^IBCRBC1(IBIFN,IBRS,IBCS)
|
|---|
| 36 | .. I IBBEVNT["PROSTHETICS" D PI^IBCRBC1(IBIFN,IBRS,IBCS)
|
|---|
| 37 | .. I IBBEVNT["PROCEDURE" D CPT^IBCRBC1(IBIFN,IBRS,IBCS)
|
|---|
| 38 | ;
|
|---|
| 39 | I '$D(^TMP($J,"IBCRCC")) G END
|
|---|
| 40 | ;
|
|---|
| 41 | D MULTCPT^IBCRBCA1
|
|---|
| 42 | D PSB^IBCRBCA2
|
|---|
| 43 | D MODADJ^IBCRBCA3
|
|---|
| 44 | ;
|
|---|
| 45 | END Q
|
|---|
| 46 | ;
|
|---|
| 47 | ;
|
|---|
| 48 | SORTCI(IBIFN) ; process charge array - create new array in sorted order with items combined, if possible
|
|---|
| 49 | ; if bs, rv cd, charge, cpt, div, item type, item ptr and component all match then charge is combined
|
|---|
| 50 | ; Input: TMP($J,"IBCRCC",X) = ... (from IBCRBC2)
|
|---|
| 51 | ; Output: TMP($J,"IBCRCSX",X) =
|
|---|
| 52 | ; RV CD ^ BS ^ CHG ^ UNITS ^ CPT ^ DIV ^ ITM TYPE ^ ITM PTR ^ CHRG CMPNT ^ CHRG SET ^ EVNT DT ^ ITM NAME
|
|---|
| 53 | ; TMP($J,"IBCRCSX",X,"CC",Y) = charge adjustment messages
|
|---|
| 54 | ; TMP($J,"IBCRCSXR",BS,RV CD,X) = ""
|
|---|
| 55 | ; TMP($J,"IBCRCSXN",DATE,ITEM NAME,X) = ""
|
|---|
| 56 | ;
|
|---|
| 57 | N IBI,IBLN,IBRVCD,IBBS,IBCHG,IBUNITS,IBCPT,IBDV,IBIT,IBIP,IBCMPT,IBCS,IBDT,IBNM,IBTUNITS,IBK,IBJ,IBX,IBY
|
|---|
| 58 | K ^TMP($J,"IBCRCSX"),^TMP($J,"IBCRCSXR"),^TMP($J,"IBCRCSXN")
|
|---|
| 59 | ;
|
|---|
| 60 | S IBI=0 F S IBI=$O(^TMP($J,"IBCRCC",IBI)) Q:'IBI D
|
|---|
| 61 | . ;
|
|---|
| 62 | . S IBLN=^TMP($J,"IBCRCC",IBI)
|
|---|
| 63 | . S IBRVCD=$P(IBLN,U,6),IBBS=$P(IBLN,U,7),IBCHG=+$FN($P(IBLN,U,12),"",2),IBUNITS=$P(IBLN,U,13)
|
|---|
| 64 | . S IBCPT=$P(IBLN,U,14),IBDV=$P(IBLN,U,15),IBIT=$P(IBLN,U,16),IBIP=$P(IBLN,U,17),IBCMPT=$P(IBLN,U,18)
|
|---|
| 65 | . S IBCS=$P(IBLN,U,2),IBDT=$P(IBLN,U,8),IBNM=$$ITMNM($G(IBIFN),IBBS,IBIT,IBIP,IBCPT)
|
|---|
| 66 | . ;
|
|---|
| 67 | . ; combine like charges, unless there are comments
|
|---|
| 68 | . S (IBTUNITS,IBK,IBJ)=0 F S IBJ=$O(^TMP($J,"IBCRCSXR",+IBBS,+IBRVCD,IBJ)) Q:'IBJ S IBK=IBJ D Q:+IBTUNITS
|
|---|
| 69 | .. I $D(^TMP($J,"IBCRCC",IBI,"CC")) Q
|
|---|
| 70 | .. S IBX=$G(^TMP($J,"IBCRCSX",IBJ))
|
|---|
| 71 | .. I IBCHG=$P(IBX,U,3),IBCPT=$P(IBX,U,5),IBDV=$P(IBX,U,6),IBIT=$P(IBX,U,7),IBIP=$P(IBX,U,8),IBCMPT=$P(IBX,U,9) D
|
|---|
| 72 | ... S IBTUNITS=$P(IBX,U,4),IBDT=$P(IBX,U,11)
|
|---|
| 73 | . ;
|
|---|
| 74 | . I 'IBTUNITS S IBK=IBI ; no combination, new line item charge
|
|---|
| 75 | . S IBTUNITS=IBTUNITS+IBUNITS
|
|---|
| 76 | . ;
|
|---|
| 77 | . S ^TMP($J,"IBCRCSXR",+IBBS,+IBRVCD,IBK)=""
|
|---|
| 78 | . S ^TMP($J,"IBCRCSXN",IBDT_" ",IBNM_" ",IBK)=""
|
|---|
| 79 | . S ^TMP($J,"IBCRCSX",IBK)=IBRVCD_U_+IBBS_U_IBCHG_U_IBTUNITS_U_IBCPT_U_IBDV_U_IBIT_U_IBIP_U_IBCMPT_U_IBCS_U_IBDT_U_IBNM
|
|---|
| 80 | . S IBY=0 F S IBY=$O(^TMP($J,"IBCRCC",IBI,"CC",IBY)) Q:'IBY S ^TMP($J,"IBCRCSX",IBK,"CC",IBY)=^TMP($J,"IBCRCC",IBI,"CC",IBY)
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | DSPCHRG(AA) ; display charges
|
|---|
| 84 | ; Input: TMP($J,"IBCRCSx",...) = ... (from SORTCI)
|
|---|
| 85 | ;
|
|---|
| 86 | N IBX,IBI,IBJ,IBK,IBLN,IBCNT,IBRVCD,IBCHG,IBUNITS,IBDV,IBCMPT,IBCS,IBDT,IBNM,IBTOTAL,IBQUIT,IBY S (IBTOTAL,IBQUIT)=0
|
|---|
| 87 | ;
|
|---|
| 88 | D DSPHDR(AA) S IBCNT=4
|
|---|
| 89 | ;
|
|---|
| 90 | S IBI="" F S IBI=$O(^TMP($J,"IBCRCSXN",IBI)) Q:IBI="" D Q:IBQUIT
|
|---|
| 91 | . S IBJ="" F S IBJ=$O(^TMP($J,"IBCRCSXN",IBI,IBJ)) Q:IBJ="" D Q:IBQUIT
|
|---|
| 92 | .. S IBK=0 F S IBK=$O(^TMP($J,"IBCRCSXN",IBI,IBJ,IBK)) Q:'IBK D Q:IBQUIT
|
|---|
| 93 | ... S IBLN=$G(^TMP($J,"IBCRCSX",IBK)) Q:IBLN=""
|
|---|
| 94 | ... ;
|
|---|
| 95 | ... ; add charges to RC multiple
|
|---|
| 96 | ... S IBRVCD=$P(IBLN,U,1),IBCHG=$P(IBLN,U,3),IBUNITS=$P(IBLN,U,4),IBDV=$P(IBLN,U,6)
|
|---|
| 97 | ... S IBCMPT=$P(IBLN,U,9),IBCS=$P(IBLN,U,10),IBDT=$P(IBLN,U,11),IBNM=$P(IBLN,U,12)
|
|---|
| 98 | ... S IBTOTAL=IBTOTAL+(IBCHG*IBUNITS),IBCNT=IBCNT+1
|
|---|
| 99 | ... ;
|
|---|
| 100 | ... S IBX=IBRVCD_U_IBCHG_U_IBUNITS_U_IBCMPT_U_IBCS_U_IBDT_U_IBDV_U_IBNM D DSPLN(IBX)
|
|---|
| 101 | ... ;
|
|---|
| 102 | ... S IBY=0 F S IBY=$O(^TMP($J,"IBCRCSX",IBK,"CC",IBY)) Q:'IBY D
|
|---|
| 103 | .... S IBX=$G(^TMP($J,"IBCRCSX",IBK,"CC",IBY)) I IBX'="" D DISPLNC(IBX) S IBCNT=IBCNT+1
|
|---|
| 104 | ... I $O(^TMP($J,"IBCRCSX",IBK,"CC",0)) D DISPLNC("") S IBCNT=IBCNT+1
|
|---|
| 105 | ... ;
|
|---|
| 106 | ... I IBCNT>20 S IBQUIT=$$PAUSE(IBCNT) Q:IBQUIT D DSPHDR(AA) S IBCNT=4
|
|---|
| 107 | ;
|
|---|
| 108 | I +IBTOTAL W !,?72,"--------",!,?70,$J(IBTOTAL,10,2) S IBCNT=IBCNT+2
|
|---|
| 109 | I 'IBQUIT S IBQUIT=$$PAUSE(IBCNT)
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | DSPHDR(AA) ;
|
|---|
| 113 | W @IOF,!,"Items and Charges on this Bill ("_$S('AA:"NOT ",1:"")_"Auto Add)"
|
|---|
| 114 | W !,"Item",?18,"Date",?28,"Charge Set",?40,"Div",?47,"Type",?52,"RvCd",?57,"Units",?64,"Charge",?75,"Total"
|
|---|
| 115 | W !,"--------------------------------------------------------------------------------"
|
|---|
| 116 | Q
|
|---|
| 117 | ;
|
|---|
| 118 | DSPLN(LN) ;
|
|---|
| 119 | N CS,DIV,CMP,RVCD,ITM,CHG,UNIT S LN=$G(LN)
|
|---|
| 120 | S CS=$P(LN,U,5) I +CS S CS=$P($G(^IBE(363.1,+$P(LN,U,5),0)),U,1)
|
|---|
| 121 | S DIV=$P($G(^DG(40.8,+$P(LN,U,7),0)),U,2)
|
|---|
| 122 | S CMP=$S($P(LN,U,4)=1:"INST",$P(LN,U,4)=2:"PROF",1:"")
|
|---|
| 123 | S RVCD=$P($G(^DGCR(399.2,+LN,0)),U,1)
|
|---|
| 124 | S ITM=$P(LN,U,8),CHG=+$P(LN,U,2),UNIT=$P(LN,U,3)
|
|---|
| 125 | W !,$E(ITM,1,15),?18,$$DATE($P(LN,U,6)),?28,$E(CS,1,7),?40,DIV,?47,CMP,?52,RVCD,?57,$J(UNIT,3),?62,$J(CHG,8,2),?71,$J((UNIT*CHG),9,2)
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | DISPLNC(LN) ; display charge adjustment commenmts
|
|---|
| 129 | W !,?18,$G(LN)
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | DATE(X) ;
|
|---|
| 133 | S X=$G(X),X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|---|
| 134 | Q X
|
|---|
| 135 | ;
|
|---|
| 136 | PAUSE(CNT) ;
|
|---|
| 137 | N IBI F IBI=CNT:1:22 W !
|
|---|
| 138 | N DIR,DUOUT,DTOUT,DIRUT,IBX,X,Y S IBX=0,DIR(0)="E" D ^DIR K DIR I $D(DIRUT) S IBX=1
|
|---|
| 139 | Q IBX
|
|---|
| 140 | ;
|
|---|
| 141 | ITMNM(IBIFN,IBBS,IBIT,IBIP,IBCPT) ; return external form of the item name
|
|---|
| 142 | N ITM S ITM="",IBBS=$G(IBBS),IBIT=$G(IBIT),IBIP=$G(IBIP),IBCPT=$G(IBCPT)
|
|---|
| 143 | I +IBIP S ITM=$$NAME^IBCSC61(IBIT,IBIP)
|
|---|
| 144 | I ITM="",+IBIT=4,+$G(IBIFN) S ITM=$$CPTNM(IBIFN,IBIT,IBIP)
|
|---|
| 145 | I ITM="",+IBCPT S ITM=$P($$CPT^ICPTCOD(+IBCPT,DT),U,2)
|
|---|
| 146 | I ITM="" S ITM=$$EMUTL^IBCRU1(IBBS)
|
|---|
| 147 | Q ITM
|
|---|
| 148 | ;
|
|---|
| 149 | CPTNM(IBIFN,TYPE,ITEM) ; retrurn external name of the charge item if it is a CPT item (type=399,42,.1)
|
|---|
| 150 | N IBX,NAME S IBX=0,NAME=""
|
|---|
| 151 | I +$G(TYPE)=4 S IBX=$G(^DGCR(399,+$G(IBIFN),"CP",+$G(ITEM),0))
|
|---|
| 152 | I +IBX S NAME=$P($$CPT^ICPTCOD(+$P(IBX,U,1),DT),U,2)
|
|---|
| 153 | I +IBX S IBX=$$GETMOD^IBEFUNC(+$G(IBIFN),+$G(ITEM),1) I IBX'="" S NAME=NAME_"-"_IBX
|
|---|
| 154 | Q NAME
|
|---|
| 155 | ;
|
|---|
| 156 | ;
|
|---|
| 157 | ;
|
|---|
| 158 | ;
|
|---|
| 159 | NOTES(IBIFN,PAUSE) ; compile and print charge notes for a bill
|
|---|
| 160 | ;
|
|---|
| 161 | ; Current Checks are for those Treating Specialties that should not be billed using DRG:
|
|---|
| 162 | ; - Inpatient Institutional Reasonable Charges bill contains SNF Treating Specialty
|
|---|
| 163 | ; - Inpatient Institutional Reasonable Charges bill contains Observation Treating Specialty
|
|---|
| 164 | ;
|
|---|
| 165 | I $D(ZTQUEUED)!(+$G(IBAUTO)) Q
|
|---|
| 166 | N IB0,IBU,PTF,BEG,END,IBMVLN,IBENDDT,IBMDRG,IBFND,IBMSG,IBX S IBFND=0 K ^TMP($J,"IBCRC-PTF")
|
|---|
| 167 | S IB0=$G(^DGCR(399,+$G(IBIFN),0)) Q:IB0="" S IBU=$G(^DGCR(399,+$G(IBIFN),"U")) Q:'IBU
|
|---|
| 168 | ;
|
|---|
| 169 | I '$$BILLRATE^IBCRU3($P(IB0,U,7),$P(IB0,U,5),$P(IB0,U,3),"RC") Q ; not Reasonable Charges bill
|
|---|
| 170 | ;
|
|---|
| 171 | ; Outpatient Freestanding bill: display message if this is a non-provider based freestanding bill
|
|---|
| 172 | I $P(IB0,U,5)=3,$P(IB0,U,3)'<$$VERSDT^IBCRU8(2),$P($$RCDV^IBCRU8(+$P(IB0,U,22)),U,3)=3 D
|
|---|
| 173 | . S IBFND=IBFND+1,IBX=">>> Bill Division is Freestanding Non-Provider with Professional Charges only.",IBMSG(IBFND)=IBX
|
|---|
| 174 | ;
|
|---|
| 175 | ; Inpatient Institutional bill: check for treating specialties that should not be billed by DRG
|
|---|
| 176 | I +$P(IB0,U,8),$P(IB0,U,5)<3,$P(IB0,U,27)<2 D
|
|---|
| 177 | . ;
|
|---|
| 178 | . S PTF=+$P(IB0,U,8),BEG=+$P(IBU,U,1)\1,END=$S(+$P(IBU,U,2):+$P(IBU,U,2)\1,1:DT)
|
|---|
| 179 | . ;
|
|---|
| 180 | . D PTF^IBCRBG(PTF)
|
|---|
| 181 | . ;
|
|---|
| 182 | . S IBENDDT=BEG F S IBENDDT=$O(^TMP($J,"IBCRC-PTF",IBENDDT)) Q:'IBENDDT D I IBENDDT>END Q
|
|---|
| 183 | .. I (IBENDDT\1)=BEG,BEG'=END Q
|
|---|
| 184 | .. ;
|
|---|
| 185 | .. S IBMVLN=$G(^TMP($J,"IBCRC-PTF",IBENDDT)),IBMVLN=+$P(IBMVLN,U,6) Q:'IBMVLN
|
|---|
| 186 | .. S IBMDRG=$$NODRG^IBCRBG2(IBMVLN) Q:'IBMDRG
|
|---|
| 187 | .. ;
|
|---|
| 188 | .. S IBFND=IBFND+1,IBX=">>> "_$P(IBMDRG,U,2)_" ("_$$FMTE^XLFDT(IBENDDT,2)_") not billed using DRG"
|
|---|
| 189 | .. S:IBMDRG["Nursing" IBX=IBX_", use SNF." S:IBMDRG["Observa" IBX=IBX_", use Procedures."
|
|---|
| 190 | .. S IBMSG(IBFND)=$G(IBX)
|
|---|
| 191 | ;
|
|---|
| 192 | I +IBFND D I +$G(PAUSE) S IBFND=$$PAUSE(21)
|
|---|
| 193 | . W ! S IBX="" F S IBX=$O(IBMSG(IBX)) Q:IBX="" W !,IBMSG(IBX)
|
|---|
| 194 | K ^TMP($J,"IBCRC-PTF")
|
|---|
| 195 | Q
|
|---|
