PSOREF ;BIR/SAB-refill data entry ;24-Jun-2013 10:51;PLS
;;7.0;OUTPATIENT PHARMACY;**1,23,27,36,46,78,130,131,1001,1006,1009,1013,148,206,1014,1016**;DEC 1997;Build 74
;External reference to ^PSDRUG supported by DBIA 221
;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
;
; Modified - IHS/CIA/PLS - 10/27/04 - Line SPEED+16
; IHS/MSC/PLS - 11/20/2010 - Line REFILL+6
; 10/05/2011 - Line OERR+1,OERR+8,SPEED+1,SPEED+10
; 06/24/2013 - Line OERR+3,SPEED+10
EOJ ;
K PSOMSG,PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RXO,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
Q
OERR ;single refil
I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q
N APSPDRG
;IHS/MSC/PLS - 06/24/2013
I $E($$GET1^DIQ(52,$P(PSOLST(ORN),U,2),.01),1)="X" S VALMBCK="R",VALMSG="An external Rx can't be refilled!" Q
I $D(RXRP($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Reprint Label has been requested!" Q
I $D(RXPR($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Partial has already been requested!" Q
I $D(RXRS($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="Rx is being pulled from suspense!" Q
I $D(RXFL($P(PSOLST(ORN),"^",2))) S PTRX=$P(PSOLST(ORN),"^",2) D ^PSOCMOPT I '$G(PSOXFLAG) K PSOXFLAG S VALMBCK="",VALMSG="Fill already requested for CMOP!" Q
K PSOXFLAG
D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG Q
;IHS/MSC/MGH Text for REM medication. Patch 1013
S APSPDRG=$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",6)
I +APSPDRG D REMMSG^APSPFUNC(APSPDRG)
N RXN K PSORX("FILL DATE") D FULL^VALM1 S:$G(PSOFROM)'="NEW" PSOFROM="REFILL" S PSOREF("DFLG")=0,PSOREF("IRXN")=$P(PSOLST(ORN),"^",2),PSOREF("QFLG")=0
K PSOID D ^PSOREF1 I PSOREF("DFLG") D EOJ S VALMBCK="R" Q
D ^PSOREF0
W ! K DIR,DIRUT,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DTOUT,DUOUT S PSORXED=1 D ^PSOBUILD,ACT^PSOORNE2 K PSORXED S VALMBCK="Q" D EOJ
Q
SPEED ;speed refill
N APSPDRG
K LST,PSORX("FILL DATE") N VALMCNT I '$G(PSOCNT) S VALMSG="This patient has no Prescriptions!" S VALMBCK="" Q
K DIR,DIRUT S DIR(0)="Y",DIR("B")="NO",DIR("A")="Barcode Refill",DIR("?")="If you want to use a barcode reader to process refills enter 'Y'."
D ^DIR K DIR,DUOUT,DTOUT I $D(DIRUT) S VALMBCK="" Q
G BCREF:Y
K PSOREF,PSOFDR,DIR,DUOUT,DIRUT S DIR("A")="Select Orders by number",DIR(0)="LO^1:"_PSOCNT D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT I +Y S (ASK,SPEED,PSOOELSE)=1 D FULL^VALM1 S LST=Y D G:$G(PSOREF("DFLG"))!($G(PSOREF("QFLG"))) SPEEDX
.F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']""!($G(PSOREF("QFLG"))) S ORN=$P(LST,",",ORD) D:+PSOLST(ORN)=52
..I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2)) W $C(7),!!,"Rx "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" has OPEN/UNRESOLVED 3rd Party Payer Reject!" K DIR D PAUSE^VALM1 Q
..;IHS/MSC/PLS - 06/24/2013
..I $E($$GET1^DIQ(52,$P(PSOLST(ORN),U,2),.01),1)="X" D K DIR D PAUSE^VALM1 Q
...W $C(7),!!,"Rx "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" is an external prescription and can't be refilled!"
..;IHS/MSC/MGH Text for REM medication. Patch 1013
..S APSPDRG=$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",6)
..I +APSPDRG D REMMSG^APSPFUNC(APSPDRG)
..D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) W $C(7),!!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")),! D PAUSE^VALM1 K PSOMSG Q
..K PSOMSG I $D(RXRP($P(PSOLST(ORN),"^",2))) W $C(7),!!,"A Reprint Label has been requested!" D ULK D PAUSE^VALM1 Q
..I $D(RXPR($P(PSOLST(ORN),"^",2))) W $C(7),!!,"A Partial has already been requested!" D ULK D PAUSE^VALM1 Q
..I $D(RXFL($P(PSOLST(ORN),"^",2))) S PTRX=$P(PSOLST(ORN),"^",2) D ^PSOCMOPT I '$G(PSOXFLAG) K PSOXFLAG W $C(7),!!,"A CMOP fill has already been requested for Rx "_$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^") D ULK D PAUSE^VALM1 Q
..K PSOXFLAG I $D(RXRS($P(PSOLST(ORN),"^",2))) W $C(7),!!,"Rx is being pulled from suspense!" D ULK D PAUSE^VALM1 Q
..I $P($G(^PSRX($P(PSOLST(ORN),"^",2),"STA")),"^")=11 D D ULK Q
...W $C(7),!!?5,"RX "_$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^")_" is in an EXPIRED status." W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
..; IHS/CIA/PLS - 10/27/04 - Added call to IHSSET for each successive prescription refill
..;S PSOREF("IRXN")=$P(PSOLST(ORN),"^",2) I ASK D ^PSOREF1 S ASK=0 D:$G(PSOREF("QFLG")) ULK Q:$G(PSOREF("QFLG"))
..S PSOREF("IRXN")=$P(PSOLST(ORN),"^",2)
..I ASK D Q:$G(PSOREF("QFLG"))
...D ^PSOREF1 S ASK=0 D:$G(PSOREF("QFLG")) ULK
..E D IHSSET^PSOREF1
..N RXN D FULL^VALM1 S:$G(PSOFROM)'="NEW" PSOFROM="REFILL" S PSOREF("DFLG")=0,PSOREF("IRXN")=$P(PSOLST(ORN),"^",2)
..I PSOREF("DFLG") D EOJ S VALMBCK="R" Q
..D ^PSOREF0 D ULK
S:'$G(PSOOELSE) VALMBCK=""
S PSORXED=1 D ^PSOBUILD,BLD^PSOORUT1
SPEEDX K PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RXO,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
K LST,SPEED,PSORXED,PSOREF,PSOFDR,PSOOELSE,ASK S:'$D(VALMBCK) VALMBCK="R"
K PSORX("FILL DATE"),PSORX("MAIL/WINDOW"),PSORX("METHOD OF PICK-UP")
Q
BCREF ;barcode refills
K LST,DIR,DIRUT,DUOUT,DTOUT D FULL^VALM1
ASK S DIR(0)="FO^5:245^K:X'?3N1""-""1.N X",DIR("A")="WAND BARCODE"
S DIR("?",1)="Wand the barcoded number of the prescription to be processed."
S DIR("?",2)="The number should be of the form NNN-NNNNNN",DIR("?",3)="where the number before the dash is your station number."
S DIR("?")="Enter ""^"", or a RETURN to quit."
D ^DIR I $D(DUOUT)!($D(DTOUT)) S VALMBCK="" G BCREFX
I $G(X)']"",'$G(LST) S VALMBCK="" G BCREFX
I $D(DIRUT),+$G(LST) D S VALMBCK="R" G BCREFX
.K DIR,DIRUT,DTOUT,PSOOELSE,DTOUT
.S (BCREF,ASK,SPEED,PSOOELSE)=1 D FULL^VALM1 D
..F ORD=1:1:$L(LST,",") Q:$P(LST,",",ORD)']""!($G(PSOREF("QFLG"))) S ORN=$P(LST,",",ORD) D:+PSOLST(ORN)=52
...I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2)) W $C(7),!!,"Rx "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" has OPEN/UNRESOLVED 3rd Party Payer Reject!" K DIR D PAUSE^VALM1 Q
...D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) W $C(7),!!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")),! D PAUSE^VALM1 K PSOMSG Q
...K PSOMSG I $D(RXRP($P(PSOLST(ORN),"^",2))) W $C(7),!!,"A Reprint Label has been requested for Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! D ULK D PAUSE^VALM1 Q
...I $D(RXPR($P(PSOLST(ORN),"^",2))) W $C(7),!!,"A Partial has already been requested for Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),! D ULK D PAUSE^VALM1 Q
...I $D(RXFL($P(PSOLST(ORN),"^",2))) S PTRX=$P(PSOLST(ORN),"^",2) D ^PSOCMOPT I '$G(PSOXFLAG) K PSOXFLAG W $C(7),!!,"A CMOP fill has already been requested for Rx "_$P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^") D ULK D PAUSE^VALM1 Q
...K PSOXFLAG I $D(RXRS($P(PSOLST(ORN),"^",2))) W $C(7),!!,"Rx "_$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^")_" is being pulled from suspense!" D ULK D PAUSE^VALM1 Q
...S PSOREF("IRXN")=$P(PSOLST(ORN),"^",2) I ASK D ^PSOREF1 S ASK=0 D:$G(PSOREF("DFLG")) ULK Q:$G(PSOREF("DFLG"))
...N RXN D FULL^VALM1 S:$G(PSOFROM)'="NEW" PSOFROM="REFILL" S PSOREF("DFLG")=0,PSOREF("IRXN")=$P(PSOLST(ORN),"^",2)
...I PSOREF("DFLG") D EOJ S VALMBCK="R" Q
...D ^PSOREF0 D ULK
F RX=1:1:PSOCNT I $P(PSOLST(RX),"^",2)=$P(X,"-",2) D Q
.I $D(PSOBBC(RX)) Q
.S LST=$G(LST)_RX_",",PSOBBC(RX)=1
G ASK
BCREFX K BCREF,ASK,LST,SPEED,RX,PSOBBC,DIR,DIRUT,PSORXED,PSOREF,PSOFDR,PSOOELSE S PSORXED=1 D ^PSOBUILD,BLD^PSOORUT1
S VALMBCK="R" Q
REFILL(PLACER) ;passes flag to CPRS for front door refill request
;PLACER=PHARMACY NUMBER
N PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST,PSODEA
I $G(PLACER)["S"!('$G(PLACER)) Q "-1^Not a Valid Outpatient Medication Order."
S RXN=PLACER I '$D(^PSRX(RXN,0)) Q "-1^Not a Valid Outpatient Medication Order."
S RX0=^PSRX(RXN,0),PSODRG=$P(^PSRX(RXN,0),"^",6),ST=+^("STA"),PSODRUG0=^PSDRUG(PSODRG,0),PSODEA=$P($G(^(0)),"^",3),DIV=$P(^PSRX(RXN,2),"^",9),PSORFRM=$P(RX0,"^",9)
I '$$SCREEN^APSPMULT(PSODRG,,1) Q "0^Sorry, this drug is not currently available in this facility" ;IHS/MSC/JDS - 11/20/2010
I PSODEA["2" Q "0^Schedule 2 Drug. Order cannot be refilled."
I '$P($G(^PSRX(RXN,"OR1")),"^"),'$P($G(^PSDRUG(PSODRG,2)),"^") Q "0^Cannot Refill. Drug not matched to a Pharmacy Orderable Item."
I '$P($G(^PSRX(RXN,"OR1")),"^"),$P($G(^PSDRUG(PSODRG,2)),"^") S $P(^PSRX(RXN,"OR1"),"^")=$P(^PSDRUG(PSODRG,2),"^")
S CLOZPAT=$S($P($G(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0)
I 'CLOZPAT I PSODEA["A"&(PSODEA'["B")!(PSODEA["F")!(PSODEA[1)!(PSODEA[2) Q "0^"_$S(PSODEA["A":"Narcotic Drug. ",1:"")_"Order Non-Refillable."
K CLOZPAT I DT>$P($G(^PSRX(RXN,2)),"^",6) Q "0^Non-Refillable. Prescription has Expired."
I $P(^PSRX(RXN,3),"^",2)>$P(^PSRX(RXN,2),"^",6) Q "0^Next Refill Date Past Expiration Date. New Order Required."
I '$P($G(^PS(59,DIV,1)),"^",11),$G(^PSDRUG(PSODRG,"I"))]"",DT>$G(^("I")) Q "0^Inactive Drug, Non Refillable."
I ST Q "0^Prescription is in a Non-Refillable Status."
I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" Q "0^Cannot Refill. Drug No Longer Used by Outpatient Pharmacy."
S PSORFRM=$P(RX0,"^",9) F PSOJ=0:0 S PSOJ=$O(^PSRX(RXN,1,PSOJ)) Q:'PSOJ S PSORFRM=PSORFRM-1
I PSORFRM<1 Q "0^No Refills remaining. New Med order required."
I $P(^PSRX(RXN,3),"^"),DT=$P(^PSRX(RXN,3),"^") Q "0^Can't Refill, Fill Date already exists for "_$E($P(^PSRX(RXN,3),"^"),4,5)_"/"_$E($P(^PSRX(RXN,3),"^"),6,7)_"/"_$E($P(^PSRX(RXN,3),"^"),2,3)_"."
I $P(^PSRX(RXN,3),"^"),DT<$P(^PSRX(RXN,3),"^") Q "0^Can't Refill, later Refill Date already exists for "_$E($P(^PSRX(RXN,3),"^"),4,5)_"/"_$E($P(^PSRX(RXN,3),"^"),6,7)_"/"_$E($P(^PSRX(RXN,3),"^"),2,3)_"."
I $O(^PS(52.41,"ARF",RXN,0)) Q "0^Pending Refill Request already exists."
I $P($G(^PSRX(RXN,999999921)),U,3) Q "0^Outside Pharmacy prescriptions can't be refilled." ;IHS/MSC/PLS - 10/17/07
Q 1
;
ULK D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
Q
PSOREF ;BIR/SAB-refill data entry ;24-Jun-2013 10:51;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**1,23,27,36,46,78,130,131,1001,1006,1009,1013,148,206,1014,1016**;DEC 1997;Build 74
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
+4 ;
+5 ; Modified - IHS/CIA/PLS - 10/27/04 - Line SPEED+16
+6 ; IHS/MSC/PLS - 11/20/2010 - Line REFILL+6
+7 ; 10/05/2011 - Line OERR+1,OERR+8,SPEED+1,SPEED+10
+8 ; 06/24/2013 - Line OERR+3,SPEED+10
EOJ ;
+1 KILL PSOMSG,PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RXO,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
+2 DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
+3 QUIT
OERR ;single refil
+1 IF $$LMREJ^PSOREJU1($PIECE(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK)
QUIT
+2 NEW APSPDRG
+3 ;IHS/MSC/PLS - 06/24/2013
+4 IF $EXTRACT($$GET1^DIQ(52,$PIECE(PSOLST(ORN),U,2),.01),1)="X"
SET VALMBCK="R"
SET VALMSG="An external Rx can't be refilled!"
QUIT
+5 IF $DATA(RXRP($PIECE(PSOLST(ORN),"^",2)))
SET VALMBCK=""
SET VALMSG="A Reprint Label has been requested!"
QUIT
+6 IF $DATA(RXPR($PIECE(PSOLST(ORN),"^",2)))
SET VALMBCK=""
SET VALMSG="A Partial has already been requested!"
QUIT
+7 IF $DATA(RXRS($PIECE(PSOLST(ORN),"^",2)))
SET VALMBCK=""
SET VALMSG="Rx is being pulled from suspense!"
QUIT
+8 IF $DATA(RXFL($PIECE(PSOLST(ORN),"^",2)))
SET PTRX=$PIECE(PSOLST(ORN),"^",2)
DO ^PSOCMOPT
IF '$GET(PSOXFLAG)
KILL PSOXFLAG
SET VALMBCK=""
SET VALMSG="Fill already requested for CMOP!"
QUIT
+9 KILL PSOXFLAG
+10 DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
IF '$GET(PSOMSG)
SET VALMSG=$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing this order.")
SET VALMBCK=""
KILL PSOMSG
QUIT
+11 ;IHS/MSC/MGH Text for REM medication. Patch 1013
+12 SET APSPDRG=$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^",6)
+13 IF +APSPDRG
DO REMMSG^APSPFUNC(APSPDRG)
+14 NEW RXN
KILL PSORX("FILL DATE")
DO FULL^VALM1
IF $GET(PSOFROM)'="NEW"
SET PSOFROM="REFILL"
SET PSOREF("DFLG")=0
SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
SET PSOREF("QFLG")=0
+15 KILL PSOID
DO ^PSOREF1
IF PSOREF("DFLG")
DO EOJ
SET VALMBCK="R"
QUIT
+16 DO ^PSOREF0
+17 WRITE !
KILL DIR,DIRUT,DTOUT,DUOUT
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR,DIRUT,DTOUT,DUOUT
SET PSORXED=1
DO ^PSOBUILD
DO ACT^PSOORNE2
KILL PSORXED
SET VALMBCK="Q"
DO EOJ
+18 QUIT
SPEED ;speed refill
+1 NEW APSPDRG
+2 KILL LST,PSORX("FILL DATE")
NEW VALMCNT
IF '$GET(PSOCNT)
SET VALMSG="This patient has no Prescriptions!"
SET VALMBCK=""
QUIT
+3 KILL DIR,DIRUT
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Barcode Refill"
SET DIR("?")="If you want to use a barcode reader to process refills enter 'Y'."
+4 DO ^DIR
KILL DIR,DUOUT,DTOUT
IF $DATA(DIRUT)
SET VALMBCK=""
QUIT
+5 IF Y
GOTO BCREF
+6 KILL PSOREF,PSOFDR,DIR,DUOUT,DIRUT
SET DIR("A")="Select Orders by number"
SET DIR(0)="LO^1:"_PSOCNT
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
KILL DIR,DIRUT,DTOUT,DUOUT
SET VALMBCK=""
QUIT
+7 KILL DIR,DIRUT,DTOUT,PSOOELSE,DTOUT
IF +Y
SET (ASK,SPEED,PSOOELSE)=1
DO FULL^VALM1
SET LST=Y
Begin DoDot:1
+8 FOR ORD=1:1:$LENGTH(LST,",")
IF $PIECE(LST,",",ORD)']""!($GET(PSOREF("QFLG")))
QUIT
SET ORN=$PIECE(LST,",",ORD)
IF +PSOLST(ORN)=52
Begin DoDot:2
+9 IF $$LMREJ^PSOREJU1($PIECE(PSOLST(ORN),"^",2))
WRITE $CHAR(7),!!,"Rx "_$$GET1^DIQ(52,$PIECE(PSOLST(ORN),"^",2),.01)_" has OPEN/UNRESOLVED 3rd Party Payer Reject!"
KILL DIR
DO PAUSE^VALM1
QUIT
+10 ;IHS/MSC/PLS - 06/24/2013
+11 IF $EXTRACT($$GET1^DIQ(52,$PIECE(PSOLST(ORN),U,2),.01),1)="X"
Begin DoDot:3
+12 WRITE $CHAR(7),!!,"Rx "_$$GET1^DIQ(52,$PIECE(PSOLST(ORN),"^",2),.01)_" is an external prescription and can't be refilled!"
End DoDot:3
KILL DIR
DO PAUSE^VALM1
QUIT
+13 ;IHS/MSC/MGH Text for REM medication. Patch 1013
+14 SET APSPDRG=$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^",6)
+15 IF +APSPDRG
DO REMMSG^APSPFUNC(APSPDRG)
+16 DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
IF '$GET(PSOMSG)
WRITE $CHAR(7),!!,$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing Rx "_$PIECE(^PSRX($PIECE(PSOLST(ORN),"^",2),0),"^")),!
DO PAUSE^VALM1
KILL PSOMSG
QUIT
+17 KILL PSOMSG
IF $DATA(RXRP($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"A Reprint Label has been requested!"
DO ULK
DO PAUSE^VALM1
QUIT
+18 IF $DATA(RXPR($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"A Partial has already been requested!"
DO ULK
DO PAUSE^VALM1
QUIT
+19 IF $DATA(RXFL($PIECE(PSOLST(ORN),"^",2)))
SET PTRX=$PIECE(PSOLST(ORN),"^",2)
DO ^PSOCMOPT
IF '$GET(PSOXFLAG)
KILL PSOXFLAG
WRITE $CHAR(7),!!,"A CMOP fill has already been requested for Rx "_$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^")
DO ULK
DO PAUSE^VALM1
QUIT
+20 KILL PSOXFLAG
IF $DATA(RXRS($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"Rx is being pulled from suspense!"
DO ULK
DO PAUSE^VALM1
QUIT
+21 IF $PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),"STA")),"^")=11
Begin DoDot:3
+22 WRITE $CHAR(7),!!?5,"RX "_$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^")_" is in an EXPIRED status."
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
End DoDot:3
DO ULK
QUIT
+23 ; IHS/CIA/PLS - 10/27/04 - Added call to IHSSET for each successive prescription refill
+24 ;S PSOREF("IRXN")=$P(PSOLST(ORN),"^",2) I ASK D ^PSOREF1 S ASK=0 D:$G(PSOREF("QFLG")) ULK Q:$G(PSOREF("QFLG"))
+25 SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
+26 IF ASK
Begin DoDot:3
+27 DO ^PSOREF1
SET ASK=0
IF $GET(PSOREF("QFLG"))
DO ULK
End DoDot:3
IF $GET(PSOREF("QFLG"))
QUIT
+28 IF '$TEST
DO IHSSET^PSOREF1
+29 NEW RXN
DO FULL^VALM1
IF $GET(PSOFROM)'="NEW"
SET PSOFROM="REFILL"
SET PSOREF("DFLG")=0
SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
+30 IF PSOREF("DFLG")
DO EOJ
SET VALMBCK="R"
QUIT
+31 DO ^PSOREF0
DO ULK
End DoDot:2
End DoDot:1
IF $GET(PSOREF("DFLG"))!($GET(PSOREF("QFLG")))
GOTO SPEEDX
+32 IF '$GET(PSOOELSE)
SET VALMBCK=""
+33 SET PSORXED=1
DO ^PSOBUILD
DO BLD^PSOORUT1
SPEEDX KILL PSOREF,PSORX("BAR CODE"),PSOLIST,LFD,MAX,MIN,NODE,PS,PSOERR,REF,RF,RXO,RXN,RXP,RXS,SD,VAERR,PSORX("FILL DATE")
+1 KILL LST,SPEED,PSORXED,PSOREF,PSOFDR,PSOOELSE,ASK
IF '$DATA(VALMBCK)
SET VALMBCK="R"
+2 KILL PSORX("FILL DATE"),PSORX("MAIL/WINDOW"),PSORX("METHOD OF PICK-UP")
+3 QUIT
BCREF ;barcode refills
+1 KILL LST,DIR,DIRUT,DUOUT,DTOUT
DO FULL^VALM1
ASK SET DIR(0)="FO^5:245^K:X'?3N1""-""1.N X"
SET DIR("A")="WAND BARCODE"
+1 SET DIR("?",1)="Wand the barcoded number of the prescription to be processed."
+2 SET DIR("?",2)="The number should be of the form NNN-NNNNNN"
SET DIR("?",3)="where the number before the dash is your station number."
+3 SET DIR("?")="Enter ""^"", or a RETURN to quit."
+4 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET VALMBCK=""
GOTO BCREFX
+5 IF $GET(X)']""
IF '$GET(LST)
SET VALMBCK=""
GOTO BCREFX
+6 IF $DATA(DIRUT)
IF +$GET(LST)
Begin DoDot:1
+7 KILL DIR,DIRUT,DTOUT,PSOOELSE,DTOUT
+8 SET (BCREF,ASK,SPEED,PSOOELSE)=1
DO FULL^VALM1
Begin DoDot:2
+9 FOR ORD=1:1:$LENGTH(LST,",")
IF $PIECE(LST,",",ORD)']""!($GET(PSOREF("QFLG")))
QUIT
SET ORN=$PIECE(LST,",",ORD)
IF +PSOLST(ORN)=52
Begin DoDot:3
+10 IF $$LMREJ^PSOREJU1($PIECE(PSOLST(ORN),"^",2))
WRITE $CHAR(7),!!,"Rx "_$$GET1^DIQ(52,$PIECE(PSOLST(ORN),"^",2),.01)_" has OPEN/UNRESOLVED 3rd Party Payer Reject!"
KILL DIR
DO PAUSE^VALM1
QUIT
+11 DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
IF '$GET(PSOMSG)
WRITE $CHAR(7),!!,$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing Rx "_$PIECE(^PSRX($PIECE(PSOLST(ORN),"^",2),0),"^")),!
DO PAUSE^VALM1
KILL PSOMSG
QUIT
+12 KILL PSOMSG
IF $DATA(RXRP($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"A Reprint Label has been requested for Rx "_$PIECE(^PSRX($PIECE(PSOLST(ORN),"^",2),0),"^"),!
DO ULK
DO PAUSE^VALM1
QUIT
+13 IF $DATA(RXPR($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"A Partial has already been requested for Rx "_$PIECE(^PSRX($PIECE(PSOLST(ORN),"^",2),0),"^"),!
DO ULK
DO PAUSE^VALM1
QUIT
+14 IF $DATA(RXFL($PIECE(PSOLST(ORN),"^",2)))
SET PTRX=$PIECE(PSOLST(ORN),"^",2)
DO ^PSOCMOPT
IF '$GET(PSOXFLAG)
KILL PSOXFLAG
WRITE $CHAR(7),!!,"A CMOP fill has already been requested for Rx "_$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^")
DO ULK
DO PAUSE^VALM1
QUIT
+15 KILL PSOXFLAG
IF $DATA(RXRS($PIECE(PSOLST(ORN),"^",2)))
WRITE $CHAR(7),!!,"Rx "_$PIECE(^PSRX($PIECE(PSOLST(ORN),"^",2),0),"^")_" is being pulled from suspense!"
DO ULK
DO PAUSE^VALM1
QUIT
+16 SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
IF ASK
DO ^PSOREF1
SET ASK=0
IF $GET(PSOREF("DFLG"))
DO ULK
IF $GET(PSOREF("DFLG"))
QUIT
+17 NEW RXN
DO FULL^VALM1
IF $GET(PSOFROM)'="NEW"
SET PSOFROM="REFILL"
SET PSOREF("DFLG")=0
SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
+18 IF PSOREF("DFLG")
DO EOJ
SET VALMBCK="R"
QUIT
+19 DO ^PSOREF0
DO ULK
End DoDot:3
End DoDot:2
End DoDot:1
SET VALMBCK="R"
GOTO BCREFX
+20 FOR RX=1:1:PSOCNT
IF $PIECE(PSOLST(RX),"^",2)=$PIECE(X,"-",2)
Begin DoDot:1
+21 IF $DATA(PSOBBC(RX))
QUIT
+22 SET LST=$GET(LST)_RX_","
SET PSOBBC(RX)=1
End DoDot:1
QUIT
+23 GOTO ASK
BCREFX KILL BCREF,ASK,LST,SPEED,RX,PSOBBC,DIR,DIRUT,PSORXED,PSOREF,PSOFDR,PSOOELSE
SET PSORXED=1
DO ^PSOBUILD
DO BLD^PSOORUT1
+1 SET VALMBCK="R"
QUIT
REFILL(PLACER) ;passes flag to CPRS for front door refill request
+1 ;PLACER=PHARMACY NUMBER
+2 NEW PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST,PSODEA
+3 IF $GET(PLACER)["S"!('$GET(PLACER))
QUIT "-1^Not a Valid Outpatient Medication Order."
+4 SET RXN=PLACER
IF '$DATA(^PSRX(RXN,0))
QUIT "-1^Not a Valid Outpatient Medication Order."
+5 SET RX0=^PSRX(RXN,0)
SET PSODRG=$PIECE(^PSRX(RXN,0),"^",6)
SET ST=+^("STA")
SET PSODRUG0=^PSDRUG(PSODRG,0)
SET PSODEA=$PIECE($GET(^(0)),"^",3)
SET DIV=$PIECE(^PSRX(RXN,2),"^",9)
SET PSORFRM=$PIECE(RX0,"^",9)
+6 ;IHS/MSC/JDS - 11/20/2010
IF '$$SCREEN^APSPMULT(PSODRG,,1)
QUIT "0^Sorry, this drug is not currently available in this facility"
+7 IF PSODEA["2"
QUIT "0^Schedule 2 Drug. Order cannot be refilled."
+8 IF '$PIECE($GET(^PSRX(RXN,"OR1")),"^")
IF '$PIECE($GET(^PSDRUG(PSODRG,2)),"^")
QUIT "0^Cannot Refill. Drug not matched to a Pharmacy Orderable Item."
+9 IF '$PIECE($GET(^PSRX(RXN,"OR1")),"^")
IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^")
SET $PIECE(^PSRX(RXN,"OR1"),"^")=$PIECE(^PSDRUG(PSODRG,2),"^")
+10 SET CLOZPAT=$SELECT($PIECE($GET(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0)
+11 IF 'CLOZPAT
IF PSODEA["A"&(PSODEA'["B")!(PSODEA["F")!(PSODEA[1)!(PSODEA[2)
QUIT "0^"_$SELECT(PSODEA["A":"Narcotic Drug. ",1:"")_"Order Non-Refillable."
+12 KILL CLOZPAT
IF DT>$PIECE($GET(^PSRX(RXN,2)),"^",6)
QUIT "0^Non-Refillable. Prescription has Expired."
+13 IF $PIECE(^PSRX(RXN,3),"^",2)>$PIECE(^PSRX(RXN,2),"^",6)
QUIT "0^Next Refill Date Past Expiration Date. New Order Required."
+14 IF '$PIECE($GET(^PS(59,DIV,1)),"^",11)
IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DT>$GET(^("I"))
QUIT "0^Inactive Drug, Non Refillable."
+15 IF ST
QUIT "0^Prescription is in a Non-Refillable Status."
+16 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
QUIT "0^Cannot Refill. Drug No Longer Used by Outpatient Pharmacy."
+17 SET PSORFRM=$PIECE(RX0,"^",9)
FOR PSOJ=0:0
SET PSOJ=$ORDER(^PSRX(RXN,1,PSOJ))
IF 'PSOJ
QUIT
SET PSORFRM=PSORFRM-1
+18 IF PSORFRM<1
QUIT "0^No Refills remaining. New Med order required."
+19 IF $PIECE(^PSRX(RXN,3),"^")
IF DT=$PIECE(^PSRX(RXN,3),"^")
QUIT "0^Can't Refill, Fill Date already exists for "_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),4,5)_"/"_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),6,7)_"/"_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),2,3)_"."
+20 IF $PIECE(^PSRX(RXN,3),"^")
IF DT<$PIECE(^PSRX(RXN,3),"^")
QUIT "0^Can't Refill, later Refill Date already exists for "_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),4,5)_"/"_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),6,7)_"/"_$EXTRACT($PIECE(^PSRX(RXN,3),"^"),2,3)_"."
+21 IF $ORDER(^PS(52.41,"ARF",RXN,0))
QUIT "0^Pending Refill Request already exists."
+22 ;IHS/MSC/PLS - 10/17/07
IF $PIECE($GET(^PSRX(RXN,999999921)),U,3)
QUIT "0^Outside Pharmacy prescriptions can't be refilled."
+23 QUIT 1
+24 ;
ULK DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
+1 QUIT
