- 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
