| [613] | 1 | IBOMTC ;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"
|
|---|
| 11 | BDT 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
|
|---|
| 13 | EDT 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 | ;
|
|---|
| 33 | END 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
|
|---|
