Routine: BEXREXC

BEXREXC ;IHS/CMI/DAY - Print reports [ 07/14/2011  1:01 AM ] ; 12 Mar 2012  9:18 PM

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

 ;Prints the Exceptions/Non-Refillable Transactions by Date Report

 ;IHS/CMI/DAY - New routine released in patch 5

W #

 W !,"Exceptions/Non-Refillable Transaction Report"

W !

 W !,"This option prints a list of Exceptions/Non-Refillable transactions that"

 W !,"were received within 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,DR,DA,DD,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,DIRUT

 S DIR("A")="Select Window, Local Mail, or Mail"

 S DIR(0)="S^A:All Entries;W:Window Only;L:Local Mail Only;M:Mail Only (CMOP)"

 D ^DIR

 K DIR

 S BEXWIND=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_".24"

 I BEXBEG>BEXEND W !!,"Beginning Date is later than the Ending Date.  Try Again!",! G BEGDATE

W !

 S XBRP="LIST^BEXREXC"

 S XBNS="BEX"

 D ^XBDBQUE

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

EOJ ;-->  End of Job Processing

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

 X ^%ZIS("C")

 I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR

 K BEX

 K ^BEXREXC($J)

 D EN^XBVK("BEX")

 K DIR,DIE,DIC,DD,DA,DR

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

LIST ;-->  EP - Entry Point from XBDBQUE

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

W #

 D HEADER

 K ^BEXREXC($J)

 K BEXTOT

 S BEXTOT=0

 S BEXQUIT=0,BEXEXIT=0

 ;Loop to build sorted array

 S BEXDATE=BEXBEG

 F  S BEXDATE=$O(^VEXHRX0(19080.1,"C",BEXDATE)) Q:'BEXDATE  D  Q:BEXQUIT=1

.;

 .I BEXDATE<BEXBEG Q

 .I BEXDATE>BEXEND 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

..;

 ..;Only want to look at refill requests

 ..I BEXTYPE'="R" Q

..;

 ..;Screen by Division

 ..I +BEXDIV,BEXDVIEN="" Q

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

..;

 ..S BEXHRNO=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)

 ..I BEXHRNO="" Q

..;

 ..S BEXNAME=$$GET1^DIQ(2,BEXPTIEN,.01)

..;

 ..;No RX # for Deceased, and other conditions

 ..I BEXRXNUM="" S BEXRXNUM=0

..;

 ..I BEXMAIL="W" S BEXSORT=1

 ..I BEXMAIL="L" S BEXSORT=3

 ..I BEXMAIL="M" S BEXSORT=2

 ..I BEXMAIL="" S BEXSORT=4

