BEXRHOR.m

BEXRHOR ;IHS/CMI/DAY - BEX - Transactions by Hour Report ; 12 Mar 2012  7:14 PM

 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1

 ;

 ;Prints the Transactions by Hour Report

 ;

 W #

 ;

 W !,"Transactions by Hour Report"

 W !

 W !,"This option prints a list of Transactions that were processed within"

 W !,"a selected date/time range."

 W !

 ;

 K BEXDIV

 S BEXDIV=0

 S BEXSITE=0

 S BEXQUIT=0

 ;

 W !,"Press Enter for ALL Pharmacy Divisions or you may"

 F  D  Q:BEXQUIT=1

 .K DIC,DIR,DIE,DA,DR,DO,DD

 .S DIC(0)="AEQMZ"

 .S DIC("A")="Select a Pharmacy Division: "

 .S DIC=59

 .D ^DIC

 .K DIC,DIE,DIR,DR,DA,DD,DO

 .I X="" S BEXQUIT=1 Q

 .I Y<0 S BEXQUIT=1 Q

 .S BEXSITE=+Y

 .S BEXDIV=BEXDIV+1

 .S Y=$P($G(^PS(59,BEXSITE,"INI")),U)

 .I +Y S BEXDIV(Y)=""

 ;

 W !

 K DIR

 S DIR("B")="N"

 S DIR("A")="Do you want TOTALS only"

 S DIR(0)="Y"

 S DIR("?")="Answering NO will print detailed transactions"

 D ^DIR

 K DIR

 I Y=0 S BEXRTYPE="DETAIL"

 I Y=1 S BEXRTYPE="TOTALS"

 ;

 ;

 ;---------------------------------------------------------------

BEGDATE ;EP - Come here if end date is before begin date

 ;---------------------------------------------------------------

 ;

 W !

 K DIRUT

 K %DT

 S %DT("A")="Select the Beginning Date/Time: "

 S %DT="AET"

 D ^%DT

 K %DT

 I ($D(DIRUT))!(Y<0) W !!,"No Beginning Date selected" G EOJ

 S BEXBEG=Y

 ;

 W !

 K DIRUT

 K %DT

 S %DT("A")="Select the Ending Date/Time: "

 S %DT="AET"

 D ^%DT

 K %DT

 I ($D(DIRUT))!(Y<0) W !!,"No Ending Date selected" G EOJ

 S BEXEND=Y

 I $P(BEXEND,".",2)="" S BEXEND=BEXEND_".240000"

 ;

 I BEXBEG>BEXEND W !!,"Beginning Date is later than the Ending Date.  Try Again!",! G BEGDATE

 ;

 W !

 S XBRP="LIST^BEXRHOR"

 S XBRX="EOJ^BEXRHOR"

 S XBNS="BEX"

 D ^XBDBQUE

 Q

 ;

 ;

 ;---------------------------------------------------------------

EOJ ;EP - End of Job Processing

 ;---------------------------------------------------------------

 ;

 X ^%ZIS("C")

 I BEXEXIT=0 I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR

 K ^BEXTMP($J,"BEXRHOR")

 K BEX

 D EN^XBVK("BEX")

 K DIR,DIE,DIC,DD,DA,DR

 Q

 ;

 ;

 ;---------------------------------------------------------------

