BEXRQUE ;IHS/CMI/DAY - BEX - Refill Queue Report ; 05 Oct 2015 10:51 AM
;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5,6**;APR 20, 2015;Build 7
;
;Prints the Refill Queue Report
;
; New routine released in Patch 5
; Patch 6 improves Site Selection
;
W #
;
W !,"Refill Queue Report"
W !
W !,"This option prints a list of entries in the Refill Queue."
W !
;
;IHS/BJI/DAY - Patch 6 - Improved Site Selection
;
;Capture Site when entering BEXRQUE
D HOLD^BEXSITE
;
;Display Site to User and Ask for Change
D CHANGE^BEXSITE
;
;End Patch 6
;
K BEXOPSIT
S BEXOPSIT=0
S BEXQUIT=0
S BEXEXIT=0
;
W !,"Press Enter to select ALL Outpatient Sites, or"
F D Q:BEXQUIT=1
.K DUOUT,DIC,DIR,DIE,DA,DR,DO,DD
.S DIC(0)="AEQMZ"
.S DIC("A")="Select a Outpatient Site: "
.S DIC=59
.D ^DIC
.K DIC,DIR,DIE,DA,DD,DR,DO
.I $G(DUOUT) K DUOUT S (BEXQUIT,BEXEXIT)=1 Q
.I X="" S BEXQUIT=1 Q
.I Y<0 Q
.S BEXOPSIT=BEXOPSIT+1
.I +Y S BEXOPSIT(+Y)=""
;
I BEXEXIT=1 Q
;
W !
K DIR,DIRUT
S DIR("A")="Choose Sorting Order"
S DIR(0)="SO^A:Alphabetic within Window/Local/Mail;I:Internal Numbers - Similar to Refill Queue Order"
S DIR("B")="A"
D ^DIR
K DIR
I $D(DIRUT) K DIRUT G EOJ
I Y="A" S BEXSAME=0
I Y="I" S BEXSAME=1
;
;Only have Unprocessed entries
S BEXRTYPE="UNPROC"
;
W !
K DIR,DIRUT
S DIR(0)="S^A:All Entries;L:Local Mail Only;M:Mail Only (CMOP);W:Window Only"
S DIR("A")="Process All, Local Mail, Mail, or Window"
D ^DIR
I $G(DIRUT) K DIR,DIRUT Q
K DIR
S BEXWIND=Y
;
;
;--------------------------------------------------------------------------
;
W !
S XBRP="LIST^BEXRQUE"
S XBRX="EOJ^BEXRQUE"
S XBNS="BEX"
D ^XBDBQUE
Q
;
;
;---------------------------------------------------------------
EOJ ;EP - End of Job Processing
;---------------------------------------------------------------
;
X ^%ZIS("C")
I $E(IOST)="C",$G(BEXEXIT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR
;
;IHS/BJI/DAY - Patch 6 - Check if User Changed Sites
;
I $$CHECK^BEXSITE() D
.;
.W !!
.W "You may have changed your Outpatient Site!",!
.;
.D CHANGE^BEXSITE
;
;End Patch 6
;
K BEX
K ^BEXUTL($J)
D EN^XBVK("BEX")
K DIR,DIE,DIC,DD,DA,DR
Q
;
;
;---------------------------------------------------------------
LIST ;EP - Entry Point from XBDBQUE
;---------------------------------------------------------------
;
;
U IO
W #
D HEADER
;
K ^BEXUTL($J)
K BEXTOT
S BEXTOT=0
K BEXSUM
S BEXSUM="0^0^0^0^0^0^0"
;
S BEXQUIT=0
S BEXEXIT=0
;
;VEXHRX is subscripted by the value in ^DD("SITE",1) for all Divs
S BEXSITE=0
F S BEXSITE=$O(^VEXHRX(19080,BEXSITE)) Q:'BEXSITE D Q:BEXQUIT=1 Q:BEXEXIT=1
.;
.S BEXIEN=0
.F S BEXIEN=$O(^VEXHRX(19080,BEXSITE,BEXIEN)) Q:'BEXIEN D Q:BEXQUIT=1 Q:BEXEXIT=1
..;
..S BEXPTIEN=$P(BEXIEN,"-")
..S BEXRXIEN=$P(BEXIEN,"-",2)
..;
..;Screen by Division
..S BEXOPIEN=0
..I +BEXRXIEN S BEXOPIEN=$P($G(^PSRX(BEXRXIEN,2)),U,9)
..S BEXRFIEN=0
..I +BEXRXIEN S BEXRFIEN=$O(^PSRX(BEXRXIEN,1,99),-1)
..I +BEXRFIEN S BEXOPIEN=$P($G(^PSRX(BEXRXIEN,1,BEXRFIEN,0)),U,9)
..I +BEXOPSIT,+BEXOPIEN=0 Q
..I +BEXOPSIT,'$D(BEXOPSIT(BEXOPIEN)) Q
..;
..S BEXMAIL=$P(^VEXHRX(19080,BEXSITE,BEXIEN),U,4)
..I BEXMAIL="" S BEXMAIL="M"
..;
..;Did user want only Unprocessed entries
..S BEXFILL=$P($G(^PSRX(BEXRXIEN,3)),U)
..I BEXRTYPE="UNPROC",BEXFILL=DT Q
..I BEXRTYPE="UNPROC",BEXFILL>DT Q
..;
..;Did user want to restrict to certain values
..I BEXMAIL="W",BEXWIND="M" Q
..I BEXMAIL="W",BEXWIND="L" Q
..I BEXMAIL="L",BEXWIND="M" Q
..I BEXMAIL="L",BEXWIND="W" Q
..I BEXMAIL="M",BEXWIND="L" Q
..I BEXMAIL="M",BEXWIND="W" Q
..;
..;Want to sort by Window, Local, then Mail
..I BEXMAIL="W" S BEXSORT=1
..I BEXMAIL="L" S BEXSORT=2
..I BEXMAIL="M" S BEXSORT=3
..I $G(BEXSAME)=1 S BEXSORT=4
..;
..;Get Patient ID for Sort
..S BEXPAT=$$GET1^DIQ(2,BEXPTIEN,.01)
..I BEXPAT="" S BEXPAT="??"
..I $G(BEXSAME)=1 S BEXPAT=BEXPTIEN
..;
..S ^BEXUTL($J,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN)=BEXPTIEN_U_BEXMAIL
;
;Loop BEXUTL to extract sorted data
;
S BEXOPIEN=0
F S BEXOPIEN=$O(^BEXUTL($J,BEXOPIEN)) Q:'BEXOPIEN D Q:BEXEXIT=1
.;
.S BEXSORT=0
.F S BEXSORT=$O(^BEXUTL($J,BEXOPIEN,BEXSORT)) Q:'BEXSORT D Q:BEXEXIT=1
..;
..S BEXPAT=""
..F S BEXPAT=$O(^BEXUTL($J,BEXOPIEN,BEXSORT,BEXPAT)) Q:BEXPAT="" D Q:BEXEXIT=1
...;
...S BEXRXIEN=0
...F S BEXRXIEN=$O(^BEXUTL($J,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN)) Q:'BEXRXIEN D Q:BEXEXIT=1
....;
....S BEXPTIEN=$P(^BEXUTL($J,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN),U)
....S BEXMAIL=$P(^BEXUTL($J,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN),U,2)
....;
....D DETAIL
;
;
;Write Totals
;
I BEXEXIT=1 Q
;
I $Y>(IOSL-5) 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 !
;
I BEXEXIT=1 Q
;
I BEXTOT>0 D
.W !,"WINDOW",?14,$J(BEXTOT("W"),7)
.W !,"LOCAL MAIL",?14,$J(BEXTOT("L"),7)
.W !,"MAIL",?14,$J(BEXTOT("M"),7)
.W !,"TOTAL",?14,$J(BEXTOT,7)
;
Q
;
;
;--------------------------------------------------------------
;---------------------------------------------------------------
;
U IO
W #
W !,"REPORT: Refill Queue Report"
W " for "
I BEXOPSIT=1 W $$GET1^DIQ(59,$O(BEXOPSIT(0)),.01)
I BEXOPSIT=0 W "all Divisions"
I BEXOPSIT>1 W "selected Divisions"
W !,"DATE RUN: " S Y=DT X ^DD("DD") W Y
W !,"PARAMETERS: "
;
;
I BEXRTYPE="ALL" W "Both Processed and Unprocessed Entries"
I BEXRTYPE="UNPROC" W "Unprocessed Entries"
I BEXWIND="W" W ", Window Only"
I BEXWIND="L" W ", Local Mail Only"
I BEXWIND="M" W ", Mail (CMOP) Only"
I BEXSAME=0 W ", Alpha within W/L/M"
I BEXSAME=1 W ", Internal Sort"
;
W !
W "-------------------------------------------------------------------------------"
W !
W "Name"
W ?21,"Chart"
W ?30,"RX #"
W ?37,"M/W"
W ?42,"LFill"
W ?49,"Drug"
W ?74,"DEA"
;
W !
W "-------------------------------------------------------------------------------"
W !
;
Q
;
;
;-----------------------------------------------------------------
DETAIL ;EP - Write Detail for each Record and Add up totals
;-----------------------------------------------------------------
;
U IO
S BEXTOT=BEXTOT+1
;
;Initialize Counters for each type
I '$D(BEXTOT("M")) S BEXTOT("M")=0
I '$D(BEXTOT("L")) S BEXTOT("L")=0
I '$D(BEXTOT("W")) S BEXTOT("W")=0
;
;
;Add to Counters by Type
I BEXMAIL="W" S BEXTOT("W")=BEXTOT("W")+1
I BEXMAIL="L" S BEXTOT("L")=BEXTOT("L")+1
I BEXMAIL="M" S BEXTOT("M")=BEXTOT("M")+1
;
;--> Let's write out the record detail
;
;Patient Name
S Y=$$GET1^DIQ(2,BEXPTIEN,.01)
S Y=$E(Y,1,17)
I Y]"" W Y
;
;Write Patient HRNO
S Y=""
I +$G(BEXOPIEN) D
.S BEXINST=$P($G(^PS(59,BEXOPIEN,"INI")),U)
.I +BEXINST S Y=$$HRN^AUPNPAT(BEXPTIEN,BEXINST)
I Y="" S Y=$$HRN^AUPNPAT(BEXPTIEN,DUZ(2))
I Y>0 W ?20,$J(Y,6)
;
;Write RX Number
S BEXRXNUM=$$GET1^DIQ(52,BEXRXIEN,.01)
;Align numbers, then add any alpha to the end
I BEXRXNUM W ?28,$J(+BEXRXNUM,8)
S Y=$E(BEXRXNUM,$L(BEXRXNUM)) I Y?1A W Y
;
;Mail/Window Code
I BEXMAIL="W" W ?39,"W"
I BEXMAIL="L" W ?39,"L"
I BEXMAIL="M" W ?39,"M"
;
;
;Write Last Fill Date
S Y=$P($G(^PSRX(BEXRXIEN,3)),U)
I Y S Y=$E(Y,4,5)_"/"_$E(Y,6,7)
W ?42,Y
;
;Write Drug Name
S Y=$$GET1^DIQ(52,BEXRXIEN,6)
S Y=$E(Y,1,22)
W ?49,Y
;
;DEA, Special Handling
S BEXDRIEN=$$GET1^DIQ(52,BEXRXIEN,6,"I")
S Y=""
I BEXDRIEN D
.S X=$$GET1^DIQ(50,BEXDRIEN,3)
.I X[3 S Y=X
.I X[4 S Y=X
.I X[5 S Y=X
W ?74,Y
;
W !
;
I $Y>(IOSL-5) D
.I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR
.I X="^" S BEXEXIT=1 Q
.D HEADER
;
Q
;
BEXRQUE ;IHS/CMI/DAY - BEX - Refill Queue Report ; 05 Oct 2015 10:51 AM
+1 ;;1.0;BEX TELEPHONE REFILL SYSTEM;**4,5,6**;APR 20, 2015;Build 7
+2 ;
+3 ;Prints the Refill Queue Report
+4 ;
+5 ; New routine released in Patch 5
+6 ; Patch 6 improves Site Selection
+7 ;
+8 WRITE #
+9 ;
+10 WRITE !,"Refill Queue Report"
+11 WRITE !
+12 WRITE !,"This option prints a list of entries in the Refill Queue."
+13 WRITE !
+14 ;
+15 ;IHS/BJI/DAY - Patch 6 - Improved Site Selection
+16 ;
+17 ;Capture Site when entering BEXRQUE
+18 DO HOLD^BEXSITE
+19 ;
+20 ;Display Site to User and Ask for Change
+21 DO CHANGE^BEXSITE
+22 ;
+23 ;End Patch 6
+24 ;
+25 KILL BEXOPSIT
+26 SET BEXOPSIT=0
+27 SET BEXQUIT=0
+28 SET BEXEXIT=0
+29 ;
+30 WRITE !,"Press Enter to select ALL Outpatient Sites, or"
+31 FOR
Begin DoDot:1
+32 KILL DUOUT,DIC,DIR,DIE,DA,DR,DO,DD
+33 SET DIC(0)="AEQMZ"
+34 SET DIC("A")="Select a Outpatient Site: "
+35 SET DIC=59
+36 DO ^DIC
+37 KILL DIC,DIR,DIE,DA,DD,DR,DO
+38 IF $GET(DUOUT)
KILL DUOUT
SET (BEXQUIT,BEXEXIT)=1
QUIT
+39 IF X=""
SET BEXQUIT=1
QUIT
+40 IF Y<0
QUIT
+41 SET BEXOPSIT=BEXOPSIT+1
+42 IF +Y
SET BEXOPSIT(+Y)=""
End DoDot:1
IF BEXQUIT=1
QUIT
+43 ;
+44 IF BEXEXIT=1
QUIT
+45 ;
+46 WRITE !
+47 KILL DIR,DIRUT
+48 SET DIR("A")="Choose Sorting Order"
+49 SET DIR(0)="SO^A:Alphabetic within Window/Local/Mail;I:Internal Numbers - Similar to Refill Queue Order"
+50 SET DIR("B")="A"
+51 DO ^DIR
+52 KILL DIR
+53 IF $DATA(DIRUT)
KILL DIRUT
GOTO EOJ
+54 IF Y="A"
SET BEXSAME=0
+55 IF Y="I"
SET BEXSAME=1
+56 ;
+57 ;Only have Unprocessed entries
+58 SET BEXRTYPE="UNPROC"
+59 ;
+60 WRITE !
+61 KILL DIR,DIRUT
+62 SET DIR(0)="S^A:All Entries;L:Local Mail Only;M:Mail Only (CMOP);W:Window Only"
+63 SET DIR("A")="Process All, Local Mail, Mail, or Window"
+64 DO ^DIR
+65 IF $GET(DIRUT)
KILL DIR,DIRUT
QUIT
+66 KILL DIR
+67 SET BEXWIND=Y
+68 ;
+69 ;
+70 ;--------------------------------------------------------------------------
+71 ;
+72 WRITE !
+73 SET XBRP="LIST^BEXRQUE"
+74 SET XBRX="EOJ^BEXRQUE"
+75 SET XBNS="BEX"
+76 DO ^XBDBQUE
+77 QUIT
+78 ;
+79 ;
+80 ;---------------------------------------------------------------
EOJ ;EP - End of Job Processing
+1 ;---------------------------------------------------------------
+2 ;
+3 XECUTE ^%ZIS("C")
+4 IF $EXTRACT(IOST)="C"
IF $GET(BEXEXIT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 ;
+6 ;IHS/BJI/DAY - Patch 6 - Check if User Changed Sites
+7 ;
+8 IF $$CHECK^BEXSITE()
Begin DoDot:1
+9 ;
+10 WRITE !!
+11 WRITE "You may have changed your Outpatient Site!",!
+12 ;
+13 DO CHANGE^BEXSITE
End DoDot:1
+14 ;
+15 ;End Patch 6
+16 ;
+17 KILL BEX
+18 KILL ^BEXUTL($JOB)
+19 DO EN^XBVK("BEX")
+20 KILL DIR,DIE,DIC,DD,DA,DR
+21 QUIT
+22 ;
+23 ;
+24 ;---------------------------------------------------------------
LIST ;EP - Entry Point from XBDBQUE
+1 ;---------------------------------------------------------------
+2 ;
+3 ;
+4 USE IO
+5 WRITE #
+6 DO HEADER
+7 ;
+8 KILL ^BEXUTL($JOB)
+9 KILL BEXTOT
+10 SET BEXTOT=0
+11 KILL BEXSUM
+12 SET BEXSUM="0^0^0^0^0^0^0"
+13 ;
+14 SET BEXQUIT=0
+15 SET BEXEXIT=0
+16 ;
+17 ;VEXHRX is subscripted by the value in ^DD("SITE",1) for all Divs
+18 SET BEXSITE=0
+19 FOR
SET BEXSITE=$ORDER(^VEXHRX(19080,BEXSITE))
IF 'BEXSITE
QUIT
Begin DoDot:1
+20 ;
+21 SET BEXIEN=0
+22 FOR
SET BEXIEN=$ORDER(^VEXHRX(19080,BEXSITE,BEXIEN))
IF 'BEXIEN
QUIT
Begin DoDot:2
+23 ;
+24 SET BEXPTIEN=$PIECE(BEXIEN,"-")
+25 SET BEXRXIEN=$PIECE(BEXIEN,"-",2)
+26 ;
+27 ;Screen by Division
+28 SET BEXOPIEN=0
+29 IF +BEXRXIEN
SET BEXOPIEN=$PIECE($GET(^PSRX(BEXRXIEN,2)),U,9)
+30 SET BEXRFIEN=0
+31 IF +BEXRXIEN
SET BEXRFIEN=$ORDER(^PSRX(BEXRXIEN,1,99),-1)
+32 IF +BEXRFIEN
SET BEXOPIEN=$PIECE($GET(^PSRX(BEXRXIEN,1,BEXRFIEN,0)),U,9)
+33 IF +BEXOPSIT
IF +BEXOPIEN=0
QUIT
+34 IF +BEXOPSIT
IF '$DATA(BEXOPSIT(BEXOPIEN))
QUIT
+35 ;
+36 SET BEXMAIL=$PIECE(^VEXHRX(19080,BEXSITE,BEXIEN),U,4)
+37 IF BEXMAIL=""
SET BEXMAIL="M"
+38 ;
+39 ;Did user want only Unprocessed entries
+40 SET BEXFILL=$PIECE($GET(^PSRX(BEXRXIEN,3)),U)
+41 IF BEXRTYPE="UNPROC"
IF BEXFILL=DT
QUIT
+42 IF BEXRTYPE="UNPROC"
IF BEXFILL>DT
QUIT
+43 ;
+44 ;Did user want to restrict to certain values
+45 IF BEXMAIL="W"
IF BEXWIND="M"
QUIT
+46 IF BEXMAIL="W"
IF BEXWIND="L"
QUIT
+47 IF BEXMAIL="L"
IF BEXWIND="M"
QUIT
+48 IF BEXMAIL="L"
IF BEXWIND="W"
QUIT
+49 IF BEXMAIL="M"
IF BEXWIND="L"
QUIT
+50 IF BEXMAIL="M"
IF BEXWIND="W"
QUIT
+51 ;
+52 ;Want to sort by Window, Local, then Mail
+53 IF BEXMAIL="W"
SET BEXSORT=1
+54 IF BEXMAIL="L"
SET BEXSORT=2
+55 IF BEXMAIL="M"
SET BEXSORT=3
+56 IF $GET(BEXSAME)=1
SET BEXSORT=4
+57 ;
+58 ;Get Patient ID for Sort
+59 SET BEXPAT=$$GET1^DIQ(2,BEXPTIEN,.01)
+60 IF BEXPAT=""
SET BEXPAT="??"
+61 IF $GET(BEXSAME)=1
SET BEXPAT=BEXPTIEN
+62 ;
+63 SET ^BEXUTL($JOB,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN)=BEXPTIEN_U_BEXMAIL
End DoDot:2
IF BEXQUIT=1
QUIT
IF BEXEXIT=1
QUIT
End DoDot:1
IF BEXQUIT=1
QUIT
IF BEXEXIT=1
QUIT
+64 ;
+65 ;Loop BEXUTL to extract sorted data
+66 ;
+67 SET BEXOPIEN=0
+68 FOR
SET BEXOPIEN=$ORDER(^BEXUTL($JOB,BEXOPIEN))
IF 'BEXOPIEN
QUIT
Begin DoDot:1
+69 ;
+70 SET BEXSORT=0
+71 FOR
SET BEXSORT=$ORDER(^BEXUTL($JOB,BEXOPIEN,BEXSORT))
IF 'BEXSORT
QUIT
Begin DoDot:2
+72 ;
+73 SET BEXPAT=""
+74 FOR
SET BEXPAT=$ORDER(^BEXUTL($JOB,BEXOPIEN,BEXSORT,BEXPAT))
IF BEXPAT=""
QUIT
Begin DoDot:3
+75 ;
+76 SET BEXRXIEN=0
+77 FOR
SET BEXRXIEN=$ORDER(^BEXUTL($JOB,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN))
IF 'BEXRXIEN
QUIT
Begin DoDot:4
+78 ;
+79 SET BEXPTIEN=$PIECE(^BEXUTL($JOB,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN),U)
+80 SET BEXMAIL=$PIECE(^BEXUTL($JOB,BEXOPIEN,BEXSORT,BEXPAT,BEXRXIEN),U,2)
+81 ;
+82 DO DETAIL
End DoDot:4
IF BEXEXIT=1
QUIT
End DoDot:3
IF BEXEXIT=1
QUIT
End DoDot:2
IF BEXEXIT=1
QUIT
End DoDot:1
IF BEXEXIT=1
QUIT
+83 ;
+84 ;
+85 ;Write Totals
+86 ;
+87 IF BEXEXIT=1
QUIT
+88 ;
+89 IF $Y>(IOSL-5)
Begin DoDot:1
+90 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF X="^"
SET BEXEXIT=1
KILL DIR
+91 IF BEXEXIT=1
QUIT
+92 DO HEADER
+93 WRITE !
End DoDot:1
+94 ;
+95 IF BEXEXIT=1
QUIT
+96 ;
+97 IF BEXTOT>0
Begin DoDot:1
+98 WRITE !,"WINDOW",?14,$JUSTIFY(BEXTOT("W"),7)
+99 WRITE !,"LOCAL MAIL",?14,$JUSTIFY(BEXTOT("L"),7)
+100 WRITE !,"MAIL",?14,$JUSTIFY(BEXTOT("M"),7)
+101 WRITE !,"TOTAL",?14,$JUSTIFY(BEXTOT,7)
End DoDot:1
+102 ;
+103 QUIT
+104 ;
+105 ;
+106 ;--------------------------------------------------------------
+1 ;---------------------------------------------------------------
+2 ;
+3 USE IO
+4 WRITE #
+5 WRITE !,"REPORT: Refill Queue Report"
+6 WRITE " for "
+7 IF BEXOPSIT=1
WRITE $$GET1^DIQ(59,$ORDER(BEXOPSIT(0)),.01)
+8 IF BEXOPSIT=0
WRITE "all Divisions"
+9 IF BEXOPSIT>1
WRITE "selected Divisions"
+10 WRITE !,"DATE RUN: "
SET Y=DT
XECUTE ^DD("DD")
WRITE Y
+11 WRITE !,"PARAMETERS: "
+12 ;
+13 ;
+14 IF BEXRTYPE="ALL"
WRITE "Both Processed and Unprocessed Entries"
+15 IF BEXRTYPE="UNPROC"
WRITE "Unprocessed Entries"
+16 IF BEXWIND="W"
WRITE ", Window Only"
+17 IF BEXWIND="L"
WRITE ", Local Mail Only"
+18 IF BEXWIND="M"
WRITE ", Mail (CMOP) Only"
+19 IF BEXSAME=0
WRITE ", Alpha within W/L/M"
+20 IF BEXSAME=1
WRITE ", Internal Sort"
+21 ;
+22 WRITE !
+23 WRITE "-------------------------------------------------------------------------------"
+24 WRITE !
+25 WRITE "Name"
+26 WRITE ?21,"Chart"
+27 WRITE ?30,"RX #"
+28 WRITE ?37,"M/W"
+29 WRITE ?42,"LFill"
+30 WRITE ?49,"Drug"
+31 WRITE ?74,"DEA"
+32 ;
+33 WRITE !
+34 WRITE "-------------------------------------------------------------------------------"
+35 WRITE !
+36 ;
+37 QUIT
+38 ;
+39 ;
+40 ;-----------------------------------------------------------------
DETAIL ;EP - Write Detail for each Record and Add up totals
+1 ;-----------------------------------------------------------------
+2 ;
+3 USE IO
+4 SET BEXTOT=BEXTOT+1
+5 ;
+6 ;Initialize Counters for each type
+7 IF '$DATA(BEXTOT("M"))
SET BEXTOT("M")=0
+8 IF '$DATA(BEXTOT("L"))
SET BEXTOT("L")=0
+9 IF '$DATA(BEXTOT("W"))
SET BEXTOT("W")=0
+10 ;
+11 ;
+12 ;Add to Counters by Type
+13 IF BEXMAIL="W"
SET BEXTOT("W")=BEXTOT("W")+1
+14 IF BEXMAIL="L"
SET BEXTOT("L")=BEXTOT("L")+1
+15 IF BEXMAIL="M"
SET BEXTOT("M")=BEXTOT("M")+1
+16 ;
+17 ;--> Let's write out the record detail
+18 ;
+19 ;Patient Name
+20 SET Y=$$GET1^DIQ(2,BEXPTIEN,.01)
+21 SET Y=$EXTRACT(Y,1,17)
+22 IF Y]""
WRITE Y
+23 ;
+24 ;Write Patient HRNO
+25 SET Y=""
+26 IF +$GET(BEXOPIEN)
Begin DoDot:1
+27 SET BEXINST=$PIECE($GET(^PS(59,BEXOPIEN,"INI")),U)
+28 IF +BEXINST
SET Y=$$HRN^AUPNPAT(BEXPTIEN,BEXINST)
End DoDot:1
+29 IF Y=""
SET Y=$$HRN^AUPNPAT(BEXPTIEN,DUZ(2))
+30 IF Y>0
WRITE ?20,$JUSTIFY(Y,6)
+31 ;
+32 ;Write RX Number
+33 SET BEXRXNUM=$$GET1^DIQ(52,BEXRXIEN,.01)
+34 ;Align numbers, then add any alpha to the end
+35 IF BEXRXNUM
WRITE ?28,$JUSTIFY(+BEXRXNUM,8)
+36 SET Y=$EXTRACT(BEXRXNUM,$LENGTH(BEXRXNUM))
IF Y?1A
WRITE Y
+37 ;
+38 ;Mail/Window Code
+39 IF BEXMAIL="W"
WRITE ?39,"W"
+40 IF BEXMAIL="L"
WRITE ?39,"L"
+41 IF BEXMAIL="M"
WRITE ?39,"M"
+42 ;
+43 ;
+44 ;Write Last Fill Date
+45 SET Y=$PIECE($GET(^PSRX(BEXRXIEN,3)),U)
+46 IF Y
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)
+47 WRITE ?42,Y
+48 ;
+49 ;Write Drug Name
+50 SET Y=$$GET1^DIQ(52,BEXRXIEN,6)
+51 SET Y=$EXTRACT(Y,1,22)
+52 WRITE ?49,Y
+53 ;
+54 ;DEA, Special Handling
+55 SET BEXDRIEN=$$GET1^DIQ(52,BEXRXIEN,6,"I")
+56 SET Y=""
+57 IF BEXDRIEN
Begin DoDot:1
+58 SET X=$$GET1^DIQ(50,BEXDRIEN,3)
+59 IF X[3
SET Y=X
+60 IF X[4
SET Y=X
+61 IF X[5
SET Y=X
End DoDot:1
+62 WRITE ?74,Y
+63 ;
+64 WRITE !
+65 ;
+66 IF $Y>(IOSL-5)
Begin DoDot:1
+67 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+68 IF X="^"
SET BEXEXIT=1
QUIT
+69 DO HEADER
End DoDot:1
+70 ;
+71 QUIT
+72 ;