..;

 ..;If this was refilled within the date range - remove it

 ..;Because we sort by M/W you may see an RX that was refillable

 ..;not get removed if the Exception was under a different M/W

 ..I BEXRESLT["REFILLABLE" K ^BEXREXC($J,BEXSORT,BEXNAME,BEXRXNUM) Q

..;

 ..;Screen by Mail or Window

 ..I BEXWIND="M",BEXMAIL="L" Q

 ..I BEXWIND="M",BEXMAIL="W" Q

 ..I BEXWIND="L",BEXMAIL="M" Q

 ..I BEXWIND="L",BEXMAIL="W" Q

 ..I BEXWIND="W",BEXMAIL="M" Q

 ..I BEXWIND="W",BEXMAIL="L" Q

..;

..;

 ..;Sort by Mail/Window, then Name and RXNUM

 ..S ^BEXREXC($J,BEXSORT,BEXNAME,BEXRXNUM)=BEXIEN

 ;Loop to write out detail and add to totals counters

 S BEXSORT=""

 F  S BEXSORT=$O(^BEXREXC($J,BEXSORT)) Q:BEXSORT=""  D  Q:BEXEXIT=1

.;

 .S BEXNAME=""

 .F  S BEXNAME=$O(^BEXREXC($J,BEXSORT,BEXNAME)) Q:BEXNAME=""  D  Q:BEXEXIT=1

..;

 ..S BEXRXN=""

 ..F  S BEXRXN=$O(^BEXREXC($J,BEXSORT,BEXNAME,BEXRXN)) Q:BEXRXN=""  D  Q:BEXEXIT=1

 ...;

 ...S BEXIEN=$G(^BEXREXC($J,BEXSORT,BEXNAME,BEXRXN))

 ...I BEXIEN="" Q

 ...;

 ...S BEX(0)=$G(^VEXHRX0(19080.1,BEXIEN,0))

 ...I BEX(0)="" Q

 ...;

 ...D PARSE^BEXRUTL

 ...;

 ...D DETAIL

 ;Write Totals

 I BEXEXIT=1 Q

W !

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

W !

 W "TOTALS by Date"

W !

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

W !

 S BEXDAT=""

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

 .S X=BEXDAT

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

 .W ?10,"EXCEPTIONS: "

 .W ?29,$J(BEXTOT(BEXDAT),4)

 .W !

 W !,"TOTAL Exceptions:",?25,$J(BEXTOT,8)

W !

 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR

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

HEADER ;-->  Write the Header

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

W #

 W !,"REPORT:      Exceptions/Non-Refillable Report"

 W " for "

 I BEXSITE>0 W $$GET1^DIQ(59,BEXDIV,.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

 W "Date"

 W ?7,"Name"

 W ?27,"HRNO"

 W ?36,"RX #"

 W ?44,"Drug"

 W ?60,"M/W"

 W ?65,"Result"

W !

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

W !

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

DETAIL ;EP -  Write Detail for each Record and Add up totals

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

 S BEXTOT=BEXTOT+1

 ;Initialize Counter for this date

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

 ;Add to Counters by Type

 ;Refills

 I BEXTYPE="R" S BEXTOT(BEXDAT)=BEXTOT(BEXDAT)+1

 ;Quit if totals only

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

 .;Remove Time

 .;X ^DD("DD")

 .;W "@"

 .;I $P(Y,"@",2)]"" W $E($P(Y,"@",2),1,5)

 .;I $P(Y,"@",2)="" W "00:00"

 ;Patient Name

 S Y=$$GET1^DIQ(2,BEXPTIEN,.01)

 W ?7,$E(Y,1,16)

 ;Write Patient HRNO

 S Y=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)

 I Y>0 W ?25,$J(Y,6)

 ;Write RX Number

 I $E(BEXRXNUM,$L(BEXRXNUM))?1A W ?33,$J(BEXRXNUM,9)

 I $E(BEXRXNUM,$L(BEXRXNUM))?1N W ?32,$J(BEXRXNUM,9)

 ;Drug Name

 S Y=$$GET1^DIQ(50,BEXDRIEN,.01)

 W ?44,$E(Y,1,16)

 ;Write Mail/Window

 W ?62,BEXMAIL

 ;Write Results

 W ?65,$E(BEXRESLT,1,14)

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

BEXREXC   ;IHS/CMI/DAY - Print reports [ 07/14/2011  1:01 AM ] ; 12 Mar 2012  9:18 PM

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

 +2       ;

 +3       ;Prints the Exceptions/Non-Refillable Transactions by Date Report

 +4       ;

 +5       ;IHS/CMI/DAY - New routine released in patch 5

 +6       ;

 +7        WRITE #

 +8       ;

 +9        WRITE !,"Exceptions/Non-Refillable Transaction Report"

 +10       WRITE !

 +11       WRITE !,"This option prints a list of Exceptions/Non-Refillable transactions that"

 +12       WRITE !,"were received within a selected date/time range."

 +13       WRITE !

 +14      ;

 +15       KILL BEXDIV

 +16       SET BEXDIV=0

 +17       SET BEXSITE=0

 +18       SET BEXQUIT=0

 +19      ;

 +20      ;

 +21       WRITE !,"Press Enter to select ALL Pharmacy Divisions, or"

 +22       FOR

               Begin DoDot:1

 +23               KILL DIC,DIR,DIE,DA,DR,DO,DD

 +24               SET DIC(0)="AEQMZ"

 +25               SET DIC("A")="Select a Pharmacy Division: "

 +26               SET DIC=59

 +27               DO ^DIC

 +28               KILL DIC,DIE,DIR,DR,DA,DD,DO

 +29               IF X=""

                       SET BEXQUIT=1

                       QUIT

 +30               IF Y<0

                       SET BEXQUIT=1

                       QUIT

 +31               SET BEXSITE=+Y

 +32               SET BEXDIV=BEXDIV+1

 +33               SET Y=$PIECE($GET(^PS(59,BEXSITE,"INI")),U)

 +34               IF +Y

                       SET BEXDIV(Y)=""

               End DoDot:1

               IF BEXQUIT=1

                   QUIT

 +35      ;

 +36       WRITE !

 +37       KILL DIR,DIRUT

 +38       SET DIR("A")="Select Window, Local Mail, or Mail"

 +39       SET DIR(0)="S^A:All Entries;W:Window Only;L:Local Mail Only;M:Mail Only (CMOP)"

 +40       DO ^DIR

 +41       KILL DIR

 +42       SET BEXWIND=Y

 +43      ;

