PSORENW ;BIR/SAB-renew main driver ;22-Jan-2013 17:42;DU
;;7.0;OUTPATIENT PHARMACY;**11,27,30,46,71,96,100,130,1004,1009,1010,148,206,1014,1016**;DEC 1997;Build 74
;External reference to ^PSDRUG supported by DBIA 221
;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
;External reference to LK^ORX2 and ULK^ORX2 supported by DBIA 867
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to MAIN^TIUEDIT supported by DBIA 2410
;Modified - IHS/CIA/DKM - 10/11/2005 - line RENEW
; IHS/MSC/JDS - 11/20/2010 - Line RENEW+7
; IHS/MSC/JDS - 01/25/2011 - Line OERR+5
; - 10/25/2011 - Line OERR+1,OERR+8
; IHS/MSC/PB - 01/22/2013 - Line OERR+5 added for external rx screen during renew
ASK ;
K PSORENW("FILL DATE") D FILLDT^PSODIR2(.PSORENW) S:$G(PSORENW("DFLG")) VALMSG="Renew Rx request canceled",VALMBCK="R"
I PSORENW("DFLG")!('$D(PSORENW("FILL DATE"))) S PSORENW("QFLG")=1,PSORENW("DFLG")=0 G ASKX
S PSORNW("FILL DATE")=PSORENW("FILL DATE")
D MW^PSOCMOPA(.PSORENW)
I PSORENW("DFLG") S PSORENW("QFLG")=1,PSORENW("DFLG")=0 G ASKX
S PSORNW("MAIL/WINDOW")=PSORENW("MAIL/WINDOW") S PSORX("MAIL/WINDOW")=$S(PSORENW("MAIL/WINDOW")="M":"MAIL",1:"WINDOW")
D NOORE^PSONEW(.PSORENW) S:$G(PSORENW("DFLG")) VALMSG="Renew Rx request canceled",VALMBCK="R"
I PSORENW("DFLG")!('$D(PSORENW("FILL DATE"))) S PSORENW("QFLG")=1,PSORENW("DFLG")=0
ASKX Q
;
EOJ ;
K VERB,RTE,DRET,PSOMSG,PSORNW,PSOLIST,PSORENW,PSORX("BAR CODE"),PSORX("FILL DATE"),PSODIR,PSOID,PSONOOR,PSOCOU,PSOCOUU,PSOID,PSOFDMX,PSODRUG,COPY,PSOBCKDR
S RXN=$O(^TMP("PSORXN",$J,0)) I RXN D
.S RXN1=^TMP("PSORXN",$J,RXN) D EN^PSOHLSN1(RXN,$P(RXN1,"^"),$P(RXN1,"^",2),"",$P(RXN1,"^",3))
.I $P(^PSRX(RXN,"STA"),"^")=5 D EN^PSOHLSN1(RXN,"SC","ZS",$P(RXN1,"^",4))
K RXN,RXN1,^TMP("PSORXN",$J)
I $G(PSONOTE) D MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
K PSONOTE
Q
OERR ;entry for renew backdoor
I $$LMREJ^PSOREJU1($P(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK) Q
N APSPDRG
;ISH/MSC/PB - Screen added in P1016 to check for external Rx. If external, Rx can't be renewed, must be copied and a new Rx created. 1/22/13
I $E($P($G(^PSRX($P(PSOLST(ORN),"^",2),0)),"^",1))="X" D Q
.W !,"An external Rx can't be Renewed in RPMS Prescription Processing."
.W !,"Use Copy to create a new internal Rx from this external Rx."
.S DIR("A")="Press Return to continue",DIR(0)="E",DIR("?")="Press Return to continue" D ^DIR K DIR
;ISH/MSC/PB end changes for screen of external Rx for renew
S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.") K PSOPLCK S VALMBCK="" Q
K PSOPLCK S X=PSODFN_";DPT(" D LK^ORX2 I 'Y S VALMSG="Another person is entering orders for this patient.",VALMBCK="" D UL^PSSLOCK(PSODFN) Q
K PSOID,PSOFDMX,PSORX("FILL DATE"),PSORENW("FILL DATE"),PSORX("QS"),PSORENW("QS"),PSOBARCD,COPY
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 D ULPAT Q
;IHS/MSC/JDS - 01/25/2011
I '$$SCREEN^APSPMULT(+$P($G(^PSRX(+$P(PSOLST(ORN),"^",2),0)),"^",6),,1) S VALMSG="Drug is not currently available in this facility",VALMBCK="" D ULPAT 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)
S PSOBCKDR=1,PSOFROM="NEW",PSORENW("OIRXN")=$P(PSOLST(ORN),"^",2),PSOOPT=3,(PSORENW("DFLG"),PSORENW("QFLG"),PSORX("DFLG"))=0
S PSONEW("DAYS SUPPLY")=$P(^PSRX(PSORENW("OIRXN"),0),"^",8),PSONEW("# OF REFILLS")=$P(^(0),"^",9)
D FULL^VALM1,ASK D:PSORENW("QFLG") KLIB^PSORENW1 D:PSORENW("QFLG") ULPAT D:PSORENW("QFLG") PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2)) G:PSORENW("QFLG") EOJ D ^PSORENW0
D ULPAT,EOJ,KLIB^PSORENW1 K PSOOPT,PSONEW,PSORX("DFLG")
Q
ULPAT K PSOMSG D UL^PSSLOCK(PSODFN) S X=PSODFN_";DPT(" D ULK^ORX2
Q
; IHS/CIA/DKM - 10/11/2005 - Added DAYS parameter to extrinsic.
RENEW(PLACER,PSOCPDRG,DAYS) ;passes flag to CPRS for front door renews
;-1=couldn't find order, 0=unable to renew, 1=renewable
;Placer=Pharmacy number
N PSOSURX,PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST,PSONEWOI,PSOOLDOI,PSOIFLAG,PSOINA
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)
I '$$SCREEN^APSPMULT(PSODRG,,1) Q "0^Sorry, this drug is not currently available in this facility" ;IHS/MSC/JDS - 11/20/10
S PSOIFLAG=0,PSOOLDOI=+$P($G(^PSRX(RXN,"OR1")),"^"),PSONEWOI=+$P($G(^PSDRUG(+$G(PSODRG),2)),"^") I PSONEWOI,PSONEWOI'=PSOOLDOI S PSOIFLAG=1
S PSOINA=$P($G(^PS(50.7,PSONEWOI,0)),"^",4)
I PSOINA,DT>PSOINA Q "0^This Orderable Item has been Inactivated."
I ST=5 S PSOSURX=$O(^PS(52.5,"B",RXN,0)) I PSOSURX,$P($G(^PS(52.5,PSOSURX,0)),"^",7)="L" Q "0^Rx loading into a CMOP Transmission."
; IHS/CIA/DKM - 10/11/2005 - Modified next 2 lines to use DAYS parameter
;S X1=DT,X2=-120 D C^%DTC I $P($G(^PSRX(RXN,2)),"^",6)<X Q "0^Prescription Expired more than 120 Days."
;S X1=DT,X2=-120 D C^%DTC I $P($G(^PSRX(RXN,3)),"^",5),$P($G(^(3)),"^",5)<X,$P(^("STA"),"^")=12 Q "0^Prescription Discontinued more than 120 Days."
S:'$G(DAYS) DAYS=120
S X=$$FMADD^XLFDT(DT,-DAYS) I $P($G(^PSRX(RXN,2)),"^",6)<X Q "0^Prescription Expired more than "_DAYS_" Days."
S X=$$FMADD^XLFDT(DT,-DAYS) I $P($G(^PSRX(RXN,3)),"^",5),$P($G(^(3)),"^",5)<X,$P(^("STA"),"^")=12 Q "0^Prescription Discontinued more than "_DAYS_" Days."
I $G(PSOCPDRG),$G(PSOCPDRG)'=$G(PSODRG) Q "0^Drug Mismatch, Non-Renewable."
N PSOOCPRX,PSOOLPF,PSOOLPD,PSONOSIG S PSOOCPRX=RXN D CDOSE^PSORENW0 I PSOOLPF Q "0^Non-Renewable, invalid Dosage of "_$G(PSOOLPD)
I PSONOSIG Q "0^Non-Renewable, missing Sig."
I $P($G(^PSDRUG(PSODRG,2)),"^",3)'["O" Q "0^Drug is No longer used by Outpatient Pharmacy."
I $G(^PSDRUG(PSODRG,"I"))]"",DT>$G(^("I")) Q "0^This Drug has been Inactivated."
I ($P(PSODRUG0,"^",3)[1)!($P(PSODRUG0,"^",3)[2)!($P(PSODRUG0,"^",3)["W") Q "0^Non-Renewable "_$S($P(PSODRUG0,"^",3)["A":"Drug Narcotic.",1:"Drug.")
I $D(^PS(53,+$P(RX0,"^",3),0)),'$P(^(0),"^",5) Q "0^Non-Renewable Prescription."
S PSOLC=$P(RX0,"^"),PSOLC=$E(PSOLC,$L(PSOLC)) I $A(PSOLC)'<90 Q "0^Max number of renewals (26) has been reached."
I ST,ST'=2,ST'=5,ST'=6,ST'=11,ST'=12,ST'=14 Q "0^Prescritpion is in a Non-Renewable Status."
I $P($G(^PSRX(RXN,"OR1")),"^",4) Q "0^Duplicate Rx Renewal Request."
I $O(^PS(52.41,"AQ",RXN,0)) Q "0^Duplicate Rx Renewal Request."
K PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST
Q 1_$S($G(PSOIFLAG):"^"_$G(PSONEWOI),1:"")
;
INST1 ;Set Pharmacy Instructions array
N PSOTZ
I $O(^PSRX(RXN,"PI",0)) S PHI=$G(^PSRX(RXN,"PI",0)),PSOTZ=0 D
.F S PSOTZ=$O(^PSRX(RXN,"PI",PSOTZ)) Q:PSOTZ="" S PHI(PSOTZ)=$G(^PSRX(RXN,"PI",PSOTZ,0))
Q
INST2 ;Set Instructions and Comments
I '$G(PSORENW("OIRXN")) Q
I $G(PSOFDR) Q
N PSOPHL,PSOPRL
I $O(^PSRX(PSORENW("OIRXN"),"PI",0)) K PHI S PHI=$G(^PSRX(PSORENW("OIRXN"),"PI",0)),PSOPHL="" D
.F S PSOPHL=$O(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL)) Q:PSOPHL="" S PHI(PSOPHL)=$G(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL,0))
I $O(^PSRX(PSORENW("OIRXN"),"PRC",0)) K PRC S PRC=$G(^PSRX(PSORENW("OIRXN"),"PRC",0)),PSOPRL="" D
.F S PSOPRL=$O(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL)) Q:PSOPRL="" S PRC(PSOPRL)=$G(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL,0))
Q
PSORENW ;BIR/SAB-renew main driver ;22-Jan-2013 17:42;DU
+1 ;;7.0;OUTPATIENT PHARMACY;**11,27,30,46,71,96,100,130,1004,1009,1010,148,206,1014,1016**;DEC 1997;Build 74
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
+4 ;External reference to LK^ORX2 and ULK^ORX2 supported by DBIA 867
+5 ;External reference to ^PS(50.7 supported by DBIA 2223
+6 ;External reference to MAIN^TIUEDIT supported by DBIA 2410
+7 ;Modified - IHS/CIA/DKM - 10/11/2005 - line RENEW
+8 ; IHS/MSC/JDS - 11/20/2010 - Line RENEW+7
+9 ; IHS/MSC/JDS - 01/25/2011 - Line OERR+5
+10 ; - 10/25/2011 - Line OERR+1,OERR+8
+11 ; IHS/MSC/PB - 01/22/2013 - Line OERR+5 added for external rx screen during renew
ASK ;
+1 KILL PSORENW("FILL DATE")
DO FILLDT^PSODIR2(.PSORENW)
IF $GET(PSORENW("DFLG"))
SET VALMSG="Renew Rx request canceled"
SET VALMBCK="R"
+2 IF PSORENW("DFLG")!('$DATA(PSORENW("FILL DATE")))
SET PSORENW("QFLG")=1
SET PSORENW("DFLG")=0
GOTO ASKX
+3 SET PSORNW("FILL DATE")=PSORENW("FILL DATE")
+4 DO MW^PSOCMOPA(.PSORENW)
+5 IF PSORENW("DFLG")
SET PSORENW("QFLG")=1
SET PSORENW("DFLG")=0
GOTO ASKX
+6 SET PSORNW("MAIL/WINDOW")=PSORENW("MAIL/WINDOW")
SET PSORX("MAIL/WINDOW")=$SELECT(PSORENW("MAIL/WINDOW")="M":"MAIL",1:"WINDOW")
+7 DO NOORE^PSONEW(.PSORENW)
IF $GET(PSORENW("DFLG"))
SET VALMSG="Renew Rx request canceled"
SET VALMBCK="R"
+8 IF PSORENW("DFLG")!('$DATA(PSORENW("FILL DATE")))
SET PSORENW("QFLG")=1
SET PSORENW("DFLG")=0
ASKX QUIT
+1 ;
EOJ ;
+1 KILL VERB,RTE,DRET,PSOMSG,PSORNW,PSOLIST,PSORENW,PSORX("BAR CODE"),PSORX("FILL DATE"),PSODIR,PSOID,PSONOOR,PSOCOU,PSOCOUU,PSOID,PSOFDMX,PSODRUG,COPY,PSOBCKDR
+2 SET RXN=$ORDER(^TMP("PSORXN",$JOB,0))
IF RXN
Begin DoDot:1
+3 SET RXN1=^TMP("PSORXN",$JOB,RXN)
DO EN^PSOHLSN1(RXN,$PIECE(RXN1,"^"),$PIECE(RXN1,"^",2),"",$PIECE(RXN1,"^",3))
+4 IF $PIECE(^PSRX(RXN,"STA"),"^")=5
DO EN^PSOHLSN1(RXN,"SC","ZS",$PIECE(RXN1,"^",4))
End DoDot:1
+5 KILL RXN,RXN1,^TMP("PSORXN",$JOB)
+6 IF $GET(PSONOTE)
DO MAIN^TIUEDIT(3,.TIUDA,PSODFN,"","","","",1)
+7 KILL PSONOTE
+8 QUIT
OERR ;entry for renew backdoor
+1 IF $$LMREJ^PSOREJU1($PIECE(PSOLST(ORN),"^",2),,.VALMSG,.VALMBCK)
QUIT
+2 NEW APSPDRG
+3 ;ISH/MSC/PB - Screen added in P1016 to check for external Rx. If external, Rx can't be renewed, must be copied and a new Rx created. 1/22/13
+4 IF $EXTRACT($PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^",1))="X"
Begin DoDot:1
+5 WRITE !,"An external Rx can't be Renewed in RPMS Prescription Processing."
+6 WRITE !,"Use Copy to create a new internal Rx from this external Rx."
+7 SET DIR("A")="Press Return to continue"
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+8 ;ISH/MSC/PB end changes for screen of external Rx for renew
+9 SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
SET VALMSG=$SELECT($PIECE($GET(PSOPLCK),"^",2)'="":$PIECE($GET(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is entering orders for this patient.")
KILL PSOPLCK
SET VALMBCK=""
QUIT
+10 KILL PSOPLCK
SET X=PSODFN_";DPT("
DO LK^ORX2
IF 'Y
SET VALMSG="Another person is entering orders for this patient."
SET VALMBCK=""
DO UL^PSSLOCK(PSODFN)
QUIT
+11 KILL PSOID,PSOFDMX,PSORX("FILL DATE"),PSORENW("FILL DATE"),PSORX("QS"),PSORENW("QS"),PSOBARCD,COPY
+12 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
DO ULPAT
QUIT
+13 ;IHS/MSC/JDS - 01/25/2011
+14 IF '$$SCREEN^APSPMULT(+$PIECE($GET(^PSRX(+$PIECE(PSOLST(ORN),"^",2),0)),"^",6),,1)
SET VALMSG="Drug is not currently available in this facility"
SET VALMBCK=""
DO ULPAT
QUIT
+15 ;IHS/MSC/MGH Text for REM medication. Patch 1013
+16 SET APSPDRG=$PIECE($GET(^PSRX($PIECE(PSOLST(ORN),"^",2),0)),"^",6)
+17 IF +APSPDRG
DO REMMSG^APSPFUNC(APSPDRG)
+18 SET PSOBCKDR=1
SET PSOFROM="NEW"
SET PSORENW("OIRXN")=$PIECE(PSOLST(ORN),"^",2)
SET PSOOPT=3
SET (PSORENW("DFLG"),PSORENW("QFLG"),PSORX("DFLG"))=0
+19 SET PSONEW("DAYS SUPPLY")=$PIECE(^PSRX(PSORENW("OIRXN"),0),"^",8)
SET PSONEW("# OF REFILLS")=$PIECE(^(0),"^",9)
+20 DO FULL^VALM1
DO ASK
IF PSORENW("QFLG")
DO KLIB^PSORENW1
IF PSORENW("QFLG")
DO ULPAT
IF PSORENW("QFLG")
DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
IF PSORENW("QFLG")
GOTO EOJ
DO ^PSORENW0
+21 DO ULPAT
DO EOJ
DO KLIB^PSORENW1
KILL PSOOPT,PSONEW,PSORX("DFLG")
+22 QUIT
ULPAT KILL PSOMSG
DO UL^PSSLOCK(PSODFN)
SET X=PSODFN_";DPT("
DO ULK^ORX2
+1 QUIT
+2 ; IHS/CIA/DKM - 10/11/2005 - Added DAYS parameter to extrinsic.
RENEW(PLACER,PSOCPDRG,DAYS) ;passes flag to CPRS for front door renews
+1 ;-1=couldn't find order, 0=unable to renew, 1=renewable
+2 ;Placer=Pharmacy number
+3 NEW PSOSURX,PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST,PSONEWOI,PSOOLDOI,PSOIFLAG,PSOINA
+4 IF $GET(PLACER)["S"!('$GET(PLACER))
QUIT "-1^Not a Valid Outpatient Medication Order."
+5 SET RXN=PLACER
IF '$DATA(^PSRX(RXN,0))
QUIT "-1^Not a Valid Outpatient Medication Order."
+6 SET RX0=^PSRX(RXN,0)
SET PSODRG=+$PIECE(^PSRX(RXN,0),"^",6)
SET ST=+^("STA")
SET PSODRUG0=^PSDRUG(PSODRG,0)
+7 ;IHS/MSC/JDS - 11/20/10
IF '$$SCREEN^APSPMULT(PSODRG,,1)
QUIT "0^Sorry, this drug is not currently available in this facility"
+8 SET PSOIFLAG=0
SET PSOOLDOI=+$PIECE($GET(^PSRX(RXN,"OR1")),"^")
SET PSONEWOI=+$PIECE($GET(^PSDRUG(+$GET(PSODRG),2)),"^")
IF PSONEWOI
IF PSONEWOI'=PSOOLDOI
SET PSOIFLAG=1
+9 SET PSOINA=$PIECE($GET(^PS(50.7,PSONEWOI,0)),"^",4)
+10 IF PSOINA
IF DT>PSOINA
QUIT "0^This Orderable Item has been Inactivated."
+11 IF ST=5
SET PSOSURX=$ORDER(^PS(52.5,"B",RXN,0))
IF PSOSURX
IF $PIECE($GET(^PS(52.5,PSOSURX,0)),"^",7)="L"
QUIT "0^Rx loading into a CMOP Transmission."
+12 ; IHS/CIA/DKM - 10/11/2005 - Modified next 2 lines to use DAYS parameter
+13 ;S X1=DT,X2=-120 D C^%DTC I $P($G(^PSRX(RXN,2)),"^",6)<X Q "0^Prescription Expired more than 120 Days."
+14 ;S X1=DT,X2=-120 D C^%DTC I $P($G(^PSRX(RXN,3)),"^",5),$P($G(^(3)),"^",5)<X,$P(^("STA"),"^")=12 Q "0^Prescription Discontinued more than 120 Days."
+15 IF '$GET(DAYS)
SET DAYS=120
+16 SET X=$$FMADD^XLFDT(DT,-DAYS)
IF $PIECE($GET(^PSRX(RXN,2)),"^",6)<X
QUIT "0^Prescription Expired more than "_DAYS_" Days."
+17 SET X=$$FMADD^XLFDT(DT,-DAYS)
IF $PIECE($GET(^PSRX(RXN,3)),"^",5)
IF $PIECE($GET(^(3)),"^",5)<X
IF $PIECE(^("STA"),"^")=12
QUIT "0^Prescription Discontinued more than "_DAYS_" Days."
+18 IF $GET(PSOCPDRG)
IF $GET(PSOCPDRG)'=$GET(PSODRG)
QUIT "0^Drug Mismatch, Non-Renewable."
+19 NEW PSOOCPRX,PSOOLPF,PSOOLPD,PSONOSIG
SET PSOOCPRX=RXN
DO CDOSE^PSORENW0
IF PSOOLPF
QUIT "0^Non-Renewable, invalid Dosage of "_$GET(PSOOLPD)
+20 IF PSONOSIG
QUIT "0^Non-Renewable, missing Sig."
+21 IF $PIECE($GET(^PSDRUG(PSODRG,2)),"^",3)'["O"
QUIT "0^Drug is No longer used by Outpatient Pharmacy."
+22 IF $GET(^PSDRUG(PSODRG,"I"))]""
IF DT>$GET(^("I"))
QUIT "0^This Drug has been Inactivated."
+23 IF ($PIECE(PSODRUG0,"^",3)[1)!($PIECE(PSODRUG0,"^",3)[2)!($PIECE(PSODRUG0,"^",3)["W")
QUIT "0^Non-Renewable "_$SELECT($PIECE(PSODRUG0,"^",3)["A":"Drug Narcotic.",1:"Drug.")
+24 IF $DATA(^PS(53,+$PIECE(RX0,"^",3),0))
IF '$PIECE(^(0),"^",5)
QUIT "0^Non-Renewable Prescription."
+25 SET PSOLC=$PIECE(RX0,"^")
SET PSOLC=$EXTRACT(PSOLC,$LENGTH(PSOLC))
IF $ASCII(PSOLC)'<90
QUIT "0^Max number of renewals (26) has been reached."
+26 IF ST
IF ST'=2
IF ST'=5
IF ST'=6
IF ST'=11
IF ST'=12
IF ST'=14
QUIT "0^Prescritpion is in a Non-Renewable Status."
+27 IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",4)
QUIT "0^Duplicate Rx Renewal Request."
+28 IF $ORDER(^PS(52.41,"AQ",RXN,0))
QUIT "0^Duplicate Rx Renewal Request."
+29 KILL PSORFRM,PSOLC,PSODRG,PSODRUG0,RXN,ST
+30 QUIT 1_$SELECT($GET(PSOIFLAG):"^"_$GET(PSONEWOI),1:"")
+31 ;
INST1 ;Set Pharmacy Instructions array
+1 NEW PSOTZ
+2 IF $ORDER(^PSRX(RXN,"PI",0))
SET PHI=$GET(^PSRX(RXN,"PI",0))
SET PSOTZ=0
Begin DoDot:1
+3 FOR
SET PSOTZ=$ORDER(^PSRX(RXN,"PI",PSOTZ))
IF PSOTZ=""
QUIT
SET PHI(PSOTZ)=$GET(^PSRX(RXN,"PI",PSOTZ,0))
End DoDot:1
+4 QUIT
INST2 ;Set Instructions and Comments
+1 IF '$GET(PSORENW("OIRXN"))
QUIT
+2 IF $GET(PSOFDR)
QUIT
+3 NEW PSOPHL,PSOPRL
+4 IF $ORDER(^PSRX(PSORENW("OIRXN"),"PI",0))
KILL PHI
SET PHI=$GET(^PSRX(PSORENW("OIRXN"),"PI",0))
SET PSOPHL=""
Begin DoDot:1
+5 FOR
SET PSOPHL=$ORDER(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL))
IF PSOPHL=""
QUIT
SET PHI(PSOPHL)=$GET(^PSRX(PSORENW("OIRXN"),"PI",PSOPHL,0))
End DoDot:1
+6 IF $ORDER(^PSRX(PSORENW("OIRXN"),"PRC",0))
KILL PRC
SET PRC=$GET(^PSRX(PSORENW("OIRXN"),"PRC",0))
SET PSOPRL=""
Begin DoDot:1
+7 FOR
SET PSOPRL=$ORDER(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL))
IF PSOPRL=""
QUIT
SET PRC(PSOPRL)=$GET(^PSRX(PSORENW("OIRXN"),"PRC",PSOPRL,0))
End DoDot:1
+8 QUIT