LIST ;EP - Entry Point from XBDBQUE

 ;---------------------------------------------------------------

 ;

 ;

 W #

 D HEADER

 ;

 K ^BEXTMP($J,"BEXRHOR")

 K BEXTOT

 S BEXTOT=0

 ;

 S BEXQUIT=0

 S BEXEXIT=0

 ;

 S BEXDATE=$O(^VEXHRX0(19080.1,"C",BEXBEG),-1)

 F  S BEXDATE=$O(^VEXHRX0(19080.1,"C",BEXDATE)) Q:'BEXDATE  D  Q:BEXQUIT=1

 .;

 .I BEXDATE>BEXEND S BEXQUIT=1 Q

 .;

 .;This loops around to some non-numeric dates

 .I +BEXDATE<BEXBEG S BEXQUIT=1 Q

 .;

 .S BEXIEN=0

 .F  S BEXIEN=$O(^VEXHRX0(19080.1,"C",BEXDATE,BEXIEN)) Q:'BEXIEN  D  Q:BEXQUIT=1

 ..;

 ..S BEX(0)=$G(^VEXHRX0(19080.1,BEXIEN,0))

 ..I BEX(0)="" Q

 ..;

 ..D PARSE^BEXRUTL

 ..;

 ..;Screen by Division

 ..I +BEXDIV,BEXDVIEN="" Q

 ..I +BEXDIV,'$D(BEXDIV(BEXDVIEN)) Q

 ..;

 ..D TOTAL

 ;

 ;Now we loop the TMP global to write out detail within each time slot

 I BEXRTYPE="DETAIL" D

 .;

 .S BEXHOR=0

 .F  S BEXHOR=$O(^BEXTMP($J,"BEXRHOR",BEXHOR)) Q:'BEXHOR  D  Q:BEXEXIT=1

 ..;

 ..D SUBHEAD

 ..D DETHEAD

 ..;

 ..S BEXIEN=0

 ..F  S BEXIEN=$O(^BEXTMP($J,"BEXRHOR",BEXHOR,BEXIEN)) Q:'BEXIEN  D  Q:BEXEXIT=1

 ...;

 ...S BEX(0)=$G(^VEXHRX0(19080.1,BEXIEN,0))

 ...I BEX(0)="" Q

 ...;

 ...D PARSE^BEXRUTL

 ...;

 ...D DETAIL

 ;

 I BEXEXIT=1 Q

 ;

 ;Write Totals

 ;

 I BEXTOT>0 D

 .W !

 .W "-------------------------------------------------------------------------------"

 .W !

 .W "TOTALS by Hour"

 .W !

 .W "-------------------------------------------------------------------------------"

 .W !

 ;

 S BEXHOR=""

 F  S BEXHOR=$O(BEXTOT(BEXHOR)) Q:'BEXHOR  D

 .I BEXHOR=1 W "MIDNIGHT TO  1:00 AM"

 .I BEXHOR=2 W " 1:00 AM TO  2:00 AM"

 .I BEXHOR=3 W " 2:00 AM TO  3:00 AM"

 .I BEXHOR=4 W " 3:00 AM TO  4:00 AM"

 .I BEXHOR=5 W " 4:00 AM TO  5:00 AM"

 .I BEXHOR=6 W " 5:00 AM TO  6:00 AM"

 .I BEXHOR=7 W " 6:00 AM TO  7:00 AM"

 .I BEXHOR=8 W " 7:00 AM TO  8:00 AM"

 .I BEXHOR=9 W " 8:00 AM TO  9:00 AM"

 .I BEXHOR=10 W " 9:00 AM TO 10:00 AM"

 .I BEXHOR=11 W "10:00 AM TO 11:00 AM"

 .I BEXHOR=12 W "11:00 AM TO     NOON"

 .I BEXHOR=13 W "NOON     TO  1:00 PM"

 .I BEXHOR=14 W " 1:00 PM TO  2:00 PM"

 .I BEXHOR=15 W " 2:00 PM TO  3:00 PM"

 .I BEXHOR=16 W " 3:00 PM TO  4:00 PM"

 .I BEXHOR=17 W " 4:00 PM TO  5:00 PM"

 .I BEXHOR=18 W " 5:00 PM TO  6:00 PM"

 .I BEXHOR=19 W " 6:00 PM TO  7:00 PM"

 .I BEXHOR=20 W " 7:00 PM TO  8:00 PM"

 .I BEXHOR=21 W " 8:00 PM TO  9:00 PM"

 .I BEXHOR=22 W " 9:00 PM TO 10:00 PM"

 .I BEXHOR=23 W "10:00 PM TO 11:00 PM"

 .I BEXHOR=24 W "11:00 PM TO MIDNIGHT"

 .W !

 .W ?6,"REFILL: "

 .W $J($P(BEXTOT(BEXHOR),U),5)

 .W ?21,"STATUS: "

 .W $J($P(BEXTOT(BEXHOR),U,2),5)

 .W ?36,"PHARM: "

 .W $J($P(BEXTOT(BEXHOR),U,3),5)

 .;Remove LIST since this type does not seem to be used

 .;W ?50,"INFO: "

 .;W $J($P(BEXTOT(BEXHOR),U,4),5)

 .W ?50,"TOTAL: "

 .W $J($P(BEXTOT(BEXHOR),U,5),6)

 .W !

 .;

 .I $Y>(IOSL-4) D

 ..I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:X="^" BEXEXIT=1 K DIR

 ..I BEXEXIT=1 Q

 ..D HEADER

 ;

 W !,"TOTAL Transactions:",?25,$J(BEXTOT,8)

 W !

 ;

 Q

 ;

 ;

 ;---------------------------------------------------------------

