PSOOREDT.m

PSOOREDT ;BIR/SAB - Edit orders from backdoor ;Jan 25, 2022@14:31:38

 ;;7.0;OUTPATIENT PHARMACY;**4,20,27,37,57,46,78,102,104,119,143,148,260,281,304,289,298,379,377,391,313,427,411,505,517,574,524,617,441,700,746,753**;DEC 1997;Build 53

 ;External reference to ^PSDRUG( supported by DBIA 221

 ;External reference to ^PSSLOCK supported by DBIA 2789

 ;External reference to ^VA(200 supported by DBIA 10060

 ;

 ;*524 add Hazardous meds alerts

 ;

SEL K PSOISLKD,PSOLOKED S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="" Q

 K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="" Q

 K PSOMSG S PSOLOKED=1

 N PSOHZ S PSOHZ=0    ;reset haz alert displayed to user *524

 S REF=0 S:$$LSTRFL^PSOBPSU1($P(PSOLST(ORN),"^",2)) REF=1  ;*377

 K PSORX("DFLG"),DIR,DUOUT,DIRUT S DIR("A")="Select fields by number"

 S DIR(0)="LO^1:"_$S($$STATUS^PSOBPSUT($P(PSOLST(ORN),"^",2))'="":21,$G(REF):22,1:22)

 D ^DIR I $D(DIRUT) K DIR,DIRUT,DTOUT S VALMBCK="" D UL K PSOLOKED Q

EDTSEL N VALMCNT K PSOISLKD,PSORX("DFLG"),PSOOIFLG,PSOMRFLG,DIR,DIRUT,DTOUT,DTOUT,ZONE S PSOQUIT=0,(PSOEDIT,PSORXED)=1 I +Y S FST=Y D HLDHDR^PSOLMUTL D  G EX ;PSO LM SELECT MENU protocol

 .I '$G(PSOLOKED) S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY D SVAL K PSOPLCK S VALMBCK="",(PSOISLKD,PSODE)=1 Q

 .I '$G(PSOLOKED) K PSOPLCK D PSOL^PSSLOCK($P(PSOLST(ORN),"^",2)) I '$G(PSOMSG) D UL^PSSLOCK(+$G(PSODFN)) D SVALO K PSOMSG S VALMBCK="",(PSOISLKD,PSODE)=1 Q

 .K PSOMSG,PSOPLCK S (NEWEDT,PSOLOKED)=1 D EDT

 E  S VALMBCK="",PSODE=1

EX I $G(PSOISLKD)!($G(PSOQUIT)) D UL K PSOISLKD G EX2

 I '$G(PSOSIGFL),'$G(PSORXED("DFLG")) D UPDATE^PSOORED6 D LOG^PSORXED,POST^PSORXED G EX1

 I $G(PSOSIGFL)=1 D  Q:$G(PSORX("FN"))

 .N PSOTMP

 .S PSOTMP=$G(PSOFROM),PSOFROM="NEW"

 .S VALMSG="This change will create a new prescription!",NCPDPFLG=1

 .D EN^PSOORED1(.PSORXED)

 .I $G(PSORX("FN")) D  Q

 ..D ^PSOBUILD

 ..K QUIT,PSORX("DFLG"),FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT

 ..K PSORENW,PSOSIGFL,PSOOIFLG,PSOMRFLG,PSODIR,CHK,PSORX("SIG"),PSODE

 ..K PSOTRN,PSORX("EDIT"),PSORXED("FLD"),NEWEDT

 ..S ZZEDIT=1 D EOJ^PSONEW K ZZEDIT

 ..D UL K PSOLOKED S VALMBCK="Q"

 .S PSOFROM=PSOTMP I PSOFROM="" K PSOFROM

 ;

EX1 I '$G(PSODE)!('$G(ZONE)) I $G(PSORENW("OIRXN")) D EN^PSOHLSN1(PSORENW("OIRXN"),"XX","","Order edited")

QUIT D UL K PSOLOKED D ^PSOBUILD,ACT^PSOORNE2 D:+^PSRX($P(PSOLST(ORN),"^",2),"STA")=5 EN^PSOCMOPC($P(PSOLST(ORN),"^",2))

 K:'$O(^PSRX($P(PSOLST(ORN),"^",2),1,0)) REF

EX2 S VALMBCK=$S($G(PSOQUIT):"R",$G(PSORX("FN")):"Q",$G(ZONE):"Q",1:"R")

 K PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT,PSORENW,PSOSIGFL,PSODIR,CHK,PSORX("SIG"),PSODE,PSOTRN,PSORX("DFLG"),RFED,ZONE,PSORX("EDIT"),PSOOIFLG,PSOMRFLG,SIG,QUIT,PSOQUIT

 K NEWEDT I $G(VALMBCK)="R" W ! D CLEAN^PSOVER1 ;p753 H 2

 Q

 ;

EDT ; Rx Edit (Backdoor)

 ;/BLB/ Patch PSO*7*505/517 Modified EDT to block the editing functionality of certain fields of CS drugs

 N FLNCHK,CSDRG,DRGIEN

 K NCPDPFLG,PSOPKI,DEA

 S I=0 F  S I=$O(^PSRX($P(PSOLST(ORN),"^",2),1,I)) Q:'I  S PSORXED("RX1")=^PSRX($P(PSOLST(ORN),"^",2),1,I,0)

 ;*298 Track PI and Oth Lang PI

 S (RX0,PSORXED("RX0"))=^PSRX($P(PSOLST(ORN),"^",2),0),PSORXED("RX2")=$G(^(2)),PSORXED("RX3")=$G(^(3)),PSOSIG=$P(^("SIG"),"^"),PSOPINS=$G(^("INS")),PSOOINS=$G(^("INSS")),PSOPIND=$P($G(^("IND")),"^"),PSOPINDF=$P($G(^("IND")),"^",2) ;*441-IND

 I '$D(PSODRUG) NEW PSOY S PSOY=$P(RX0,U,6),PSOY(0)=^PSDRUG(PSOY,0) D SET^PSODRG ; *298 moved this line from EDT+2  RX0 was not defined yet

 S CSDRG=0 I $$NDF^PSOORNEW(PSODRUG("IEN"))!$$CSDRG^PSOERUT6(PSODRUG("IEN")) S CSDRG=1

 I CSDRG,$$CSFLDBLK(FST) D

 .W !!,"The selection includes field(s) that are not editable" W !,"for controlled substances. These field(s) will be skipped.",!

 .S DIR(0)="E" D ^DIR K DIR

 F FLD=1:1:$L(FST,",") Q:$P(FST,",",FLD)']""!($G(PSORXED("DFLG")))!($G(PSORX("DFLG")))  S FLN=+$P(FST,",",FLD) S DRGIEN=PSODRUG("IEN") D

 .S FLNCHK=","_FLN_","

 .S PSORXED("DFLG")=0,(DA,PSORXED("IRXN"),PSORENW("OIRXN"))=$P(PSOLST(ORN),"^",2),RX0=^PSRX(PSORXED("IRXN"),0)

 .S PSOPKI=$S($P($G(^PSRX(PSORXED("IRXN"),"PKI")),"^")!$P($G(^PSRX(PSORXED("IRXN"),"PKI")),"^",3):1,1:0) S:$G(PSOSIG)="" PSOSIG=$P(^("SIG"),"^")

 .;*298 Track PI and Oth Lang PI

 .S:$G(PSOPINS)="" PSOPINS=$G(^PSRX(DA,"INS")) S:$G(PSOOINS)="" PSOOINS=$G(^PSRX(DA,"INSS"))

 .S:$G(PSOPIND)="" PSOPIND=$P($G(^PSRX(DA,"IND")),"^") S:$G(PSOPINDF)="" PSOPINDF=$P($G(^PSRX(DA,"IND")),"^",2) ;*441-IND

 .I '$G(PSOSIGFL) D

 ..S PSOI=+^PSRX(DA,"OR1"),PSODAYS=$P(RX0,"^",8),PSORXST=+$P($G(^PS(53,$P(RX0,"^",3),0)),"^",7)

 ..I 'PSOI S PSOI=+^PSDRUG($P(RX0,"^",6),2),$P(^PSRX(DA,"OR1"),"^")=PSOI

 ..S:'$G(PSODRUG("IEN")) PSODRUG("IEN")=$P(RX0,"^",6),PSODRUG("NAME")=$P(^PSDRUG($P(RX0,"^",6),0),"^")

 ..S PSODRUG("OI")=PSOI

 .S PSORX("PROVIDER")=$P(RX0,"^",4),PSORX("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^"),PSOTRN=$G(^PSRX(DA,"TN"))

 .D:'$G(CHK) POP^PSOSIGNO(DA),CHK Q:$G(PSORXED("DFLG"))

 .S FDR="39.2^"_$S($P(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$S($P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81^100.2" ;p753

 .; Titration/Maintenance Rx check

 .I $$REQFLDS(FST),$$TITRX^PSOUTL($P(PSOLST(ORN),"^",2))="t" D  S PSORXED("DFLG")=1 Q

 .. S VALMSG="Cannot edit Drug/Dose fields (Titration Rx).",VALMBCK="R" W $C(7)

 .D:'$G(CHK) POP^PSOSIGNO(DA),CHK Q:$G(PSORXED("DFLG"))

 .S FDR="39.2^"_$S($P(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$S($P(RX0,"^",11)="W"&($P(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81^100.2" ;p753

 .I $G(ST)=11!($G(ST)=12)!($G(ST)=14)!($G(ST)=15) D NDCDAWDE^PSOORED7(ST,FLN,$G(RXN)) Q

 .S REF=0 S:$$LSTRFL^PSOBPSU1($P(PSOLST(ORN),"^",2)) REF=1  ;*377

 .I FLN=20,'$G(REF) S VALMSG="There is no Refill Data to be edited." Q

 .S DR=$P(FDR,"^",FLN) I DR="RF" D REF^PSOORED2 Q

 .I DR="PSOCOU" D PSOCOU^PSOORED6 Q

 .I DR="100.2" D  Q  ;p753

 ..K DIR,DUOUT,DIRUT S DIR(0)="52,100.2" D ^DIR

 ..I $D(DIRUT),X'="@" K DIR,DIRUT Q

 ..S PSORXED("FLD",DR)=$S(X="@":X,1:Y) K DIR,DIRUT,DTOUT,X,Y Q

 .I $$CSDRG^PSOERUT6(DRGIEN)!($$NDF^PSOORNEW(DRGIEN)),",1,3,12,17,"[FLNCHK Q

 .; Allow edit of the NDC when the EDIT DRUG setting is off

 .; Other checks regarding if the NDC may be edited are found in NDC^PSODRG - PSO*7*427

 .;

 .; If clozpaine drug set clozapine edit variable to control expire date calculation PSO*7*574

 .I $$ISCLOZ^PSJCLOZ(,,,,$G(PSODRUG("IEN"))) S PSORXED("CLOZ EDIT")=1

 .I FLN=2,'$P(PSOPAR,"^",3) D  Q

 ..N NDC D NDC^PSODRG(RXN,0,,.NDC) I $G(NDC)="^"!($G(NDC)="") Q

 ..S (PSODRUG("NDC"),PSORXED("FLD",27))=NDC

 .I FLN'>2,'$P(PSOPAR,"^",3) S VALMSG="Check site parameters, Drug data is not editable." Q

 .I FLN=3 D EDTDOSE^PSOORED2,FULL^VALM1,POST^PSODRG S:$G(PSORX("DFLG")) PSOISLKD=1,PSORX("FN")=1 Q

 .I FLN=4 D INS^PSOORED1 Q

 .I FLN=1 D PSOI^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=$S($D(DA):DA,$D(PSORXED("IRXN")):PSORXED("IRXN"),$D(PSORENW("OIRXN")):PSORENW("OIRXN")) D:'$G(PSORXED("DFLG")) EN^PSODIAG Q

 .I FLN=2 D DRG^PSOORED6 N PSOX S PSORXED=1,PSOX("IRXN")=PSORXED("IRXN") D:'$G(PSORXED("DFLG")) EN^PSODIAG S:$O(^PSRX(PSORXED("IRXN"),1,0)) REF=1 Q

 .I FLN=12,PSOPKI W !!,"Digitally Signed Order - Provider can't be changed" D PAUSE Q

 .I FLN=12 D PROV Q

 .I FLN=6 D ISDT^PSOORED2 Q

 .I FLN=7 D FLDT^PSOORED2 Q

 .I FLN=21,$$STATUS^PSOBPSUT(RXN,0)="" S VALMSG="Invalid selection!" Q

 .I FLN=21 D  Q

 ..N DAW D EDTDAW^PSODAWUT(RXN,0,.DAW) I $G(DAW)="^" Q

 ..S (PSODRUG("DAW"),PSORXED("FLD",81))=DAW

 .I FLN=9!(FLN=10)!(FLN=11) D NOCHG^PSOORED7 Q

 .S DR=+DR

 .;441 PAPI

 .I DR=11 D  Q

 ..S PREVMWP=$P(RX0,"^",11) D MWP^PSOPRK(DA,PREVMWP,0) K DIR

 ..I $G(PRKMW)="" Q

 ..S PSORXED("FLD",DR)=PRKMW

 ..I PSORXED("FLD",DR)="W",$P(PSOPAR,"^",12) D

 ...D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ

 ...S DR=35,DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ,DIRUT,DUOUT,DTOUT

 ...S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR)

 ...S DIR(0)="52,"_(DR) D ^DIR I $D(DIRUT),X'="@" K DIR,DIRUT Q

 ...S PSORXED("FLD",DR)=X K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)

 .K DIR,DIRUT,DIROUT ;S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1

 .K DIC,DIQ S DIC=52,DA=PSORXED("IRXN"),DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ

 .S DIR("B")=$S($G(PSORXED("FLD",DR))'="":PSORXED("FLD",DR),$G(PSORXED(52,DA,DR))'="":PSORXED(52,DA,DR),1:""),DIR(0)="52,"_DR D ^DIR

 .I DR=24!(DR=12) S PSORXED("FLD",DR)=X

 .I $D(DIRUT) K DIR,DIRUT,DUOUT,DTOUT,PSORXED(52,DA,DR),PSORXED("FLD",DR) Q

 .I DR'=5,X="@" W !,"Data Required!",! K DIC,DIQ,DR,DA,DIR,DIRUT,PSORXED(52,DA,DR),X,Y Q

 .I DR=5,X'="@" S Y=+Y

 .I DR=3!(DR=20)!(DR=23) S Y=+Y

 .S PSORXED("FLD",DR)=$S(X="@":X,1:Y) K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)

 .I DR=11,PSORXED("FLD",DR)="W",$P(PSOPAR,"^",12) D

 ..D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ

 ..S DR=35,DIQ="PSORXED" D EN^DIQ1 K DIC,DIQ,DIRUT,DUOUT,DTOUT

 ..S:$G(PSORXED(52,DA,DR))]"" DIR("B")=PSORXED(52,DA,DR)

 ..S DIR(0)="52,"_(DR) D ^DIR I $D(DIRUT),X'="@" K DIR,DIRUT Q

 ..S PSORXED("FLD",DR)=X K DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)

 .I $G(PSORXED("FLD",DR))]"" D FIELD^DID(52,DR,"","LABEL","ZZ") S PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR) K ZZ

 Q:$G(PSOSIGFL)

 S (RX1,I,RFD,RFDT)=0 F  S I=$O(^PSRX(PSORXED("IRXN"),1,I)) Q:'I  S RFD=I,RFDT=$P(^PSRX(PSORXED("IRXN"),1,I,0),"^"),RX1(I)=$G(RX1(I))+1

 Q

CHK S CHK=1 I $G(^PSDRUG($P(PSORXED("RX0"),"^",6),"I"))]"",^("I")<DT S VALMSG="This drug has been inactivated. ",PSORXED("DFLG")=1 Q

 K PSPOP I $G(PSODIV),$P(PSORXED("RX2"),"^",9)'=PSOSITE S PSPRXN=PSORXED("IRXN") D  Q:PSORXED("DFLG")

 .I '$P(PSOSYS,"^",2) S VALMSG="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is not a valid choice. (Different Division)" S PSORXED("DFLG")=1 Q

 .I $P(PSOSYS,"^",3) K DIR,DUOUT,DTOUT D  K DIR,DUOUT,DTOUT Q

 ..W $C(7) S DIR("A",1)="",DIR("A",2)="RX# "_$P(^PSRX(PSPRXN,0),"^")_" is from another division.",DIR("A")="Continue: (Y/N)",DIR(0)="Y",DIR("?",1)="'Y' FOR YES",DIR("?")="'N' FOR NO"

 ..S DIR("B")="N" D ^DIR I 'Y!($D(DIRUT)) S PSORXED("DFLG")=1 W !

 ;

 I $P(^PSRX(PSORXED("IRXN"),"STA"),"^")=16 D  Q

 . S PSORXED("DFLG")=1 S VALMSG="Prescriptions on Provider Hold cannot be edited."

 ;

CHKX K PSPOP,DIR,DTOUT,DUOUT,Y,X Q

 Q

PROV ;select provider

 S PSORXED("PROVIDER")=$P(RX0,"^",4),PSORXED("PROVIDER NAME")=$P(^VA(200,$P(RX0,"^",4),0),"^")

 D PROV^PSODIR(.PSORXED) I PSORXED("PROVIDER")'=$P(RX0,"^",4) D

 .K DIR,DIRUT W ! S DIR(0)="Y",DIR("A",1)="You have changed the name of the provider entered for this Rx."

 .S DIR("A",2)="This edit will cause the provider's name to be update for all fills.",DIR("A")="Do you want to continue" D ^DIR

 .I 'Y!$D(DIRUT) K PSORX("PROVIDER"),PSORX("PROVIDER NAME"),PSORX("COSIGNING PROVIDER") Q

 .S PSORXED("FLD",4)=PSORXED("PROVIDER") K DIR,DIRUT,DUOUT

 .S PSORXED("FLD",109)=$G(PSORXED("COSIGNING PROVIDER"))

 Q

UDPROV ;update provider

 S $P(^PSRX(PSORXED("IRXN"),0),"^",4)=PSORXED("PROVIDER"),$P(^(3),"^",3)=$G(PSORX("COSIGNING PROVIDER"))

 F XTY="1","P" F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),XTY,I)) Q:'I  S $P(^PSRX(PSORXED("IRXN"),XTY,I,0),"^",17)=PSORXED("PROVIDER") S:XTY RFED=I

 K XTY,I

 Q