BEGDATE   ;EP - Come here if end date is before begin date

 +1       ;

 +2        WRITE !

 +3        KILL DIRUT

 +4        KILL %DT

 +5        SET %DT("A")="Select the Beginning Date/Time: "

 +6        SET %DT="AET"

 +7        DO ^%DT

 +8        KILL %DT

 +9        IF ($DATA(DIRUT))!(Y<0)

               WRITE !!,"No Beginning Date selected"

               GOTO EOJ

 +10       SET BEXBEG=Y

 +11      ;

 +12       WRITE !

 +13       KILL DIRUT

 +14       KILL %DT

 +15       SET %DT("A")="Select the Ending Date/Time: "

 +16       SET %DT="AET"

 +17       DO ^%DT

 +18       KILL %DT

 +19       IF ($DATA(DIRUT))!(Y<0)

               WRITE !!,"No Ending Date selected"

               GOTO EOJ

 +20       SET BEXEND=Y

 +21       IF $PIECE(BEXEND,".",2)=""

               SET BEXEND=BEXEND_".24"

 +22      ;

 +23       IF BEXBEG>BEXEND

               WRITE !!,"Beginning Date is later than the Ending Date.  Try Again!",!

               GOTO BEGDATE

 +24      ;

 +25       WRITE !

 +26       SET XBRP="LIST^BEXREXC"

 +27       SET XBNS="BEX"

 +28       DO ^XBDBQUE

 +29       QUIT

 +30      ;

 +31      ;

 +32      ;---------------------------------------------------------------

EOJ       ;-->  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        KILL ^BEXREXC($JOB)

 +7        DO EN^XBVK("BEX")

 +8        KILL DIR,DIE,DIC,DD,DA,DR

 +9        QUIT

 +10      ;

 +11      ;

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

