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**;DEC 1997;Build 261
;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):20,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 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^PSOORNEW(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"
.; 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"
.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 $$CSDRG^PSOORNEW(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 ---[H[J[2J[HPSOOREDT 12469 printed Apr 09, 2024@21:39:22 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**;DEC 1997;Build 261
+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):20,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 KILL NEWEDT
IF $GET(VALMBCK)="R"
WRITE !
DO CLEAN^PSOVER1
HANG 2
+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^PSOORNEW(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 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"
+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 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"
+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 IF $$CSDRG^PSOORNEW(DRGIEN)!($$NDF^PSOORNEW(DRGIEN))
IF ",1,3,12,17,"[FLNCHK
QUIT
+38 ; Allow edit of the NDC when the EDIT DRUG setting is off
+39 ; Other checks regarding if the NDC may be edited are found in NDC^PSODRG - PSO*7*427
+40 ;
+41 ; If clozpaine drug set clozapine edit variable to control expire date calculation PSO*7*574
+42 IF $$ISCLOZ^PSJCLOZ(,,,,$GET(PSODRUG("IEN")))
SET PSORXED("CLOZ EDIT")=1
+43 IF FLN=2
IF '$PIECE(PSOPAR,"^",3)
Begin DoDot:2
+44 NEW NDC
DO NDC^PSODRG(RXN,0,,.NDC)
IF $GET(NDC)="^"!($GET(NDC)="")
QUIT
+45 SET (PSODRUG("NDC"),PSORXED("FLD",27))=NDC
End DoDot:2
QUIT
+46 IF FLN'>2
IF '$PIECE(PSOPAR,"^",3)
SET VALMSG="Check site parameters, Drug data is not editable."
QUIT
+47 IF FLN=3
DO EDTDOSE^PSOORED2
DO FULL^VALM1
DO POST^PSODRG
if $GET(PSORX("DFLG"))
SET PSOISLKD=1
SET PSORX("FN")=1
QUIT
+48 IF FLN=4
DO INS^PSOORED1
QUIT
+49 IF FLN=1
DO PSOI^PSOORED6
NEW PSOX
SET PSORXED=1
SET PSOX("IRXN")=$SELECT($DATA(DA):DA,$DATA(PSORXED("IRXN")):PSORXED("IRXN"),$DATA(PSORENW("OIRXN")):PSORENW("OIRXN"))
if '$GET(PSORXED("DFLG"))
DO EN^PSODIAG
QUIT
+50 IF FLN=2
DO DRG^PSOORED6
NEW PSOX
SET PSORXED=1
SET PSOX("IRXN")=PSORXED("IRXN")
if '$GET(PSORXED("DFLG"))
DO EN^PSODIAG
if $ORDER(^PSRX(PSORXED("IRXN"),1,0))
SET REF=1
QUIT
+51 IF FLN=12
IF PSOPKI
WRITE !!,"Digitally Signed Order - Provider can't be changed"
DO PAUSE
QUIT
+52 IF FLN=12
DO PROV
QUIT
+53 IF FLN=6
DO ISDT^PSOORED2
QUIT
+54 IF FLN=7
DO FLDT^PSOORED2
QUIT
+55 IF FLN=21
IF $$STATUS^PSOBPSUT(RXN,0)=""
SET VALMSG="Invalid selection!"
QUIT
+56 IF FLN=21
Begin DoDot:2
+57 NEW DAW
DO EDTDAW^PSODAWUT(RXN,0,.DAW)
IF $GET(DAW)="^"
QUIT
+58 SET (PSODRUG("DAW"),PSORXED("FLD",81))=DAW
End DoDot:2
QUIT
+59 IF FLN=9!(FLN=10)!(FLN=11)
DO NOCHG^PSOORED7
QUIT
+60 SET DR=+DR
+61 ;441 PAPI
+62 IF DR=11
Begin DoDot:2
+63 SET PREVMWP=$PIECE(RX0,"^",11)
DO MWP^PSOPRK(DA,PREVMWP,0)
KILL DIR
+64 IF $GET(PRKMW)=""
QUIT
+65 SET PSORXED("FLD",DR)=PRKMW
+66 IF PSORXED("FLD",DR)="W"
IF $PIECE(PSOPAR,"^",12)
Begin DoDot:3
+67 DO FIELD^DID(52,DR,"","LABEL","ZZ")
SET PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR)
KILL ZZ
+68 SET DR=35
SET DIQ="PSORXED"
DO EN^DIQ1
KILL DIC,DIQ,DIRUT,DUOUT,DTOUT
+69 if $GET(PSORXED(52,DA,DR))]""
SET DIR("B")=PSORXED(52,DA,DR)
+70 SET DIR(0)="52,"_(DR)
DO ^DIR
IF $DATA(DIRUT)
IF X'="@"
KILL DIR,DIRUT
QUIT
+71 SET PSORXED("FLD",DR)=X
KILL DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
End DoDot:3
End DoDot:2
QUIT
+72 ;S DIE=52 D ^DIE I $D(Y) S PSORXED("DFLG")=1
KILL DIR,DIRUT,DIROUT
+73 KILL DIC,DIQ
SET DIC=52
SET DA=PSORXED("IRXN")
SET DIQ="PSORXED"
DO EN^DIQ1
KILL DIC,DIQ
+74 SET DIR("B")=$SELECT($GET(PSORXED("FLD",DR))'="":PSORXED("FLD",DR),$GET(PSORXED(52,DA,DR))'="":PSORXED(52,DA,DR),1:"")
SET DIR(0)="52,"_DR
DO ^DIR
+75 IF DR=24!(DR=12)
SET PSORXED("FLD",DR)=X
+76 IF $DATA(DIRUT)
KILL DIR,DIRUT,DUOUT,DTOUT,PSORXED(52,DA,DR),PSORXED("FLD",DR)
QUIT
+77 IF DR'=5
IF X="@"
WRITE !,"Data Required!",!
KILL DIC,DIQ,DR,DA,DIR,DIRUT,PSORXED(52,DA,DR),X,Y
QUIT
+78 IF DR=5
IF X'="@"
SET Y=+Y
+79 IF DR=3!(DR=20)!(DR=23)
SET Y=+Y
+80 SET PSORXED("FLD",DR)=$SELECT(X="@":X,1:Y)
KILL DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
+81 IF DR=11
IF PSORXED("FLD",DR)="W"
IF $PIECE(PSOPAR,"^",12)
Begin DoDot:2
+82 DO FIELD^DID(52,DR,"","LABEL","ZZ")
SET PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR)
KILL ZZ
+83 SET DR=35
SET DIQ="PSORXED"
DO EN^DIQ1
KILL DIC,DIQ,DIRUT,DUOUT,DTOUT
+84 if $GET(PSORXED(52,DA,DR))]""
SET DIR("B")=PSORXED(52,DA,DR)
+85 SET DIR(0)="52,"_(DR)
DO ^DIR
IF $DATA(DIRUT)
IF X'="@"
KILL DIR,DIRUT
QUIT
+86 SET PSORXED("FLD",DR)=X
KILL DIR,DIRUT,DIROUT,X,Y,PSORXED(52,DA,DR)
End DoDot:2
+87 IF $GET(PSORXED("FLD",DR))]""
DO FIELD^DID(52,DR,"","LABEL","ZZ")
SET PSORXED(ZZ("LABEL"))=PSORXED("FLD",DR)
KILL ZZ
End DoDot:1
+88 if $GET(PSOSIGFL)
QUIT
+89 SET (RX1,I,RFD,RFDT)=0
FOR
SET I=$ORDER(^PSRX(PSORXED("IRXN"),1,I))
if 'I
QUIT
SET RFD=I
SET RFDT=$PIECE(^PSRX(PSORXED("IRXN"),1,I,0),"^")
SET RX1(I)=$GET(RX1(I))+1
+90 QUIT
CHK SET CHK=1
IF $GET(^PSDRUG($PIECE(PSORXED("RX0"),"^",6),"I"))]""
IF ^("I")<DT
SET VALMSG="This drug has been inactivated. "
SET PSORXED("DFLG")=1
QUIT
+1 KILL PSPOP
IF $GET(PSODIV)
IF $PIECE(PSORXED("RX2"),"^",9)'=PSOSITE
SET PSPRXN=PSORXED("IRXN")
Begin DoDot:1
+2 IF '$PIECE(PSOSYS,"^",2)
SET VALMSG="RX# "_$PIECE(^PSRX(PSPRXN,0),"^")_" is not a valid choice. (Different Division)"
SET PSORXED("DFLG")=1
QUIT
+3 IF $PIECE(PSOSYS,"^",3)
KILL DIR,DUOUT,DTOUT
Begin DoDot:2
+4 WRITE $CHAR(7)
SET DIR("A",1)=""
SET DIR("A",2)="RX# "_$PIECE(^PSRX(PSPRXN,0),"^")_" is from another division."
SET DIR("A")="Continue: (Y/N)"
SET DIR(0)="Y"
SET DIR("?",1)="'Y' FOR YES"
SET DIR("?")="'N' FOR NO"
+5 SET DIR("B")="N"
DO ^DIR
IF 'Y!($DATA(DIRUT))
SET PSORXED("DFLG")=1
WRITE !
End DoDot:2
KILL DIR,DUOUT,DTOUT
QUIT
End DoDot:1
if PSORXED("DFLG")
QUIT
+6 ;
+7 IF $PIECE(^PSRX(PSORXED("IRXN"),"STA"),"^")=16
Begin DoDot:1
+8 SET PSORXED("DFLG")=1
SET VALMSG="Prescriptions on Provider Hold cannot be edited."
End DoDot:1
QUIT
+9 ;
CHKX KILL PSPOP,DIR,DTOUT,DUOUT,Y,X
QUIT
+1 QUIT
PROV ;select provider
+1 SET PSORXED("PROVIDER")=$PIECE(RX0,"^",4)
SET PSORXED("PROVIDER NAME")=$PIECE(^VA(200,$PIECE(RX0,"^",4),0),"^")
+2 DO PROV^PSODIR(.PSORXED)
IF PSORXED("PROVIDER")'=$PIECE(RX0,"^",4)
Begin DoDot:1
+3 KILL DIR,DIRUT
WRITE !
SET DIR(0)="Y"
SET DIR("A",1)="You have changed the name of the provider entered for this Rx."
+4 SET DIR("A",2)="This edit will cause the provider's name to be update for all fills."
SET DIR("A")="Do you want to continue"
DO ^DIR
+5 IF 'Y!$DATA(DIRUT)
KILL PSORX("PROVIDER"),PSORX("PROVIDER NAME"),PSORX("COSIGNING PROVIDER")
QUIT
+6 SET PSORXED("FLD",4)=PSORXED("PROVIDER")
KILL DIR,DIRUT,DUOUT
+7 SET PSORXED("FLD",109)=$GET(PSORXED("COSIGNING PROVIDER"))
End DoDot:1
+8 QUIT
UDPROV ;update provider
+1 SET $PIECE(^PSRX(PSORXED("IRXN"),0),"^",4)=PSORXED("PROVIDER")
SET $PIECE(^(3),"^",3)=$GET(PSORX("COSIGNING PROVIDER"))
+2 FOR XTY="1","P"
FOR I=0:0
SET I=$ORDER(^PSRX(PSORXED("IRXN"),XTY,I))
if 'I
QUIT
SET $PIECE(^PSRX(PSORXED("IRXN"),XTY,I,0),"^",17)=PSORXED("PROVIDER")
if XTY
SET RFED=I
+3 KILL XTY,I
+4 QUIT
SIG ;edit medication instructions (SIG)
+1 SET PSOFDR=+$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^",2)
IF PSOFDR
Begin DoDot:1
+2 FOR I=0:0
SET I=$ORDER(^PSRX(PSORXED("IRXN"),"SIG1",I))
if 'I
QUIT
SET SIG(I)=^PSRX(PSORXED("IRXN"),"SIG1",I,0)
End DoDot:1
+3 IF '$TEST
SET PSORX("SIG")=$PIECE(^PSRX(PSORXED("IRXN"),"SIG"),"^")
+4 DO SIG^PSODIR1(.PSORX)
if $GET(PSORX("SIG"))]""
DO EN1^PSOSIGNO(PSORXED("IRXN"),PSORX("SIG"))
+5 IF '$GET(PSOSIGFL)
IF $GET(PSORX("SIG"))]""
SET ^PSRX(PSORXED("IRXN"),"SIG")=PSORX("SIG")
KILL ^PSRX(PSORXED("IRXN"),"SIG1")
QUIT
+6 SET PSOMRFLG=1
+7 QUIT
UL ;
+1 IF '$GET(PSOLOKED)
QUIT
+2 DO UL^PSSLOCK(PSODFN)
+3 DO PSOUL^PSSLOCK($PIECE(PSOLST(ORN),"^",2))
+4 QUIT
SVAL ;Set message for patient lock
+1 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.")
+2 QUIT
SVALO ;Set message for order lock
+1 SET VALMSG=$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing this order.")
+2 QUIT
+3 ;
PAUSE ;
+1 NEW DIR,X,Y
+2 WRITE !
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
+3 QUIT
REQFLDS(FIELDS) ; Checks if fields 1,2 or 3 are being edited
+1 NEW REQFLDS,I
+2 SET REQFLDS=0
+3 FOR I=1:1:$LENGTH(FIELDS)
IF ",1,2,3,"[(","_+$PIECE(FIELDS,",",I)_",")
SET REQFLDS=1
QUIT
+4 QUIT REQFLDS
CSFLDBLK(FIELDS) ; checks if this field shold be blocked for a controlled substance
+1 NEW B,FLDCHECK
+2 SET FLDCHECK=0
+3 FOR B=1:1:$LENGTH(FIELDS)
IF ",1,3,12,17,"[(","_+$PIECE(FIELDS,",",B)_",")
SET FLDCHECK=1
+4 ;*517
+5 QUIT FLDCHECK
