Routine: BEXRRPH

BEXRRPH ;IHS/CMI/DAY - BEX - Refills Processed by RPHS Report ; 12 Mar 2012  9:19 PM

 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1

 ;Prints the Refills Processed by RPH Report

W #

 W !,"Refills Processed by RPH 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,DIE,DIR,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)=""

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

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^BEXRRPH"

 S XBRX="EOJ^BEXRRPH"

 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^0^0"

 S BEXQUIT=0

 S BEXEXIT=0

 ;Loop Date Xref to get totals and build sort array

 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

..;

 ..;Only want pharmacy type transactions

 ..I $P(BEX(0),U,4)'="P" Q

 ..D PARSE^BEXRUTL

..;

 ..;Screen by Division

 ..I +BEXDIV,BEXDVIEN="" Q

 ..I +BEXDIV,'$D(BEXDIV(BEXDVIEN)) Q

 ..D TOTAL

 S BEXQUIT=0

 ;Loop the sort array

 S BEXRPH=0

 F  S BEXRPH=$O(BEXTOT(BEXRPH)) Q:'BEXRPH  D  Q:BEXQUIT=1  Q:BEXEXIT=1

.;

 .D SUBHEAD

.;

 .S BEXDAT=0

 .F  S BEXDAT=$O(BEXTOT(BEXRPH,BEXDAT)) Q:'BEXDAT  D  Q:BEXQUIT=1  Q:BEXEXIT=1

..;

 ..D DETAIL

.;

 .W "TOTAL"

 .W ?18,$J($P(BEXTOT(BEXRPH),U),7)

 .W ?36,$J($P(BEXTOT(BEXRPH),U,2),7)

 .W ?53,$J($P(BEXTOT(BEXRPH),U,3),7)

 .W !

 ;Write Totals

 W !,?21,"MAIL",?37,"WINDOW",?55,"TOTAL"

 W !,"GRAND TOTAL",?18,$J($P(BEXTOT,U),7)

 W ?36,$J($P(BEXTOT,U,2),7)

 W ?53,$J($P(BEXTOT,U,3),7)

W !

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

HEADER ;EP - Write the Header

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

W #

 W !,"REPORT:      Refills Processed by RPH Report"

 W " for "

 I +BEXSITE 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 !

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

SUBHEAD ;EP - Write Subheader for each pharmacist

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

W !

 W "-------------------------------------------------------------------------------"

W !

 W $$GET1^DIQ(200,BEXRPH,.01)

W !

 W "-------------------------------------------------------------------------------"

W !

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

TOTAL ;EP -  Add up totals and build sort array

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

 I BEXRPH="" Q

 S $P(BEXTOT,U,3)=$P(BEXTOT,U,3)+1

 ;Initialize Total Counter for this Pharmacist

 I '$D(BEXTOT(BEXRPH)) S BEXTOT(BEXRPH)="0^0^0"

 ;Add to Total Counter for this Pharmacist

 S $P(BEXTOT(BEXRPH),U,3)=$P(BEXTOT(BEXRPH),U,3)+1

 ;Initialize Date Counter for this Pharmacist

 I '$D(BEXTOT(BEXRPH,BEXDAT)) S BEXTOT(BEXRPH,BEXDAT)="0^0^0"

 ;Add to Date Counter for this Pharmacist

 S $P(BEXTOT(BEXRPH,BEXDAT),U,3)=$P(BEXTOT(BEXRPH,BEXDAT),U,3)+1

 ;Check for Mail/Window

 I $G(BEXMLWIN)="M" D

 .S $P(BEXTOT(BEXRPH),U)=$P(BEXTOT(BEXRPH),U)+1

 .S $P(BEXTOT(BEXRPH,BEXDAT),U)=$P(BEXTOT(BEXRPH,BEXDAT),U)+1

 .S $P(BEXTOT,U)=$P(BEXTOT,U)+1

 I $G(BEXMLWIN)="W" D

 .S $P(BEXTOT(BEXRPH),U,2)=$P(BEXTOT(BEXRPH),U,2)+1

 .S $P(BEXTOT(BEXRPH,BEXDAT),U,2)=$P(BEXTOT(BEXRPH,BEXDAT),U,2)+1

 .S $P(BEXTOT,U,2)=$P(BEXTOT,U,2)+1

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

