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