LIST      ;-->  EP - Entry Point from XBDBQUE

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

 +2       ;

 +3        WRITE #

 +4        DO HEADER

 +5       ;

 +6        KILL ^BEXREXC($JOB)

 +7        KILL BEXTOT

 +8        SET BEXTOT=0

 +9       ;

 +10       SET BEXQUIT=0

           SET BEXEXIT=0

 +11      ;

 +12      ;Loop to build sorted array

 +13       SET BEXDATE=BEXBEG

 +14       FOR

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

               IF 'BEXDATE

                   QUIT

               Begin DoDot:1

 +15      ;

 +16               IF BEXDATE<BEXBEG

                       QUIT

 +17               IF BEXDATE>BEXEND

                       SET BEXQUIT=1

                       QUIT

 +18      ;

 +19               SET BEXIEN=0

 +20               FOR

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

                       IF 'BEXIEN

                           QUIT

                       Begin DoDot:2

 +21      ;

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

 +23                       IF BEX(0)=""

                               QUIT

 +24      ;

 +25                       DO PARSE^BEXRUTL

 +26      ;

 +27      ;Only want to look at refill requests

 +28                       IF BEXTYPE'="R"

                               QUIT

 +29      ;

 +30      ;Screen by Division

 +31                       IF +BEXDIV

                               IF BEXDVIEN=""

                                   QUIT

 +32                       IF +BEXDIV

                               IF '$DATA(BEXDIV(BEXDVIEN))

                                   QUIT

 +33      ;

 +34                       SET BEXHRNO=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)

 +35                       IF BEXHRNO=""

                               QUIT

 +36      ;

 +37                       SET BEXNAME=$$GET1^DIQ(2,BEXPTIEN,.01)

 +38      ;

 +39      ;No RX # for Deceased, and other conditions

 +40                       IF BEXRXNUM=""

                               SET BEXRXNUM=0

 +41      ;

 +42                       IF BEXMAIL="W"

                               SET BEXSORT=1

 +43                       IF BEXMAIL="L"

                               SET BEXSORT=3

 +44                       IF BEXMAIL="M"

                               SET BEXSORT=2

 +45                       IF BEXMAIL=""

                               SET BEXSORT=4

 +46      ;

 +47      ;If this was refilled within the date range - remove it

 +48      ;Because we sort by M/W you may see an RX that was refillable

 +49      ;not get removed if the Exception was under a different M/W

 +50                       IF BEXRESLT["REFILLABLE"

                               KILL ^BEXREXC($JOB,BEXSORT,BEXNAME,BEXRXNUM)

                               QUIT

 +51      ;

 +52      ;Screen by Mail or Window

 +53                       IF BEXWIND="M"

                               IF BEXMAIL="L"

                                   QUIT

 +54                       IF BEXWIND="M"

                               IF BEXMAIL="W"

                                   QUIT

 +55                       IF BEXWIND="L"

                               IF BEXMAIL="M"

                                   QUIT

 +56                       IF BEXWIND="L"

                               IF BEXMAIL="W"

                                   QUIT

 +57                       IF BEXWIND="W"

                               IF BEXMAIL="M"

                                   QUIT

 +58                       IF BEXWIND="W"

                               IF BEXMAIL="L"

                                   QUIT

 +59      ;

 +60      ;

 +61      ;Sort by Mail/Window, then Name and RXNUM

 +62                       SET ^BEXREXC($JOB,BEXSORT,BEXNAME,BEXRXNUM)=BEXIEN

                       End DoDot:2

                       IF BEXQUIT=1

                           QUIT

               End DoDot:1

               IF BEXQUIT=1

                   QUIT

 +63      ;

 +64      ;

 +65      ;Loop to write out detail and add to totals counters

 +66       SET BEXSORT=""

 +67       FOR

               SET BEXSORT=$ORDER(^BEXREXC($JOB,BEXSORT))

               IF BEXSORT=""

                   QUIT

               Begin DoDot:1

 +68      ;

 +69               SET BEXNAME=""

 +70               FOR

                       SET BEXNAME=$ORDER(^BEXREXC($JOB,BEXSORT,BEXNAME))

                       IF BEXNAME=""

                           QUIT

                       Begin DoDot:2

 +71      ;

 +72                       SET BEXRXN=""

 +73                       FOR

                               SET BEXRXN=$ORDER(^BEXREXC($JOB,BEXSORT,BEXNAME,BEXRXN))

                               IF BEXRXN=""

                                   QUIT

                               Begin DoDot:3

 +74      ;

 +75                               SET BEXIEN=$GET(^BEXREXC($JOB,BEXSORT,BEXNAME,BEXRXN))

 +76                               IF BEXIEN=""

                                       QUIT

 +77      ;

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

 +79                               IF BEX(0)=""

                                       QUIT

 +80      ;

 +81                               DO PARSE^BEXRUTL

 +82      ;

 +83                               DO DETAIL

                               End DoDot:3

                               IF BEXEXIT=1

                                   QUIT

                       End DoDot:2

                       IF BEXEXIT=1

                           QUIT

               End DoDot:1

               IF BEXEXIT=1

                   QUIT

 +84      ;

 +85      ;Write Totals

 +86      ;

 +87       IF BEXEXIT=1

               QUIT

 +88      ;

 +89       WRITE !

 +90       WRITE "----------------------------------------------------------------"

 +91       WRITE !

 +92       WRITE "TOTALS by Date"

 +93       WRITE !

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

 +95       WRITE !

 +96      ;

 +97       SET BEXDAT=""

 +98       FOR

               SET BEXDAT=$ORDER(BEXTOT(BEXDAT))

               IF 'BEXDAT

                   QUIT

               Begin DoDot:1

 +99               SET X=BEXDAT

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

 +101              WRITE ?10,"EXCEPTIONS: "

 +102              WRITE ?29,$JUSTIFY(BEXTOT(BEXDAT),4)

 +103              WRITE !

               End DoDot:1

 +104     ;

 +105      WRITE !,"TOTAL Exceptions:",?25,$JUSTIFY(BEXTOT,8)

 +106      WRITE !

 +107     ;

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

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               KILL DIR

 +109     ;

 +110      QUIT

 +111     ;

 +112     ;

 +113     ;---------------------------------------------------------------

HEADER    ;-->  Write the Header

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

 +2       ;

 +3        WRITE #

 +4        WRITE !,"REPORT:      Exceptions/Non-Refillable Report"

 +5        WRITE " for "

 +6        IF BEXSITE>0

               WRITE $$GET1^DIQ(59,BEXDIV,.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      ;

 +33       WRITE "Date"

 +34       WRITE ?7,"Name"

 +35       WRITE ?27,"HRNO"

 +36       WRITE ?36,"RX #"

 +37       WRITE ?44,"Drug"

 +38       WRITE ?60,"M/W"

 +39       WRITE ?65,"Result"

 +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 Counter for this date

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

               SET BEXTOT(BEXDAT)=0

 +7       ;

 +8       ;Add to Counters by Type

 +9       ;

 +10      ;Refills

 +11       IF BEXTYPE="R"

               SET BEXTOT(BEXDAT)=BEXTOT(BEXDAT)+1

 +12      ;

 +13      ;Quit if totals only

 +14      ;

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

 +16      ;

 +17      ;Write Transaction Date/Time

 +18       SET Y=BEXTXDAT

 +19       IF Y]""

               Begin DoDot:1

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

 +21      ;Remove Time

 +22      ;X ^DD("DD")

 +23      ;W "@"

 +24      ;I $P(Y,"@",2)]"" W $E($P(Y,"@",2),1,5)

 +25      ;I $P(Y,"@",2)="" W "00:00"

               End DoDot:1

 +26      ;

 +27      ;Patient Name

 +28       SET Y=$$GET1^DIQ(2,BEXPTIEN,.01)

 +29       WRITE ?7,$EXTRACT(Y,1,16)

 +30      ;

 +31      ;Write Patient HRNO

 +32       SET Y=$$HRN^AUPNPAT(BEXPTIEN,BEXDVIEN)

 +33       IF Y>0

               WRITE ?25,$JUSTIFY(Y,6)

 +34      ;

 +35      ;Write RX Number

 +36       IF $EXTRACT(BEXRXNUM,$LENGTH(BEXRXNUM))?1A

               WRITE ?33,$JUSTIFY(BEXRXNUM,9)

 +37       IF $EXTRACT(BEXRXNUM,$LENGTH(BEXRXNUM))?1N

               WRITE ?32,$JUSTIFY(BEXRXNUM,9)

 +38      ;

 +39      ;Drug Name

 +40       SET Y=$$GET1^DIQ(50,BEXDRIEN,.01)

 +41       WRITE ?44,$EXTRACT(Y,1,16)

 +42      ;

 +43      ;Write Mail/Window

 +44       WRITE ?62,BEXMAIL

 +45      ;

 +46      ;Write Results

 +47       WRITE ?65,$EXTRACT(BEXRESLT,1,14)

 +48      ;

 +49       WRITE !

 +50      ;

 +51       IF $Y>(IOSL-4)

               Begin DoDot:1

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

                       KILL DIR

                       SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

 +53               IF X="^"

                       SET BEXEXIT=1

                       QUIT

 +54               DO HEADER

               End DoDot:1

 +55      ;

 +56       QUIT

 +57      ;

BEXREXC.m