PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;Mar 30, 2022@14:37:15
;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,225,386,390,391,313,411,661,441,700,743,746,769**;DEC 1997;Build 26
;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228
;External reference to EN1^ORCFLAG supported by DBIA 3620
;External reference to ^DD("DD" supported by DBIA 999
;External reference to ^PS(50.606 supported by DBIA 2174
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^PS(51.2 supported by DBIA 2226
;
EN(PSONEW) N FLD,LST,VALMCNT,ERXIEN,PSOVLMBG
EN1 K PSOQUIT D:$G(PSONEW("ENT"))'>0 I $G(PSORENW("POE"))=1 S PSOREEDT=1 D SV
.S PSOREEDT=1 D SV
.K PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE")
.K PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE")
RDD D DSPL,^PSOLMRN D:$G(PKI1)=2 DCP^PSOPKIV1 I $G(PSORX("FN")) S VALMBCK="Q" K PSOREEDT Q
G:'$G(PSOQUIT) RDD
Q
EDT D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:"_$S($G(PSOREEDT):10,1:8)
D ^DIR I $D(DTOUT)!($D(DUOUT)) D KV^PSOVER1 S VALMBCK="" Q
EDTSEL S PSOLM=1,(PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
K PSOVLMBG I '$G(PSORXIEN),$G(ORD),$$ERXIEN^PSOERXUT($G(ORD)_"P") S PSOVLMBG=VALMBG
I +Y S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
.F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']"" D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
E S VALMBCK="" D FULL^VALM1
Q
ACP ; Renewal Accept
N DIR,Y,DIRUT,DUOUT,DTOUT,DIR S Y=0
I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 D Q:$D(DIRUT)!'Y D EN1^ORCFLAG(+$P($G(^PS(52.41,ORD,0)),"^")) H 1
. D FULL^VALM1
. I '$D(^XUSEC("PSORPH",DUZ)) D S Y=0 Q
. . S DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished."
. . S DIR("A",2)=""
. . S DIR(0)="E",DIR("A")="Enter RETURN to continue" W !,$C(7) D ^DIR
. . S VALMBCK="R"
. D FULL^VALM1
. S DIR("A",1)="This Order is flagged. In order to finish it"
. S DIR("A",2)="you must unflag it first."
. S DIR("A",3)=""
. S DIR(0)="Y",DIR("A")="Unflag Order",DIR("B")="NO"
. W ! D ^DIR I $D(DIRUT)!'Y S VALMBCK="Q"
I $G(ORD),+$P($G(^PS(52.41,+ORD,0)),"^",23)=1 Q
;
D INST2^PSORENW S PSOFROM1=1 D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER
K PSOFROM1
PKI I $G(PSONEW("QFLG")) S POERR("DFLG")=1,VALMBCK="R" K PSONEW2 Q
I PSONEW("ENT")>0,$G(NEWDOSE) K NEWDOSE G EN1 Q
S PSORX("FN")=1 D EN^PSORN52(.PSONEW) D:$G(PKI)=89802020 ALERT^PSOPKIV1
S ZFRENEW=1
;saves drug allergy order chks pso*7*390
I $D(^TMP("PSODAOC",$J)),'$G(PSORNALL) D
.I $G(PSORX("DFLG")) K ^TMP("PSODAOC",$J) Q
.S RXN=PSORENW("IRXN") D DAOC^PSONEW
I $G(PSORNALL),$D(^TMP("PSODAOC",$J)) S PSORNEDT=$O(^TMP("PSORXN",$J,0))
K ZFRENEW
D RNPSOSD^PSOUTIL,ACP1^PSOORNE6,^PSOBUILD S VALMBCK="Q"
W !!!,"...ORDER RENEWED.",!!! ;P661
Q
VER1(PSONEW) ;
VER S (PSONEW("DFLG"),PSONEW("QFLG"))=0 I PSONEW("ENT")=0 D K PSOORRNW,PSOFROM1 I PSONEW("DFLG")=1 S (PSONEW("QFLG"),POERR("DFLG"))=1 Q
.S (PSOREEDT,PSOORRNW)=1 W !!,"Dosing Instruction Missing!!",!
.S PSONEW("IRXN")=PSONEW("OIRXN") K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME") D
..I $O(SIG(0)) D Q
...N I F I=1:1 Q:$G(SIG(I))']"" W !,SIG(I)
..I $P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
.K DIRUT W ! D DOSE^PSODIR(.PSONEW) Q:$G(PSONEW("DFLG")) D EN^PSOFSIG(.PSONEW)
.I PSONEW("ENT")>0,$O(SIG(0)) S (SIGOK,NEWDOSE)=1
.I '$G(SPEED),PSONEW("DFLG")=1 S VALMSG="Renewal Request Cancelled!" W:$G(SPEED) !,"Renewal Request Cancelled!" Q:$G(PSONEW("DFLG"))
.I +$G(PSONEW("ENT"))'>0 K DIRUT Q
.D INS^PSODIR(.PSONEW),EN^PSOFSIG(.PSONEW),SINS^PSODIR(.PSONEW):$G(^PS(55,PSODFN,"LAN"))
.S:'$G(SPEED)&(PSONEW("DFLG")=1) VALMSG="Renewal Request Cancelled!" W:$G(SPEED)&(PSONEW("DFLG")=1) !,"Renewal Request Cancelled!"
.I $G(SPEED),'$G(PSONEW("DFLG")) D KV^PSOVER1 S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,KV^PSOVER1 K X,Y
I +$G(PSONEW("ENT"))'>0 G VER
D STOP^PSORENW1 I +$G(PSEXDT) D S PSORENW("QFLG")=1
.S Y=PSORENW("FILL DATE") X ^DD("DD") S VALMSG=Y_" fill date is past expiration date "
.S Y=$P(PSEXDT,"^",2) X ^DD("DD") S VALMSG=VALMSG_Y_"."
Q
DSPL G:$G(PSONEW("ENT"))>0 DSP
S PSONEW("ENT")=0 N I F I=0:0 S I=$O(^PSRX(PSONEW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSONEW("OIRXN"),6,I,0) D
.S PSONEW("ENT")=PSONEW("ENT")+1,PSONEW("DOSE",PSONEW("ENT"))=$P(DOSE,"^")
.S PSONEW("UNITS",PSONEW("ENT"))=$P(DOSE,"^",3),PSONEW("DOSE ORDERED",PSONEW("ENT"))=$P(DOSE,"^",2),PSONEW("ROUTE",PSONEW("ENT"))=$P(DOSE,"^",7)
.S PSONEW("SCHEDULE",PSONEW("ENT"))=$P(DOSE,"^",8),PSONEW("DURATION",PSONEW("ENT"))=$P(DOSE,"^",5),PSONEW("CONJUNCTION",PSONEW("ENT"))=$P(DOSE,"^",6)
.S PSONEW("NOUN",PSONEW("ENT"))=$P(DOSE,"^",4),PSONEW("VERB",PSONEW("ENT"))=$P(DOSE,"^",9)
.I $G(^PSRX(PSONEW("OIRXN"),6,I,1))]"" S PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1)
.K DOSE
DSP D ^PSOORUT2 K ^TMP("PSOPO",$J) S IEN=0
D:$G(PSONEW("PENDING ORDER")) LMDISP^PSOORFI5(+PSONEW("PENDING ORDER"))
I $G(PKI1)!($G(PKI)=1) D L1^PSOPKIV1 K:$G(PKI)=1 PKI
D DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Rx#: "_PSONEW("NRX #")
I +$G(PSODRUG("OI")) D
.S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Orderable Item: "_$P(^PS(50.7,+$G(PSODRUG("OI")),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
.S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
S:$G(PSONEW("TN"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Trade Name: "_$G(PSONEW("TN"))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Patient Status: "_$P(PSONEW("PTST NODE"),"^"),PSONEW("PATIENT STATUS")=$P(PSONEW("PTST NODE"),"^")
S (PSOID,Y)=PSONEW("ISSUE DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1) Issue Date: "_Y
S Y=PSONEW("FILL DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Fill Date: "_Y
I PSONEW("ENT")=0 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (9)",1:" ")_" Dosage:" G PAT
N I F I=1:1:PSONEW("ENT") D
.I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
.S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)
.S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($G(PSONEW("UNITS",I))]"":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
.I $P($G(^PS(55,PSODFN,"LAN")),"^"),'$G(PSONEW("DOSE ORDERED",I)) D
..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))
.I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" D
..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I))
..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_$G(PSONEW("NOUN",I))
.I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")
.S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
.I $G(PSONEW("DURATION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Duration: "_$G(PSONEW("DURATION",I))
.I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
PAT S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (10)",1:" ")_"Pat Instruction:" D INS2^PSOBKDED
S RXN=PSONEW("OIRXN") D INST1^PSORENW
;I $O(PRC(0)) D PC1^PSOORNE5
K RXN N I,SG S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"
I $G(SIGOK),$O(SIG(0)) D K SG,MIG
.F I=0:0 S I=$O(SIG(I)) Q:'I F SG=1:1:$L(SIG(I)) D
..S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG(I)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" "
..S:$P(SIG(I)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG(I)," ",SG)
E D
.S X=$S($G(PSONEW("SIG"))]"":PSONEW("SIG"),1:$P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")) D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
.F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$S($L(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" QTY"_$S($G(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
I $D(^PSDRUG("AQ",PSODRUG("IEN"))),$P($G(^PSDRUG(PSODRUG("IEN"),5)),"^")]"" D
.S $P(RN," ",79)=" ",IEN=IEN+1
.S ^TMP("PSOPO",$J,IEN,0)=" QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Routing: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$E($G(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL") ;441 PAPI
S:$G(PSONEW("METHOD OF PICK-UP"))]""&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Clinic: "_$S($G(PSONEW("CLINIC")):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"")
S $P(RN," ",31)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,31) K RN
I $G(PSODRUG("DEA")),+PSODRUG("DEA")>1,+PSODRUG("DEA")<6 D PRV^PSOORFI5($G(PSORENW("PROVIDER")),$G(PSODRUG("IEN")),$P($G(OR0),"^"))
I $G(PSONEW("COSIGNING PROVIDER"))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
RMK S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,DUZ,0),"^")_$E(RN,$L($P(^VA(200,DUZ,0),"^"))+1,35)
I $G(PSOFDR) S ^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(OR0,"^",4),0),"^")_$E(RN,$L($P(^VA(200,$P(OR0,"^",4),0),"^"))+1,35)
D NOW^%DTC S PSONEW("LOGIN DATE")=$S($P($G(OR0),"^",6):$P($G(OR0),"^",6),1:%) K %,X S Y=PSONEW("LOGIN DATE") X ^DD("DD")
S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$P(Y,"@")_" "_$P(Y,"@",2) K RN
S (VALMCNT,PSOPF)=IEN
; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above) (PSORXIEN indicates a manual renewal from Backdoor)
S ERXIEN=0 I '$G(PSORXIEN),$G(ORD) S ERXIEN=$$ERXIEN^PSOERXUT(ORD_"P")
I ERXIEN D
. N SUGFLDT,LASTRX,Y
. S SUGFLDT=$$SUGFLDT^PSOERUT(ORD),LASTRX=0
. I $D(^XUSEC("PSO ERX P746 TEMP KEY",DUZ)),'$G(FDEDITED),SUGFLDT>DT D
. . S (PSONEW("FILL DATE"),Y)=$P(SUGFLDT,"^"),LASTRX=+$P(SUGFLDT,"^",2) X ^DD("DD") S PSORX("FILL DATE")=Y
. S (IEN,LINE)=0 K ^TMP("PSOPO",$J)
. D SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,.SIG,1,LASTRX) S (VALMCNT,PSOPF,IEN)=LINE-1
. D RV^PSONFI
I $G(PSOFDR) D:$P(OR0,"^",24)
.K PSOCSP S PSOCSP("NAME")=$G(PSODRUG("NAME")) M PSOCSP("DOSE")=PSONEW("DOSE"),PSOCSP("DOSE ORDERED")=PSONEW("DOSE ORDERED")
.S PSOCSP("# OF REFILLS")=PSONEW("# OF REFILLS") ;track original data for dig. orders
.S PSOCSP("ISSUE DATE")=$E($P(OR0,"^",6),1,7),PSOCSP("QTY")=PSONEW("QTY"),PSOCSP("DAYS SUPPLY")=PSONEW("DAYS SUPPLY")
Q
1 D 1^PSOBKDED Q
2 D 2^PSOBKDED Q
3 I $P($G(OR0),"^",24) D Q
. W !!,"Digitally Signed Order - Refills cannot be changed",! D PZ
D 9^PSOBKDED Q
4 D 12^PSOBKDED Q
5 D 5^PSOBKDED Q
6 I $P($G(OR0),"^",24) D Q
. W !!,"Digitally Signed Order - Provider cannot be changed",! D PZ
D 4^PSOBKDED Q
7 D 11^PSOBKDED Q
8 D 13^PSOBKDED Q
9 W !!,"Drug: "_PSODRUG("NAME") S PSOORRNW=1 D DOSE1^PSOORED5(.PSONEW)
I $G(PSONEW("DFLG")) S PSODIR("DFLG")=1,VALMBCK="Q" Q
D SV Q
10 D INS^PSODIR(.PSONEW),SINS^PSODIR(.PSONEW) D SV Q
SV D SV^PSOORNE5 Q
;
PZ ;
N DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORNE4 12772 printed Dec 13, 2024@02:32:10 Page 2
PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;Mar 30, 2022@14:37:15
+1 ;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,225,386,390,391,313,411,661,441,700,743,746,769**;DEC 1997;Build 26
+2 ;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228
+3 ;External reference to EN1^ORCFLAG supported by DBIA 3620
+4 ;External reference to ^DD("DD" supported by DBIA 999
+5 ;External reference to ^PS(50.606 supported by DBIA 2174
+6 ;External reference to ^PS(50.7 supported by DBIA 2223
+7 ;External reference to ^PS(51.2 supported by DBIA 2226
+8 ;
EN(PSONEW) NEW FLD,LST,VALMCNT,ERXIEN,PSOVLMBG
EN1 KILL PSOQUIT
if $GET(PSONEW("ENT"))'>0
Begin DoDot:1
+1 SET PSOREEDT=1
DO SV
+2 KILL PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE")
+3 KILL PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE")
End DoDot:1
IF $GET(PSORENW("POE"))=1
SET PSOREEDT=1
DO SV
RDD DO DSPL
DO ^PSOLMRN
if $GET(PKI1)=2
DO DCP^PSOPKIV1
IF $GET(PSORX("FN"))
SET VALMBCK="Q"
KILL PSOREEDT
QUIT
+1 if '$GET(PSOQUIT)
GOTO RDD
+2 QUIT
EDT DO KV^PSOVER1
SET DIR("A")="Select Field to Edit by number"
SET DIR(0)="LO^1:"_$SELECT($GET(PSOREEDT):10,1:8)
+1 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
DO KV^PSOVER1
SET VALMBCK=""
QUIT
EDTSEL SET PSOLM=1
SET (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
+1 KILL PSOVLMBG
IF '$GET(PSORXIEN)
IF $GET(ORD)
IF $$ERXIEN^PSOERXUT($GET(ORD)_"P")
SET PSOVLMBG=VALMBG
+2 IF +Y
SET LST=Y
DO HLDHDR^PSOLMUTL
SET PSOEDT=1
Begin DoDot:1
+3 FOR FLD=1:1:$LENGTH(LST,",")
if $PIECE(LST,",",FLD)']""
QUIT
DO @(+$PIECE(LST,",",FLD))
if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
QUIT
End DoDot:1
if $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
QUIT
+4 IF '$TEST
SET VALMBCK=""
DO FULL^VALM1
+5 QUIT
ACP ; Renewal Accept
+1 NEW DIR,Y,DIRUT,DUOUT,DTOUT,DIR
SET Y=0
+2 IF $GET(ORD)
IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
Begin DoDot:1
+3 DO FULL^VALM1
+4 IF '$DATA(^XUSEC("PSORPH",DUZ))
Begin DoDot:2
+5 SET DIR("A",1)="Order must be unflagged by a pharmacist before it can be finished."
+6 SET DIR("A",2)=""
+7 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue"
WRITE !,$CHAR(7)
DO ^DIR
+8 SET VALMBCK="R"
End DoDot:2
SET Y=0
QUIT
+9 DO FULL^VALM1
+10 SET DIR("A",1)="This Order is flagged. In order to finish it"
+11 SET DIR("A",2)="you must unflag it first."
+12 SET DIR("A",3)=""
+13 SET DIR(0)="Y"
SET DIR("A")="Unflag Order"
SET DIR("B")="NO"
+14 WRITE !
DO ^DIR
IF $DATA(DIRUT)!'Y
SET VALMBCK="Q"
End DoDot:1
if $DATA(DIRUT)!'Y
QUIT
DO EN1^ORCFLAG(+$PIECE($GET(^PS(52.41,ORD,0)),"^"))
HANG 1
+15 IF $GET(ORD)
IF +$PIECE($GET(^PS(52.41,+ORD,0)),"^",23)=1
QUIT
+16 ;
+17 DO INST2^PSORENW
SET PSOFROM1=1
if $DATA(^XUSEC("PSORPH",DUZ))!('$PIECE(PSOPAR,"^",2))
DO VER
+18 KILL PSOFROM1
PKI IF $GET(PSONEW("QFLG"))
SET POERR("DFLG")=1
SET VALMBCK="R"
KILL PSONEW2
QUIT
+1 IF PSONEW("ENT")>0
IF $GET(NEWDOSE)
KILL NEWDOSE
GOTO EN1
QUIT
+2 SET PSORX("FN")=1
DO EN^PSORN52(.PSONEW)
if $GET(PKI)=89802020
DO ALERT^PSOPKIV1
+3 SET ZFRENEW=1
+4 ;saves drug allergy order chks pso*7*390
+5 IF $DATA(^TMP("PSODAOC",$JOB))
IF '$GET(PSORNALL)
Begin DoDot:1
+6 IF $GET(PSORX("DFLG"))
KILL ^TMP("PSODAOC",$JOB)
QUIT
+7 SET RXN=PSORENW("IRXN")
DO DAOC^PSONEW
End DoDot:1
+8 IF $GET(PSORNALL)
IF $DATA(^TMP("PSODAOC",$JOB))
SET PSORNEDT=$ORDER(^TMP("PSORXN",$JOB,0))
+9 KILL ZFRENEW
+10 DO RNPSOSD^PSOUTIL
DO ACP1^PSOORNE6
DO ^PSOBUILD
SET VALMBCK="Q"
+11 ;P661
WRITE !!!,"...ORDER RENEWED.",!!!
+12 QUIT
VER1(PSONEW) ;
VER SET (PSONEW("DFLG"),PSONEW("QFLG"))=0
IF PSONEW("ENT")=0
Begin DoDot:1
+1 SET (PSOREEDT,PSOORRNW)=1
WRITE !!,"Dosing Instruction Missing!!",!
+2 SET PSONEW("IRXN")=PSONEW("OIRXN")
KILL VALMSG
DO FULL^VALM1
WRITE !,"Drug: "_PSODRUG("NAME")
Begin DoDot:2
+3 IF $ORDER(SIG(0))
Begin DoDot:3
+4 NEW I
FOR I=1:1
if $GET(SIG(I))']""
QUIT
WRITE !,SIG(I)
End DoDot:3
QUIT
+5 IF $PIECE($GET(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]""
SET X=$PIECE(^PSRX(PSONEW("OIRXN"),"SIG"),"^")
DO SIGONE^PSOHELP
WRITE !,$EXTRACT($GET(INS1),2,250)
End DoDot:2
+6 KILL DIRUT
WRITE !
DO DOSE^PSODIR(.PSONEW)
if $GET(PSONEW("DFLG"))
QUIT
DO EN^PSOFSIG(.PSONEW)
+7 IF PSONEW("ENT")>0
IF $ORDER(SIG(0))
SET (SIGOK,NEWDOSE)=1
+8 IF '$GET(SPEED)
IF PSONEW("DFLG")=1
SET VALMSG="Renewal Request Cancelled!"
if $GET(SPEED)
WRITE !,"Renewal Request Cancelled!"
if $GET(PSONEW("DFLG"))
QUIT
+9 IF +$GET(PSONEW("ENT"))'>0
KILL DIRUT
QUIT
+10 DO INS^PSODIR(.PSONEW)
DO EN^PSOFSIG(.PSONEW)
if $GET(^PS(55,PSODFN,"LAN"))
DO SINS^PSODIR(.PSONEW)
+11 if '$GET(SPEED)&(PSONEW("DFLG")=1)
SET VALMSG="Renewal Request Cancelled!"
if $GET(SPEED)&(PSONEW("DFLG")=1)
WRITE !,"Renewal Request Cancelled!"
+12 IF $GET(SPEED)
IF '$GET(PSONEW("DFLG"))
DO KV^PSOVER1
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
DO KV^PSOVER1
KILL X,Y
End DoDot:1
KILL PSOORRNW,PSOFROM1
IF PSONEW("DFLG")=1
SET (PSONEW("QFLG"),POERR("DFLG"))=1
QUIT
+13 IF +$GET(PSONEW("ENT"))'>0
GOTO VER
+14 DO STOP^PSORENW1
IF +$GET(PSEXDT)
Begin DoDot:1
+15 SET Y=PSORENW("FILL DATE")
XECUTE ^DD("DD")
SET VALMSG=Y_" fill date is past expiration date "
+16 SET Y=$PIECE(PSEXDT,"^",2)
XECUTE ^DD("DD")
SET VALMSG=VALMSG_Y_"."
End DoDot:1
SET PSORENW("QFLG")=1
+17 QUIT
DSPL if $GET(PSONEW("ENT"))>0
GOTO DSP
+1 SET PSONEW("ENT")=0
NEW I
FOR I=0:0
SET I=$ORDER(^PSRX(PSONEW("OIRXN"),6,I))
if 'I
QUIT
SET DOSE=^PSRX(PSONEW("OIRXN"),6,I,0)
Begin DoDot:1
+2 SET PSONEW("ENT")=PSONEW("ENT")+1
SET PSONEW("DOSE",PSONEW("ENT"))=$PIECE(DOSE,"^")
+3 SET PSONEW("UNITS",PSONEW("ENT"))=$PIECE(DOSE,"^",3)
SET PSONEW("DOSE ORDERED",PSONEW("ENT"))=$PIECE(DOSE,"^",2)
SET PSONEW("ROUTE",PSONEW("ENT"))=$PIECE(DOSE,"^",7)
+4 SET PSONEW("SCHEDULE",PSONEW("ENT"))=$PIECE(DOSE,"^",8)
SET PSONEW("DURATION",PSONEW("ENT"))=$PIECE(DOSE,"^",5)
SET PSONEW("CONJUNCTION",PSONEW("ENT"))=$PIECE(DOSE,"^",6)
+5 SET PSONEW("NOUN",PSONEW("ENT"))=$PIECE(DOSE,"^",4)
SET PSONEW("VERB",PSONEW("ENT"))=$PIECE(DOSE,"^",9)
+6 IF $GET(^PSRX(PSONEW("OIRXN"),6,I,1))]""
SET PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1)
+7 KILL DOSE
End DoDot:1
DSP DO ^PSOORUT2
KILL ^TMP("PSOPO",$JOB)
SET IEN=0
+1 if $GET(PSONEW("PENDING ORDER"))
DO LMDISP^PSOORFI5(+PSONEW("PENDING ORDER"))
+2 IF $GET(PKI1)!($GET(PKI)=1)
DO L1^PSOPKIV1
if $GET(PKI)=1
KILL PKI
+3 DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
+4 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Rx#: "_PSONEW("NRX #")
+5 IF +$GET(PSODRUG("OI"))
Begin DoDot:1
+6 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Orderable Item: "_$PIECE(^PS(50.7,+$GET(PSODRUG("OI")),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
+7 if NFIO["<DIN>"
SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
End DoDot:1
+8 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
+9 if NFID["<DIN>"
SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
+10 if $GET(PSONEW("TN"))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Trade Name: "_$GET(PSONEW("TN"))
+11 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Patient Status: "_$PIECE(PSONEW("PTST NODE"),"^")
SET PSONEW("PATIENT STATUS")=$PIECE(PSONEW("PTST NODE"),"^")
+12 SET (PSOID,Y)=PSONEW("ISSUE DATE")
XECUTE ^DD("DD")
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (1) Issue Date: "_Y
+13 SET Y=PSONEW("FILL DATE")
XECUTE ^DD("DD")
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Fill Date: "_Y
+14 IF PSONEW("ENT")=0
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT):" (9)",1:" ")_" Dosage:"
GOTO PAT
+15 NEW I
FOR I=1:1:PSONEW("ENT")
Begin DoDot:1
+16 IF '$GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+17 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$SELECT($EXTRACT(PSONEW("DOSE",I),1)="."&($GET(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)
+18 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_$SELECT($GET(PSONEW("UNITS",I))]"":" ("_$PIECE(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
+19 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
IF '$GET(PSONEW("DOSE ORDERED",I))
Begin DoDot:2
+20 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Oth. Lang. Dosage: "_$GET(PSONEW("ODOSE",I))
End DoDot:2
+21 IF $GET(PSONEW("DOSE ORDERED",I))
IF $GET(PSONEW("VERB",I))]""
Begin DoDot:2
+22 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
+23 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Dispense Units: "_$SELECT($EXTRACT($GET(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$GET(PSONEW("DOSE ORDERED",I))
+24 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Noun: "_$GET(PSONEW("NOUN",I))
End DoDot:2
+25 IF $GET(PSONEW("ROUTE",I))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Route: "_$PIECE(^PS(51.2,PSONEW("ROUTE",I),0),"^")
+26 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
+27 IF $GET(PSONEW("DURATION",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" *Duration: "_$GET(PSONEW("DURATION",I))
+28 IF $GET(PSONEW("CONJUNCTION",I))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Conjunction: "_$SELECT($GET(PSONEW("CONJUNCTION",I))="A":"AND",$GET(PSONEW("CONJUNCTION",I))="T":"THEN",$GET(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
End DoDot:1
PAT SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT):" (10)",1:" ")_"Pat Instruction:"
DO INS2^PSOBKDED
+1 SET RXN=PSONEW("OIRXN")
DO INST1^PSORENW
+2 ;I $O(PRC(0)) D PC1^PSOORNE5
+3 KILL RXN
NEW I,SG
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
+4 IF $GET(SIGOK)
IF $ORDER(SIG(0))
Begin DoDot:1
+5 FOR I=0:0
SET I=$ORDER(SIG(I))
if 'I
QUIT
FOR SG=1:1:$LENGTH(SIG(I))
Begin DoDot:2
+6 if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG(I)," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
+7 if $PIECE(SIG(I)," ",SG)'=""
SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG(I)," ",SG)
End DoDot:2
End DoDot:1
KILL SG,MIG
+8 IF '$TEST
Begin DoDot:1
+9 SET X=$SELECT($GET(PSONEW("SIG"))]"":PSONEW("SIG"),1:$PIECE($GET(^PSRX(PSONEW("OIRXN"),"SIG")),"^"))
DO SIGONE^PSOHELP
SET SIG=$EXTRACT($GET(INS1),2,250)
+10 FOR SG=1:1:$LENGTH(SIG)
if $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
SET IEN=IEN+1
SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
if $PIECE(SIG," ",SG)'=""
SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
End DoDot:1
+11 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$SELECT($LENGTH(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
+12 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" QTY"_$SELECT($GET(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
+13 IF $DATA(^PSDRUG("AQ",PSODRUG("IEN")))
IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),5)),"^")]""
Begin DoDot:1
+14 SET $PIECE(RN," ",79)=" "
SET IEN=IEN+1
+15 SET ^TMP("PSOPO",$JOB,IEN,0)=" QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")
End DoDot:1
+16 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$SELECT($LENGTH(PSONEW("# OF REFILLS"))=1:" ",1:"")
+17 ;441 PAPI
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Routing: "_$SELECT($GET(PSORENW("MAIL/WINDOW"))["W":"WINDOW",$EXTRACT($GET(PSORENW("MAIL/WINDOW")))="P":"PARK",1:"MAIL")
+18 if $GET(PSONEW("METHOD OF PICK-UP"))]""&($PIECE(PSOPAR,"^",12))
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP")
+19 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Clinic: "_$SELECT($GET(PSONEW("CLINIC")):$PIECE(^SC(PSONEW("CLINIC"),0),"^"),1:"")
+20 SET $PIECE(RN," ",31)=" "
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$EXTRACT(RN,$LENGTH(PSONEW("PROVIDER NAME"))+1,31)
KILL RN
+21 IF $GET(PSODRUG("DEA"))
IF +PSODRUG("DEA")>1
IF +PSODRUG("DEA")<6
DO PRV^PSOORFI5($GET(PSORENW("PROVIDER")),$GET(PSODRUG("IEN")),$PIECE($GET(OR0),"^"))
+22 IF $GET(PSONEW("COSIGNING PROVIDER"))]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
+23 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (7) Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
RMK SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (8) Remarks: "_$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
+1 SET $PIECE(RN," ",35)=" "
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,DUZ,0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,DUZ,0),"^"))+1,35)
+2 IF $GET(PSOFDR)
SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^"))+1,35)
+3 DO NOW^%DTC
SET PSONEW("LOGIN DATE")=$SELECT($PIECE($GET(OR0),"^",6):$PIECE($GET(OR0),"^",6),1:%)
KILL %,X
SET Y=PSONEW("LOGIN DATE")
XECUTE ^DD("DD")
+4 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
KILL RN
+5 SET (VALMCNT,PSOPF)=IEN
+6 ; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above) (PSORXIEN indicates a manual renewal from Backdoor)
+7 SET ERXIEN=0
IF '$GET(PSORXIEN)
IF $GET(ORD)
SET ERXIEN=$$ERXIEN^PSOERXUT(ORD_"P")
+8 IF ERXIEN
Begin DoDot:1
+9 NEW SUGFLDT,LASTRX,Y
+10 SET SUGFLDT=$$SUGFLDT^PSOERUT(ORD)
SET LASTRX=0
+11 IF $DATA(^XUSEC("PSO ERX P746 TEMP KEY",DUZ))
IF '$GET(FDEDITED)
IF SUGFLDT>DT
Begin DoDot:2
+12 SET (PSONEW("FILL DATE"),Y)=$PIECE(SUGFLDT,"^")
SET LASTRX=+$PIECE(SUGFLDT,"^",2)
XECUTE ^DD("DD")
SET PSORX("FILL DATE")=Y
End DoDot:2
+13 SET (IEN,LINE)=0
KILL ^TMP("PSOPO",$JOB)
+14 DO SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,.SIG,1,LASTRX)
SET (VALMCNT,PSOPF,IEN)=LINE-1
+15 DO RV^PSONFI
End DoDot:1
+16 IF $GET(PSOFDR)
if $PIECE(OR0,"^",24)
Begin DoDot:1
+17 KILL PSOCSP
SET PSOCSP("NAME")=$GET(PSODRUG("NAME"))
MERGE PSOCSP("DOSE")=PSONEW("DOSE"),PSOCSP("DOSE ORDERED")=PSONEW("DOSE ORDERED")
+18 ;track original data for dig. orders
SET PSOCSP("# OF REFILLS")=PSONEW("# OF REFILLS")
+19 SET PSOCSP("ISSUE DATE")=$EXTRACT($PIECE(OR0,"^",6),1,7)
SET PSOCSP("QTY")=PSONEW("QTY")
SET PSOCSP("DAYS SUPPLY")=PSONEW("DAYS SUPPLY")
End DoDot:1
+20 QUIT
1 DO 1^PSOBKDED
QUIT
2 DO 2^PSOBKDED
QUIT
3 IF $PIECE($GET(OR0),"^",24)
Begin DoDot:1
+1 WRITE !!,"Digitally Signed Order - Refills cannot be changed",!
DO PZ
End DoDot:1
QUIT
+2 DO 9^PSOBKDED
QUIT
4 DO 12^PSOBKDED
QUIT
5 DO 5^PSOBKDED
QUIT
6 IF $PIECE($GET(OR0),"^",24)
Begin DoDot:1
+1 WRITE !!,"Digitally Signed Order - Provider cannot be changed",!
DO PZ
End DoDot:1
QUIT
+2 DO 4^PSOBKDED
QUIT
7 DO 11^PSOBKDED
QUIT
8 DO 13^PSOBKDED
QUIT
9 WRITE !!,"Drug: "_PSODRUG("NAME")
SET PSOORRNW=1
DO DOSE1^PSOORED5(.PSONEW)
+1 IF $GET(PSONEW("DFLG"))
SET PSODIR("DFLG")=1
SET VALMBCK="Q"
QUIT
+2 DO SV
QUIT
10 DO INS^PSODIR(.PSONEW)
DO SINS^PSODIR(.PSONEW)
DO SV
QUIT
SV DO SV^PSOORNE5
QUIT
+1 ;
PZ ;
+1 NEW DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
WRITE !
+2 QUIT
