- PSOREF ;BIR/SAB - refill data entry ; Feb 14, 2023@10:12:23
- ;;7.0;OUTPATIENT PHARMACY;**1,23,27,36,46,78,130,131,148,206,313,441,710,712**;DEC 1997;Build 20
- ; Reference to ^PSDRUG in ICR #221
- ; Reference to PSOL^PSSLOCK,PSOUL^PSSLOCK in ICR #2789
- ;
- 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"),PTRX
- D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
- Q
- OERR ;single refil
- I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q
- I $D(RXRP($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Reprint Label has been requested!" W $C(7) Q
- I $D(RXPR($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Partial has already been requested!" W $C(7) Q
- I $D(RXRS($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="Rx is being pulled from suspense!" W $C(7) 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
- I $$TITRX^PSOUTL($P(PSOLST(ORN),"^",2))="t" S VALMBCK="",VALMSG="Cannot refill 'Titration Rx'." W $C(7) 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
- 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
- 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 I $G(PSOREF("DFLG"))!($G(PSOREF("QFLG"))) D ^PSOBUILD,BLD^PSOORUT1 G SPEEDX
- .N ORD,ORN
- .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
- ..I $$TITRX^PSOUTL($P(PSOLST(ORN),"^",2))="t" D Q
- ...W $C(7),!!,"Rx# "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" is marked as 'Titration Rx' and cannot be refilled."
- ...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!" 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
- ..S PSOREF("IRXN")=$P(PSOLST(ORN),"^",2) I ASK D ^PSOREF1 S ASK=0 D:$G(PSOREF("QFLG")) ULK Q:$G(PSOREF("QFLG"))
- ..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
- ...I $$TITRX^PSOUTL($P(PSOLST(ORN),"^",2))="t" D Q
- ....W $C(7),!!,"Rx# "_$$GET1^DIQ(52,$P(PSOLST(ORN),"^",2),.01)_" is marked as 'Titration Rx' and cannot be refilled."
- ....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,DIV
- 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 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) N PSOJ F PSOJ=0:0 S PSOJ=$O(^PSRX(RXN,1,PSOJ)) Q:'PSOJ S PSORFRM=PSORFRM-1
- I $G(^PSRX(RXN,"PARK")) N RFGO S RFGO=$$REFNO(RXN) I 'RFGO Q "0^No Refills remaining. New Med order required." ;*712
- I PSORFRM<1,'$G(RFGO) 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."
- Q 1
- ;
- ULK D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))
- Q
- ;
- REFNO(DA) ;
- N RSDT,LBLP,PSOCMOP,RXF,I,RXC
- S (I,RXF,RSDT,LBLP)=0,RXC=$P(^PSRX(DA,0),"^",9)
- F S I=$O(^PSRX(DA,1,I)) Q:'I S RXF=I,RSDT=$P(^PSRX(DA,1,RXF,0),"^",18)
- S:'RXF RSDT=$P(^PSRX(DA,2),"^",13)
- I 'RSDT D CHKLBL^PSOPRKA(DA,RXF)
- I 'RSDT,'LBLP D ^PSOCMOPA
- I RXF=0,RXC>0 S RXF=RXC
- I RSDT!(LBLP)!($D(PSOCMOP)) Q:'RXF 0 I RXF,PSORFRM<1 Q 0
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOREF 9832 printed Mar 13, 2025@21:38:21 Page 2
- PSOREF ;BIR/SAB - refill data entry ; Feb 14, 2023@10:12:23
- +1 ;;7.0;OUTPATIENT PHARMACY;**1,23,27,36,46,78,130,131,148,206,313,441,710,712**;DEC 1997;Build 20
- +2 ; Reference to ^PSDRUG in ICR #221
- +3 ; Reference to PSOL^PSSLOCK,PSOUL^PSSLOCK in ICR #2789
- +4 ;
- 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"),PTRX
- +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 IF $DATA(RXRP($PIECE(PSOLST(ORN),"^",2)))
- SET VALMBCK=""
- SET VALMSG="A Reprint Label has been requested!"
- WRITE $CHAR(7)
- QUIT
- +3 IF $DATA(RXPR($PIECE(PSOLST(ORN),"^",2)))
- SET VALMBCK=""
- SET VALMSG="A Partial has already been requested!"
- WRITE $CHAR(7)
- QUIT
- +4 IF $DATA(RXRS($PIECE(PSOLST(ORN),"^",2)))
- SET VALMBCK=""
- SET VALMSG="Rx is being pulled from suspense!"
- WRITE $CHAR(7)
- QUIT
- +5 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
- +6 IF $$TITRX^PSOUTL($PIECE(PSOLST(ORN),"^",2))="t"
- SET VALMBCK=""
- SET VALMSG="Cannot refill 'Titration Rx'."
- WRITE $CHAR(7)
- QUIT
- +7 KILL PSOXFLAG
- +8 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
- +9 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
- +10 KILL PSOID
- DO ^PSOREF1
- IF PSOREF("DFLG")
- DO EOJ
- SET VALMBCK="R"
- QUIT
- +11 DO ^PSOREF0
- +12 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
- +13 QUIT
- SPEED ;speed refill
- +1 KILL LST,PSORX("FILL DATE")
- NEW VALMCNT
- IF '$GET(PSOCNT)
- SET VALMSG="This patient has no Prescriptions!"
- SET VALMBCK=""
- QUIT
- +2 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'."
- +3 DO ^DIR
- KILL DIR,DUOUT,DTOUT
- IF $DATA(DIRUT)
- SET VALMBCK=""
- QUIT
- +4 if Y
- GOTO BCREF
- +5 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
- +6 KILL DIR,DIRUT,DTOUT,PSOOELSE,DTOUT
- IF +Y
- SET (ASK,SPEED,PSOOELSE)=1
- DO FULL^VALM1
- SET LST=Y
- Begin DoDot:1
- +7 NEW ORD,ORN
- +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 IF $$TITRX^PSOUTL($PIECE(PSOLST(ORN),"^",2))="t"
- Begin DoDot:3
- +11 WRITE $CHAR(7),!!,"Rx# "_$$GET1^DIQ(52,$PIECE(PSOLST(ORN),"^",2),.01)_" is marked as 'Titration Rx' and cannot be refilled."
- +12 KILL DIR
- DO PAUSE^VALM1
- QUIT
- End DoDot:3
- QUIT
- +13 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
- +14 KILL PSOMSG
- IF $DATA(RXRP($PIECE(PSOLST(ORN),"^",2)))
- WRITE $CHAR(7),!!,"A Reprint Label has been requested!"
- DO ULK
- DO PAUSE^VALM1
- QUIT
- +15 IF $DATA(RXPR($PIECE(PSOLST(ORN),"^",2)))
- WRITE $CHAR(7),!!,"A Partial has already been requested!"
- DO ULK
- DO PAUSE^VALM1
- QUIT
- +16 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
- +17 KILL PSOXFLAG
- IF $DATA(RXRS($PIECE(PSOLST(ORN),"^",2)))
- WRITE $CHAR(7),!!,"Rx is being pulled from suspense!"
- DO ULK
- DO PAUSE^VALM1
- QUIT
- +18 IF $PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),"STA")),"^")=11
- Begin DoDot:3
- +19 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
- +20 SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
- IF ASK
- DO ^PSOREF1
- SET ASK=0
- if $GET(PSOREF("QFLG"))
- DO ULK
- if $GET(PSOREF("QFLG"))
- QUIT
- +21 NEW RXN
- DO FULL^VALM1
- if $GET(PSOFROM)'="NEW"
- SET PSOFROM="REFILL"
- SET PSOREF("DFLG")=0
- SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
- +22 IF PSOREF("DFLG")
- DO EOJ
- SET VALMBCK="R"
- QUIT
- +23 DO ^PSOREF0
- DO ULK
- End DoDot:2
- End DoDot:1
- IF $GET(PSOREF("DFLG"))!($GET(PSOREF("QFLG")))
- DO ^PSOBUILD
- DO BLD^PSOORUT1
- GOTO SPEEDX
- +24 if '$GET(PSOOELSE)
- SET VALMBCK=""
- +25 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 IF $$TITRX^PSOUTL($PIECE(PSOLST(ORN),"^",2))="t"
- Begin DoDot:4
- +12 WRITE $CHAR(7),!!,"Rx# "_$$GET1^DIQ(52,$PIECE(PSOLST(ORN),"^",2),.01)_" is marked as 'Titration Rx' and cannot be refilled."
- +13 KILL DIR
- DO PAUSE^VALM1
- QUIT
- End DoDot:4
- QUIT
- +14 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
- +15 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
- +16 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
- +17 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
- +18 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
- +19 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
- +20 NEW RXN
- DO FULL^VALM1
- if $GET(PSOFROM)'="NEW"
- SET PSOFROM="REFILL"
- SET PSOREF("DFLG")=0
- SET PSOREF("IRXN")=$PIECE(PSOLST(ORN),"^",2)
- +21 IF PSOREF("DFLG")
- DO EOJ
- SET VALMBCK="R"
- QUIT
- +22 DO ^PSOREF0
- DO ULK
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SET VALMBCK="R"
- GOTO BCREFX
- +23 FOR RX=1:1:PSOCNT
- IF $PIECE(PSOLST(RX),"^",2)=$PIECE(X,"-",2)
- Begin DoDot:1
- +24 IF $DATA(PSOBBC(RX))
- QUIT
- +25 SET LST=$GET(LST)_RX_","
- SET PSOBBC(RX)=1
- End DoDot:1
- QUIT
- +26 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,DIV
- +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 IF PSODEA["2"
- QUIT "0^Schedule 2 Drug. Order cannot be refilled."
- +7 IF '$PIECE($GET(^PSRX(RXN,"OR1")),"^")
- IF '$PIECE($GET(^PSDRUG(PSODRG,2)),"^")
- QUIT "0^Cannot Refill. Drug not matched to a Pharmacy Orderable Item."
- +8 IF '$PIECE($GET(^PSRX(RXN,"OR1")),"^")
- IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^")
- SET $PIECE(^PSRX(RXN,"OR1"),"^")=$PIECE(^PSDRUG(PSODRG,2),"^")
- +9 SET CLOZPAT=$SELECT($PIECE($GET(^PSDRUG(PSODRG,"CLOZ1")),"^")="PSOCLO1":1,1:0)
- +10 IF 'CLOZPAT
- IF PSODEA["A"&(PSODEA'["B")!(PSODEA["F")!(PSODEA[1)!(PSODEA[2)
- QUIT "0^"_$SELECT(PSODEA["A":"Narcotic Drug. ",1:"")_"Order Non-Refillable."
- +11 KILL CLOZPAT
- IF DT>$PIECE($GET(^PSRX(RXN,2)),"^",6)
- QUIT "0^Non-Refillable. Prescription has Expired."
- +12 IF $PIECE(^PSRX(RXN,3),"^",2)>$PIECE(^PSRX(RXN,2),"^",6)
- QUIT "0^Next Refill Date Past Expiration Date. New Order Required."
- +13 IF '$PIECE($GET(^PS(59,DIV,1)),"^",11)
- IF $GET(^PSDRUG(PSODRG,"I"))]""
- IF DT>$GET(^("I"))
- QUIT "0^Inactive Drug, Non Refillable."
- +14 IF ST
- QUIT "0^Prescription is in a Non-Refillable Status."
- +15 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
- QUIT "0^Cannot Refill. Drug No Longer Used by Outpatient Pharmacy."
- +16 SET PSORFRM=$PIECE(RX0,"^",9)
- NEW PSOJ
- FOR PSOJ=0:0
- SET PSOJ=$ORDER(^PSRX(RXN,1,PSOJ))
- if 'PSOJ
- QUIT
- SET PSORFRM=PSORFRM-1
- +17 ;*712
- IF $GET(^PSRX(RXN,"PARK"))
- NEW RFGO
- SET RFGO=$$REFNO(RXN)
- IF 'RFGO
- QUIT "0^No Refills remaining. New Med order required."
- +18 IF PSORFRM<1
- IF '$GET(RFGO)
- 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 QUIT 1
- +23 ;
- ULK DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
- +1 QUIT
- +2 ;
- REFNO(DA) ;
- +1 NEW RSDT,LBLP,PSOCMOP,RXF,I,RXC
- +2 SET (I,RXF,RSDT,LBLP)=0
- SET RXC=$PIECE(^PSRX(DA,0),"^",9)
- +3 FOR
- SET I=$ORDER(^PSRX(DA,1,I))
- if 'I
- QUIT
- SET RXF=I
- SET RSDT=$PIECE(^PSRX(DA,1,RXF,0),"^",18)
- +4 if 'RXF
- SET RSDT=$PIECE(^PSRX(DA,2),"^",13)
- +5 IF 'RSDT
- DO CHKLBL^PSOPRKA(DA,RXF)
- +6 IF 'RSDT
- IF 'LBLP
- DO ^PSOCMOPA
- +7 IF RXF=0
- IF RXC>0
- SET RXF=RXC
- +8 IF RSDT!(LBLP)!($DATA(PSOCMOP))
- if 'RXF
- QUIT 0
- IF RXF
- IF PSORFRM<1
- QUIT 0
- +9 QUIT 1
- +10 ;