SIG ;edit medication instructions (SIG)

 S PSOFDR=+$P(^PSRX(PSORXED("IRXN"),"SIG"),"^",2) I PSOFDR D

 .F I=0:0 S I=$O(^PSRX(PSORXED("IRXN"),"SIG1",I)) Q:'I  S SIG(I)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)

 E  S PSORX("SIG")=$P(^PSRX(PSORXED("IRXN"),"SIG"),"^")

 D SIG^PSODIR1(.PSORX) D:$G(PSORX("SIG"))]"" EN1^PSOSIGNO(PSORXED("IRXN"),PSORX("SIG"))

 I '$G(PSOSIGFL),$G(PSORX("SIG"))]"" S ^PSRX(PSORXED("IRXN"),"SIG")=PSORX("SIG") K ^PSRX(PSORXED("IRXN"),"SIG1") Q

 S PSOMRFLG=1

 Q

UL ;

 I '$G(PSOLOKED) Q

 D UL^PSSLOCK(PSODFN)

 D PSOUL^PSSLOCK($P(PSOLST(ORN),"^",2))

 Q

SVAL ;Set message for patient lock

 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.")

 Q

SVALO ;Set message for order lock

 S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.")

 Q

 ;

PAUSE ;

 N DIR,X,Y

 W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR

 Q

