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
;
;
;---------------------------------------------------------------
;---------------------------------------------------------------
;
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 ;---------------------------------------------------------------
+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"
+26 ;
+27 WRITE !
+28 WRITE "-------------------------------------------------------------------------------"
+29 WRITE !
+30 ;
+31 QUIT
+32 ;
+33 ;
+34 ;-----------------------------------------------------------------
DETHEAD ;EP - Write Detail Header
+1 ;------------------------------------------------------------------
+2 ;
+3 ;Quit if totals only
+4 IF BEXRTYPE="TOTALS"
QUIT
+5 ;
+6 WRITE "Date of TX"
+7 WRITE ?15,"HRNO"
+8 WRITE ?23,"RX #"
+9 WRITE ?33,"Date Filled"
+10 WRITE ?47,"Type"
+11 WRITE ?57,"Result/[Status]"
+12 WRITE !
+13 WRITE "-------------------------------------------------------------------------------"
+14 WRITE !
+15 QUIT
+16 ;
+17 ;
+18 ;-----------------------------------------------------------------
SUBHEAD ;EP - Write Subhead totals
+1 ;-----------------------------------------------------------------
+2 ;
+3 WRITE !
+4 WRITE "-------------------------------------------------------------------------------"
+5 WRITE !
+6 IF BEXHOR=1
WRITE "MIDNIGHT TO 1:00 AM"
+7 IF BEXHOR=2
WRITE " 1:00 AM TO 2:00 AM"
+8 IF BEXHOR=3
WRITE " 2:00 AM TO 3:00 AM"
+9 IF BEXHOR=4
WRITE " 3:00 AM TO 4:00 AM"
+10 IF BEXHOR=5
WRITE " 4:00 AM TO 5:00 AM"
+11 IF BEXHOR=6
WRITE " 5:00 AM TO 6:00 AM"
+12 IF BEXHOR=7
WRITE " 6:00 AM TO 7:00 AM"
+13 IF BEXHOR=8
WRITE " 7:00 AM TO 8:00 AM"
+14 IF BEXHOR=9
WRITE " 8:00 AM TO 9:00 AM"
+15 IF BEXHOR=10
WRITE " 9:00 AM TO 10:00 AM"
+16 IF BEXHOR=11
WRITE "10:00 AM TO 11:00 AM"
+17 IF BEXHOR=12
WRITE "11:00 AM TO NOON"
+18 IF BEXHOR=13
WRITE "NOON TO 1:00 PM"
+19 IF BEXHOR=14
WRITE " 1:00 PM TO 2:00 PM"
+20 IF BEXHOR=15
WRITE " 2:00 PM TO 3:00 PM"
+21 IF BEXHOR=16
WRITE " 3:00 PM TO 4:00 PM"
+22 IF BEXHOR=17
WRITE " 4:00 PM TO 5:00 PM"
+23 IF BEXHOR=18
WRITE " 5:00 PM TO 6:00 PM"
+24 IF BEXHOR=19
WRITE " 6:00 PM TO 7:00 PM"
+25 IF BEXHOR=20
WRITE " 7:00 PM TO 8:00 PM"
+26 IF BEXHOR=21
WRITE " 8:00 PM TO 9:00 PM"
+27 IF BEXHOR=22
WRITE " 9:00 PM TO 10:00 PM"
+28 IF BEXHOR=23
WRITE "10:00 PM TO 11:00 PM"
+29 IF BEXHOR=24
WRITE "11:00 PM TO MIDNIGHT"
+30 WRITE !
+31 WRITE ?6,"REFILL: "
+32 WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U),5)
+33 WRITE ?21,"STATUS: "
+34 WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,2),5)
+35 WRITE ?36,"PHARM: "
+36 WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,3),5)
+37 ;Remove INFO since this type does not seem to be used
+38 ;W ?50,"INFO: "
+39 ;W $J($P(BEXTOT(BEXHOR),U,4),5)
+40 WRITE ?50,"TOTAL: "
+41 WRITE $JUSTIFY($PIECE(BEXTOT(BEXHOR),U,5),6)
+42 WRITE !
+43 WRITE "-------------------------------------------------------------------------------"
+44 WRITE !
+45 QUIT
+46 ;
+47 ;
+48 ;----------------------------------------------------------------
TOTAL ;EP - Calculate Totals and Suntotals
+1 ;------------------------------------------------------------------
+2 ;
+3 IF BEXTIM=""
QUIT
+4 SET BEXHOR=BEXTIM
+5 ;
+6 SET BEXTOT=BEXTOT+1
+7 ;
+8 ;Fix Midnight
+9 IF BEXHOR="24"
SET BEXHOR="00"
+10 ;
+11 ;Fix 10:00
+12 IF BEXHOR=1
SET BEXHOR="10"
+13 ;Initialize Counters for this date
+14 Begin DoDot:1
+15 IF $EXTRACT(BEXHOR,1,2)="00"
SET BEXHOR=1
QUIT
+16 IF $EXTRACT(BEXHOR,1,2)="01"
SET BEXHOR=2
QUIT
+17 IF $EXTRACT(BEXHOR,1,2)="02"
SET BEXHOR=3
QUIT
+18 IF $EXTRACT(BEXHOR,1,2)="03"
SET BEXHOR=4
QUIT
+19 IF $EXTRACT(BEXHOR,1,2)="04"
SET BEXHOR=5
QUIT
+20 IF $EXTRACT(BEXHOR,1,2)="05"
SET BEXHOR=6
QUIT
+21 IF $EXTRACT(BEXHOR,1,2)="06"
SET BEXHOR=7
QUIT
+22 IF $EXTRACT(BEXHOR,1,2)="07"
SET BEXHOR=8
QUIT
+23 IF $EXTRACT(BEXHOR,1,2)="08"
SET BEXHOR=9
QUIT
+24 IF $EXTRACT(BEXHOR,1,2)="09"
SET BEXHOR=10
QUIT
+25 IF $EXTRACT(BEXHOR,1,2)="10"
SET BEXHOR=11
QUIT
+26 IF $EXTRACT(BEXHOR,1,2)="11"
SET BEXHOR=12
QUIT
+27 IF $EXTRACT(BEXHOR,1,2)="12"
SET BEXHOR=13
QUIT
+28 IF $EXTRACT(BEXHOR,1,2)="13"
SET BEXHOR=14
QUIT
+29 IF $EXTRACT(BEXHOR,1,2)="14"
SET BEXHOR=15
QUIT
+30 IF $EXTRACT(BEXHOR,1,2)="15"
SET BEXHOR=16
QUIT
+31 IF $EXTRACT(BEXHOR,1,2)="16"
SET BEXHOR=17
QUIT
+32 IF $EXTRACT(BEXHOR,1,2)="17"
SET BEXHOR=18
QUIT
+33 IF $EXTRACT(BEXHOR,1,2)="18"
SET BEXHOR=19
QUIT
+34 IF $EXTRACT(BEXHOR,1,2)="19"
SET BEXHOR=20
QUIT
+35 IF $EXTRACT(BEXHOR,1,2)="20"
SET BEXHOR=21
QUIT
+36 IF $EXTRACT(BEXHOR,1,2)="21"
SET BEXHOR=22
QUIT
+37 IF $EXTRACT(BEXHOR,1,2)="22"
SET BEXHOR=23
QUIT
+38 IF $EXTRACT(BEXHOR,1,2)="23"
SET BEXHOR=24
QUIT
End DoDot:1
+39 ;
+40 IF BEXHOR>24
QUIT
+41 ;
+42 IF '$DATA(BEXTOT(BEXHOR))
SET BEXTOT(BEXHOR)="0^0^0^0^0"
+43 ;
+44 ;Refills
+45 IF BEXTYPE="R"
SET $PIECE(BEXTOT(BEXHOR),U)=$PIECE(BEXTOT(BEXHOR),U)+1
+46 ;
+47 ;Status
+48 IF BEXTYPE="S"
SET $PIECE(BEXTOT(BEXHOR),U,2)=$PIECE(BEXTOT(BEXHOR),U,2)+1
+49 ;
+50 ;Pharmacy
+51 IF BEXTYPE="P"
SET $PIECE(BEXTOT(BEXHOR),U,3)=$PIECE(BEXTOT(BEXHOR),U,3)+1
+52 ;
+53 ;RX Info
+54 IF BEXTYPE="I"
SET $PIECE(BEXTOT(BEXHOR),U,4)=$PIECE(BEXTOT(BEXHOR),U,4)+1
+55 ;
+56 ;Total (for this date)
+57 SET $PIECE(BEXTOT(BEXHOR),U,5)=$PIECE(BEXTOT(BEXHOR),U,5)+1
+58 ;
+59 ;
+60 ;Set Sort Array
+61 SET ^BEXTMP($JOB,"BEXRHOR",BEXHOR,BEXIEN)=""
+62 ;
+63 QUIT
+64 ;
+65 ;
+66 ;-----------------------------------------------------------------
DETAIL ;EP - Write out detail
+1 ;-----------------------------------------------------------------
+2 ;
+3 ;--> Let's write out the record detail
+4 ;
+5 ;Write Transaction Date/Time
+6 SET Y=BEXTXDAT
+7 IF Y]""
Begin DoDot:1
+8 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7)
+9 XECUTE ^DD("DD")
+10 WRITE "@"
+11 IF $PIECE(Y,"@",2)]""
WRITE $EXTRACT($PIECE(Y,"@",2),1,5)
+12 IF $PIECE(Y,"@",2)=""
WRITE "00:00"
End DoDot:1
+13 ;
+14 ;Write Patient HRNO
+15 IF +BEXDVIEN
SET Y=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)
+16 IF BEXDVIEN=""
SET Y=$$HRN^AUPNPAT(BEXPTIEN,DUZ(2))
+17 IF Y>0
WRITE ?13,$JUSTIFY(Y,6)
+18 ;
+19 ;Write RX Number
+20 IF +BEXRXNUM
WRITE ?22,$JUSTIFY(+BEXRXNUM,8)
+21 SET Y=$EXTRACT(BEXRXNUM,$LENGTH(BEXRXNUM))
IF Y?1A
WRITE Y
+22 ;
+23 ;Write Date Filled
+24 SET Y=BEXRFDAT
+25 IF Y]""
WRITE ?33,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+26 ;
+27 ;Write Type
+28 SET Y=""
+29 IF BEXTYPE="R"
SET Y="REFILL"
+30 IF BEXTYPE="S"
SET Y="STATUS"
+31 IF BEXTYPE="I"
SET Y="RX INFO"
+32 IF BEXTYPE="P"
SET Y="PHARMACY"
+33 WRITE ?47,Y
+34 ;
+35 ;Write Results
+36 WRITE ?57,$EXTRACT(BEXRESLT,1,22)
+37 IF BEXTYPE="P"
IF BEXRESLT=""
SET Y=$$GET1^DIQ(52,BEXRXIEN,100)
WRITE ?57,"[",$EXTRACT(Y,1,20),"]"
+38 ;
+39 WRITE !
+40 ;
+41 IF $Y>(IOSL-4)
Begin DoDot:1
+42 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+43 IF X="^"
SET BEXEXIT=1
QUIT
+44 DO HEADER
+45 DO DETHEAD
End DoDot:1
+46 ;
+47 QUIT
+48 ;
