BEXRDOW ;IHS/CMI/DAY - BEX - Transactions by Day of Week Report ; 12 Mar 2012 7:13 PM
;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1
;
;Prints the Transactions by Day of Week Report
;
W #
;
W !,"Transactions by Day of Week"
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 to select ALL Pharmacy Divisions, or"
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,DA,DD,DO,DR
.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)=""
;
;
;--------------------------------------------------------------------
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^BEXRDOW"
S XBRX="EOJ^BEXRDOW"
S XBNS="BEX"
D ^XBDBQUE
Q
;
;
;---------------------------------------------------------------
EOJ ;EP - End of Job Processing
;---------------------------------------------------------------
;
X ^%ZIS("C")
I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR
K BEX
D EN^XBVK("BEX")
K DIR,DIE,DIC,DD,DA,DR
Q
;
;
;---------------------------------------------------------------
LIST ;EP - Entry Point from XBDBQUE
;---------------------------------------------------------------
;
;
W #
D HEADER
;
K BEXTOT
S BEXTOT=0
K BEXSUM
S BEXSUM="0^0^0^0^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
;
;Write Totals
;
W !
W "------------------------------------------------------------------------------"
W !
W "TOTALS by Day of Week"
W !
W "------------------------------------------------------------------------------"
W !
;
S BEXDOW=0
F S BEXDOW=$O(BEXTOT(BEXDOW)) Q:'BEXDOW D
.I BEXDOW=1 W "SUN"
.I BEXDOW=2 W "MON"
.I BEXDOW=3 W "TUE"
.I BEXDOW=4 W "WED"
.I BEXDOW=5 W "THU"
.I BEXDOW=6 W "FRI"
.I BEXDOW=7 W "SAT"
.W ?8,"REFILL: "
.W $J($P(BEXTOT(BEXDOW),U),5)
.W ?23,"STATUS: "
.W $J($P(BEXTOT(BEXDOW),U,2),5)
.W ?38,"PHARM: "
.W $J($P(BEXTOT(BEXDOW),U,3),5)
.;Remove LIST since this type does not seem to be used
.;W ?52,"INFO: "
.;W $J($P(BEXTOT(BEXDOW),U,4),5)
.W ?52,"TOTAL: "
.W $J($P(BEXTOT(BEXDOW),U,5),6)
.W !
;
W "TOTAL"
W ?14,$J($P(BEXSUM,U),7)
W ?29,$J($P(BEXSUM,U,2),7)
W ?43,$J($P(BEXSUM,U,3),7)
;W ?56,$J($P(BEXSUM,U,4),7)
W ?58,$J($P(BEXSUM,U,5),7)
W !
;
W !,"TOTAL Transactions:",?25,$J(BEXTOT,8)
W !
;
Q
;
;
;---------------------------------------------------------------
;---------------------------------------------------------------
;
W #
W !,"REPORT: Transactions by Day of Week 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
;
;
;-----------------------------------------------------------------
TOTAL ;EP - Add up totals
;-----------------------------------------------------------------
;
S BEXTOT=BEXTOT+1
;
;Initialize Counters for this date
S X=BEXDAT
D DOW^%DTC
I Y=-1 Q
;Add 1 to DOW because Sunday is zero
S BEXDOW=Y+1
I '$D(BEXTOT(BEXDOW)) S BEXTOT(BEXDOW)="0^0^0^0^0"
;
;Refills
I BEXTYPE="R" S $P(BEXTOT(BEXDOW),U)=$P(BEXTOT(BEXDOW),U)+1
I BEXTYPE="R" S $P(BEXSUM,U)=$P(BEXSUM,U)+1
;
;Status
I BEXTYPE="S" S $P(BEXTOT(BEXDOW),U,2)=$P(BEXTOT(BEXDOW),U,2)+1
I BEXTYPE="S" S $P(BEXSUM,U,2)=$P(BEXSUM,U,2)+1
;
;Pharmacy
I BEXTYPE="P" S $P(BEXTOT(BEXDOW),U,3)=$P(BEXTOT(BEXDOW),U,3)+1
I BEXTYPE="P" S $P(BEXSUM,U,3)=$P(BEXSUM,U,3)+1
;
;RX Info
I BEXTYPE="I" S $P(BEXTOT(BEXDOW),U,4)=$P(BEXTOT(BEXDOW),U,4)+1
I BEXTYPE="I" S $P(BEXSUM,U,4)=$P(BEXSUM,U,4)+1
;
;Total (for this date)
S $P(BEXTOT(BEXDOW),U,5)=$P(BEXTOT(BEXDOW),U,5)+1
S $P(BEXSUM,U,5)=$P(BEXSUM,U,5)+1
;
Q
;
BEXRDOW ;IHS/CMI/DAY - BEX - Transactions by Day of Week Report ; 12 Mar 2012 7:13 PM
+1 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1
+2 ;
+3 ;Prints the Transactions by Day of Week Report
+4 ;
+5 WRITE #
+6 ;
+7 WRITE !,"Transactions by Day of Week"
+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 to select ALL Pharmacy Divisions, or"
+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,DA,DD,DO,DR
+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 ;
+34 ;--------------------------------------------------------------------
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^BEXRDOW"
+28 SET XBRX="EOJ^BEXRDOW"
+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 $EXTRACT(IOST)="C"
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 KILL BEX
+6 DO EN^XBVK("BEX")
+7 KILL DIR,DIE,DIC,DD,DA,DR
+8 QUIT
+9 ;
+10 ;
+11 ;---------------------------------------------------------------
LIST ;EP - Entry Point from XBDBQUE
+1 ;---------------------------------------------------------------
+2 ;
+3 ;
+4 WRITE #
+5 DO HEADER
+6 ;
+7 KILL BEXTOT
+8 SET BEXTOT=0
+9 KILL BEXSUM
+10 SET BEXSUM="0^0^0^0^0"
+11 ;
+12 SET BEXQUIT=0
+13 SET BEXEXIT=0
+14 ;
+15 SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXBEG),-1)
+16 FOR
SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE))
IF 'BEXDATE
QUIT
Begin DoDot:1
+17 ;
+18 IF BEXDATE>BEXEND
SET BEXQUIT=1
QUIT
+19 ;
+20 ;This loops around to some non-numeric dates
+21 IF +BEXDATE<BEXBEG
SET BEXQUIT=1
QUIT
+22 ;
+23 SET BEXIEN=0
+24 FOR
SET BEXIEN=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE,BEXIEN))
IF 'BEXIEN
QUIT
Begin DoDot:2
+25 ;
+26 SET BEX(0)=$GET(^VEXHRX0(19080.1,BEXIEN,0))
+27 IF BEX(0)=""
QUIT
+28 ;
+29 DO PARSE^BEXRUTL
+30 ;
+31 ;Screen by division
+32 IF +BEXDIV
IF BEXDVIEN=""
QUIT
+33 IF +BEXDIV
IF '$DATA(BEXDIV(BEXDVIEN))
QUIT
+34 ;
+35 DO TOTAL
End DoDot:2
IF BEXQUIT=1
QUIT
End DoDot:1
IF BEXQUIT=1
QUIT
+36 ;
+37 ;Write Totals
+38 ;
+39 WRITE !
+40 WRITE "------------------------------------------------------------------------------"
+41 WRITE !
+42 WRITE "TOTALS by Day of Week"
+43 WRITE !
+44 WRITE "------------------------------------------------------------------------------"
+45 WRITE !
+46 ;
+47 SET BEXDOW=0
+48 FOR
SET BEXDOW=$ORDER(BEXTOT(BEXDOW))
IF 'BEXDOW
QUIT
Begin DoDot:1
+49 IF BEXDOW=1
WRITE "SUN"
+50 IF BEXDOW=2
WRITE "MON"
+51 IF BEXDOW=3
WRITE "TUE"
+52 IF BEXDOW=4
WRITE "WED"
+53 IF BEXDOW=5
WRITE "THU"
+54 IF BEXDOW=6
WRITE "FRI"
+55 IF BEXDOW=7
WRITE "SAT"
+56 WRITE ?8,"REFILL: "
+57 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDOW),U),5)
+58 WRITE ?23,"STATUS: "
+59 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDOW),U,2),5)
+60 WRITE ?38,"PHARM: "
+61 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDOW),U,3),5)
+62 ;Remove LIST since this type does not seem to be used
+63 ;W ?52,"INFO: "
+64 ;W $J($P(BEXTOT(BEXDOW),U,4),5)
+65 WRITE ?52,"TOTAL: "
+66 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDOW),U,5),6)
+67 WRITE !
End DoDot:1
+68 ;
+69 WRITE "TOTAL"
+70 WRITE ?14,$JUSTIFY($PIECE(BEXSUM,U),7)
+71 WRITE ?29,$JUSTIFY($PIECE(BEXSUM,U,2),7)
+72 WRITE ?43,$JUSTIFY($PIECE(BEXSUM,U,3),7)
+73 ;W ?56,$J($P(BEXSUM,U,4),7)
+74 WRITE ?58,$JUSTIFY($PIECE(BEXSUM,U,5),7)
+75 WRITE !
+76 ;
+77 WRITE !,"TOTAL Transactions:",?25,$JUSTIFY(BEXTOT,8)
+78 WRITE !
+79 ;
+80 QUIT
+81 ;
+82 ;
+83 ;---------------------------------------------------------------
+1 ;---------------------------------------------------------------
+2 ;
+3 WRITE #
+4 WRITE !,"REPORT: Transactions by Day of Week 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 QUIT
+31 ;
+32 ;
+33 ;-----------------------------------------------------------------
TOTAL ;EP - Add up totals
+1 ;-----------------------------------------------------------------
+2 ;
+3 SET BEXTOT=BEXTOT+1
+4 ;
+5 ;Initialize Counters for this date
+6 SET X=BEXDAT
+7 DO DOW^%DTC
+8 IF Y=-1
QUIT
+9 ;Add 1 to DOW because Sunday is zero
+10 SET BEXDOW=Y+1
+11 IF '$DATA(BEXTOT(BEXDOW))
SET BEXTOT(BEXDOW)="0^0^0^0^0"
+12 ;
+13 ;Refills
+14 IF BEXTYPE="R"
SET $PIECE(BEXTOT(BEXDOW),U)=$PIECE(BEXTOT(BEXDOW),U)+1
+15 IF BEXTYPE="R"
SET $PIECE(BEXSUM,U)=$PIECE(BEXSUM,U)+1
+16 ;
+17 ;Status
+18 IF BEXTYPE="S"
SET $PIECE(BEXTOT(BEXDOW),U,2)=$PIECE(BEXTOT(BEXDOW),U,2)+1
+19 IF BEXTYPE="S"
SET $PIECE(BEXSUM,U,2)=$PIECE(BEXSUM,U,2)+1
+20 ;
+21 ;Pharmacy
+22 IF BEXTYPE="P"
SET $PIECE(BEXTOT(BEXDOW),U,3)=$PIECE(BEXTOT(BEXDOW),U,3)+1
+23 IF BEXTYPE="P"
SET $PIECE(BEXSUM,U,3)=$PIECE(BEXSUM,U,3)+1
+24 ;
+25 ;RX Info
+26 IF BEXTYPE="I"
SET $PIECE(BEXTOT(BEXDOW),U,4)=$PIECE(BEXTOT(BEXDOW),U,4)+1
+27 IF BEXTYPE="I"
SET $PIECE(BEXSUM,U,4)=$PIECE(BEXSUM,U,4)+1
+28 ;
+29 ;Total (for this date)
+30 SET $PIECE(BEXTOT(BEXDOW),U,5)=$PIECE(BEXTOT(BEXDOW),U,5)+1
+31 SET $PIECE(BEXSUM,U,5)=$PIECE(BEXSUM,U,5)+1
+32 ;
+33 QUIT
+34 ;
