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

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1IBOMTC ;ALB/CPM-BILLING ACTIVITY LIST ; 09-JAN-92
2 ;;2.0;INTEGRATED BILLING;**145,176**;21-MAR-94
3 ;; Per VHA Directive 10-93-142, this routine should not be modified
4 ;
5 ;***
6 ;S XRTL=$ZU(0),XRTN="IBOMTC-1" D T0^%ZOSV ;start rt clock
7 ;
8 S:'$D(DTIME) DTIME=300 D HOME^%ZIS
9 ; Select Start and End dates.
10 S DIR(0)="SM^0:NO;1:YES",DIR("A")="Run this report for Purple Heart Vets only?",DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT) END I Y S IBPURPHT=1,IBBDT=2991130,%DT("B")="November 30 1999"
11BDT S %DT="AEPX",%DT("A")="Start with DATE: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
12 I '$G(IBPURPHT) I IBBDT<2901001 W !,"The Start Date cannot be earlier than 10/1/90.",! G BDT
13EDT S %DT="EX" R !,"Go to DATE: ",X:DTIME S:X=" " X=IBBDT
14 G END:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y
15 I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
16 ;
17 S IBDESC="Billing Activity List"
18 ; Select output device.
19 S %ZIS="QM" D ^%ZIS G:POP END
20 I $D(IO("Q")) D G END
21 .S ZTRTN="^IBOMTC1",ZTDESC=IBDESC
22 .S (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDESC"))=""
23 .I $G(IBPURPHT) S ZTSAVE("IBPURPHT")=""
24 .D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
25 .K ZTSK,ZTDESC,IO("Q") D HOME^%ZIS
26 ;
27 U IO
28 ;***
29 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
30 ;
31 D ^IBOMTC1 ; generate report
32 ;
33END K %DT,IBBDT,IBDESC,IBEDT,IBPURPHT,IBX,POP,X,Y
34 D KVAR^VADPT
35 ;***
36 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
37 Q
Note: See TracBrowser for help on using the repository browser.