HEADER ;EP - Write the Header

 ;---------------------------------------------------------------

 ;

 W #

 W !,"REPORT:      Transactions by Hour Report"

 W " for "

 I BEXSITE>0 W $$GET1^DIQ(59,BEXSITE,.01)

 I BEXSITE=0 W "all Divisions"

 W !,"DATE RUN:    " S Y=DT X ^DD("DD") W Y

 W !,"PARAMETERS:  "

 ;

 W "Between "

 S Y=BEXBEG

 W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 X ^DD("DD")

 W "@"

 I $P(Y,"@",2)]"" W $E($P(Y,"@",2),1,5)

 I $P(Y,"@",2)="" W "00:00"

 ;

 W " and "

 S Y=BEXEND

 W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 X ^DD("DD")

 W "@"

 I $P(Y,"@",2)]"" W $E($P(Y,"@",2),1,5)

 I $P(Y,"@",2)="" W "00:00"

 ;

 W !

 W "-------------------------------------------------------------------------------"

 W !

 ;

 Q

 ;

 ;

 ;-----------------------------------------------------------------

DETHEAD ;EP - Write Detail Header

 ;------------------------------------------------------------------

 ;

 ;Quit if totals only

 I BEXRTYPE="TOTALS" Q

 ;

 W "Date of TX"

 W ?15,"HRNO"

 W ?23,"RX #"

 W ?33,"Date Filled"

 W ?47,"Type"

 W ?57,"Result/[Status]"

 W !

 W "-------------------------------------------------------------------------------"

 W !

 Q

 ;

 ;

 ;-----------------------------------------------------------------

SUBHEAD ;EP - Write Subhead totals  

 ;-----------------------------------------------------------------

 ;

 W !

 W "-------------------------------------------------------------------------------"

 W !

 I BEXHOR=1 W "MIDNIGHT TO  1:00 AM"

 I BEXHOR=2 W " 1:00 AM TO  2:00 AM"

 I BEXHOR=3 W " 2:00 AM TO  3:00 AM"

 I BEXHOR=4 W " 3:00 AM TO  4:00 AM"

 I BEXHOR=5 W " 4:00 AM TO  5:00 AM"

 I BEXHOR=6 W " 5:00 AM TO  6:00 AM"

 I BEXHOR=7 W " 6:00 AM TO  7:00 AM"

 I BEXHOR=8 W " 7:00 AM TO  8:00 AM"

 I BEXHOR=9 W " 8:00 AM TO  9:00 AM"

 I BEXHOR=10 W " 9:00 AM TO 10:00 AM"

 I BEXHOR=11 W "10:00 AM TO 11:00 AM"

 I BEXHOR=12 W "11:00 AM TO     NOON"

 I BEXHOR=13 W "NOON     TO  1:00 PM"

 I BEXHOR=14 W " 1:00 PM TO  2:00 PM"

 I BEXHOR=15 W " 2:00 PM TO  3:00 PM"

 I BEXHOR=16 W " 3:00 PM TO  4:00 PM"

 I BEXHOR=17 W " 4:00 PM TO  5:00 PM"

 I BEXHOR=18 W " 5:00 PM TO  6:00 PM"

 I BEXHOR=19 W " 6:00 PM TO  7:00 PM"

 I BEXHOR=20 W " 7:00 PM TO  8:00 PM"

 I BEXHOR=21 W " 8:00 PM TO  9:00 PM"

 I BEXHOR=22 W " 9:00 PM TO 10:00 PM"

 I BEXHOR=23 W "10:00 PM TO 11:00 PM"

 I BEXHOR=24 W "11:00 PM TO MIDNIGHT"

 W !

 W ?6,"REFILL: "

 W $J($P(BEXTOT(BEXHOR),U),5)

 W ?21,"STATUS: "

 W $J($P(BEXTOT(BEXHOR),U,2),5)

 W ?36,"PHARM: "

 W $J($P(BEXTOT(BEXHOR),U,3),5)

 ;Remove INFO since this type does not seem to be used

 ;W ?50,"INFO: "

 ;W $J($P(BEXTOT(BEXHOR),U,4),5)

 W ?50,"TOTAL: "

 W $J($P(BEXTOT(BEXHOR),U,5),6)

 W !

 W "-------------------------------------------------------------------------------"

 W !

 Q

 ;

 ;

 ;----------------------------------------------------------------

