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 Dec 13, 2024@02:25:52 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