REQFLDS(FIELDS) ; Checks if fields 1,2 or 3 are being edited

 N REQFLDS,I

 S REQFLDS=0

 F I=1:1:$L(FIELDS) I ",1,2,3,"[(","_+$P(FIELDS,",",I)_",") S REQFLDS=1 Q

 Q REQFLDS

CSFLDBLK(FIELDS) ; checks if this field shold be blocked for a controlled substance

 N B,FLDCHECK

 S FLDCHECK=0

 F B=1:1:$L(FIELDS) I ",1,3,12,17,"[(","_+$P(FIELDS,",",B)_",") S FLDCHECK=1

 ;*517

 Q FLDCHECK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSOOREDT   12684     printed  Mar 13, 2025@21:36:49                                                                                                                                                                                                   Page 2

PSOOREDT  ;BIR/SAB - Edit orders from backdoor ;Jan 25, 2022@14:31:38

 +1       ;;7.0;OUTPATIENT PHARMACY;**4,20,27,37,57,46,78,102,104,119,143,148,260,281,304,289,298,379,377,391,313,427,411,505,517,574,524,617,441,700,746,753**;DEC 1997;Build 53

 +2       ;External reference to ^PSDRUG( supported by DBIA 221

 +3       ;External reference to ^PSSLOCK supported by DBIA 2789

 +4       ;External reference to ^VA(200 supported by DBIA 10060

 +5       ;

 +6       ;*524 add Hazardous meds alerts

 +7       ;

SEL        KILL PSOISLKD,PSOLOKED

           SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)

           IF '$GET(PSOPLCK)

               DO LOCK^PSOORCPY

               DO SVAL

               KILL PSOPLCK

               SET VALMBCK=""

               QUIT 

 +1        KILL PSOPLCK

           DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))

           IF '$GET(PSOMSG)

               DO UL^PSSLOCK(+$GET(PSODFN))

               DO SVALO

               KILL PSOMSG

               SET VALMBCK=""

               QUIT 

 +2        KILL PSOMSG

           SET PSOLOKED=1

 +3       ;reset haz alert displayed to user *524

           NEW PSOHZ

           SET PSOHZ=0

 +4       ;*377

           SET REF=0

           if $$LSTRFL^PSOBPSU1($PIECE(PSOLST(ORN),"^",2))

               SET REF=1

 +5        KILL PSORX("DFLG"),DIR,DUOUT,DIRUT

           SET DIR("A")="Select fields by number"

 +6        SET DIR(0)="LO^1:"_$SELECT($$STATUS^PSOBPSUT($PIECE(PSOLST(ORN),"^",2))'="":21,$GET(REF):22,1:22)

 +7        DO ^DIR

           IF $DATA(DIRUT)

               KILL DIR,DIRUT,DTOUT

               SET VALMBCK=""

               DO UL

               KILL PSOLOKED

               QUIT 

EDTSEL    ;PSO LM SELECT MENU protocol

           NEW VALMCNT

           KILL PSOISLKD,PSORX("DFLG"),PSOOIFLG,PSOMRFLG,DIR,DIRUT,DTOUT,DTOUT,ZONE

           SET PSOQUIT=0

           SET (PSOEDIT,PSORXED)=1

           IF +Y

               SET FST=Y

               DO HLDHDR^PSOLMUTL

               Begin DoDot:1

 +1                IF '$GET(PSOLOKED)

                       SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)

                       IF '$GET(PSOPLCK)

                           DO LOCK^PSOORCPY

                           DO SVAL

                           KILL PSOPLCK

                           SET VALMBCK=""

                           SET (PSOISLKD,PSODE)=1

                           QUIT 

 +2                IF '$GET(PSOLOKED)

                       KILL PSOPLCK

                       DO PSOL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))

                       IF '$GET(PSOMSG)

                           DO UL^PSSLOCK(+$GET(PSODFN))

                           DO SVALO

                           KILL PSOMSG

                           SET VALMBCK=""

                           SET (PSOISLKD,PSODE)=1

                           QUIT 

 +3                KILL PSOMSG,PSOPLCK

                   SET (NEWEDT,PSOLOKED)=1

                   DO EDT

               End DoDot:1

               GOTO EX

 +4       IF '$TEST

               SET VALMBCK=""

               SET PSODE=1