DETAIL ;EP - Write Detail

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

 ;-->  Let's write out the record detail

 S Y=BEXDAT

 W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)

 W ?14,"MAIL"

 W $J($P(BEXTOT(BEXRPH,BEXDAT),U),7)

 W ?30,"WINDOW"

 W $J($P(BEXTOT(BEXRPH,BEXDAT),U,2),7)

 W ?48,"TOTAL"

 W $J($P(BEXTOT(BEXRPH,BEXDAT),U,3),7)

W !

 I $Y>(IOSL-7) D

 .I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:X="^" BEXEXIT=1 K DIR

 .I X="^" S BEXQUIT=1 Q

 .D HEADER

BEXRRPH   ;IHS/CMI/DAY - BEX - Refills Processed by RPHS Report ; 12 Mar 2012  9:19 PM

 +1       ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5**;MAR 12, 2012;Build 1

 +2       ;

 +3       ;Prints the Refills Processed by RPH Report

 +4       ;

 +5        WRITE #

 +6       ;

 +7        WRITE !,"Refills Processed by RPH 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,DIE,DIR,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      ;

 +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^BEXRRPH"

 +28       SET XBRX="EOJ^BEXRRPH"

 +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^0^0"

 +9       ;

 +10       SET BEXQUIT=0

 +11       SET BEXEXIT=0

 +12      ;

 +13      ;Loop Date Xref to get totals and build sort array

 +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      ;Only want pharmacy type transactions

 +29                       IF $PIECE(BEX(0),U,4)'="P"

                               QUIT

 +30                       DO PARSE^BEXRUTL

 +31      ;

 +32      ;Screen by Division

 +33                       IF +BEXDIV

                               IF BEXDVIEN=""

                                   QUIT

 +34                       IF +BEXDIV

                               IF '$DATA(BEXDIV(BEXDVIEN))

                                   QUIT

 +35                       DO TOTAL

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT

               End DoDot:1

               IF BEXQUIT=1

                   QUIT

 +36      ;

 +37      ;

 +38       SET BEXQUIT=0

 +39      ;

 +40      ;Loop the sort array

 +41       SET BEXRPH=0

 +42       FOR

               SET BEXRPH=$ORDER(BEXTOT(BEXRPH))

               IF 'BEXRPH

                   QUIT

               Begin DoDot:1

 +43      ;

 +44               DO SUBHEAD

 +45      ;

 +46               SET BEXDAT=0

 +47               FOR

                       SET BEXDAT=$ORDER(BEXTOT(BEXRPH,BEXDAT))

                       IF 'BEXDAT

                           QUIT

                       Begin DoDot:2

 +48      ;

 +49                       DO DETAIL

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT

                       IF BEXEXIT=1

                           QUIT

 +50      ;

 +51               WRITE "TOTAL"

 +52               WRITE ?18,$JUSTIFY($PIECE(BEXTOT(BEXRPH),U),7)

 +53               WRITE ?36,$JUSTIFY($PIECE(BEXTOT(BEXRPH),U,2),7)

 +54               WRITE ?53,$JUSTIFY($PIECE(BEXTOT(BEXRPH),U,3),7)

 +55               WRITE !

               End DoDot:1

               IF BEXQUIT=1

                   QUIT

               IF BEXEXIT=1

                   QUIT

 +56      ;

 +57      ;

 +58      ;Write Totals

 +59      ;

 +60       WRITE !,?21,"MAIL",?37,"WINDOW",?55,"TOTAL"

 +61       WRITE !,"GRAND TOTAL",?18,$JUSTIFY($PIECE(BEXTOT,U),7)

 +62       WRITE ?36,$JUSTIFY($PIECE(BEXTOT,U,2),7)

 +63       WRITE ?53,$JUSTIFY($PIECE(BEXTOT,U,3),7)

 +64       WRITE !

 +65      ;

 +66       QUIT

 +67      ;

 +68      ;

 +69      ;---------------------------------------------------------------

HEADER    ;EP - Write the Header

 +1       ;---------------------------------------------------------------

 +2       ;

 +3        WRITE #

 +4        WRITE !,"REPORT:      Refills Processed by RPH Report"

 +5        WRITE " for "

 +6        IF +BEXSITE

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

