- 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 Mar 13, 2025@21:30:54 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
