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
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^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 !
;
Q
;
;
;---------------------------------------------------------------
;---------------------------------------------------------------
;
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 !
;
Q
;
;
;-----------------------------------------------------------------
SUBHEAD ;EP - Write Subheader for each pharmacist
;-----------------------------------------------------------------
;
W !
W "-------------------------------------------------------------------------------"
W !
;
W $$GET1^DIQ(200,BEXRPH,.01)
;
W !
W "-------------------------------------------------------------------------------"
W !
;
Q
;
;
;-----------------------------------------------------------------
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
;
Q
;
;
;-----------------------------------------------------------------
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
;
Q
;
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 ;---------------------------------------------------------------
+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 ;
