PSOERXEN ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
;;7.0;OUTPATIENT PHARMACY;**508,581,617,700**;DEC 1997;Build 261
;
Q
EN ;
N PSNPINST,DIR,Y,CODE,DIRUT,DTOUT,PSOVIEW,PSOCSSCH,PSOCSERX
I '$$CHKKEY^PSOERX(DUZ) D Q
.W !,"You do not have the appropriate key to access this option." S DIR(0)="E" D ^DIR K DIR
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) D MSG^PSODPT D EX^PSOERX Q
D:'$D(PSOPINST) INST^PSOORFI2 I $G(PSOIQUIT) K PSOIQUIT D EX^PSOERX Q
S PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
I 'PSNPINST W !,"NPI Institution must be defined to continue." S DIR(0)="E" D ^DIR K DIR Q
;
W !!?5,"************************** NOTICE ****************************"
W !?5,"This option will be retired soon. Please, use the new option:"
W !!?5,"ERX eRx Holding Queue Processing [PSO ERX QUEUE PROCESSING]"
W !!?5,"It fully replaces this option and provides some additional"
W !?5,"functionality that will help you process incoming eRx records"
W !?5,"more efficiently."
W !?5,"**************************************************************",$C(7)
K DIR S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
; Controlled Substance Filter Prompts
K DIR S DIR(0)="S^Non-CS:Non-Controlled Substance;CS:Controlled Substance;B:Both"
S DIR("B")="B",DIR("?")="Select the type of prescription to be included in the Holding Queue"
S DIR("A")="Select eRx Record Type"
D ^DIR I $D(DIRUT)!$D(DTOUT) Q
S PSOCSERX=Y,PSOCSSCH=""
;
I PSOCSERX'="Non-CS" D I $D(DIRUT)!$D(DTOUT) Q
. K DIR S DIR(0)="S^1:Schedule II;2:Schedules III - V;3:Schedules II - V"
. S DIR("B")="3",DIR("?")="Select the CS Schedule(s) to be included in the Holding Queue"
. S DIR("A")="Select Schedule(s)"
. D ^DIR I $D(DIRUT)!$D(DTOUT) Q
. S PSOCSSCH=Y
;
I '($D(PSOPRMPT)) D
.S DIR(0)="S^PT:PATIENT(Grouped);RX:PRESCRIPTION RECEIVED DATE;E:EXIT"
.S DIR("B")="PT"
.S DIR("?")=" PT - Patient Centric View"
.S DIR("?",1)=" RX - Traditional Holding Queue View"
.S DIR("A")="Select By: (PT/RX)"
.D ^DIR K DIR I $D(DIRUT)!$D(DTOUT) S PSOVIEW="^" Q
.;I $G(Y)="RX" D EN^PSOERX Q
.S PSOVIEW=Y
.I PSOVIEW="RX" Q
.I PSOVIEW="PT" D
..S DIR(0)="SO^A:ALL;1:NEW;2:IN PROGRESS;3:WAIT;4:HOLD;5:CCR"
..;S DIR("L")=""
..S DIR("L",1)=" Select By: Status"
..S DIR("L",2)=""
..S DIR("L",3)=" A All"
..S DIR("L",4)=" 1 New"
..S DIR("L",5)=" 2 In Process"
..S DIR("L",6)=" 3 Wait"
..S DIR("L",7)=" 4 Hold"
..S DIR("L")=" 5 CCR"
..S DIR("B")="A"
..S DIR("?")=" "
..S DIR("?",1)=" All - View all patients with actionable prescriptions"
..S DIR("?",2)=" New - View patients with prescriptions in the 'NEW' status"
..S DIR("?",3)=" In Process - View patients with prescriptions in the 'IN PROCESS' status"
..S DIR("?",4)=" Wait - View patients with prescriptions in the 'WAIT' status"
..S DIR("?",5)=" Hold - View patients with prescriptions in the 'HOLD' status"
..S DIR("?",6)=" CCR - View patients with prescriptions in the 'CCR' status"
..D ^DIR K DIR
..I Y["^" S CODE=0 S PSOVIEW="^" Q
..S CODE=$S(Y=1:$$PRESOLV^PSOERXA1("N","ERX"),Y=2:$$PRESOLV^PSOERXA1("I","ERX"),Y=3:$$PRESOLV^PSOERXA1("W","ERX"),1:"A")
..I Y=4 D
...S DIR(0)="SO^S:SINGLE CODE;A:ALL HOLD CODES",DIR("B")="A"
...S DIR("?")=" ",DIR("?",1)=" Single code - Allows selection of a single hold code",DIR("?",2)=" All Hold Codes - Selects all available hold codes"
...D ^DIR K DIR
...I Y=U S CODE=0 S PSOVIEW="^" Q
...I Y="S" S CODE=$P($$ESTAT(),U)
...I Y="A" S CODE="AH"
..I Y=5 D
...S DIR("B")="A",DIR(0)="SO^S:SINGLE CODE;A:ALL CCR CODES"
...S DIR("?")=" ",DIR("?",1)=" Single code - Allows selection of a single CCR code",DIR("?",2)=" All CCR Codes - Selects all available CCR codes"
...D ^DIR K DIR
...I Y=U S CODE=0 S PSOVIEW="^" Q
...I Y="S" S CODE=$P($$ESTAT2("RXN^RXD^RXR^RXE^RXF^CAO^CAH^CAP^CAR^CAX^CAF^CXD^CXN^CXV^CXY^CXE"),U)
...I Y="A" S CODE="CCR"
..Q:CODE=0
;
I PSOVIEW="^" Q
;
; Rx View
I PSOVIEW="RX" D EN^PSOERX Q
; Patient Centric View
D EN^PSOERXC1(,,CODE)
Q
;
ESTAT() ;
; prompt for erx status
N Y,DIC,X
S DIC("A")="Select eRx Status: "
S DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),($E($P(^PS(52.45,Y,0),U))=""H"")"
S DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
D ^DIC K DIC
I X=U!($D(DUOUT)) Q 0
I Y<1 Q ""
Q Y
ESTAT2(LST) ;
N I,DONE,DIC,Y,X,CODE,CARY,CIEN
S DONE=0
F I=1:1 D Q:DONE
.S CODE=$P(LST,U,I) I CODE="" S DONE=1 Q
.S CIEN=$$PRESOLV^PSOERXA1(CODE,"ERX")
.S CARY(CIEN)=""
S DIC("A")="Select eRx Status: "
S DIC=52.45,DIC(0)="AEQ",DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$D(CARY(Y))"
S DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
D ^DIC K DIC
I X=U!($D(DUOUT)) Q 0
I Y<1 Q ""
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERXEN 4820 printed Oct 16, 2024@18:29:09 Page 2
PSOERXEN ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**508,581,617,700**;DEC 1997;Build 261
+2 ;
+3 QUIT
EN ;
+1 NEW PSNPINST,DIR,Y,CODE,DIRUT,DTOUT,PSOVIEW,PSOCSSCH,PSOCSERX
+2 IF '$$CHKKEY^PSOERX(DUZ)
Begin DoDot:1
+3 WRITE !,"You do not have the appropriate key to access this option."
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+4 if '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
DO MSG^PSODPT
DO EX^PSOERX
QUIT
+5 if '$DATA(PSOPINST)
DO INST^PSOORFI2
IF $GET(PSOIQUIT)
KILL PSOIQUIT
DO EX^PSOERX
QUIT
+6 SET PSNPINST=$$GET1^DIQ(59,PSOSITE,101,"I")
+7 IF 'PSNPINST
WRITE !,"NPI Institution must be defined to continue."
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+8 ;
+9 WRITE !!?5,"************************** NOTICE ****************************"
+10 WRITE !?5,"This option will be retired soon. Please, use the new option:"
+11 WRITE !!?5,"ERX eRx Holding Queue Processing [PSO ERX QUEUE PROCESSING]"
+12 WRITE !!?5,"It fully replaces this option and provides some additional"
+13 WRITE !?5,"functionality that will help you process incoming eRx records"
+14 WRITE !?5,"more efficiently."
+15 WRITE !?5,"**************************************************************",$CHAR(7)
+16 KILL DIR
SET DIR("A")="Press Return to continue"
SET DIR(0)="E"
DO ^DIR
+17 ; Controlled Substance Filter Prompts
+18 KILL DIR
SET DIR(0)="S^Non-CS:Non-Controlled Substance;CS:Controlled Substance;B:Both"
+19 SET DIR("B")="B"
SET DIR("?")="Select the type of prescription to be included in the Holding Queue"
+20 SET DIR("A")="Select eRx Record Type"
+21 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+22 SET PSOCSERX=Y
SET PSOCSSCH=""
+23 ;
+24 IF PSOCSERX'="Non-CS"
Begin DoDot:1
+25 KILL DIR
SET DIR(0)="S^1:Schedule II;2:Schedules III - V;3:Schedules II - V"
+26 SET DIR("B")="3"
SET DIR("?")="Select the CS Schedule(s) to be included in the Holding Queue"
+27 SET DIR("A")="Select Schedule(s)"
+28 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+29 SET PSOCSSCH=Y
End DoDot:1
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+30 ;
+31 IF '($DATA(PSOPRMPT))
Begin DoDot:1
+32 SET DIR(0)="S^PT:PATIENT(Grouped);RX:PRESCRIPTION RECEIVED DATE;E:EXIT"
+33 SET DIR("B")="PT"
+34 SET DIR("?")=" PT - Patient Centric View"
+35 SET DIR("?",1)=" RX - Traditional Holding Queue View"
+36 SET DIR("A")="Select By: (PT/RX)"
+37 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
SET PSOVIEW="^"
QUIT
+38 ;I $G(Y)="RX" D EN^PSOERX Q
+39 SET PSOVIEW=Y
+40 IF PSOVIEW="RX"
QUIT
+41 IF PSOVIEW="PT"
Begin DoDot:2
+42 SET DIR(0)="SO^A:ALL;1:NEW;2:IN PROGRESS;3:WAIT;4:HOLD;5:CCR"
+43 ;S DIR("L")=""
+44 SET DIR("L",1)=" Select By: Status"
+45 SET DIR("L",2)=""
+46 SET DIR("L",3)=" A All"
+47 SET DIR("L",4)=" 1 New"
+48 SET DIR("L",5)=" 2 In Process"
+49 SET DIR("L",6)=" 3 Wait"
+50 SET DIR("L",7)=" 4 Hold"
+51 SET DIR("L")=" 5 CCR"
+52 SET DIR("B")="A"
+53 SET DIR("?")=" "
+54 SET DIR("?",1)=" All - View all patients with actionable prescriptions"
+55 SET DIR("?",2)=" New - View patients with prescriptions in the 'NEW' status"
+56 SET DIR("?",3)=" In Process - View patients with prescriptions in the 'IN PROCESS' status"
+57 SET DIR("?",4)=" Wait - View patients with prescriptions in the 'WAIT' status"
+58 SET DIR("?",5)=" Hold - View patients with prescriptions in the 'HOLD' status"
+59 SET DIR("?",6)=" CCR - View patients with prescriptions in the 'CCR' status"
+60 DO ^DIR
KILL DIR
+61 IF Y["^"
SET CODE=0
SET PSOVIEW="^"
QUIT
+62 SET CODE=$SELECT(Y=1:$$PRESOLV^PSOERXA1("N","ERX"),Y=2:$$PRESOLV^PSOERXA1("I","ERX"),Y=3:$$PRESOLV^PSOERXA1("W","ERX"),1:"A")
+63 IF Y=4
Begin DoDot:3
+64 SET DIR(0)="SO^S:SINGLE CODE;A:ALL HOLD CODES"
SET DIR("B")="A"
+65 SET DIR("?")=" "
SET DIR("?",1)=" Single code - Allows selection of a single hold code"
SET DIR("?",2)=" All Hold Codes - Selects all available hold codes"
+66 DO ^DIR
KILL DIR
+67 IF Y=U
SET CODE=0
SET PSOVIEW="^"
QUIT
+68 IF Y="S"
SET CODE=$PIECE($$ESTAT(),U)
+69 IF Y="A"
SET CODE="AH"
End DoDot:3
+70 IF Y=5
Begin DoDot:3
+71 SET DIR("B")="A"
SET DIR(0)="SO^S:SINGLE CODE;A:ALL CCR CODES"
+72 SET DIR("?")=" "
SET DIR("?",1)=" Single code - Allows selection of a single CCR code"
SET DIR("?",2)=" All CCR Codes - Selects all available CCR codes"
+73 DO ^DIR
KILL DIR
+74 IF Y=U
SET CODE=0
SET PSOVIEW="^"
QUIT
+75 IF Y="S"
SET CODE=$PIECE($$ESTAT2("RXN^RXD^RXR^RXE^RXF^CAO^CAH^CAP^CAR^CAX^CAF^CXD^CXN^CXV^CXY^CXE"),U)
+76 IF Y="A"
SET CODE="CCR"
End DoDot:3
+77 if CODE=0
QUIT
End DoDot:2
End DoDot:1
+78 ;
+79 IF PSOVIEW="^"
QUIT
+80 ;
+81 ; Rx View
+82 IF PSOVIEW="RX"
DO EN^PSOERX
QUIT
+83 ; Patient Centric View
+84 DO EN^PSOERXC1(,,CODE)
+85 QUIT
+86 ;
ESTAT() ;
+1 ; prompt for erx status
+2 NEW Y,DIC,X
+3 SET DIC("A")="Select eRx Status: "
+4 SET DIC=52.45
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),($E($P(^PS(52.45,Y,0),U))=""H"")"
+5 SET DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
+6 DO ^DIC
KILL DIC
+7 IF X=U!($DATA(DUOUT))
QUIT 0
+8 IF Y<1
QUIT ""
+9 QUIT Y
ESTAT2(LST) ;
+1 NEW I,DONE,DIC,Y,X,CODE,CARY,CIEN
+2 SET DONE=0
+3 FOR I=1:1
Begin DoDot:1
+4 SET CODE=$PIECE(LST,U,I)
IF CODE=""
SET DONE=1
QUIT
+5 SET CIEN=$$PRESOLV^PSOERXA1(CODE,"ERX")
+6 SET CARY(CIEN)=""
End DoDot:1
if DONE
QUIT
+7 SET DIC("A")="Select eRx Status: "
+8 SET DIC=52.45
SET DIC(0)="AEQ"
SET DIC("S")="I $D(^PS(52.45,""TYPE"",""ERX"",Y)),$D(CARY(Y))"
+9 SET DIC("W")="W "" - "",$P($G(^(0)),""^"",2)"
+10 DO ^DIC
KILL DIC
+11 IF X=U!($DATA(DUOUT))
QUIT 0
+12 IF Y<1
QUIT ""
+13 QUIT Y
