IBOMTC.m

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 ---IBOMTC   1537     printed  Apr 09, 2024@21:04:45                                                                                                                                                                                                      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