Routine: BEXRDAT

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

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

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

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

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 !

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

HEADER ;EP - Write the Header

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

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 !

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

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

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     ;---------------------------------------------------------------

HEADER    ;EP - Write the Header

 +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      ;

BEXRDAT.m