EX         IF $GET(PSOISLKD)!($GET(PSOQUIT))

               DO UL

               KILL PSOISLKD

               GOTO EX2

 +1        IF '$GET(PSOSIGFL)

               IF '$GET(PSORXED("DFLG"))

                   DO UPDATE^PSOORED6

                   DO LOG^PSORXED

                   DO POST^PSORXED

                   GOTO EX1

 +2        IF $GET(PSOSIGFL)=1

               Begin DoDot:1

 +3                NEW PSOTMP

 +4                SET PSOTMP=$GET(PSOFROM)

                   SET PSOFROM="NEW"

 +5                SET VALMSG="This change will create a new prescription!"

                   SET NCPDPFLG=1

 +6                DO EN^PSOORED1(.PSORXED)

 +7                IF $GET(PSORX("FN"))

                       Begin DoDot:2

 +8                        DO ^PSOBUILD

 +9                        KILL QUIT,PSORX("DFLG"),FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT

 +10                       KILL PSORENW,PSOSIGFL,PSOOIFLG,PSOMRFLG,PSODIR,CHK,PSORX("SIG"),PSODE

 +11                       KILL PSOTRN,PSORX("EDIT"),PSORXED("FLD"),NEWEDT

 +12                       SET ZZEDIT=1

                           DO EOJ^PSONEW

                           KILL ZZEDIT

 +13                       DO UL

                           KILL PSOLOKED

                           SET VALMBCK="Q"

                       End DoDot:2

                       QUIT 

 +14               SET PSOFROM=PSOTMP

                   IF PSOFROM=""

                       KILL PSOFROM

               End DoDot:1

               if $GET(PSORX("FN"))

                   QUIT 

 +15      ;

