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