- IBOMTE ;ALB/CPM-ESTIMATE MEANS TEST CHARGES ;17-DEC-91
- ;;2.0;INTEGRATED BILLING;**153,183,202**;21-MAR-94
- ;
- S:'$D(DTIME) DTIME=300 D HOME^%ZIS
- ; Check the MAS Service pointer first.
- START ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBOMTE-1" D T0^%ZOSV ;start rt clock
- S IBY=1 D SERV^IBAUTL2 I IBY<1 D G END
- . W !!,"Medical Administration Service is not defined in your IB Site Parameter File."
- . W !,"Please contact your System Manager, as this impacts on all aspects of",!,"Means Test billing.",!!
- ;
- ; Select patient to be admitted; check for previously billed charges.
- S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
- S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC G END:Y<1 S (DFN,IBDFN)=+Y
- K DPTNOFZY
- S IBGMT=$$ISGMTPT^IBAGMT(DFN,DT) ;GMT Copay Status
- I IBGMT>0 W !!,"The patient has Geographic Means Test Copayment Status.",!
- ;
- S IBADMDT=0 D EVFIND^IBAUTL3
- I IBEVDA D G EDT
- . W !!,"Please note that this patient was admitted on ",$$DAT1^IBOUTL(IBEVDT)," and Means Test charges"
- . W !,"have been calculated through ",$$DAT1^IBOUTL(IBEVCAL),".",!
- . S X1=IBEVCAL,X2=1 D C^%DTC S IBBDT=X
- ;
- ; Get proposed Admission and Discharge dates.
- BDT S %DT="AEPX",%DT("A")="Proposed ADMISSION Date: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
- I IBBDT<DT W !!,"Past admissions cannot be accurately estimated.",! G BDT
- EDT S %DT="EX" R !,"Proposed DISCHARGE Date: ",X:DTIME S:X=" " X=IBBDT
- G END:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y
- I Y<IBBDT W *7," ??",!,"The DISCHARGE Date must follow the ADMISSION Date." G EDT:IBEVDA,BDT
- ;
- ; Select the anticipated Facility Treating Specialty, if the patient
- ; is not currently admitted, and check to see if a 'billable'
- ; bedsection is associated with it.
- I IBEVDA S VAIP("D")=IBEVCAL+.2359 D IN5^VADPT S Y=+VAIP(8) G BED
- ;
- S DIC="^DIC(45.7,",DIC(0)="AEQMN",DIC("A")="Anticipated Facility Treating Specialty: "
- D ^DIC K DIC G END:Y<1
- BED S IBBS=$$SECT^IBAUTL5(+Y) I 'IBBS D G END
- . W !!,"A 'billable' bedsection is not associated with this ",$S(IBEVDA:"Admission",1:"Treating Specialty"),"."
- . W !,"Means Test charges ",$S(IBEVDA:"are not being",1:"would not be")," billed for this admission.",!
- ;
- ; Select an output device.
- S %ZIS="QM" D ^%ZIS G:POP END
- I $D(IO("Q")) S ZTRTN="^IBOMTE1",ZTDESC="MEANS TEST INPATIENT BILLING ESTIMATOR",ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q") D HOME^%ZIS,END W ! G START
- U IO
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- D ^IBOMTE1 ; generate report
- D END W ! G START ; re-run report
- ;
- END K %DT,DFN,IBADMDT,IBBS,IBDFN,IBBDT,IBEVDA,IBEVDT,IBEVCAL,IBEDT,IBSERV,IBY,VAIP,VAERR,X,X1,X2,X3,Y,ZTSK,IBRATE,IBGMT
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOMTE 2811 printed Jan 18, 2025@03:27:04 Page 2
- IBOMTE ;ALB/CPM-ESTIMATE MEANS TEST CHARGES ;17-DEC-91
- +1 ;;2.0;INTEGRATED BILLING;**153,183,202**;21-MAR-94
- +2 ;
- +3 if '$DATA(DTIME)
- SET DTIME=300
- DO HOME^%ZIS
- +4 ; Check the MAS Service pointer first.
- START ;
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- +3 ;S XRTL=$ZU(0),XRTN="IBOMTE-1" D T0^%ZOSV ;start rt clock
- +4 SET IBY=1
- DO SERV^IBAUTL2
- IF IBY<1
- Begin DoDot:1
- +5 WRITE !!,"Medical Administration Service is not defined in your IB Site Parameter File."
- +6 WRITE !,"Please contact your System Manager, as this impacts on all aspects of",!,"Means Test billing.",!!
- End DoDot:1
- GOTO END
- +7 ;
- +8 ; Select patient to be admitted; check for previously billed charges.
- +9 ;Suppress PATIENT file fuzzy lookups
- SET DPTNOFZY=1
- +10 SET DIC="^DPT("
- SET DIC(0)="AEQMN"
- DO ^DIC
- KILL DIC
- if Y<1
- GOTO END
- SET (DFN,IBDFN)=+Y
- +11 KILL DPTNOFZY
- +12 ;GMT Copay Status
- SET IBGMT=$$ISGMTPT^IBAGMT(DFN,DT)
- +13 IF IBGMT>0
- WRITE !!,"The patient has Geographic Means Test Copayment Status.",!
- +14 ;
- +15 SET IBADMDT=0
- DO EVFIND^IBAUTL3
- +16 IF IBEVDA
- Begin DoDot:1
- +17 WRITE !!,"Please note that this patient was admitted on ",$$DAT1^IBOUTL(IBEVDT)," and Means Test charges"
- +18 WRITE !,"have been calculated through ",$$DAT1^IBOUTL(IBEVCAL),".",!
- +19 SET X1=IBEVCAL
- SET X2=1
- DO C^%DTC
- SET IBBDT=X
- End DoDot:1
- GOTO EDT
- +20 ;
- +21 ; Get proposed Admission and Discharge dates.
- BDT SET %DT="AEPX"
- SET %DT("A")="Proposed ADMISSION Date: "
- DO ^%DT
- KILL %DT
- if Y<0
- GOTO END
- SET IBBDT=Y
- +1 IF IBBDT<DT
- WRITE !!,"Past admissions cannot be accurately estimated.",!
- GOTO BDT
- EDT SET %DT="EX"
- READ !,"Proposed DISCHARGE Date: ",X:DTIME
- if X=" "
- SET X=IBBDT
- +1 if (X="")!(X["^")
- GOTO END
- DO ^%DT
- if Y<0
- GOTO EDT
- SET IBEDT=Y
- +2 IF Y<IBBDT
- WRITE *7," ??",!,"The DISCHARGE Date must follow the ADMISSION Date."
- if IBEVDA
- GOTO EDT
- GOTO BDT
- +3 ;
- +4 ; Select the anticipated Facility Treating Specialty, if the patient
- +5 ; is not currently admitted, and check to see if a 'billable'
- +6 ; bedsection is associated with it.
- +7 IF IBEVDA
- SET VAIP("D")=IBEVCAL+.2359
- DO IN5^VADPT
- SET Y=+VAIP(8)
- GOTO BED
- +8 ;
- +9 SET DIC="^DIC(45.7,"
- SET DIC(0)="AEQMN"
- SET DIC("A")="Anticipated Facility Treating Specialty: "
- +10 DO ^DIC
- KILL DIC
- if Y<1
- GOTO END
- BED SET IBBS=$$SECT^IBAUTL5(+Y)
- IF 'IBBS
- Begin DoDot:1
- +1 WRITE !!,"A 'billable' bedsection is not associated with this ",$SELECT(IBEVDA:"Admission",1:"Treating Specialty"),"."
- +2 WRITE !,"Means Test charges ",$SELECT(IBEVDA:"are not being",1:"would not be")," billed for this admission.",!
- End DoDot:1
- GOTO END
- +3 ;
- +4 ; Select an output device.
- +5 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO END
- +6 IF $DATA(IO("Q"))
- SET ZTRTN="^IBOMTE1"
- SET ZTDESC="MEANS TEST INPATIENT BILLING ESTIMATOR"
- SET ZTSAVE("IB*")=""
- DO ^%ZTLOAD
- KILL IO("Q")
- DO HOME^%ZIS
- DO END
- WRITE !
- GOTO START
- +7 USE IO
- +8 ;***
- +9 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- +10 ; generate report
- DO ^IBOMTE1
- +11 ; re-run report
- DO END
- WRITE !
- GOTO START
- +12 ;
- END KILL %DT,DFN,IBADMDT,IBBS,IBDFN,IBBDT,IBEVDA,IBEVDT,IBEVCAL,IBEDT,IBSERV,IBY,VAIP,VAERR,X,X1,X2,X3,Y,ZTSK,IBRATE,IBGMT
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
- +3 QUIT