SUBHEAD   ;EP - Write Subheader for each pharmacist

 +1       ;-----------------------------------------------------------------

 +2       ;

 +3        WRITE !

 +4        WRITE "-------------------------------------------------------------------------------"

 +5        WRITE !

 +6       ;

 +7        WRITE $$GET1^DIQ(200,BEXRPH,.01)

 +8       ;

 +9        WRITE !

 +10       WRITE "-------------------------------------------------------------------------------"

 +11       WRITE !

 +12      ;

 +13       QUIT

 +14      ;

 +15      ;

 +16      ;-----------------------------------------------------------------

TOTAL     ;EP -  Add up totals and build sort array

 +1       ;-----------------------------------------------------------------

 +2       ;

 +3        IF BEXRPH=""

               QUIT

 +4       ;

 +5        SET $PIECE(BEXTOT,U,3)=$PIECE(BEXTOT,U,3)+1

 +6       ;

 +7       ;Initialize Total Counter for this Pharmacist

 +8        IF '$DATA(BEXTOT(BEXRPH))

               SET BEXTOT(BEXRPH)="0^0^0"

 +9       ;

 +10      ;Add to Total Counter for this Pharmacist

 +11       SET $PIECE(BEXTOT(BEXRPH),U,3)=$PIECE(BEXTOT(BEXRPH),U,3)+1

 +12      ;

 +13      ;Initialize Date Counter for this Pharmacist

 +14       IF '$DATA(BEXTOT(BEXRPH,BEXDAT))

               SET BEXTOT(BEXRPH,BEXDAT)="0^0^0"

 +15      ;

 +16      ;Add to Date Counter for this Pharmacist

 +17       SET $PIECE(BEXTOT(BEXRPH,BEXDAT),U,3)=$PIECE(BEXTOT(BEXRPH,BEXDAT),U,3)+1

 +18      ;

 +19      ;Check for Mail/Window

 +20       IF $GET(BEXMLWIN)="M"

               Begin DoDot:1

 +21               SET $PIECE(BEXTOT(BEXRPH),U)=$PIECE(BEXTOT(BEXRPH),U)+1

 +22               SET $PIECE(BEXTOT(BEXRPH,BEXDAT),U)=$PIECE(BEXTOT(BEXRPH,BEXDAT),U)+1

 +23               SET $PIECE(BEXTOT,U)=$PIECE(BEXTOT,U)+1

               End DoDot:1

 +24      ;

 +25       IF $GET(BEXMLWIN)="W"

               Begin DoDot:1

 +26               SET $PIECE(BEXTOT(BEXRPH),U,2)=$PIECE(BEXTOT(BEXRPH),U,2)+1

 +27               SET $PIECE(BEXTOT(BEXRPH,BEXDAT),U,2)=$PIECE(BEXTOT(BEXRPH,BEXDAT),U,2)+1

 +28               SET $PIECE(BEXTOT,U,2)=$PIECE(BEXTOT,U,2)+1

               End DoDot:1

 +29      ;

 +30       QUIT

 +31      ;

 +32      ;

 +33      ;-----------------------------------------------------------------

DETAIL    ;EP - Write Detail

 +1       ;-----------------------------------------------------------------

 +2       ;

 +3       ;-->  Let's write out the record detail

 +4       ;

 +5        SET Y=BEXDAT

 +6        WRITE $EXTRACT(Y,4,5),"/",$EXTRACT(Y,6,7),"/",$EXTRACT(Y,2,3)

 +7       ;

 +8        WRITE ?14,"MAIL"

 +9        WRITE $JUSTIFY($PIECE(BEXTOT(BEXRPH,BEXDAT),U),7)

 +10       WRITE ?30,"WINDOW"

 +11       WRITE $JUSTIFY($PIECE(BEXTOT(BEXRPH,BEXDAT),U,2),7)

 +12       WRITE ?48,"TOTAL"

 +13       WRITE $JUSTIFY($PIECE(BEXTOT(BEXRPH,BEXDAT),U,3),7)

 +14       WRITE !

 +15      ;

 +16       IF $Y>(IOSL-7)

               Begin DoDot:1

 +17               IF $EXTRACT(IOST)="C"

                       KILL DIR

                       SET DIR(0)="E"

                       DO ^DIR

                       IF X="^"

                           SET BEXEXIT=1

                       KILL DIR

 +18               IF X="^"

                       SET BEXQUIT=1

                       QUIT

 +19               DO HEADER

               End DoDot:1

 +20      ;

 +21       QUIT

 +22      ;

BEXRRPH.m