BEXRREJ.m

BEXRREJ ;IHS/CMI/DAY - BEX - Refill Rejections Percentage Report ; 12 Mar 2012  7:15 PM

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

 ;

 ;Prints the Refill Rejections Percentage Report

 ;

 W #

 ;

 W !,"Refill Rejections Percentage 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^BEXRREJ"

 S XBRX="EOJ^BEXRREJ"

 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

 S BEXTOT("REJECTS")=0

 S BEXTOT("TOO EARLY")=0

 S BEXTOT("DISCONTINUED")=0

 S BEXTOT("CANCELLED")=0

 S BEXTOT("NO REFILLS")=0

 S BEXTOT("EXPIRED")=0

 S BEXTOT("DUE EXPIRE")=0

 S BEXTOT("RESTOCKED")=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

 ..;

 ..;Restrict to non-Pharmacy Type

 ..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 through sort array

 S BEXDAT=0

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

 .;

 .W !

 .S Y=BEXDAT

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

 .;

 .W ?30,"TOO EARLY",?49,$J($P(BEXTOT(BEXDAT),U,3),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,3),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"DISCONTINUED",?49,$J($P(BEXTOT(BEXDAT),U,4),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,4),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"CANCELLED",?49,$J($P(BEXTOT(BEXDAT),U,5),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,5),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"NO REFILLS",?49,$J($P(BEXTOT(BEXDAT),U,6),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,6),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"EXPIRED",?49,$J($P(BEXTOT(BEXDAT),U,7),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,7),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"DUE EXPIRE",?49,$J($P(BEXTOT(BEXDAT),U,8),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,8),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .W ?30,"RESTOCKED",?49,$J($P(BEXTOT(BEXDAT),U,9),6)

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U,9),$P(BEXTOT(BEXDAT),U,2)),!

 .;

 .;

 .W ?2,"TOTAL TRANSACTIONS "

 .W $J($P(BEXTOT(BEXDAT),U,2),6)

 .;

 .W ?30,"TOTAL REJECTS      "

 .W $J($P(BEXTOT(BEXDAT),U),6)

 .;

 .W ?58,"PERCENT  "

 .W $$PERCENT($P(BEXTOT(BEXDAT),U),$P(BEXTOT(BEXDAT),U,2))

 .;

 .W !

 .W "----------------------------------------------------------------------------"

 .W !

 .;

 .I $Y>(IOSL-12) D

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

 ..I BEXEXIT=1 Q

 ..D HEADER

 ;

 W !

 ;

 W "GRAND TOTALS"

 ;Write Totals for each type

 W ?30,"TOO EARLY"

 W ?49,$J(BEXTOT("TOO EARLY"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("TOO EARLY"),BEXTOT),!

 ;

 W ?30,"DISCONTINUED"

 W ?49,$J(BEXTOT("DISCONTINUED"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("DISCONTINUED"),BEXTOT),!

 ;

 W ?30,"CANCELLED"

 W ?49,$J(BEXTOT("CANCELLED"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("CANCELLED"),BEXTOT),!

 ;

 W ?30,"NO REFILLS"

 W ?49,$J(BEXTOT("NO REFILLS"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("NO REFILLS"),BEXTOT),!

 ;

 W ?30,"EXPIRED"

 W ?49,$J(BEXTOT("EXPIRED"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("EXPIRED"),BEXTOT),!

 ;

 W ?30,"DUE EXPIRE"

 W ?49,$J(BEXTOT("DUE EXPIRE"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("DUE EXPIRE"),BEXTOT),!

 ;

 W ?30,"RESTOCKED"

 W ?49,$J(BEXTOT("RESTOCKED"),6)

 W ?58,"PERCENT  "

 W $$PERCENT(BEXTOT("RESTOCKED"),BEXTOT),!

 ;

 W !

 W ?2,"TOTAL TRANSACTIONS "

 W $J(BEXTOT,6)

 W ?30,"TOTAL REJECTS      "

 W $J(BEXTOT("REJECTS"),6)

 W ?58,"PERCENT  ",$$PERCENT(BEXTOT("REJECTS"),BEXTOT)

 W !

 ;

 Q

 ;

 ;

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

HEADER ;EP - Write the Header

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

 ;

 W #

 W !,"REPORT:      Refill Rejections Percentage 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

 ;

 ;

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

PERCENT(X,Y) ;EP - Calculate Percent

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

 ;

 I X=0 Q " 0.00%"

 I Y=0 Q " 0.00%"

 S Z=X/Y

 S Z=$J(Z,4,4)

 S Z=$E(Z,3,4)_"."_$E(Z,5,6)_"%"

 I $E(Z)=0 S Z=" "_$E(Z,2,99)

 Q Z

 ;

 ;

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

TOTAL ;EP -  Add up totals

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

 ;

 ;We are adding up individual totals by reject type, but are not

 ;writing them at this time.  In the future, the users may want them.

 ;

 S BEXTOT=BEXTOT+1

 ;

 ;Initialize Counters for this date

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

 ;

 ;Add to Total Transactions for this date

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

 ;

 ;Reject - Too Early (piece 3)

 I BEXRESLT="TOO EARLY" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("TOO EARLY")=BEXTOT("TOO EARLY")+1

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

 ;

 ;Reject - Discontinued (piece 4)

 I BEXRESLT="DISCONTINUED" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("DISCONTINUED")=BEXTOT("DISCONTINUED")+1

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

 ;

 ;Reject - Canceled (piece 5) - yes it is misspelled 

 I BEXRESLT="CANCELED" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("CANCELLED")=BEXTOT("CANCELLED")+1

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

 ;

 ;Reject - No Refills (piece 6) 

 I BEXRESLT="NO REFILLS" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("NO REFILLS")=BEXTOT("NO REFILLS")+1

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

 ;

 ;Reject - Expired (piece 7)

 I BEXRESLT="EXPIRED" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("EXPIRED")=BEXTOT("EXPIRED")+1

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

 ;

 ;Reject - Due Expire

 I BEXRESLT="DUE EXPIRE" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("DUE EXPIRE")=BEXTOT("DUE EXPIRE")+1

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

 ;

 ;Reject - Restocked

 I BEXRESLT="RESTOCKED" D  Q

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

 .S BEXTOT("REJECTS")=BEXTOT("REJECTS")+1

 .S BEXTOT("RESTOCKED")=BEXTOT("RESTOCKED")+1

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

 ;

 Q

 ;

BEXRREJ   ;IHS/CMI/DAY - BEX - Refill Rejections Percentage Report ; 12 Mar 2012  7:15 PM

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

 +2       ;

 +3       ;Prints the Refill Rejections Percentage Report

 +4       ;

 +5        WRITE #

 +6       ;

 +7        WRITE !,"Refill Rejections Percentage 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      ;

 +35      ;--------------------------------------------------------------------

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

 +28       SET XBRX="EOJ^BEXRREJ"

 +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        SET BEXTOT("REJECTS")=0

 +10       SET BEXTOT("TOO EARLY")=0

 +11       SET BEXTOT("DISCONTINUED")=0

 +12       SET BEXTOT("CANCELLED")=0

 +13       SET BEXTOT("NO REFILLS")=0

 +14       SET BEXTOT("EXPIRED")=0

 +15       SET BEXTOT("DUE EXPIRE")=0

 +16       SET BEXTOT("RESTOCKED")=0

 +17      ;

 +18       SET BEXQUIT=0

 +19       SET BEXEXIT=0

 +20      ;

 +21       SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXBEG),-1)

 +22       FOR 

               SET BEXDATE=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE))

               IF 'BEXDATE

                   QUIT 

               Begin DoDot:1

 +23      ;

 +24               IF BEXDATE>BEXEND

                       SET BEXQUIT=1

                       QUIT 

 +25      ;

 +26      ;This loops around to some non-numeric dates

 +27               IF +BEXDATE<BEXBEG

                       SET BEXQUIT=1

                       QUIT 

 +28      ;

 +29               SET BEXIEN=0

 +30               FOR 

                       SET BEXIEN=$ORDER(^VEXHRX0(19080.1,"C",BEXDATE,BEXIEN))

                       IF 'BEXIEN

                           QUIT 

                       Begin DoDot:2

 +31      ;

 +32                       SET BEX(0)=$GET(^VEXHRX0(19080.1,BEXIEN,0))

 +33                       IF BEX(0)=""

                               QUIT 

 +34      ;

 +35      ;Restrict to non-Pharmacy Type

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

                               QUIT 

 +37      ;

 +38                       DO PARSE^BEXRUTL

 +39      ;

 +40      ;Screen by Division

 +41                       IF +BEXDIV

                               IF BEXDVIEN=""

                                   QUIT 

 +42                       IF +BEXDIV

                               IF '$DATA(BEXDIV(BEXDVIEN))

                                   QUIT 

 +43      ;

 +44                       DO TOTAL

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT 

               End DoDot:1

               IF BEXQUIT=1

                   QUIT 

 +45      ;

 +46       SET BEXQUIT=0

 +47      ;Loop through sort array

 +48       SET BEXDAT=0

 +49       FOR 

               SET BEXDAT=$ORDER(BEXTOT(BEXDAT))

               IF 'BEXDAT

                   QUIT 

               Begin DoDot:1

 +50      ;

 +51               WRITE !

 +52               SET Y=BEXDAT

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

 +54      ;

 +55               WRITE ?30,"TOO EARLY",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,3),6)

 +56               WRITE ?58,"PERCENT  "

 +57               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,3),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +58      ;

 +59               WRITE ?30,"DISCONTINUED",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,4),6)

 +60               WRITE ?58,"PERCENT  "

 +61               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,4),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +62      ;

 +63               WRITE ?30,"CANCELLED",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,5),6)

 +64               WRITE ?58,"PERCENT  "

 +65               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,5),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +66      ;

 +67               WRITE ?30,"NO REFILLS",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,6),6)

 +68               WRITE ?58,"PERCENT  "

 +69               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,6),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +70      ;

 +71               WRITE ?30,"EXPIRED",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,7),6)

 +72               WRITE ?58,"PERCENT  "

 +73               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,7),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +74      ;

 +75               WRITE ?30,"DUE EXPIRE",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,8),6)

 +76               WRITE ?58,"PERCENT  "

 +77               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,8),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +78      ;

 +79               WRITE ?30,"RESTOCKED",?49,$JUSTIFY($PIECE(BEXTOT(BEXDAT),U,9),6)

 +80               WRITE ?58,"PERCENT  "

 +81               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U,9),$PIECE(BEXTOT(BEXDAT),U,2)),!

 +82      ;

 +83      ;

 +84               WRITE ?2,"TOTAL TRANSACTIONS "

 +85               WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U,2),6)

 +86      ;

 +87               WRITE ?30,"TOTAL REJECTS      "

 +88               WRITE $JUSTIFY($PIECE(BEXTOT(BEXDAT),U),6)

 +89      ;

 +90               WRITE ?58,"PERCENT  "

 +91               WRITE $$PERCENT($PIECE(BEXTOT(BEXDAT),U),$PIECE(BEXTOT(BEXDAT),U,2))

 +92      ;

 +93               WRITE !

 +94               WRITE "----------------------------------------------------------------------------"

 +95               WRITE !

 +96      ;

 +97               IF $Y>(IOSL-12)

                       Begin DoDot:2

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

                               KILL DIR

                               SET DIR(0)="E"

                               DO ^DIR

                               IF X="^"

                                   SET BEXEXIT=1

                               KILL DIR

 +99                       IF BEXEXIT=1

                               QUIT 

 +100                      DO HEADER

                       End DoDot:2

               End DoDot:1

               IF BEXQUIT=1

                   QUIT 

               IF BEXEXIT=1

                   QUIT 

 +101     ;

 +102      WRITE !

 +103     ;

 +104      WRITE "GRAND TOTALS"

 +105     ;Write Totals for each type

 +106      WRITE ?30,"TOO EARLY"

 +107      WRITE ?49,$JUSTIFY(BEXTOT("TOO EARLY"),6)

 +108      WRITE ?58,"PERCENT  "

 +109      WRITE $$PERCENT(BEXTOT("TOO EARLY"),BEXTOT),!

 +110     ;

 +111      WRITE ?30,"DISCONTINUED"

 +112      WRITE ?49,$JUSTIFY(BEXTOT("DISCONTINUED"),6)

 +113      WRITE ?58,"PERCENT  "

 +114      WRITE $$PERCENT(BEXTOT("DISCONTINUED"),BEXTOT),!

 +115     ;

 +116      WRITE ?30,"CANCELLED"

 +117      WRITE ?49,$JUSTIFY(BEXTOT("CANCELLED"),6)

 +118      WRITE ?58,"PERCENT  "

 +119      WRITE $$PERCENT(BEXTOT("CANCELLED"),BEXTOT),!

 +120     ;

 +121      WRITE ?30,"NO REFILLS"

 +122      WRITE ?49,$JUSTIFY(BEXTOT("NO REFILLS"),6)

 +123      WRITE ?58,"PERCENT  "

 +124      WRITE $$PERCENT(BEXTOT("NO REFILLS"),BEXTOT),!

 +125     ;

 +126      WRITE ?30,"EXPIRED"

 +127      WRITE ?49,$JUSTIFY(BEXTOT("EXPIRED"),6)

 +128      WRITE ?58,"PERCENT  "

 +129      WRITE $$PERCENT(BEXTOT("EXPIRED"),BEXTOT),!

 +130     ;

 +131      WRITE ?30,"DUE EXPIRE"

 +132      WRITE ?49,$JUSTIFY(BEXTOT("DUE EXPIRE"),6)

 +133      WRITE ?58,"PERCENT  "

 +134      WRITE $$PERCENT(BEXTOT("DUE EXPIRE"),BEXTOT),!

 +135     ;

 +136      WRITE ?30,"RESTOCKED"

 +137      WRITE ?49,$JUSTIFY(BEXTOT("RESTOCKED"),6)

 +138      WRITE ?58,"PERCENT  "

 +139      WRITE $$PERCENT(BEXTOT("RESTOCKED"),BEXTOT),!

 +140     ;

 +141      WRITE !

 +142      WRITE ?2,"TOTAL TRANSACTIONS "

 +143      WRITE $JUSTIFY(BEXTOT,6)

 +144      WRITE ?30,"TOTAL REJECTS      "

 +145      WRITE $JUSTIFY(BEXTOT("REJECTS"),6)

 +146      WRITE ?58,"PERCENT  ",$$PERCENT(BEXTOT("REJECTS"),BEXTOT)

 +147      WRITE !

 +148     ;

 +149      QUIT 

 +150     ;

 +151     ;

 +152     ;---------------------------------------------------------------