TOTAL ;EP -  Calculate Totals and Suntotals

 ;------------------------------------------------------------------

 ;

 I BEXTIM="" Q

 S BEXHOR=BEXTIM

 ;

 S BEXTOT=BEXTOT+1

 ;

 ;Fix Midnight

 I BEXHOR="24" S BEXHOR="00"

 ;

 ;Fix 10:00

 I BEXHOR=1 S BEXHOR="10"

 ;Initialize Counters for this date

 D

 .I $E(BEXHOR,1,2)="00" S BEXHOR=1 Q

 .I $E(BEXHOR,1,2)="01" S BEXHOR=2 Q

 .I $E(BEXHOR,1,2)="02" S BEXHOR=3 Q

 .I $E(BEXHOR,1,2)="03" S BEXHOR=4 Q

 .I $E(BEXHOR,1,2)="04" S BEXHOR=5 Q

 .I $E(BEXHOR,1,2)="05" S BEXHOR=6 Q

 .I $E(BEXHOR,1,2)="06" S BEXHOR=7 Q

 .I $E(BEXHOR,1,2)="07" S BEXHOR=8 Q

 .I $E(BEXHOR,1,2)="08" S BEXHOR=9 Q

 .I $E(BEXHOR,1,2)="09" S BEXHOR=10 Q

 .I $E(BEXHOR,1,2)="10" S BEXHOR=11 Q

 .I $E(BEXHOR,1,2)="11" S BEXHOR=12 Q

 .I $E(BEXHOR,1,2)="12" S BEXHOR=13 Q

 .I $E(BEXHOR,1,2)="13" S BEXHOR=14 Q

 .I $E(BEXHOR,1,2)="14" S BEXHOR=15 Q

 .I $E(BEXHOR,1,2)="15" S BEXHOR=16 Q

 .I $E(BEXHOR,1,2)="16" S BEXHOR=17 Q

 .I $E(BEXHOR,1,2)="17" S BEXHOR=18 Q

 .I $E(BEXHOR,1,2)="18" S BEXHOR=19 Q

 .I $E(BEXHOR,1,2)="19" S BEXHOR=20 Q

 .I $E(BEXHOR,1,2)="20" S BEXHOR=21 Q

 .I $E(BEXHOR,1,2)="21" S BEXHOR=22 Q

 .I $E(BEXHOR,1,2)="22" S BEXHOR=23 Q

 .I $E(BEXHOR,1,2)="23" S BEXHOR=24 Q

 ;

 I BEXHOR>24 Q

 ;

 I '$D(BEXTOT(BEXHOR)) S BEXTOT(BEXHOR)="0^0^0^0^0"

 ;

 ;Refills

 I BEXTYPE="R" S $P(BEXTOT(BEXHOR),U)=$P(BEXTOT(BEXHOR),U)+1

 ;

 ;Status

 I BEXTYPE="S" S $P(BEXTOT(BEXHOR),U,2)=$P(BEXTOT(BEXHOR),U,2)+1

 ;

 ;Pharmacy

 I BEXTYPE="P" S $P(BEXTOT(BEXHOR),U,3)=$P(BEXTOT(BEXHOR),U,3)+1

 ;

 ;RX Info

 I BEXTYPE="I" S $P(BEXTOT(BEXHOR),U,4)=$P(BEXTOT(BEXHOR),U,4)+1

 ;

 ;Total (for this date)

 S $P(BEXTOT(BEXHOR),U,5)=$P(BEXTOT(BEXHOR),U,5)+1

 ;

 ;

 ;Set Sort Array

 S ^BEXTMP($J,"BEXRHOR",BEXHOR,BEXIEN)=""

 ;

 Q

 ;

 ;

 ;-----------------------------------------------------------------

