| 1 | IBOMTE1 ;ALB/CPM-ESTIMATE MEANS TEST CHARGES (PRINT);17-DEC-91
 | 
|---|
| 2 |  ;;2.0;INTEGRATED BILLING;**153,183**;21-MAR-94
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;***
 | 
|---|
| 5 |  ;S XRTL=$ZU(0),XRTN="IBOMTE1-2" D T0^%ZOSV ;start rt clock
 | 
|---|
| 6 |  ; Set up report header.
 | 
|---|
| 7 |  S IBLINE="",$P(IBLINE,"-",IOM+1)="",(IBPAG,IBQUIT)=0
 | 
|---|
| 8 |  S DFN=IBDFN,IBPT=$$PT^IBEFUNC(DFN) D HDR
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ; Check to see if patient will be Means Test billable upon admission.
 | 
|---|
| 11 |  S IBLASTC=$$BILST^DGMTUB(DFN)
 | 
|---|
| 12 |  I IBBDT>DT&(IBLASTC<DT)!(IBBDT'>DT&(IBLASTC<IBBDT)) D
 | 
|---|
| 13 |  . I 'IBLASTC W "** Please note that this patient has never been Means Test billable. **",! Q
 | 
|---|
| 14 |  . W "Please note that this patient ",$S(IBBDT'<DT:"will not be",1:"was not")," MT billable on the admission date."
 | 
|---|
| 15 |  . W !,"Last date as MT billable: ",$$DAT1^IBOUTL(IBLASTC),!
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 |  ; Check to see if the patient has an active billing clock
 | 
|---|
| 18 |  ; from which to base the charges.  Print active clock data.
 | 
|---|
| 19 |  D CLOCK^IBAUTL3
 | 
|---|
| 20 |  I IBCLDA D
 | 
|---|
| 21 |  . S X1=IBBDT,X2=IBCLDT D ^%DTC S IBCLCT=X I X>365 S IBCLDA=0 Q
 | 
|---|
| 22 |  . W "** THIS PATIENT HAS AN ACTIVE BILLING CLOCK **",!?6,"Clock date: ",$$DAT1^IBOUTL(IBCLDT),"   Days of inpatient care within clock: ",$J(+IBCLDAY,2)
 | 
|---|
| 23 |  . W !?6,"Copayments made for current 90 days of inpatient care: ",$J("$"_$J(IBCLDOL,0,2),7),!
 | 
|---|
| 24 |  I 'IBCLDA S IBCLDT=IBBDT,(IBCLCT,IBCLDAY,IBCLDOL)=0 D DED^IBAUTL3
 | 
|---|
| 25 |  I IBGMT S IBMED=$$REDUCE^IBAGMT(IBMED) ;GMT Deductible adjustment
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  ; Build necessary processing variables.
 | 
|---|
| 28 |  S (IBCHGT,IBTOT)=0 K IBA
 | 
|---|
| 29 |  S X1=IBEDT,X2=IBBDT D ^%DTC S IBLOS=$S(IBEDT=IBBDT&('IBEVDA):1,1:X)
 | 
|---|
| 30 |  S X=IBBDT D H^%DTC S IBBDH=%H,IBFCTR=IBBDH-1
 | 
|---|
| 31 |  S X=IBEDT D H^%DTC S IBEDH=%H-1
 | 
|---|
| 32 |  S IBNH=$P($G(^DGCR(399.1,IBBS,0)),"^")["NURSING"
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 |  ; If continuous patient, just calculate the per diem.
 | 
|---|
| 35 |  I $$CONT^IBAUTL5(DFN)>IBEDT D COHDR^IBOMTE2,NOCOP W ?3,"(PATIENT IS CONTINUOUS SINCE 7/1/86)",! G PER
 | 
|---|
| 36 |  ;
 | 
|---|
| 37 |  ; Process each day in the admission for co-payments.
 | 
|---|
| 38 |  D ^IBOMTE2 G:IBQUIT END
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 | PER ; Calculate the total per diem charge and print total.
 | 
|---|
| 41 |  I $Y>(IOSL-7) D PAUSE^IBOUTL G:IBQUIT END D HDR
 | 
|---|
| 42 |  W !,"PER DIEM CHARGES for ",$S(IBNH:"NURSING HOME",1:"HOSPITAL")," CARE",!,IBLINE
 | 
|---|
| 43 |  S IBDIEM=$$DIEM^IBAUTL5,X=IBEDT I IBBDT'=IBEDT S %H=IBEDH D YMD^%DTC S IBEDT=X
 | 
|---|
| 44 |  I IBEDT<IBDIEM D NOPD G TOT
 | 
|---|
| 45 |  I IBDIEM>IBBDT S X1=IBEDT,(X2,IBBDT)=IBDIEM D ^%DTC S IBLOS=X+1
 | 
|---|
| 46 |  I IBLOS<1 D NOPD G TOT
 | 
|---|
| 47 |  S IBRATE=$S(IBNH:5,1:10)
 | 
|---|
| 48 |  I IBGMT>0 S IBRATE=$$REDUCE^IBAGMT(IBRATE) ;GMT Adjustment of Rate
 | 
|---|
| 49 |  S IBCHG=IBLOS*IBRATE
 | 
|---|
| 50 |  S IBTOT=IBTOT+IBCHG
 | 
|---|
| 51 |  W !,$$DAT1^IBOUTL(IBBDT),?12,$$DAT1^IBOUTL(IBEDT),?26,IBLOS," day",$E("s",IBLOS>1),"  @ $",$J(IBRATE,"",2),"/day" W:IBGMT " (GMT rate)"
 | 
|---|
| 52 |  S X=IBCHG,X2="2$",X3=12 D COMMA^%DTC W ?61,X
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 | TOT W !?62,"----------",!
 | 
|---|
| 55 |  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
 | 
|---|
| 56 |  D PAUSE^IBOUTL
 | 
|---|
| 57 |  ;
 | 
|---|
| 58 | END ; Close device and quit
 | 
|---|
| 59 |  ;***
 | 
|---|
| 60 |  ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE1" D T1^%ZOSV ;stop rt clock
 | 
|---|
| 61 |  Q:$D(ZTQUEUED)
 | 
|---|
| 62 |  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
 | 
|---|
| 63 |  D ^%ZISC Q
 | 
|---|
| 64 |  ;
 | 
|---|
| 65 |  ;
 | 
|---|
| 66 | HDR ; Print header.
 | 
|---|
| 67 |  S IBPAG=IBPAG+1,IBH="Estimated "_$S(IBGMT:"GMT",1:"Means Test")_" Inpatient Charges for "_$P(IBPT,"^")_"  "_$P(IBPT,"^",3)_$S(IBPAG>1:"  (Con't.)",1:"")
 | 
|---|
| 68 |  I $E(IOST,1,2)["C-"!(IBPAG>1) W @IOF
 | 
|---|
| 69 |  W !?IOM-$L(IBH)\2,IBH,!!
 | 
|---|
| 70 |  I IBEVDA W "Please note that this patient is a current inpatient.",!
 | 
|---|
| 71 |  I IBGMT W "The patient has GMT Copayment Status.",!
 | 
|---|
| 72 |  W "Charges will be estimated from ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT),"."
 | 
|---|
| 73 |  I IBBDT=IBEDT,'IBEVDA W "  (ONE-DAY ADMISSION)"
 | 
|---|
| 74 |  W ! Q
 | 
|---|
| 75 |  ;
 | 
|---|
| 76 | NOCOP ; Print 'No Copay' message.
 | 
|---|
| 77 |  W !,"** NO COPAYMENT CHARGES WILL BE APPLIED **",?67,"$0.00",! Q
 | 
|---|
| 78 |  ;
 | 
|---|
| 79 | NOPD ; Print 'No Per Diem' message.
 | 
|---|
| 80 |  W !,"** NO PER DIEM CHARGES WILL BE APPLIED **",?67,"$0.00" Q
 | 
|---|