Routine: BEXRDOW

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

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

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

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

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 !

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

HEADER ;EP -  Write the Header

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

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 !

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

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

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

HEADER    ;EP -  Write the Header

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

BEXRDOW.m