DETAIL ;EP - Write out detail   

 ;-----------------------------------------------------------------

 ;

 ;-->  Let's write out the record detail

 ;

 ;Write Transaction Date/Time

 S Y=BEXTXDAT

 I Y]"" D

 .W $E(Y,4,5),"/",$E(Y,6,7)

 .X ^DD("DD")

 .W "@"

 .I $P(Y,"@",2)]"" W $E($P(Y,"@",2),1,5)

 .I $P(Y,"@",2)="" W "00:00"

 ;

 ;Write Patient HRNO

 I +BEXDVIEN S Y=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)

 I BEXDVIEN="" S Y=$$HRN^AUPNPAT(BEXPTIEN,DUZ(2))

 I Y>0 W ?13,$J(Y,6)

 ;

 ;Write RX Number

 I +BEXRXNUM W ?22,$J(+BEXRXNUM,8)

 S Y=$E(BEXRXNUM,$L(BEXRXNUM)) I Y?1A W Y

 ;

 ;Write Date Filled

 S Y=BEXRFDAT

 I Y]"" W ?33,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 ;

 ;Write Type

 S Y=""

 I BEXTYPE="R" S Y="REFILL"

 I BEXTYPE="S" S Y="STATUS"

 I BEXTYPE="I" S Y="RX INFO"

 I BEXTYPE="P" S Y="PHARMACY"

 W ?47,Y

 ;

 ;Write Results

 W ?57,$E(BEXRESLT,1,22)

 I BEXTYPE="P",BEXRESLT="" S Y=$$GET1^DIQ(52,BEXRXIEN,100) W ?57,"[",$E(Y,1,20),"]"

 ;

 W !

 ;

 I $Y>(IOSL-4) D

 .I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR

 .I X="^" S BEXEXIT=1 Q

 .D HEADER

 .D DETHEAD

 ;

 Q

 ;

BEXRHOR   ;IHS/CMI/DAY - BEX - Transactions by Hour Report ; 12 Mar 2012  7:14 PM

 +1       ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1

 +2       ;

 +3       ;Prints the Transactions by Hour Report

 +4       ;

 +5        WRITE #

 +6       ;

 +7        WRITE !,"Transactions by Hour Report"

 +8        WRITE !

 +9        WRITE !,"This option prints a list of Transactions that were processed within"

 +10       WRITE !,"a selected date/time range."

 +11       WRITE !

 +12      ;

 +13       KILL BEXDIV

 +14       SET BEXDIV=0

 +15       SET BEXSITE=0

 +16       SET BEXQUIT=0

 +17      ;

 +18       WRITE !,"Press Enter for ALL Pharmacy Divisions or you may"

 +19       FOR 

               Begin DoDot:1

 +20               KILL DIC,DIR,DIE,DA,DR,DO,DD

 +21               SET DIC(0)="AEQMZ"

 +22               SET DIC("A")="Select a Pharmacy Division: "

 +23               SET DIC=59

 +24               DO ^DIC

 +25               KILL DIC,DIE,DIR,DR,DA,DD,DO

 +26               IF X=""

                       SET BEXQUIT=1

                       QUIT 

 +27               IF Y<0

                       SET BEXQUIT=1

                       QUIT 

 +28               SET BEXSITE=+Y

 +29               SET BEXDIV=BEXDIV+1

 +30               SET Y=$PIECE($GET(^PS(59,BEXSITE,"INI")),U)

 +31               IF +Y

                       SET BEXDIV(Y)=""

               End DoDot:1

               IF BEXQUIT=1

                   QUIT 

 +32      ;

 +33       WRITE !

 +34       KILL DIR

 +35       SET DIR("B")="N"

 +36       SET DIR("A")="Do you want TOTALS only"

 +37       SET DIR(0)="Y"

 +38       SET DIR("?")="Answering NO will print detailed transactions"

 +39       DO ^DIR

 +40       KILL DIR

 +41       IF Y=0

               SET BEXRTYPE="DETAIL"

 +42       IF Y=1

               SET BEXRTYPE="TOTALS"

 +43      ;

 +44      ;

 +45      ;---------------------------------------------------------------

