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

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1IBOMTP ;ALB/CPM - MEANS TEST BILLING PROFILE ; 10-DEC-91
2 ;;2.0;INTEGRATED BILLING;**153,199**;21-MAR-94
3 ;
4 S:'$D(DTIME) DTIME=300 D HOME^%ZIS
5 ;
6ASK ;
7 ;***
8 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock
9 ;S XRTL=$ZU(0),XRTN="IBOMTP-1" D T0^%ZOSV ;start rt clock
10 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
11 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC G END:Y<1 S IBDFN=+Y
12 ;
13 ; Select Start and End dates.
14BDT S %DT="AEPX",%DT("A")="Start with DATE: ",%DT("B")="OCT 01, 1990" D ^%DT K %DT G END:Y<0 S IBBDT=Y
15EDT S Y=DT D DD^%DT S %DT="EX" W !,"Go to DATE: ",Y,"//" R X:DTIME
16 G END:'$T!(X["^") S:X="" X=DT D ^%DT G EDT:Y<0 S IBEDT=Y
17 I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE.",! G BDT
18 ;
19 ; Select an output device.
20 S %ZIS="QM" D ^%ZIS G:POP END
21 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q") D HOME^%ZIS,END W ! G ASK
22 . S ZTRTN="^IBOMTP1",ZTDESC="MEANS TEST BILLING PROFILE"
23 . S (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDFN"))=""
24 U IO
25 ;***
26 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock
27 D ^IBOMTP1 ; generate report
28 D END W ! G ASK ; re-run for next patient
29 ;
30END ;
31 K %DT,IBDFN,IBBDT,IBEDT,X,Y,ZTSK
32 ;***
33 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP" D T1^%ZOSV ;stop rt clock
34 Q
Note: See TracBrowser for help on using the repository browser.