- 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 Mar 13, 2025@21:30:51 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