BEGDATE   ;EP - Come here if end date is before begin date

 +1       ;---------------------------------------------------------------

 +2       ;

 +3        WRITE !

 +4        KILL DIRUT

 +5        KILL %DT

 +6        SET %DT("A")="Select the Beginning Date/Time: "

 +7        SET %DT="AET"

 +8        DO ^%DT

 +9        KILL %DT

 +10       IF ($DATA(DIRUT))!(Y<0)

               WRITE !!,"No Beginning Date selected"

               GOTO EOJ

 +11       SET BEXBEG=Y

 +12      ;

 +13       WRITE !

 +14       KILL DIRUT

 +15       KILL %DT

 +16       SET %DT("A")="Select the Ending Date/Time: "

 +17       SET %DT="AET"

 +18       DO ^%DT

 +19       KILL %DT

 +20       IF ($DATA(DIRUT))!(Y<0)

               WRITE !!,"No Ending Date selected"

               GOTO EOJ

 +21       SET BEXEND=Y

 +22       IF $PIECE(BEXEND,".",2)=""

               SET BEXEND=BEXEND_".240000"

 +23      ;

 +24       IF BEXBEG>BEXEND

               WRITE !!,"Beginning Date is later than the Ending Date.  Try Again!",!

               GOTO BEGDATE

 +25      ;

 +26       WRITE !

 +27       SET XBRP="LIST^BEXRHOR"

 +28       SET XBRX="EOJ^BEXRHOR"

 +29       SET XBNS="BEX"

 +30       DO ^XBDBQUE

 +31       QUIT 

 +32      ;

 +33      ;

 +34      ;---------------------------------------------------------------

EOJ       ;EP - End of Job Processing

 +1       ;---------------------------------------------------------------

 +2       ;

 +3        XECUTE ^%ZIS("C")

 +4        IF BEXEXIT=0

               IF $EXTRACT(IOST)="C"

                   WRITE !

                   KILL DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

 +5        KILL ^BEXTMP($JOB,"BEXRHOR")

 +6        KILL BEX

 +7        DO EN^XBVK("BEX")

 +8        KILL DIR,DIE,DIC,DD,DA,DR

 +9        QUIT 

 +10      ;

 +11      ;

 +12      ;---------------------------------------------------------------