EX1        IF '$GET(PSODE)!('$GET(ZONE))

               IF $GET(PSORENW("OIRXN"))

                   DO EN^PSOHLSN1(PSORENW("OIRXN"),"XX","","Order edited")

QUIT       DO UL

           KILL PSOLOKED

           DO ^PSOBUILD

           DO ACT^PSOORNE2

           if +^PSRX($PIECE(PSOLST(ORN),"^",2),"STA")=5

               DO EN^PSOCMOPC($PIECE(PSOLST(ORN),"^",2))

 +1        if '$ORDER(^PSRX($PIECE(PSOLST(ORN),"^",2),1,0))

               KILL REF

EX2        SET VALMBCK=$SELECT($GET(PSOQUIT):"R",$GET(PSORX("FN")):"Q",$GET(ZONE):"Q",1:"R")

 +1        KILL PSORXED,FST,FLD,IEN,FLN,INCOM,PSOI,PSODRUG,PSOEDIT,PSORENW,PSOSIGFL,PSODIR,CHK,PSORX("SIG"),PSODE,PSOTRN,PSORX("DFLG"),RFED,ZONE,PSORX("EDIT"),PSOOIFLG,PSOMRFLG,SIG,QUIT,PSOQUIT

 +2       ;p753 H 2

           KILL NEWEDT

           IF $GET(VALMBCK)="R"

               WRITE !

               DO CLEAN^PSOVER1

 +3        QUIT 

 +4       ;

