IBOMTC ;ALB/CPM-BILLING ACTIVITY LIST ; 09-JAN-92
;;2.0;INTEGRATED BILLING;**145,176**;21-MAR-94
;; Per VHA Directive 10-93-142, this routine should not be modified
;
;***
;S XRTL=$ZU(0),XRTN="IBOMTC-1" D T0^%ZOSV ;start rt clock
;
S:'$D(DTIME) DTIME=300 D HOME^%ZIS
; Select Start and End dates.
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"
BDT S %DT="AEPX",%DT("A")="Start with DATE: " D ^%DT K %DT G END:Y<0 S IBBDT=Y
I '$G(IBPURPHT) I IBBDT<2901001 W !,"The Start Date cannot be earlier than 10/1/90.",! G BDT
EDT S %DT="EX" R !,"Go to DATE: ",X:DTIME S:X=" " X=IBBDT
G END:(X="")!(X["^") D ^%DT G EDT:Y<0 S IBEDT=Y
I Y<IBBDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
;
S IBDESC="Billing Activity List"
; Select output device.
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) D G END
.S ZTRTN="^IBOMTC1",ZTDESC=IBDESC
.S (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDESC"))=""
.I $G(IBPURPHT) S ZTSAVE("IBPURPHT")=""
.D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
.K ZTSK,ZTDESC,IO("Q") D HOME^%ZIS
;
U IO
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
;
D ^IBOMTC1 ; generate report
;
END K %DT,IBBDT,IBDESC,IBEDT,IBPURPHT,IBX,POP,X,Y
D KVAR^VADPT
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOMTC 1537 printed Nov 22, 2024@17:35:53 Page 2
IBOMTC ;ALB/CPM-BILLING ACTIVITY LIST ; 09-JAN-92
+1 ;;2.0;INTEGRATED BILLING;**145,176**;21-MAR-94
+2 ;; Per VHA Directive 10-93-142, this routine should not be modified
+3 ;
+4 ;***
+5 ;S XRTL=$ZU(0),XRTN="IBOMTC-1" D T0^%ZOSV ;start rt clock
+6 ;
+7 if '$DATA(DTIME)
SET DTIME=300
DO HOME^%ZIS
+8 ; Select Start and End dates.
+9 SET DIR(0)="SM^0:NO;1:YES"
SET DIR("A")="Run this report for Purple Heart Vets only?"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
IF Y
SET IBPURPHT=1
SET IBBDT=2991130
SET %DT("B")="November 30 1999"
BDT SET %DT="AEPX"
SET %DT("A")="Start with DATE: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET IBBDT=Y
+1 IF '$GET(IBPURPHT)
IF IBBDT<2901001
WRITE !,"The Start Date cannot be earlier than 10/1/90.",!
GOTO BDT
EDT SET %DT="EX"
READ !,"Go to DATE: ",X:DTIME
if X=" "
SET X=IBBDT
+1 if (X="")!(X["^")
GOTO END
DO ^%DT
if Y<0
GOTO EDT
SET IBEDT=Y
+2 IF Y<IBBDT
WRITE *7," ??",!,"ENDING DATE must follow BEGINNING DATE."
GOTO BDT
+3 ;
+4 SET IBDESC="Billing Activity List"
+5 ; Select output device.
+6 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO END
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="^IBOMTC1"
SET ZTDESC=IBDESC
+9 SET (ZTSAVE("IBBDT"),ZTSAVE("IBEDT"),ZTSAVE("IBDESC"))=""
+10 IF $GET(IBPURPHT)
SET ZTSAVE("IBPURPHT")=""
+11 DO ^%ZTLOAD
WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
+12 KILL ZTSK,ZTDESC,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO END
+13 ;
+14 USE IO
+15 ;***
+16 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
+17 ;
+18 ; generate report
DO ^IBOMTC1
+19 ;
END KILL %DT,IBBDT,IBDESC,IBEDT,IBPURPHT,IBX,POP,X,Y
+1 DO KVAR^VADPT
+2 ;***
+3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTC" D T1^%ZOSV ;stop rt clock
+4 QUIT
