source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOMTE.m@ 1769

Last change on this file since 1769 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1IBOMTE ;ALB/CPM-ESTIMATE MEANS TEST CHARGES ;17-DEC-91
2 ;;2.0;INTEGRATED BILLING;**153,183,202**;21-MAR-94
3 ;
4 S:'$D(DTIME) DTIME=300 D HOME^%ZIS
5 ; Check the MAS Service pointer first.
6START ;
7 ;***
8 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
9 ;S XRTL=$ZU(0),XRTN="IBOMTE-1" D T0^%ZOSV ;start rt clock
10 S IBY=1 D SERV^IBAUTL2 I IBY<1 D G END
11 . W !!,"Medical Administration Service is not defined in your IB Site Parameter File."
12 . W !,"Please contact your System Manager, as this impacts on all aspects of",!,"Means Test billing.",!!
13 ;
14 ; Select patient to be admitted; check for previously billed charges.
15 S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
16 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC G END:Y<1 S (DFN,IBDFN)=+Y
17 K DPTNOFZY
18 S IBGMT=$$ISGMTPT^IBAGMT(DFN,DT) ;GMT Copay Status
19 I IBGMT>0 W !!,"The patient has Geographic Means Test Copayment Status.",!
20 ;
21 S IBADMDT=0 D EVFIND^IBAUTL3
22 I IBEVDA D G EDT
23 . W !!,"Please note that this patient was admitted on ",$$DAT1^IBOUTL(IBEVDT)," and Means Test charges"
24 . W !,"have been calculated through ",$$DAT1^IBOUTL(IBEVCAL),".",!
25 . S X1=IBEVCAL,X2=1 D C^%DTC S IBBDT=X
26 ;
27 ; Get proposed Admission and Discharge dates.
28BDT S %DT="AEPX",%DT("A")="Proposed ADMISSION Date: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
29 I IBBDT<DT W !!,"Past admissions cannot be accurately estimated.",! G BDT
30EDT S %DT="EX" R !,"Proposed DISCHARGE Date: ",X:DTIME S:X=" " X=IBBDT
31 G END:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y
32 I Y<IBBDT W *7," ??",!,"The DISCHARGE Date must follow the ADMISSION Date." G EDT:IBEVDA,BDT
33 ;
34 ; Select the anticipated Facility Treating Specialty, if the patient
35 ; is not currently admitted, and check to see if a 'billable'
36 ; bedsection is associated with it.
37 I IBEVDA S VAIP("D")=IBEVCAL+.2359 D IN5^VADPT S Y=+VAIP(8) G BED
38 ;
39 S DIC="^DIC(45.7,",DIC(0)="AEQMN",DIC("A")="Anticipated Facility Treating Specialty: "
40 D ^DIC K DIC G END:Y<1
41BED S IBBS=$$SECT^IBAUTL5(+Y) I 'IBBS D G END
42 . W !!,"A 'billable' bedsection is not associated with this ",$S(IBEVDA:"Admission",1:"Treating Specialty"),"."
43 . W !,"Means Test charges ",$S(IBEVDA:"are not being",1:"would not be")," billed for this admission.",!
44 ;
45 ; Select an output device.
46 S %ZIS="QM" D ^%ZIS G:POP END
47 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
48 U IO
49 ;***
50 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
51 D ^IBOMTE1 ; generate report
52 D END W ! G START ; re-run report
53 ;
54END K %DT,DFN,IBADMDT,IBBS,IBDFN,IBBDT,IBEVDA,IBEVDT,IBEVCAL,IBEDT,IBSERV,IBY,VAIP,VAERR,X,X1,X2,X3,Y,ZTSK,IBRATE,IBGMT
55 ;***
56 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTE" D T1^%ZOSV ;stop rt clock
57 Q
Note: See TracBrowser for help on using the repository browser.