IBOMTE1 ;ALB/CPM - ESTIMATE MEANS TEST CHARGES (PRINT);17-DEC-91
;;2.0;INTEGRATED BILLING;**153,183,747**;21-MAR-94;Build 2
;
;***
;S XRTL=$ZU(0),XRTN="IBOMTE1-2" D T0^%ZOSV ;start rt clock
; Set up report header.
S IBLINE="",$P(IBLINE,"-",IOM+1)="",(IBPAG,IBQUIT)=0
S DFN=IBDFN,IBPT=$$PT^IBEFUNC(DFN) D HDR
;
; Check to see if patient will be Means Test billable upon admission.
S IBLASTC=$$BILST^DGMTUB(DFN)
I IBBDT>DT&(IBLASTC<DT)!(IBBDT'>DT&(IBLASTC<IBBDT)) D
. I 'IBLASTC W "** Please note that this patient has never been Means Test billable. **",! Q
. W "Please note that this patient ",$S(IBBDT'<DT:"will not be",1:"was not")," MT billable on the admission date."
. W !,"Last date as MT billable: ",$$DAT1^IBOUTL(IBLASTC),!
;
; Check to see if the patient has an active billing clock
; from which to base the charges. Print active clock data.
D CLOCK^IBAUTL3
I IBCLDA D
. S X1=IBBDT,X2=IBCLDT D ^%DTC S IBCLCT=X I X>365 S IBCLDA=0 Q
. W "** THIS PATIENT HAS AN ACTIVE BILLING CLOCK **",!?6,"Clock date: ",$$DAT1^IBOUTL(IBCLDT)," Days of inpatient care within clock: ",$J(+IBCLDAY,2)
. W !?6,"Copayments made for current 90 days of inpatient care: ",$J("$"_$J(IBCLDOL,0,2),7),!
I 'IBCLDA S IBCLDT=IBBDT,(IBCLCT,IBCLDAY,IBCLDOL)=0 D DED^IBAUTL3
I IBGMT S IBMED=$$REDUCE^IBAGMT(IBMED) ;GMT Deductible adjustment
;
; Build necessary processing variables.
S (IBCHGT,IBTOT)=0 K IBA
S X1=IBEDT,X2=IBBDT D ^%DTC S IBLOS=$S(IBEDT=IBBDT&('IBEVDA):1,1:X)
S X=IBBDT D H^%DTC S IBBDH=%H,IBFCTR=IBBDH-1
S X=IBEDT D H^%DTC S IBEDH=%H-1
S IBNH=$P($G(^DGCR(399.1,IBBS,0)),"^")["NURSING"
;
; If continuous patient, just calculate the per diem.
I $$CONT^IBAUTL5(DFN)>IBEDT D COHDR^IBOMTE2,NOCOP W ?3,"(PATIENT IS CONTINUOUS SINCE 7/1/86)",! G PER
;
; Process each day in the admission for co-payments.
D ^IBOMTE2 G:IBQUIT END
;
PER ; Calculate the total per diem charge and print total.
I $Y>(IOSL-7) D PAUSE^IBOUTL G:IBQUIT END D HDR
W !,"PER DIEM CHARGES for ",$S(IBNH:"NURSING HOME",1:"HOSPITAL")," CARE",!,IBLINE
S IBDIEM=$$DIEM^IBAUTL5,X=IBEDT I IBBDT'=IBEDT S %H=IBEDH D YMD^%DTC S IBEDT=X
I IBEDT<IBDIEM D NOPD G TOT
I IBDIEM>IBBDT S X1=IBEDT,(X2,IBBDT)=IBDIEM D ^%DTC S IBLOS=X+1
I IBLOS<1 D NOPD G TOT
S IBRATE=$S(IBNH:5,1:10)
I IBGMT>0 S IBRATE=$$REDUCE^IBAGMT(IBRATE) ;GMT Adjustment of Rate
S IBCHG=IBLOS*IBRATE
S IBTOT=IBTOT+IBCHG
W !,$$DAT1^IBOUTL(IBBDT),?12,$$DAT1^IBOUTL(IBEDT),?26,IBLOS," day",$E("s",IBLOS>1)," @ $",$J(IBRATE,"",2),"/day" W:IBGMT " (GMT rate)"
S X=IBCHG,X2="2$",X3=12 D COMMA^%DTC W ?61,X
;
TOT W !?62,"----------",!
W ?$S(IBGMT>1:23,1:35),"Total Estimated Charges" W:IBGMT>1 " (GMT Rates)" W ":" S X=IBTOT,X2="2$",X3=12 D COMMA^%DTC W ?61,X
D PAUSE^IBOUTL
;
END ; Close device and quit
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE1" D T1^%ZOSV ;stop rt clock
Q:$D(ZTQUEUED)
K %H,IBJ,IBDIEM,IBCLDOL,IBTOT,IBH,IBLOS,IBNH,IBFCTR,IBBDH,IBEDH,IBLASTC,IBMED,IBCLDA,IBCLDT,IBCLCT,IBCLDAY,IBQUIT,IBCHG,IBCHGT,IBPAG,IBLINE,IBMAX,IBDT,IBATYP,IBDESC,IBI,IBCHARG,IBPT,IBGMT,IBRATE
D ^%ZISC Q
;
;
HDR ; Print header.
S IBPAG=IBPAG+1,IBH="Estimated "_$S(IBGMT:"GMT",1:"Means Test")_" Inpatient Charges for "_$P(IBPT,"^")_$S(IBPAG>1:" (Con't.)",1:"") ; IB*2.0*747
I $E(IOST,1,2)["C-"!(IBPAG>1) W @IOF
W !?IOM-$L(IBH)\2,IBH,!!
I IBEVDA W "Please note that this patient is a current inpatient.",!
I IBGMT W "The patient has GMT Copayment Status.",!
W "Charges will be estimated from ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT),"."
I IBBDT=IBEDT,'IBEVDA W " (ONE-DAY ADMISSION)"
W ! Q
;
NOCOP ; Print 'No Copay' message.
W !,"** NO COPAYMENT CHARGES WILL BE APPLIED **",?67,"$0.00",! Q
;
NOPD ; Print 'No Per Diem' message.
W !,"** NO PER DIEM CHARGES WILL BE APPLIED **",?67,"$0.00" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOMTE1 3862 printed Nov 22, 2024@17:35:56 Page 2
IBOMTE1 ;ALB/CPM - ESTIMATE MEANS TEST CHARGES (PRINT);17-DEC-91
+1 ;;2.0;INTEGRATED BILLING;**153,183,747**;21-MAR-94;Build 2
+2 ;
+3 ;***
+4 ;S XRTL=$ZU(0),XRTN="IBOMTE1-2" D T0^%ZOSV ;start rt clock
+5 ; Set up report header.
+6 SET IBLINE=""
SET $PIECE(IBLINE,"-",IOM+1)=""
SET (IBPAG,IBQUIT)=0
+7 SET DFN=IBDFN
SET IBPT=$$PT^IBEFUNC(DFN)
DO HDR
+8 ;
+9 ; Check to see if patient will be Means Test billable upon admission.
+10 SET IBLASTC=$$BILST^DGMTUB(DFN)
+11 IF IBBDT>DT&(IBLASTC<DT)!(IBBDT'>DT&(IBLASTC<IBBDT))
Begin DoDot:1
+12 IF 'IBLASTC
WRITE "** Please note that this patient has never been Means Test billable. **",!
QUIT
+13 WRITE "Please note that this patient ",$SELECT(IBBDT'<DT:"will not be",1:"was not")," MT billable on the admission date."
+14 WRITE !,"Last date as MT billable: ",$$DAT1^IBOUTL(IBLASTC),!
End DoDot:1
+15 ;
+16 ; Check to see if the patient has an active billing clock
+17 ; from which to base the charges. Print active clock data.
+18 DO CLOCK^IBAUTL3
+19 IF IBCLDA
Begin DoDot:1
+20 SET X1=IBBDT
SET X2=IBCLDT
DO ^%DTC
SET IBCLCT=X
IF X>365
SET IBCLDA=0
QUIT
+21 WRITE "** THIS PATIENT HAS AN ACTIVE BILLING CLOCK **",!?6,"Clock date: ",$$DAT1^IBOUTL(IBCLDT)," Days of inpatient care within clock: ",$JUSTIFY(+IBCLDAY,2)
+22 WRITE !?6,"Copayments made for current 90 days of inpatient care: ",$JUSTIFY("$"_$JUSTIFY(IBCLDOL,0,2),7),!
End DoDot:1
+23 IF 'IBCLDA
SET IBCLDT=IBBDT
SET (IBCLCT,IBCLDAY,IBCLDOL)=0
DO DED^IBAUTL3
+24 ;GMT Deductible adjustment
IF IBGMT
SET IBMED=$$REDUCE^IBAGMT(IBMED)
+25 ;
+26 ; Build necessary processing variables.
+27 SET (IBCHGT,IBTOT)=0
KILL IBA
+28 SET X1=IBEDT
SET X2=IBBDT
DO ^%DTC
SET IBLOS=$SELECT(IBEDT=IBBDT&('IBEVDA):1,1:X)
+29 SET X=IBBDT
DO H^%DTC
SET IBBDH=%H
SET IBFCTR=IBBDH-1
+30 SET X=IBEDT
DO H^%DTC
SET IBEDH=%H-1
+31 SET IBNH=$PIECE($GET(^DGCR(399.1,IBBS,0)),"^")["NURSING"
+32 ;
+33 ; If continuous patient, just calculate the per diem.
+34 IF $$CONT^IBAUTL5(DFN)>IBEDT
DO COHDR^IBOMTE2
DO NOCOP
WRITE ?3,"(PATIENT IS CONTINUOUS SINCE 7/1/86)",!
GOTO PER
+35 ;
+36 ; Process each day in the admission for co-payments.
+37 DO ^IBOMTE2
if IBQUIT
GOTO END
+38 ;
PER ; Calculate the total per diem charge and print total.
+1 IF $Y>(IOSL-7)
DO PAUSE^IBOUTL
if IBQUIT
GOTO END
DO HDR
+2 WRITE !,"PER DIEM CHARGES for ",$SELECT(IBNH:"NURSING HOME",1:"HOSPITAL")," CARE",!,IBLINE
+3 SET IBDIEM=$$DIEM^IBAUTL5
SET X=IBEDT
IF IBBDT'=IBEDT
SET %H=IBEDH
DO YMD^%DTC
SET IBEDT=X
+4 IF IBEDT<IBDIEM
DO NOPD
GOTO TOT
+5 IF IBDIEM>IBBDT
SET X1=IBEDT
SET (X2,IBBDT)=IBDIEM
DO ^%DTC
SET IBLOS=X+1
+6 IF IBLOS<1
DO NOPD
GOTO TOT
+7 SET IBRATE=$SELECT(IBNH:5,1:10)
+8 ;GMT Adjustment of Rate
IF IBGMT>0
SET IBRATE=$$REDUCE^IBAGMT(IBRATE)
+9 SET IBCHG=IBLOS*IBRATE
+10 SET IBTOT=IBTOT+IBCHG
+11 WRITE !,$$DAT1^IBOUTL(IBBDT),?12,$$DAT1^IBOUTL(IBEDT),?26,IBLOS," day",$EXTRACT("s",IBLOS>1)," @ $",$JUSTIFY(IBRATE,"",2),"/day"
if IBGMT
WRITE " (GMT rate)"
+12 SET X=IBCHG
SET X2="2$"
SET X3=12
DO COMMA^%DTC
WRITE ?61,X
+13 ;
TOT WRITE !?62,"----------",!
+1 WRITE ?$SELECT(IBGMT>1:23,1:35),"Total Estimated Charges"
if IBGMT>1
WRITE " (GMT Rates)"
WRITE ":"
SET X=IBTOT
SET X2="2$"
SET X3=12
DO COMMA^%DTC
WRITE ?61,X
+2 DO PAUSE^IBOUTL
+3 ;
END ; Close device and quit
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE1" D T1^%ZOSV ;stop rt clock
+3 if $DATA(ZTQUEUED)
QUIT
+4 KILL %H,IBJ,IBDIEM,IBCLDOL,IBTOT,IBH,IBLOS,IBNH,IBFCTR,IBBDH,IBEDH,IBLASTC,IBMED,IBCLDA,IBCLDT,IBCLCT,IBCLDAY,IBQUIT,IBCHG,IBCHGT,IBPAG,IBLINE,IBMAX,IBDT,IBATYP,IBDESC,IBI,IBCHARG,IBPT,IBGMT,IBRATE
+5 DO ^%ZISC
QUIT
+6 ;
+7 ;
HDR ; Print header.
+1 ; IB*2.0*747
SET IBPAG=IBPAG+1
SET IBH="Estimated "_$SELECT(IBGMT:"GMT",1:"Means Test")_" Inpatient Charges for "_$PIECE(IBPT,"^")_$SELECT(IBPAG>1:" (Con't.)",1:"")
+2 IF $EXTRACT(IOST,1,2)["C-"!(IBPAG>1)
WRITE @IOF
+3 WRITE !?IOM-$LENGTH(IBH)\2,IBH,!!
+4 IF IBEVDA
WRITE "Please note that this patient is a current inpatient.",!
+5 IF IBGMT
WRITE "The patient has GMT Copayment Status.",!
+6 WRITE "Charges will be estimated from ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT),"."
+7 IF IBBDT=IBEDT
IF 'IBEVDA
WRITE " (ONE-DAY ADMISSION)"
+8 WRITE !
QUIT
+9 ;
NOCOP ; Print 'No Copay' message.
+1 WRITE !,"** NO COPAYMENT CHARGES WILL BE APPLIED **",?67,"$0.00",!
QUIT
+2 ;
NOPD ; Print 'No Per Diem' message.
+1 WRITE !,"** NO PER DIEM CHARGES WILL BE APPLIED **",?67,"$0.00"
QUIT
