Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOMTE

IBOMTE.m

Go to the documentation of this file.
  1. IBOMTE ;ALB/CPM-ESTIMATE MEANS TEST CHARGES ;17-DEC-91
  1. ;;2.0;INTEGRATED BILLING;**153,183,202**;21-MAR-94
  1. ;
  1. S:'$D(DTIME) DTIME=300 D HOME^%ZIS
  1. ; Check the MAS Service pointer first.
  1. START ;
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
  1. ;S XRTL=$ZU(0),XRTN="IBOMTE-1" D T0^%ZOSV ;start rt clock
  1. S IBY=1 D SERV^IBAUTL2 I IBY<1 D G END
  1. . W !!,"Medical Administration Service is not defined in your IB Site Parameter File."
  1. . W !,"Please contact your System Manager, as this impacts on all aspects of",!,"Means Test billing.",!!
  1. ;
  1. ; Select patient to be admitted; check for previously billed charges.
  1. S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC G END:Y<1 S (DFN,IBDFN)=+Y
  1. K DPTNOFZY
  1. S IBGMT=$$ISGMTPT^IBAGMT(DFN,DT) ;GMT Copay Status
  1. I IBGMT>0 W !!,"The patient has Geographic Means Test Copayment Status.",!
  1. ;
  1. S IBADMDT=0 D EVFIND^IBAUTL3
  1. I IBEVDA D G EDT
  1. . W !!,"Please note that this patient was admitted on ",$$DAT1^IBOUTL(IBEVDT)," and Means Test charges"
  1. . W !,"have been calculated through ",$$DAT1^IBOUTL(IBEVCAL),".",!
  1. . S X1=IBEVCAL,X2=1 D C^%DTC S IBBDT=X
  1. ;
  1. ; Get proposed Admission and Discharge dates.
  1. BDT S %DT="AEPX",%DT("A")="Proposed ADMISSION Date: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
  1. I IBBDT<DT W !!,"Past admissions cannot be accurately estimated.",! G BDT
  1. EDT S %DT="EX" R !,"Proposed DISCHARGE Date: ",X:DTIME S:X=" " X=IBBDT
  1. G END:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y
  1. I Y<IBBDT W *7," ??",!,"The DISCHARGE Date must follow the ADMISSION Date." G EDT:IBEVDA,BDT
  1. ;
  1. ; Select the anticipated Facility Treating Specialty, if the patient
  1. ; is not currently admitted, and check to see if a 'billable'
  1. ; bedsection is associated with it.
  1. I IBEVDA S VAIP("D")=IBEVCAL+.2359 D IN5^VADPT S Y=+VAIP(8) G BED
  1. ;
  1. S DIC="^DIC(45.7,",DIC(0)="AEQMN",DIC("A")="Anticipated Facility Treating Specialty: "
  1. D ^DIC K DIC G END:Y<1
  1. BED S IBBS=$$SECT^IBAUTL5(+Y) I 'IBBS D G END
  1. . W !!,"A 'billable' bedsection is not associated with this ",$S(IBEVDA:"Admission",1:"Treating Specialty"),"."
  1. . W !,"Means Test charges ",$S(IBEVDA:"are not being",1:"would not be")," billed for this admission.",!
  1. ;
  1. ; Select an output device.
  1. S %ZIS="QM" D ^%ZIS G:POP END
  1. 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
  1. U IO
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
  1. D ^IBOMTE1 ; generate report
  1. D END W ! G START ; re-run report
  1. ;
  1. END K %DT,DFN,IBADMDT,IBBS,IBDFN,IBBDT,IBEVDA,IBEVDT,IBEVCAL,IBEDT,IBSERV,IBY,VAIP,VAERR,X,X1,X2,X3,Y,ZTSK,IBRATE,IBGMT
  1. ;***
  1. ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
  1. Q