LIST      ;EP - Entry Point from XBDBQUE

 +1       ;---------------------------------------------------------------

 +2       ;

 +3       ;

 +4        WRITE #

 +5        DO HEADER

 +6       ;

 +7        KILL ^BEXTMP($JOB,"BEXRHOR")

 +8        KILL BEXTOT

 +9        SET BEXTOT=0

 +10      ;

 +11       SET BEXQUIT=0

 +12       SET BEXEXIT=0

 +13      ;

 +14       SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXBEG),-1)

 +15       FOR 

               SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE))

               IF 'BEXDATE

                   QUIT 

               Begin DoDot:1

 +16      ;

 +17               IF BEXDATE>BEXEND

                       SET BEXQUIT=1

                       QUIT 

 +18      ;

 +19      ;This loops around to some non-numeric dates

 +20               IF +BEXDATE<BEXBEG

                       SET BEXQUIT=1

                       QUIT 

 +21      ;

 +22               SET BEXIEN=0

 +23               FOR 

                       SET BEXIEN=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE,BEXIEN))

                       IF 'BEXIEN

                           QUIT 

                       Begin DoDot:2

 +24      ;

 +25                       SET BEX(0)=$GET(^VEXHRX0(19080.1,BEXIEN,0))

 +26                       IF BEX(0)=""

                               QUIT 

 +27      ;

 +28                       DO PARSE^BEXRUTL

 +29      ;

 +30      ;Screen by Division

 +31                       IF +BEXDIV

                               IF BEXDVIEN=""

                                   QUIT 

 +32                       IF +BEXDIV

                               IF '$DATA(BEXDIV(BEXDVIEN))

                                   QUIT 

 +33      ;

 +34                       DO TOTAL

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT 

               End DoDot:1

               IF BEXQUIT=1

                   QUIT 

 +35      ;

 +36      ;Now we loop the TMP global to write out detail within each time slot

 +37       IF BEXRTYPE="DETAIL"

               Begin DoDot:1

 +38      ;

 +39               SET BEXHOR=0

 +40               FOR 

                       SET BEXHOR=$ORDER(^BEXTMP($JOB,"BEXRHOR",BEXHOR))

                       IF 'BEXHOR

                           QUIT 

                       Begin DoDot:2

 +41      ;

 +42                       DO SUBHEAD

 +43                       DO DETHEAD

 +44      ;

 +45                       SET BEXIEN=0

 +46                       FOR 

                               SET BEXIEN=$ORDER(^BEXTMP($JOB,"BEXRHOR",BEXHOR,BEXIEN))

                               IF 'BEXIEN

                                   QUIT 

                               Begin DoDot:3

 +47      ;

 +48                               SET BEX(0)=$GET(^VEXHRX0(19080.1,BEXIEN,0))

 +49                               IF BEX(0)=""

                                       QUIT 

 +50      ;

 +51                               DO PARSE^BEXRUTL

 +52      ;

 +53                               DO DETAIL

                               End DoDot:3

                               IF BEXEXIT=1

                                   QUIT 

                       End DoDot:2

                       IF BEXEXIT=1

                           QUIT 

               End DoDot:1

 +54      ;

 +55       IF BEXEXIT=1

               QUIT 

 +56      ;

 +57      ;Write Totals

 +58      ;

 +59       IF BEXTOT>0

               Begin DoDot:1

 +60               WRITE !

 +61               WRITE "-------------------------------------------------------------------------------"

 +62               WRITE !

 +63               WRITE "TOTALS by Hour"

 +64               WRITE !

 +65               WRITE "-------------------------------------------------------------------------------"

 +66               WRITE !

               End DoDot:1

 +67      ;

 +68       SET BEXHOR=""

 +69       FOR 

               SET BEXHOR=$ORDER(BEXTOT(BEXHOR))

               IF 'BEXHOR

                   QUIT 

               Begin DoDot:1

 +70               IF BEXHOR=1

                       WRITE "MIDNIGHT TO  1:00 AM"

 +71               IF BEXHOR=2

                       WRITE " 1:00 AM TO  2:00 AM"

 +72               IF BEXHOR=3

                       WRITE " 2:00 AM TO  3:00 AM"

 +73               IF BEXHOR=4

                       WRITE " 3:00 AM TO  4:00 AM"

 +74               IF BEXHOR=5

                       WRITE " 4:00 AM TO  5:00 AM"

 +75               IF BEXHOR=6

                       WRITE " 5:00 AM TO  6:00 AM"

 +76               IF BEXHOR=7

                       WRITE " 6:00 AM TO  7:00 AM"

 +77               IF BEXHOR=8

                       WRITE " 7:00 AM TO  8:00 AM"

 +78               IF BEXHOR=9

                       WRITE " 8:00 AM TO  9:00 AM"

 +79               IF BEXHOR=10

                       WRITE " 9:00 AM TO 10:00 AM"

 +80               IF BEXHOR=11

                       WRITE "10:00 AM TO 11:00 AM"

 +81               IF BEXHOR=12

                       WRITE "11:00 AM TO     NOON"

 +82               IF BEXHOR=13

                       WRITE "NOON     TO  1:00 PM"

 +83               IF BEXHOR=14

                       WRITE " 1:00 PM TO  2:00 PM"

 +84               IF BEXHOR=15

                       WRITE " 2:00 PM TO  3:00 PM"

 +85               IF BEXHOR=16

                       WRITE " 3:00 PM TO  4:00 PM"

 +86               IF BEXHOR=17

                       WRITE " 4:00 PM TO  5:00 PM"

 +87               IF BEXHOR=18

                       WRITE " 5:00 PM TO  6:00 PM"

 +88               IF BEXHOR=19

                       WRITE " 6:00 PM TO  7:00 PM"

 +89               IF BEXHOR=20

                       WRITE " 7:00 PM TO  8:00 PM"

 +90               IF BEXHOR=21

                       WRITE " 8:00 PM TO  9:00 PM"

 +91               IF BEXHOR=22

                       WRITE " 9:00 PM TO 10:00 PM"

 +92               IF BEXHOR=23

                       WRITE "10:00 PM TO 11:00 PM"

 +93               IF BEXHOR=24

                       WRITE "11:00 PM TO MIDNIGHT"

 +94               WRITE !

 +95               WRITE ?6,"REFILL: "

 +96               WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U),5)

 +97               WRITE ?21,"STATUS: "

 +98               WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,2),5)

 +99               WRITE ?36,"PHARM: "

 +100              WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,3),5)

 +101     ;Remove LIST since this type does not seem to be used

 +102     ;W ?50,"INFO: "

 +103     ;W $J($P(BEXTOT(BEXHOR),U,4),5)

 +104              WRITE ?50,"TOTAL: "

 +105              WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,5),6)

 +106              WRITE !

 +107     ;

 +108              IF $Y>(IOSL-4)

                       Begin DoDot:2

 +109                      IF $EXTRACT(IOST)="C"

                               KILL DIR

                               SET DIR(0)="E"

                               DO ^DIR

                               IF X="^"

                                   SET BEXEXIT=1

                               KILL DIR

 +110                      IF BEXEXIT=1

                               QUIT 

 +111                      DO HEADER

                       End DoDot:2

               End DoDot:1

 +112     ;

 +113      WRITE !,"TOTAL Transactions:",?25,$JUSTIFY(BEXTOT,8)

 +114      WRITE !

 +115     ;

 +116      QUIT 

 +117     ;

 +118     ;

 +119     ;---------------------------------------------------------------