HEADER    ;EP - Write the Header

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

 +2       ;

 +3        WRITE #

 +4        WRITE !,"REPORT:      Refill Rejections Percentage 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      ;---------------------------------------------------------------

PERCENT(X,Y) ;EP - Calculate Percent

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

 +2       ;

 +3        IF X=0

               QUIT " 0.00%"

 +4        IF Y=0

               QUIT " 0.00%"

 +5        SET Z=X/Y

 +6        SET Z=$JUSTIFY(Z,4,4)

 +7        SET Z=$EXTRACT(Z,3,4)_"."_$EXTRACT(Z,5,6)_"%"

 +8        IF $EXTRACT(Z)=0

               SET Z=" "_$EXTRACT(Z,2,99)

 +9        QUIT Z

 +10      ;

 +11      ;

 +12      ;-----------------------------------------------------------------

TOTAL     ;EP -  Add up totals

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

 +2       ;

 +3       ;We are adding up individual totals by reject type, but are not

 +4       ;writing them at this time.  In the future, the users may want them.

 +5       ;

 +6        SET BEXTOT=BEXTOT+1

 +7       ;

 +8       ;Initialize Counters for this date

 +9        IF '$DATA(BEXTOT(BEXDAT))

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

 +10      ;

 +11      ;Add to Total Transactions for this date

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

 +13      ;

 +14      ;Reject - Too Early (piece 3)

 +15       IF BEXRESLT="TOO EARLY"

               Begin DoDot:1

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