EDT       ; Rx Edit (Backdoor)

 +1       ;/BLB/ Patch PSO*7*505/517 Modified EDT to block the editing functionality of certain fields of CS drugs

 +2        NEW FLNCHK,CSDRG,DRGIEN

 +3        KILL NCPDPFLG,PSOPKI,DEA

 +4        SET I=0

           FOR 

               SET I=$ORDER(^PSRX($PIECE(PSOLST(ORN),"^",2),1,I))

               if 'I

                   QUIT 

               SET PSORXED("RX1")=^PSRX($PIECE(PSOLST(ORN),"^",2),1,I,0)

 +5       ;*298 Track PI and Oth Lang PI

 +6       ;*441-IND

           SET (RX0,PSORXED("RX0"))=^PSRX($PIECE(PSOLST(ORN),"^",2),0)

           SET PSORXED("RX2")=$GET(^(2))

           SET PSORXED("RX3")=$GET(^(3))

           SET PSOSIG=$PIECE(^("SIG"),"^")

           SET PSOPINS=$GET(^("INS"))

           SET PSOOINS=$GET(^("INSS"))

           SET PSOPIND=$PIECE($GET(^("IND")),"^")

           SET PSOPINDF=$PIECE($GET(^("IND")),"^",2)

 +7       ; *298 moved this line from EDT+2  RX0 was not defined yet

           IF '$DATA(PSODRUG)

               NEW PSOY

               SET PSOY=$PIECE(RX0,U,6)

               SET PSOY(0)=^PSDRUG(PSOY,0)

               DO SET^PSODRG

 +8        SET CSDRG=0

           IF $$NDF^PSOORNEW(PSODRUG("IEN"))!$$CSDRG^PSOERUT6(PSODRUG("IEN"))

               SET CSDRG=1

 +9        IF CSDRG

               IF $$CSFLDBLK(FST)

                   Begin DoDot:1

 +10                   WRITE !!,"The selection includes field(s) that are not editable"

                       WRITE !,"for controlled substances. These field(s) will be skipped.",!

 +11                   SET DIR(0)="E"

                       DO ^DIR

                       KILL DIR

                   End DoDot:1

 +12       FOR FLD=1:1:$LENGTH(FST,",")

               if $PIECE(FST,",",FLD)']""!($GET(PSORXED("DFLG")))!($GET(PSORX("DFLG")))

                   QUIT 

               SET FLN=+$PIECE(FST,",",FLD)

               SET DRGIEN=PSODRUG("IEN")

               Begin DoDot:1

 +13               SET FLNCHK=","_FLN_","

 +14               SET PSORXED("DFLG")=0

                   SET (DA,PSORXED("IRXN"),PSORENW("OIRXN"))=$PIECE(PSOLST(ORN),"^",2)

                   SET RX0=^PSRX(PSORXED("IRXN"),0)

 +15               SET PSOPKI=$SELECT($PIECE($GET(^PSRX(PSORXED("IRXN"),"PKI")),"^")!$PIECE($GET(^PSRX(PSORXED("IRXN"),"PKI")),"^",3):1,1:0)

                   if $GET(PSOSIG)=""

                       SET PSOSIG=$PIECE(^("SIG"),"^")

 +16      ;*298 Track PI and Oth Lang PI

 +17               if $GET(PSOPINS)=""

                       SET PSOPINS=$GET(^PSRX(DA,"INS"))

                   if $GET(PSOOINS)=""

                       SET PSOOINS=$GET(^PSRX(DA,"INSS"))

 +18      ;*441-IND

                   if $GET(PSOPIND)=""

                       SET PSOPIND=$PIECE($GET(^PSRX(DA,"IND")),"^")

                   if $GET(PSOPINDF)=""

                       SET PSOPINDF=$PIECE($GET(^PSRX(DA,"IND")),"^",2)

 +19               IF '$GET(PSOSIGFL)

                       Begin DoDot:2

 +20                       SET PSOI=+^PSRX(DA,"OR1")

                           SET PSODAYS=$PIECE(RX0,"^",8)

                           SET PSORXST=+$PIECE($GET(^PS(53,$PIECE(RX0,"^",3),0)),"^",7)

 +21                       IF 'PSOI

                               SET PSOI=+^PSDRUG($PIECE(RX0,"^",6),2)

                               SET $PIECE(^PSRX(DA,"OR1"),"^")=PSOI

 +22                       if '$GET(PSODRUG("IEN"))

                               SET PSODRUG("IEN")=$PIECE(RX0,"^",6)

                               SET PSODRUG("NAME")=$PIECE(^PSDRUG($PIECE(RX0,"^",6),0),"^")

 +23                       SET PSODRUG("OI")=PSOI

                       End DoDot:2

 +24               SET PSORX("PROVIDER")=$PIECE(RX0,"^",4)

                   SET PSORX("PROVIDER NAME")=$PIECE(^VA(200,$PIECE(RX0,"^",4),0),"^")

                   SET PSOTRN=$GET(^PSRX(DA,"TN"))

 +25               if '$GET(CHK)

                       DO POP^PSOSIGNO(DA)

                       DO CHK

                   if $GET(PSORXED("DFLG"))

                       QUIT 

 +26      ;p753

                   SET FDR="39.2^"_$SELECT($PIECE(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$SELECT($PIECE(RX0,"^",11)="W"&($PIECE(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81^100.2"

 +27      ; Titration/Maintenance Rx check

 +28               IF $$REQFLDS(FST)

                       IF $$TITRX^PSOUTL($PIECE(PSOLST(ORN),"^",2))="t"

                           Begin DoDot:2

 +29                           SET VALMSG="Cannot edit Drug/Dose fields (Titration Rx)."

                               SET VALMBCK="R"

                               WRITE $CHAR(7)

                           End DoDot:2

                           SET PSORXED("DFLG")=1

                           QUIT 

 +30               if '$GET(CHK)

                       DO POP^PSOSIGNO(DA)

                       DO CHK

                   if $GET(PSORXED("DFLG"))

                       QUIT 

 +31      ;p753

                   SET FDR="39.2^"_$SELECT($PIECE(PSOPAR,"^",3):"6",1:"")_";6.5^113^114^3^1^22R^24^8^7^9^4^11;"_$SELECT($PIECE(RX0,"^",11)="W"&($PIECE(PSOPAR,"^",12)):"35;",1:"")_"^10.6^5^20^23^12^PSOCOU^RF^81^100.2"

 +32               IF $GET(ST)=11!($GET(ST)=12)!($GET(ST)=14)!($GET(ST)=15)

                       DO NDCDAWDE^PSOORED7(ST,FLN,$GET(RXN))

                       QUIT 

 +33      ;*377

                   SET REF=0

                   if $$LSTRFL^PSOBPSU1($PIECE(PSOLST(ORN),"^",2))

                       SET REF=1

 +34               IF FLN=20

                       IF '$GET(REF)

                           SET VALMSG="There is no Refill Data to be edited."

                           QUIT 

 +35               SET DR=$PIECE(FDR,"^",FLN)

                   IF DR="RF"

                       DO REF^PSOORED2

                       QUIT 

 +36               IF DR="PSOCOU"

                       DO PSOCOU^PSOORED6

                       QUIT 

 +37      ;p753

                   IF DR="100.2"

                       Begin DoDot:2

 +38                       KILL DIR,DUOUT,DIRUT

                           SET DIR(0)="52,100.2"

                           DO ^DIR

 +39                       IF $DATA(DIRUT)

                               IF X'="@"

                                   KILL DIR,DIRUT

                                   QUIT 

 +40                       SET PSORXED("FLD",DR)=$SELECT(X="@":X,1:Y)

                           KILL DIR,DIRUT,DTOUT,X,Y

                           QUIT 

                       End DoDot:2

                       QUIT 

 +41               IF $$CSDRG^PSOERUT6(DRGIEN)!($$NDF^PSOORNEW(DRGIEN))

                       IF ",1,3,12,17,"[FLNCHK

                           QUIT 

 +42      ; Allow edit of the NDC when the EDIT DRUG setting is off

 +43      ; Other checks regarding if the NDC may be edited are found in NDC^PSODRG - PSO*7*427

 +44      ;

 +45      ; If clozpaine drug set clozapine edit variable to control expire date calculation PSO*7*574

 +46               IF $$ISCLOZ^PSJCLOZ(,,,,$GET(PSODRUG("IEN")))

                       SET PSORXED("CLOZ EDIT")=1

 +47               IF FLN=2

                       IF '$PIECE(PSOPAR,"^",3)

                           Begin DoDot:2

 +48                           NEW NDC

                               DO NDC^PSODRG(RXN,0,,.NDC)

                               IF $GET(NDC)="^"!($GET(NDC)="")