HEADER    ;EP - Write the Header

 +1       ;---------------------------------------------------------------

 +2       ;

 +3        WRITE #

 +4        WRITE !,"REPORT:      Transactions by Hour Report"

 +5        WRITE " for "

 +6        IF BEXSITE>0

               WRITE $$GET1^DIQ(59,BEXSITE,.01)

 +7        IF BEXSITE=0

               WRITE "all Divisions"

 +8        WRITE !,"DATE RUN:    "

           SET Y=DT

           XECUTE ^DD("DD")

           WRITE Y

 +9        WRITE !,"PARAMETERS:  "

 +10      ;

 +11       WRITE "Between "

 +12       SET Y=BEXBEG

 +13       WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)

 +14       XECUTE ^DD("DD")

 +15       WRITE "@"

 +16       IF $PIECE(Y,"@",2)]""

               WRITE $EXTRACT($PIECE(Y,"@",2),1,5)

 +17       IF $PIECE(Y,"@",2)=""

               WRITE "00:00"

 +18      ;

 +19       WRITE " and "

 +20       SET Y=BEXEND

 +21       WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)

 +22       XECUTE ^DD("DD")

 +23       WRITE "@"

 +24       IF $PIECE(Y,"@",2)]""

               WRITE $EXTRACT($PIECE(Y,"@",2),1,5)

 +25       IF $PIECE(Y,"@",2)=""

               WRITE "00:00"