BEXRDAT ;IHS/CMI/DAY - BEX - Transactions by Date Report ; 12 Mar 2012 7:12 PM
;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1
;
;Prints the Transactions by Date Report
;
W #
;
W !,"Transactions by Date 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 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,DIR,DIE,DA,DD,DR,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_".24"
;
I BEXBEG>BEXEND W !!,"Beginning Date is later than the Ending Date. Try Again!",! G BEGDATE
;
W !
S XBRP="LIST^BEXRDAT"
S XBRX="EOJ^BEXRDAT"
S XBNS="BEX"
D ^XBDBQUE
Q
;
;
;---------------------------------------------------------------
EOJ ;EP - End of Job Processing
;---------------------------------------------------------------
;
X ^%ZIS("C")
I $E(IOST)="C",$G(BEXEXIT)'=1 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^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 Q:BEXEXIT=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 Q:BEXEXIT=1
..;
..S BEX(0)=$G(^VEXHRX0(19080.1,BEXIEN,0))
..I BEX(0)="" Q
..;
..D PARSE^BEXRUTL
..;
..;Screen by Division
..I +BEXDIV,$G(BEXDVIEN)="" Q
..I +BEXDIV,'$D(BEXDIV(BEXDVIEN)) Q
..;
..D DETAIL
;
;Write Totals
;
I BEXEXIT=1 Q
;
I BEXTOT>0 D
.W !
.W "-------------------------------------------------------------------------------"
.W !
.W "TRANSACTION TOTALS by Date"
.W !
.W "-------------------------------------------------------------------------------"
.W !
;
S BEXDAT=""
F S BEXDAT=$O(BEXTOT(BEXDAT)) Q:'BEXDAT D Q:BEXEXIT=1
.S X=BEXDAT
.W $E(X,4,5),"/",$E(X,6,7)
.W ?8,"REFILL: "
.W $J($P(BEXTOT(BEXDAT),U),5)
.W ?23,"STATUS: "
.W $J($P(BEXTOT(BEXDAT),U,2),5)
.W ?38,"PHARM: "
.W $J($P(BEXTOT(BEXDAT),U,3),5)
.;W ?52,"INFO: "
.;W $J($P(BEXTOT(BEXDAT),U,4),5)
.W ?52,"TOTAL: "
.W $J($P(BEXTOT(BEXDAT),U,5),5)
.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
..S BEXRTYPE="TOTALS"
..D HEADER
..W !
..W "-------------------------------------------------------------------------------"
..W !
..W "TRANSACTION TOTALS by Date"
..W !
..W "-------------------------------------------------------------------------------"
..W !
;
I BEXTOT>0 D
.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 ?57,$J($P(BEXSUM,U,5),7)
.W !
;
I BEXEXIT=1 Q
;
I BEXTOT>0 D
.;
.W !
.W "-------------------------------------------------------------------------------"
.W !
.W "REFILL TOTALS by Originating Transaction Date"
.W !
.W "-------------------------------------------------------------------------------"
.W !
;
S BEXDAT=""
F S BEXDAT=$O(BEXTOT(BEXDAT)) Q:'BEXDAT D Q:BEXEXIT=1
.S X=BEXDAT
.W $E(X,4,5),"/",$E(X,6,7)
.W ?12,"MAIL:"
.W $J($P(BEXTOT(BEXDAT),U,6),7)
.W ?30,"WINDOW:"
.W $J($P(BEXTOT(BEXDAT),U,7),7)
.W ?50,"TOTAL: "
.W $J(($P(BEXTOT(BEXDAT),U,6)+$P(BEXTOT(BEXDAT),U,7)),7)
.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
..S BEXRTYPE="TOTALS"
..D HEADER
..W !
..W "-------------------------------------------------------------------------------"
..W !
..W "REFILL TOTALS by Originating Transaction Date"
..W !
..W "-------------------------------------------------------------------------------"
..W !
;
I $P(BEXSUM,U,7)>0 D
.W "TOTAL"
.W ?17,$J($P(BEXSUM,U,6),7)
.W ?37,$J($P(BEXSUM,U,7),7)
.W ?57,$J(($P(BEXSUM,U,6)+$P(BEXSUM,U,7)),7)
.W !
;
W !,"TOTAL Transactions:",?25,$J(BEXTOT,8)
W !
;
Q
;
;
;---------------------------------------------------------------
;---------------------------------------------------------------
;
W #
W !,"REPORT: Transactions by Date 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 !
;
;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
;
;
;-----------------------------------------------------------------
DETAIL ;EP - Write Detail for each Record and Add up totals
;-----------------------------------------------------------------
;
S BEXTOT=BEXTOT+1
;
;Initialize Counters for this date
I '$D(BEXTOT(BEXDAT)) S BEXTOT(BEXDAT)="0^0^0^0^0^0^0"
;
;Add to Counters by Type
;
;Refills
I BEXTYPE="R" S $P(BEXTOT(BEXDAT),U)=$P(BEXTOT(BEXDAT),U)+1
I BEXTYPE="R" S $P(BEXSUM,U)=$P(BEXSUM,U)+1
;
;Status
I BEXTYPE="S" S $P(BEXTOT(BEXDAT),U,2)=$P(BEXTOT(BEXDAT),U,2)+1
I BEXTYPE="S" S $P(BEXSUM,U,2)=$P(BEXSUM,U,2)+1
;
;Pharmacy
I BEXTYPE="P" S $P(BEXTOT(BEXDAT),U,3)=$P(BEXTOT(BEXDAT),U,3)+1
I BEXTYPE="P" S $P(BEXSUM,U,3)=$P(BEXSUM,U,3)+1
;
;RX Info
I BEXTYPE="I" S $P(BEXTOT(BEXDAT),U,4)=$P(BEXTOT(BEXDAT),U,4)+1
I BEXTYPE="I" S $P(BEXSUM,U,4)=$P(BEXSUM,U,4)+1
;
;Total (for this date)
S $P(BEXTOT(BEXDAT),U,5)=$P(BEXTOT(BEXDAT),U,5)+1
S $P(BEXSUM,U,5)=$P(BEXSUM,U,5)+1
;
;Calculate Mail/Windows
I $G(BEXRFDAT)]"",$G(BEXMLWIN)="M" S $P(BEXTOT(BEXDAT),U,6)=$P(BEXTOT(BEXDAT),U,6)+1 S $P(BEXSUM,U,6)=$P(BEXSUM,U,6)+1
I $G(BEXRFDAT)]"",$G(BEXMLWIN)="W" S $P(BEXTOT(BEXDAT),U,7)=$P(BEXTOT(BEXDAT),U,7)+1 S $P(BEXSUM,U,7)=$P(BEXSUM,U,7)+1
;
;Quit if totals only
I BEXRTYPE="TOTALS" Q
;
;--> 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
;Align numbers, then add any alpha to the end
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)
;
;Mail/Window Code
I $G(BEXRDDAT)]"",$G(BEXMLWIN)="M" W " (M)"
I $G(BEXRFDAT)]"",$G(BEXMLWIN)="W" W " (W)"
;
;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
;
Q
;
BEXRDAT ;IHS/CMI/DAY - BEX - Transactions by Date Report ; 12 Mar 2012 7:12 PM
+1 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1
+2 ;
+3 ;Prints the Transactions by Date Report
+4 ;
+5 WRITE #
+6 ;
+7 WRITE !,"Transactions by Date 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 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,DIR,DIE,DA,DD,DR,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_".24"
+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^BEXRDAT"
+28 SET XBRX="EOJ^BEXRDAT"
+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"
IF $GET(BEXEXIT)'=1
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^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 $GET(BEXDVIEN)=""
QUIT
+33 IF +BEXDIV
IF '$DATA(BEXDIV(BEXDVIEN))
QUIT
+34 ;
+35 DO DETAIL
End DoDot:2
IF BEXQUIT=1
QUIT
IF BEXEXIT=1
QUIT
End DoDot:1
IF BEXQUIT=1
QUIT
IF BEXEXIT=1
QUIT
+36 ;
+37 ;Write Totals
+38 ;
+39 IF BEXEXIT=1
QUIT
+40 ;
+41 IF BEXTOT>0
Begin DoDot:1
+42 WRITE !
+43 WRITE "-------------------------------------------------------------------------------"
+44 WRITE !
+45 WRITE "TRANSACTION TOTALS by Date"
+46 WRITE !
+47 WRITE "-------------------------------------------------------------------------------"
+48 WRITE !
End DoDot:1
+49 ;
+50 SET BEXDAT=""
+51 FOR
SET BEXDAT=$ORDER(BEXTOT(BEXDAT))
IF 'BEXDAT
QUIT
Begin DoDot:1
+52 SET X=BEXDAT
+53 WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7)
+54 WRITE ?8,"REFILL: "
+55 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U),5)
+56 WRITE ?23,"STATUS: "
+57 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,2),5)
+58 WRITE ?38,"PHARM: "
+59 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,3),5)
+60 ;W ?52,"INFO: "
+61 ;W $J($P(BEXTOT(BEXDAT),U,4),5)
+62 WRITE ?52,"TOTAL: "
+63 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,5),5)
+64 WRITE !
+65 ;
+66 IF $Y>(IOSL-4)
Begin DoDot:2
+67 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF X="^"
SET BEXEXIT=1
KILL DIR
+68 IF BEXEXIT=1
QUIT
+69 SET BEXRTYPE="TOTALS"
+70 DO HEADER
+71 WRITE !
+72 WRITE "-------------------------------------------------------------------------------"
+73 WRITE !
+74 WRITE "TRANSACTION TOTALS by Date"
+75 WRITE !
+76 WRITE "-------------------------------------------------------------------------------"
+77 WRITE !
End DoDot:2
End DoDot:1
IF BEXEXIT=1
QUIT
+78 ;
+79 IF BEXTOT>0
Begin DoDot:1
+80 WRITE "TOTAL"
+81 WRITE ?14,$JUSTIFY($PIECE(BEXSUM,U),7)
+82 WRITE ?29,$JUSTIFY($PIECE(BEXSUM,U,2),7)
+83 WRITE ?43,$JUSTIFY($PIECE(BEXSUM,U,3),7)
+84 ;W ?56,$J($P(BEXSUM,U,4),7)
+85 WRITE ?57,$JUSTIFY($PIECE(BEXSUM,U,5),7)
+86 WRITE !
End DoDot:1
+87 ;
+88 IF BEXEXIT=1
QUIT
+89 ;
+90 IF BEXTOT>0
Begin DoDot:1
+91 ;
+92 WRITE !
+93 WRITE "-------------------------------------------------------------------------------"
+94 WRITE !
+95 WRITE "REFILL TOTALS by Originating Transaction Date"
+96 WRITE !
+97 WRITE "-------------------------------------------------------------------------------"
+98 WRITE !
End DoDot:1
+99 ;
+100 SET BEXDAT=""
+101 FOR
SET BEXDAT=$ORDER(BEXTOT(BEXDAT))
IF 'BEXDAT
QUIT
Begin DoDot:1
+102 SET X=BEXDAT
+103 WRITE $EXTRACT(X,4,5),"/",$EXTRACT(X,6,7)
+104 WRITE ?12,"MAIL:"
+105 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,6),7)
+106 WRITE ?30,"WINDOW:"
+107 WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,7),7)
+108 WRITE ?50,"TOTAL: "
+109 WRITE $JUSTIFY(($PIECE(BEXTOT(BEXDAT),U,6)+$PIECE(BEXTOT(BEXDAT),U,7)),7)
+110 WRITE !
+111 ;
+112 IF $Y>(IOSL-4)
Begin DoDot:2
+113 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF X="^"
SET BEXEXIT=1
KILL DIR
+114 IF BEXEXIT=1
QUIT
+115 SET BEXRTYPE="TOTALS"
+116 DO HEADER
+117 WRITE !
+118 WRITE "-------------------------------------------------------------------------------"
+119 WRITE !
+120 WRITE "REFILL TOTALS by Originating Transaction Date"
+121 WRITE !
+122 WRITE "-------------------------------------------------------------------------------"
+123 WRITE !
End DoDot:2
End DoDot:1
IF BEXEXIT=1
QUIT
+124 ;
+125 IF $PIECE(BEXSUM,U,7)>0
Begin DoDot:1
+126 WRITE "TOTAL"
+127 WRITE ?17,$JUSTIFY($PIECE(BEXSUM,U,6),7)
+128 WRITE ?37,$JUSTIFY($PIECE(BEXSUM,U,7),7)
+129 WRITE ?57,$JUSTIFY(($PIECE(BEXSUM,U,6)+$PIECE(BEXSUM,U,7)),7)
+130 WRITE !
End DoDot:1
+131 ;
+132 WRITE !,"TOTAL Transactions:",?25,$JUSTIFY(BEXTOT,8)
+133 WRITE !
+134 ;
+135 QUIT
+136 ;
+137 ;
+138 ;---------------------------------------------------------------
+1 ;---------------------------------------------------------------
+2 ;
+3 WRITE #
+4 WRITE !,"REPORT: Transactions by Date 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 if totals only
+32 IF BEXRTYPE="TOTALS"
QUIT
+33 ;
+34 WRITE "Date of TX"
+35 WRITE ?15,"HRNO"
+36 WRITE ?23,"RX #"
+37 WRITE ?33,"Date Filled"
+38 WRITE ?47,"Type"
+39 WRITE ?57,"Result/[Status]"
+40 WRITE !
+41 WRITE "-------------------------------------------------------------------------------"
+42 WRITE !
+43 QUIT
+44 ;
+45 ;
+46 ;-----------------------------------------------------------------
DETAIL ;EP - Write Detail for each Record and Add up totals
+1 ;-----------------------------------------------------------------
+2 ;
+3 SET BEXTOT=BEXTOT+1
+4 ;
+5 ;Initialize Counters for this date
+6 IF '$DATA(BEXTOT(BEXDAT))
SET BEXTOT(BEXDAT)="0^0^0^0^0^0^0"
+7 ;
+8 ;Add to Counters by Type
+9 ;
+10 ;Refills
+11 IF BEXTYPE="R"
SET $PIECE(BEXTOT(BEXDAT),U)=$PIECE(BEXTOT(BEXDAT),U)+1
+12 IF BEXTYPE="R"
SET $PIECE(BEXSUM,U)=$PIECE(BEXSUM,U)+1
+13 ;
+14 ;Status
+15 IF BEXTYPE="S"
SET $PIECE(BEXTOT(BEXDAT),U,2)=$PIECE(BEXTOT(BEXDAT),U,2)+1
+16 IF BEXTYPE="S"
SET $PIECE(BEXSUM,U,2)=$PIECE(BEXSUM,U,2)+1
+17 ;
+18 ;Pharmacy
+19 IF BEXTYPE="P"
SET $PIECE(BEXTOT(BEXDAT),U,3)=$PIECE(BEXTOT(BEXDAT),U,3)+1
+20 IF BEXTYPE="P"
SET $PIECE(BEXSUM,U,3)=$PIECE(BEXSUM,U,3)+1
+21 ;
+22 ;RX Info
+23 IF BEXTYPE="I"
SET $PIECE(BEXTOT(BEXDAT),U,4)=$PIECE(BEXTOT(BEXDAT),U,4)+1
+24 IF BEXTYPE="I"
SET $PIECE(BEXSUM,U,4)=$PIECE(BEXSUM,U,4)+1
+25 ;
+26 ;Total (for this date)
+27 SET $PIECE(BEXTOT(BEXDAT),U,5)=$PIECE(BEXTOT(BEXDAT),U,5)+1
+28 SET $PIECE(BEXSUM,U,5)=$PIECE(BEXSUM,U,5)+1
+29 ;
+30 ;Calculate Mail/Windows
+31 IF $GET(BEXRFDAT)]""
IF $GET(BEXMLWIN)="M"
SET $PIECE(BEXTOT(BEXDAT),U,6)=$PIECE(BEXTOT(BEXDAT),U,6)+1
SET $PIECE(BEXSUM,U,6)=$PIECE(BEXSUM,U,6)+1
+32 IF $GET(BEXRFDAT)]""
IF $GET(BEXMLWIN)="W"
SET $PIECE(BEXTOT(BEXDAT),U,7)=$PIECE(BEXTOT(BEXDAT),U,7)+1
SET $PIECE(BEXSUM,U,7)=$PIECE(BEXSUM,U,7)+1
+33 ;
+34 ;Quit if totals only
+35 IF BEXRTYPE="TOTALS"
QUIT
+36 ;
+37 ;--> Let's write out the record detail
+38 ;
+39 ;Write Transaction Date/Time
+40 SET Y=BEXTXDAT
+41 IF Y]""
Begin DoDot:1
+42 WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7)
+43 XECUTE ^DD("DD")
+44 WRITE "@"
+45 IF $PIECE(Y,"@",2)]""
WRITE $EXTRACT($PIECE(Y,"@",2),1,5)
+46 IF $PIECE(Y,"@",2)=""
WRITE "00:00"
End DoDot:1
+47 ;
+48 ;Write Patient HRNO
+49 IF +BEXDVIEN
SET Y=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)
+50 IF BEXDVIEN=""
SET Y=$$HRN^AUPNPAT(BEXPTIEN,DUZ(2))
+51 IF Y>0
WRITE ?13,$JUSTIFY(Y,6)
+52 ;
+53 ;Write RX Number
+54 ;Align numbers, then add any alpha to the end
+55 IF BEXRXNUM
WRITE ?22,$JUSTIFY(+BEXRXNUM,8)
+56 SET Y=$EXTRACT(BEXRXNUM,$LENGTH(BEXRXNUM))
IF Y?1A
WRITE Y
+57 ;
+58 ;Write Date Filled
+59 SET Y=BEXRFDAT
+60 IF Y]""
WRITE ?33,$EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)
+61 ;
+62 ;Mail/Window Code
+63 IF $GET(BEXRDDAT)]""
IF $GET(BEXMLWIN)="M"
WRITE " (M)"
+64 IF $GET(BEXRFDAT)]""
IF $GET(BEXMLWIN)="W"
WRITE " (W)"
+65 ;
+66 ;Write Type
+67 SET Y=""
+68 IF BEXTYPE="R"
SET Y="REFILL"
+69 IF BEXTYPE="S"
SET Y="STATUS"
+70 IF BEXTYPE="I"
SET Y="RX INFO"
+71 IF BEXTYPE="P"
SET Y="PHARMACY"
+72 WRITE ?47,Y
+73 ;
+74 ;Write Results
+75 WRITE ?57,$EXTRACT(BEXRESLT,1,22)
+76 IF BEXTYPE="P"
IF BEXRESLT=""
SET Y=$$GET1^DIQ(52,BEXRXIEN,100)
WRITE ?57,"[",$EXTRACT(Y,1,20),"]"
+77 ;
+78 WRITE !
+79 ;
+80 IF $Y>(IOSL-4)
Begin DoDot:1
+81 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+82 IF X="^"
SET BEXEXIT=1
QUIT
+83 DO HEADER
End DoDot:1
+84 ;
+85 QUIT
+86 ;
