PSOERXEN ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
;;7.0;OUTPATIENT PHARMACY;**508,581,617**;DEC 1997;Build 110
;
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
;
; 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 4284 printed May 14, 2023@14:55:33 Page 2
PSOERXEN ;ALB/BWF - eRx Utilities/RPC's ; 6/1/2018 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**508,581,617**;DEC 1997;Build 110
+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 ; Controlled Substance Filter Prompts
+10 KILL DIR
SET DIR(0)="S^Non-CS:Non-Controlled Substance;CS:Controlled Substance;B:Both"
+11 SET DIR("B")="B"
SET DIR("?")="Select the type of prescription to be included in the Holding Queue"
+12 SET DIR("A")="Select eRx Record Type"
+13 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+14 SET PSOCSERX=Y
SET PSOCSSCH=""
+15 ;
+16 IF PSOCSERX'="Non-CS"
Begin DoDot:1
+17 KILL DIR
SET DIR(0)="S^1:Schedule II;2:Schedules III - V;3:Schedules II - V"
+18 SET DIR("B")="3"
SET DIR("?")="Select the CS Schedule(s) to be included in the Holding Queue"
+19 SET DIR("A")="Select Schedule(s)"
+20 DO ^DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+21 SET PSOCSSCH=Y
End DoDot:1
IF $DATA(DIRUT)!$DATA(DTOUT)
QUIT
+22 ;
+23 IF '($DATA(PSOPRMPT))
Begin DoDot:1
+24 SET DIR(0)="S^PT:PATIENT(Grouped);RX:PRESCRIPTION RECEIVED DATE;E:EXIT"
+25 SET DIR("B")="PT"
+26 SET DIR("?")=" PT - Patient Centric View"
+27 SET DIR("?",1)=" RX - Traditional Holding Queue View"
+28 SET DIR("A")="Select By: (PT/RX)"
+29 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DTOUT)
SET PSOVIEW="^"
QUIT
+30 ;I $G(Y)="RX" D EN^PSOERX Q
+31 SET PSOVIEW=Y
+32 IF PSOVIEW="RX"
QUIT
+33 IF PSOVIEW="PT"
Begin DoDot:2
+34 SET DIR(0)="SO^A:ALL;1:NEW;2:IN PROGRESS;3:WAIT;4:HOLD;5:CCR"
+35 ;S DIR("L")=""
+36 SET DIR("L",1)=" Select By: Status"
+37 SET DIR("L",2)=""
+38 SET DIR("L",3)=" A All"
+39 SET DIR("L",4)=" 1 New"
+40 SET DIR("L",5)=" 2 In Process"
+41 SET DIR("L",6)=" 3 Wait"
+42 SET DIR("L",7)=" 4 Hold"
+43 SET DIR("L")=" 5 CCR"
+44 SET DIR("B")="A"
+45 SET DIR("?")=" "
+46 SET DIR("?",1)=" All - View all patients with actionable prescriptions"
+47 SET DIR("?",2)=" New - View patients with prescriptions in the 'NEW' status"
+48 SET DIR("?",3)=" In Process - View patients with prescriptions in the 'IN PROCESS' status"
+49 SET DIR("?",4)=" Wait - View patients with prescriptions in the 'WAIT' status"
+50 SET DIR("?",5)=" Hold - View patients with prescriptions in the 'HOLD' status"
+51 SET DIR("?",6)=" CCR - View patients with prescriptions in the 'CCR' status"
+52 DO ^DIR
KILL DIR
+53 IF Y["^"
SET CODE=0
SET PSOVIEW="^"
QUIT
+54 SET CODE=$SELECT(Y=1:$$PRESOLV^PSOERXA1("N","ERX"),Y=2:$$PRESOLV^PSOERXA1("I","ERX"),Y=3:$$PRESOLV^PSOERXA1("W","ERX"),1:"A")
+55 IF Y=4
Begin DoDot:3
+56 SET DIR(0)="SO^S:SINGLE CODE;A:ALL HOLD CODES"
SET DIR("B")="A"
+57 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"
+58 DO ^DIR
KILL DIR
+59 IF Y=U
SET CODE=0
SET PSOVIEW="^"
QUIT
+60 IF Y="S"
SET CODE=$PIECE($$ESTAT(),U)
+61 IF Y="A"
SET CODE="AH"
End DoDot:3
+62 IF Y=5
Begin DoDot:3
+63 SET DIR("B")="A"
SET DIR(0)="SO^S:SINGLE CODE;A:ALL CCR CODES"
+64 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"
+65 DO ^DIR
KILL DIR
+66 IF Y=U
SET CODE=0
SET PSOVIEW="^"
QUIT
+67 IF Y="S"
SET CODE=$PIECE($$ESTAT2("RXN^RXD^RXR^RXE^RXF^CAO^CAH^CAP^CAR^CAX^CAF^CXD^CXN^CXV^CXY^CXE"),U)
+68 IF Y="A"
SET CODE="CCR"
End DoDot:3
+69 if CODE=0
QUIT
End DoDot:2
End DoDot:1
+70 ;
+71 IF PSOVIEW="^"
QUIT
+72 ;
+73 ; Rx View
+74 IF PSOVIEW="RX"
DO EN^PSOERX
QUIT
+75 ; Patient Centric View
+76 DO EN^PSOERXC1(,,CODE)
+77 QUIT
+78 ;
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
