ORCACT0 ;SLC/MKB - Validate order action ;Sep 15, 2023@09:23
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,86,92,94,141,165,177,173,190,215,243,289,204,306,350,425,434,377,413,539,603**;Dec 17, 1997;Build 14
;
; Reference to OEL^PSOORRL in ICR #2400
; Reference to $$REFILL^PSOREF in ICR #2399
;
VALID(IFN,ACTION,ERROR,NATR) ; -- Determines if action is valid for order IFN
N OR0,OR3,ORA0,AIFN,PKG,DG,ORDSTS,ACTSTS,VER,X,Y,MEDPARM,CSORD,ORDLG,ORENVIR K ERROR
S OR0=$G(^OR(100,+IFN,0)),OR3=$G(^(3)),PKG=$$NMSP^ORCD($P(OR0,U,14))
S ORENVIR=$S('$D(XQY0):"",$P(XQY0,U)="OR CPRS GUI CHART":"GUI",1:"")
I $G(ORENVIR)'="GUI"&(ACTION="ES") D G VQ
. S CSORD="" D CSVALUE^ORDEA(.CSORD,+IFN)
. S ORDLG=$S($P(OR0,U,5)["101.41":$P($G(^ORD(101.41,+$P(OR0,U,5),0)),U),1:"")
. I CSORD&(ORDLG="PSO OERR") D
. . S ERROR="Outpatient controlled substance order(s) cannot be signed in VistA due to"_$C(13,10)
. . S ERROR=ERROR_" DEA rules! Please sign your order(s) from the CPRS GUI."
. . Q
S DG=$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,3)
S MEDPARM=$S($G(NATR)="A":2,PKG'="PS":2,'$D(^XUSEC("OREMAS",DUZ)):2,DG="NV RX":$$GET^XPAR("ALL","OR OREMAS NON-VA MED ORDERS"),1:$$GET^XPAR("ALL","OR OREMAS MED ORDERS"))
S AIFN=$P(IFN,";",2) S:'AIFN AIFN=+$P(OR3,U,7)
S ORA0=$G(^OR(100,+IFN,8,AIFN,0)),ACTSTS=$P(ORA0,U,15)
S ORDSTS=$P(OR3,U,3),VER=$S($P(OR0,U,5)["101.41":3,1:2)
CM ;I ACTION="CM" S ERROR="This action is no longer available!" G VQ ; ward comments - no restrictions
FL I ACTION="FL" D G VQ ; flag
. I PKG="SD" S ERROR="Flagging not allowed on Scheduling orders!" Q
. I +$G(^OR(100,+IFN,8,AIFN,3)) S ERROR="This order is already flagged!" Q
UF I ACTION="UF"!(ACTION="FC") D G VQ ; unflag/flag comment
. I PKG="SD" S ERROR="Un-Flagging not allowed on Scheduling orders!" Q
. I '+$G(^OR(100,+IFN,8,AIFN,3)) S ERROR="This order is not flagged!" Q
. ; *539 - checks if user is authorized to unflag/add comments
. N DA,X3,RECP,AMG
. S AMG=$$GET^XPAR("DIV^SYS^PKG","OR UNFLAGGING MESSAGE",1)
. S DA=$P(IFN,";",2),X3=$G(^OR(100,+IFN,8,+DA,3))
. S RECP=$S($D(^OR(100,+IFN,8,+DA,6,"B",DUZ)):1,$P(X3,"^",4)=DUZ:1,$P(X3,"^",9)=DUZ:1,1:0)
. I RECP Q
. I ACTION="FC" S ERROR="You are not authorized to add comments as you are not the initiator or a recipient"_$S(AMG]"":U_AMG,1:"") Q
. Q:$D(^XUSEC("ORES",DUZ)) ; No restrictions if user holds ORES key to unflag
. Q:'$$GET^XPAR("DIV^SYS^PKG","OR UNFLAGGING RESTRICTIONS",1) ; quit if no restrictions
. ; Check Security Key multiple in Display Group file and compare with user
. N DGP,DGSK,ORSKP,SFND,DGSQ S DGP=+$P(OR0,U,11),SFND=0
. D MAP^ORWDXA1(.DGSQ) ;map to the right display group
. I DGP,$G(DGSQ(DGP)) S DGP=+DGSQ(DGP)
. I $D(^ORD(100.98,DGP,2)) D
. . S DGSK=0 F S DGSK=$O(^ORD(100.98,DGP,2,DGSK)) Q:DGSK=""!(DGSK'?1N.N) I $D(^ORD(100.98,DGP,2,DGSK,0)) D
. . . S ORSKP=^ORD(100.98,DGP,2,DGSK,0)
. . . I $D(^XUSEC($$GET1^DIQ(19.1,ORSKP_",",.01,"E"),DUZ)) S SFND=1
. ; If user doesn't hold proper security key(s), send this message along with site desired help text
. I 'SFND D Q
. . S ERROR="You are not authorized to unflag this order based on your security keys and the order type."_$S(AMG]"":U_AMG,1:"")
DC1 I ACTION="DC",ACTSTS D G VQ ; discontinue/cancel unrel or canc order
. I (ACTSTS=11)!(ACTSTS=10) D Q ; unreleased
.. I 'MEDPARM S ERROR="You are not authorized to cancel med orders!" Q
.. I $G(NATR)="A" S X=$O(^ORE(100.2,"AO",+IFN,0)) I X,'$G(^ORE(100.2,X,1)) S ERROR="Future event orders may not be auto-discontinued!" Q
. I ACTSTS=12 S ERROR="This order has been dc'd due to edit!" Q
. I ACTSTS=13 S ERROR="This order has been cancelled!" Q
ES I (ACTION="ES")!(ACTION="OC")!(ACTION="RS")!(ACTION="DS") D ES^ORCACT01 G VQ ; sign
VR I ACTION="VR" D G VQ ; verify
. I $G(ORVER)="N",$P(ORA0,U,9) S ERROR="This order has been verified!" Q
. ; OR*3*413 rbd - prevent nurse verify of Pending order
. ; Also, prevent nurse verify of Non-Verified
. ; order where not FINISHed by Nurse.
. I $G(ORVER)="N" D Q:$D(ERROR)
.. N ORARR,ORFIN,ORNUM,ORXIFN,OSTYPE,ORSTATUS
.. S ORXIFN=$G(^OR(100,+IFN,4))
.. S OSTYPE=$P(OR0,U,12) K ^TMP("PS",$J)
.. D OEL^PSOORRL(+$P(OR0,U,2),ORXIFN_";"_OSTYPE) ; IA 2400
.. S ORSTATUS=$P($G(^TMP("PS",$J,0)),U,6)
.. I ORSTATUS="PENDING" D
... S ERROR="Still in PENDING status on Pharmacy side."
.. I ORSTATUS="NON-VERIFIED" D
...S ORFIN=0 M ORARR=^TMP("PS",$J,"ALOG")
...S ORNUM="" F S ORNUM=$O(ORARR(ORNUM),-1) Q:+ORNUM=0 D
....I $P(ORARR(ORNUM,0),U,3)=22000 S ORFIN=1
...I 'ORFIN D
....S ERROR="NON-VERIFIED status not Finished by Nurse with Authorized Key."
.. K ^TMP("PS",$J) ;p539
. I $G(ORVER)="C",$P(ORA0,U,11) S ERROR="This order has been verified!" Q
. I $G(ORVER)="R",$P(ORA0,U,19) S ERROR="This order has been reviewed!" Q
. I (ACTSTS=11)!(ACTSTS=10) S ERROR="This order has not been released to the service." Q
. I AIFN=1,ORDSTS=5,PKG="PS" S X=$$DISABLED I X S ERROR=$P(X,U,2) Q
DIS S X=$$DISABLED I X S ERROR=$P(X,U,2) G VQ
MN I ACTION="MN" D G VQ ; manually release (delayed)
. I ACTSTS'=10,ACTSTS'=11 S ERROR="This order has already been released!" Q
. ;I $P(OR0,U,12)="I",'$G(^DPT(+ORVP,.105)) S ERROR="This patient is not currently admitted!"
GMRA I PKG="GMRA" S ERROR="This action is not allowed on an allergy/adverse reaction!" G VQ ; no actions allowed on Allergies
MEDS I PKG="PS",'MEDPARM S ERROR="You are not authorized to enter med orders!" G VQ
RW I ACTION="RW" D RW^ORCACT01 G VQ ; rewrite/copy
XFR I ACTION="XFR" D G VQ
. N A
. S A=""
. F S A=$O(^OR(100,+IFN,4.5,"ID","CONJ",A)) Q:'A I ^OR(100,+IFN,4.5,A,1)="X" S ERROR="Orders with a conjunction of 'EXCEPT' may not be transferred." Q
. F S A=$O(^OR(100,+IFN,4.5,"ID","CONJ",A)) Q:'A I ^OR(100,+IFN,4.5,A,1)="T" S ERROR="Orders with a conjunction of 'THEN' may not be transferred." Q
. I $G(ERROR)]"" Q
. D XFR^ORCACT01 ; transfer to in/outpt
RN I ACTION="RN" D RN^ORCACT01 G VQ ; renew
TRM I $$DONE G VQ ; ORDSTS=1,2,7,12,13
EV I ACTION="EV" D G VQ ; change delay event
. I ORDSTS'=10,ORDSTS'=11 S ERROR="This order has been released!" Q
. I DG="NV RX" S ERROR="Non-VA Med orders do not support this action!" Q
. I DG="C RX"!(DG="CI RX") S ERROR="Clinic Med/IV orders do not support this action!" Q
. I $$EVTORDER^OREVNTX(IFN) S ERROR="The release event for this order may not be changed!" Q
. S X=$P(ORA0,U,4) I X'=2,X'=3 S ERROR="Signed orders may not be delayed to another event!" Q
DC2 I ACTION="DC",ACTSTS="" D G VQ ; DC released order
. I $G(NATR)="A" D Q:$D(ERROR)
.. S X=$O(^ORE(100.2,"AO",+IFN,0)) I X S:'$G(^ORE(100.2,X,1)) ERROR="Future event orders may not be auto-discontinued!" Q
.. I $$GET1^DIQ(9.4,+$P(OR0,U,14)_",",1)="PSO",$G(DGPMT)=1 Q ;177 If admission auto-dc and order is outpt med then no further checking needed
.. I $G(DGPMT)=1,$P($G(^SC(+$P(OR0,U,10),0)),U,3)'="C" S ERROR="Only outpatient orders may be auto-discontinued!" Q
.. I $G(DGPMT)'=1,$P($G(^SC(+$P(OR0,U,10),0)),U,3)="C",PKG'="PS" S ERROR="Only inpatient orders may be auto-discontinued!" Q
. I PKG="RA",ORDSTS=6 S ERROR="Active Radiology orders cannot be discontinued!" Q
. I PKG="VBEC",ORDSTS=6 S ERROR="Active Blood Product orders cannot be discontinued!" Q
. I PKG="LR" D Q
.. I $$COLLECTD S ERROR="Lab orders that have been collected may not be discontinued!" Q
.. I $G(NATR)="A","^12^38^"'[(U_$P($G(DGPMA),U,18)_U),$$VALUE^ORX8(+IFN,"COLLECT")="SP",$P(OR0,U,8)'<DT S ERROR="Future Send Patient orders may not be auto-discontinued!" Q
. I PKG="GMRC",ORDSTS=9 S ERROR="Consults orders with partial results cannot be discontinued!" Q
. I DG="DO",$G(DGPMT)'=3,ORDSTS=6 S ERROR="Active Diets cannot be discontinued; please order a new diet!" Q
RL I ACTION="RL" D G VQ ; release hold
. I ORDSTS'=3 D Q
..I $P(ORA0,U,4)=2 S ERROR="Providers has not yet signed the hold order and therefor it cannot yet be released" Q
..S ERROR="Orders not on hold cannot be released!" Q
. I ACTSTS S ERROR=$$ACTION($P(ORA0,U,2))_" orders cannot be released from hold!" Q
. N NATR,ACT S ACT=$S($P(ORA0,U,2)="HD":AIFN,1:+$P(OR3,U,7))
. S NATR=+$P($G(^OR(100,+IFN,8,ACT,0)),U,12),ACT=$P($G(^(0)),U,2)
. I PKG="RA"!(ACT'="HD")!($P($G(^ORD(100.02,NATR,0)),U,2)="S") S ERROR="Orders held by a service must be released from hold through the service!" Q
AIFN S X=$P(ORA0,U,2) I AIFN>1,ACTSTS S ERROR="This action is not allowed on a "_$$ACTION(X)_" order!" G VQ
RF I ACTION="RF" D G VQ
. I DG'="O RX",DG'="SPLY" S ERROR="Only Outpatient Med and Supply orders may be refilled!" Q
. I ORDSTS=5 S ERROR="Pending orders may not be refilled!" Q
. I ORDSTS=7 S ERROR="Expired orders may not be refilled!" Q
. N X,PSIFN S PSIFN=$G(^OR(100,+IFN,4))
. S X=$$REFILL^PSOREF(PSIFN) I X'>0 S ERROR=$P(X,U,2) Q
CP I ACTION="CP" D G VQ ; complete
. I PKG'="OR" S ERROR="Only generic text orders may be completed through this option!" Q
. I ORDSTS=11!(ORDSTS=10) S ERROR="This order has not been released!" Q
AL I ACTION="AL" D G VQ
. I PKG'="LR",PKG'="RA",PKG'="GMRC" S ERROR="This order does not generate results!" Q
. I $P(OR3,U,10) S ERROR="This order is already flagged to alert the provider when resulted!" Q
XX I ACTION="XX" D G VQ ; edit/change
. I PKG="SD",ORDSTS'=11 S ERROR="Change action not allowed on Scheduling orders!" Q
. I ORDSTS=7 S ERROR="Expired orders may not be changed!" Q
. D XX^ORCACT01
HD I ACTION="HD" D G VQ ; hold
. I PKG="FH" S ERROR="Diet orders cannot be held!" Q
. I PKG="LR" S ERROR="Lab orders cannot be held!" Q
. I PKG="RA" S ERROR="Radiology orders cannot be held!" Q
. I PKG="GMRC" S ERROR="Consult orders cannot be held!" Q
. I DG="NV RX" S ERROR="Non-VA Med orders cannot be held!" Q
. I PKG="SD" S ERROR="Scheduling orders cannot be held!" Q
. I ORDSTS=3 S ERROR="This order is already on hold!" Q
. I ORDSTS'=6,PKG="PS" S ERROR="Only active Pharmacy orders may be held!" Q
. I (ORDSTS=11)!(ORDSTS=10) S ERROR="This order has not been released to the service." Q
VQ S Y=$S($D(ERROR):0,1:1)
Q Y
;
ACTION(X) ; -- Return text of action X
N Y S Y=$S(X="NW":"New",X="DC":"Discontinue",X="HD":"Hold",X="RL":"Release Hold",X="RN":"Renew",1:X)
Q Y
;
NPO(ORIFN) ; -- Returns 1 or 0, if order ORIFN is for NPO
N X,Y S X=$$VALUE^ORX8(+ORIFN,"ORDERABLE",1,"E")
S Y=$S($E(X,1,3)="NPO":1,1:0)
Q Y
;
COLLECTD() ; -- Lab order collected/active (incl all children)?
I "^1^10^11^12^13^"[(U_ORDSTS_U) Q 0 ; unreleased or discontinued
I '$O(^OR(100,+IFN,2,0)) Q (ORDSTS'=5)
;I ORDSTS'=6 Q 1 ; Parent -> active instead of pending
N Y,Z S Y=1,Z=0
F S Z=$O(^OR(100,+IFN,2,Z)) Q:Z'>0 I $P($G(^OR(100,Z,3)),U,3)=5 S Y=0 Q
Q Y
;
DONE() ; -- sets ERROR if terminal status
I ORDSTS=1 S ERROR="This order has been discontinued!" Q 1
I ORDSTS=2 S ERROR="This order has been completed!" Q 1
I ORDSTS=7,DG'="O RX" S ERROR="This order has expired!" Q 1
I ORDSTS=12 S ERROR="This order has been changed!" Q 1
I ORDSTS=13 S ERROR="This order has been cancelled!" Q 1
I ORDSTS=14 S ERROR="This order has lapsed!" Q 1
I ORDSTS=15 S ERROR="This order has been renewed!" Q 1
Q 0
;
DISABLED() ; -- Order dialog [or protocol] disabled?
N X,DLG S DLG=$P(OR0,U,5),X=0 I +DLG'>0 Q X
I VER'<3,DLG?1.N1";ORD(101.41," S X=$$MSG^ORXD(+DLG) Q X
S DLG=$S(PKG="RA":"RA OERR EXAM",PKG="GMRC":"GMRCOR CONSULT",1:"")
I $L(DLG) S DLG=+$O(^ORD(101.41,"AB",DLG,0)),X=$$MSG^ORXD(DLG)
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCACT0 11567 printed Apr 09, 2024@21:44:38 Page 2
ORCACT0 ;SLC/MKB - Validate order action ;Sep 15, 2023@09:23
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,86,92,94,141,165,177,173,190,215,243,289,204,306,350,425,434,377,413,539,603**;Dec 17, 1997;Build 14
+2 ;
+3 ; Reference to OEL^PSOORRL in ICR #2400
+4 ; Reference to $$REFILL^PSOREF in ICR #2399
+5 ;
VALID(IFN,ACTION,ERROR,NATR) ; -- Determines if action is valid for order IFN
+1 NEW OR0,OR3,ORA0,AIFN,PKG,DG,ORDSTS,ACTSTS,VER,X,Y,MEDPARM,CSORD,ORDLG,ORENVIR
KILL ERROR
+2 SET OR0=$GET(^OR(100,+IFN,0))
SET OR3=$GET(^(3))
SET PKG=$$NMSP^ORCD($PIECE(OR0,U,14))
+3 SET ORENVIR=$SELECT('$DATA(XQY0):"",$PIECE(XQY0,U)="OR CPRS GUI CHART":"GUI",1:"")
+4 IF $GET(ORENVIR)'="GUI"&(ACTION="ES")
Begin DoDot:1
+5 SET CSORD=""
DO CSVALUE^ORDEA(.CSORD,+IFN)
+6 SET ORDLG=$SELECT($PIECE(OR0,U,5)["101.41":$PIECE($GET(^ORD(101.41,+$PIECE(OR0,U,5),0)),U),1:"")
+7 IF CSORD&(ORDLG="PSO OERR")
Begin DoDot:2
+8 SET ERROR="Outpatient controlled substance order(s) cannot be signed in VistA due to"_$CHAR(13,10)
+9 SET ERROR=ERROR_" DEA rules! Please sign your order(s) from the CPRS GUI."
+10 QUIT
End DoDot:2
End DoDot:1
GOTO VQ
+11 SET DG=$PIECE($GET(^ORD(100.98,+$PIECE(OR0,U,11),0)),U,3)
+12 SET MEDPARM=$SELECT($GET(NATR)="A":2,PKG'="PS":2,'$DATA(^XUSEC("OREMAS",DUZ)):2,DG="NV RX":$$GET^XPAR("ALL","OR OREMAS NON-VA MED ORDERS"),1:$$GET^XPAR("ALL","OR OREMAS MED ORDERS"))
+13 SET AIFN=$PIECE(IFN,";",2)
if 'AIFN
SET AIFN=+$PIECE(OR3,U,7)
+14 SET ORA0=$GET(^OR(100,+IFN,8,AIFN,0))
SET ACTSTS=$PIECE(ORA0,U,15)
+15 SET ORDSTS=$PIECE(OR3,U,3)
SET VER=$SELECT($PIECE(OR0,U,5)["101.41":3,1:2)
CM ;I ACTION="CM" S ERROR="This action is no longer available!" G VQ ; ward comments - no restrictions
FL ; flag
IF ACTION="FL"
Begin DoDot:1
+1 IF PKG="SD"
SET ERROR="Flagging not allowed on Scheduling orders!"
QUIT
+2 IF +$GET(^OR(100,+IFN,8,AIFN,3))
SET ERROR="This order is already flagged!"
QUIT
End DoDot:1
GOTO VQ
UF ; unflag/flag comment
IF ACTION="UF"!(ACTION="FC")
Begin DoDot:1
+1 IF PKG="SD"
SET ERROR="Un-Flagging not allowed on Scheduling orders!"
QUIT
+2 IF '+$GET(^OR(100,+IFN,8,AIFN,3))
SET ERROR="This order is not flagged!"
QUIT
+3 ; *539 - checks if user is authorized to unflag/add comments
+4 NEW DA,X3,RECP,AMG
+5 SET AMG=$$GET^XPAR("DIV^SYS^PKG","OR UNFLAGGING MESSAGE",1)
+6 SET DA=$PIECE(IFN,";",2)
SET X3=$GET(^OR(100,+IFN,8,+DA,3))
+7 SET RECP=$SELECT($DATA(^OR(100,+IFN,8,+DA,6,"B",DUZ)):1,$PIECE(X3,"^",4)=DUZ:1,$PIECE(X3,"^",9)=DUZ:1,1:0)
+8 IF RECP
QUIT
+9 IF ACTION="FC"
SET ERROR="You are not authorized to add comments as you are not the initiator or a recipient"_$SELECT(AMG]"":U_AMG,1:"")
QUIT
+10 ; No restrictions if user holds ORES key to unflag
if $DATA(^XUSEC("ORES",DUZ))
QUIT
+11 ; quit if no restrictions
if '$$GET^XPAR("DIV^SYS^PKG","OR UNFLAGGING RESTRICTIONS",1)
QUIT
+12 ; Check Security Key multiple in Display Group file and compare with user
+13 NEW DGP,DGSK,ORSKP,SFND,DGSQ
SET DGP=+$PIECE(OR0,U,11)
SET SFND=0
+14 ;map to the right display group
DO MAP^ORWDXA1(.DGSQ)
+15 IF DGP
IF $GET(DGSQ(DGP))
SET DGP=+DGSQ(DGP)
+16 IF $DATA(^ORD(100.98,DGP,2))
Begin DoDot:2
+17 SET DGSK=0
FOR
SET DGSK=$ORDER(^ORD(100.98,DGP,2,DGSK))
if DGSK=""!(DGSK'?1N.N)
QUIT
IF $DATA(^ORD(100.98,DGP,2,DGSK,0))
Begin DoDot:3
+18 SET ORSKP=^ORD(100.98,DGP,2,DGSK,0)
+19 IF $DATA(^XUSEC($$GET1^DIQ(19.1,ORSKP_",",.01,"E"),DUZ))
SET SFND=1
End DoDot:3
End DoDot:2
+20 ; If user doesn't hold proper security key(s), send this message along with site desired help text
+21 IF 'SFND
Begin DoDot:2
+22 SET ERROR="You are not authorized to unflag this order based on your security keys and the order type."_$SELECT(AMG]"":U_AMG,1:"")
End DoDot:2
QUIT
End DoDot:1
GOTO VQ
DC1 ; discontinue/cancel unrel or canc order
IF ACTION="DC"
IF ACTSTS
Begin DoDot:1
+1 ; unreleased
IF (ACTSTS=11)!(ACTSTS=10)
Begin DoDot:2
+2 IF 'MEDPARM
SET ERROR="You are not authorized to cancel med orders!"
QUIT
+3 IF $GET(NATR)="A"
SET X=$ORDER(^ORE(100.2,"AO",+IFN,0))
IF X
IF '$GET(^ORE(100.2,X,1))
SET ERROR="Future event orders may not be auto-discontinued!"
QUIT
End DoDot:2
QUIT
+4 IF ACTSTS=12
SET ERROR="This order has been dc'd due to edit!"
QUIT
+5 IF ACTSTS=13
SET ERROR="This order has been cancelled!"
QUIT
End DoDot:1
GOTO VQ
ES ; sign
IF (ACTION="ES")!(ACTION="OC")!(ACTION="RS")!(ACTION="DS")
DO ES^ORCACT01
GOTO VQ
VR ; verify
IF ACTION="VR"
Begin DoDot:1
+1 IF $GET(ORVER)="N"
IF $PIECE(ORA0,U,9)
SET ERROR="This order has been verified!"
QUIT
+2 ; OR*3*413 rbd - prevent nurse verify of Pending order
+3 ; Also, prevent nurse verify of Non-Verified
+4 ; order where not FINISHed by Nurse.
+5 IF $GET(ORVER)="N"
Begin DoDot:2
+6 NEW ORARR,ORFIN,ORNUM,ORXIFN,OSTYPE,ORSTATUS
+7 SET ORXIFN=$GET(^OR(100,+IFN,4))
+8 SET OSTYPE=$PIECE(OR0,U,12)
KILL ^TMP("PS",$JOB)
+9 ; IA 2400
DO OEL^PSOORRL(+$PIECE(OR0,U,2),ORXIFN_";"_OSTYPE)
+10 SET ORSTATUS=$PIECE($GET(^TMP("PS",$JOB,0)),U,6)
+11 IF ORSTATUS="PENDING"
Begin DoDot:3
+12 SET ERROR="Still in PENDING status on Pharmacy side."
End DoDot:3
+13 IF ORSTATUS="NON-VERIFIED"
Begin DoDot:3
+14 SET ORFIN=0
MERGE ORARR=^TMP("PS",$JOB,"ALOG")
+15 SET ORNUM=""
FOR
SET ORNUM=$ORDER(ORARR(ORNUM),-1)
if +ORNUM=0
QUIT
Begin DoDot:4
+16 IF $PIECE(ORARR(ORNUM,0),U,3)=22000
SET ORFIN=1
End DoDot:4
+17 IF 'ORFIN
Begin DoDot:4
+18 SET ERROR="NON-VERIFIED status not Finished by Nurse with Authorized Key."
End DoDot:4
End DoDot:3
+19 ;p539
KILL ^TMP("PS",$JOB)
End DoDot:2
if $DATA(ERROR)
QUIT
+20 IF $GET(ORVER)="C"
IF $PIECE(ORA0,U,11)
SET ERROR="This order has been verified!"
QUIT
+21 IF $GET(ORVER)="R"
IF $PIECE(ORA0,U,19)
SET ERROR="This order has been reviewed!"
QUIT
+22 IF (ACTSTS=11)!(ACTSTS=10)
SET ERROR="This order has not been released to the service."
QUIT
+23 IF AIFN=1
IF ORDSTS=5
IF PKG="PS"
SET X=$$DISABLED
IF X
SET ERROR=$PIECE(X,U,2)
QUIT
End DoDot:1
GOTO VQ
DIS SET X=$$DISABLED
IF X
SET ERROR=$PIECE(X,U,2)
GOTO VQ
MN ; manually release (delayed)
IF ACTION="MN"
Begin DoDot:1
+1 IF ACTSTS'=10
IF ACTSTS'=11
SET ERROR="This order has already been released!"
QUIT
+2 ;I $P(OR0,U,12)="I",'$G(^DPT(+ORVP,.105)) S ERROR="This patient is not currently admitted!"
End DoDot:1
GOTO VQ
GMRA ; no actions allowed on Allergies
IF PKG="GMRA"
SET ERROR="This action is not allowed on an allergy/adverse reaction!"
GOTO VQ
MEDS IF PKG="PS"
IF 'MEDPARM
SET ERROR="You are not authorized to enter med orders!"
GOTO VQ
RW ; rewrite/copy
IF ACTION="RW"
DO RW^ORCACT01
GOTO VQ
XFR IF ACTION="XFR"
Begin DoDot:1
+1 NEW A
+2 SET A=""
+3 FOR
SET A=$ORDER(^OR(100,+IFN,4.5,"ID","CONJ",A))
if 'A
QUIT
IF ^OR(100,+IFN,4.5,A,1)="X"
SET ERROR="Orders with a conjunction of 'EXCEPT' may not be transferred."
QUIT
+4 FOR
SET A=$ORDER(^OR(100,+IFN,4.5,"ID","CONJ",A))
if 'A
QUIT
IF ^OR(100,+IFN,4.5,A,1)="T"
SET ERROR="Orders with a conjunction of 'THEN' may not be transferred."
QUIT
+5 IF $GET(ERROR)]""
QUIT
+6 ; transfer to in/outpt
DO XFR^ORCACT01
End DoDot:1
GOTO VQ
RN ; renew
IF ACTION="RN"
DO RN^ORCACT01
GOTO VQ
TRM ; ORDSTS=1,2,7,12,13
IF $$DONE
GOTO VQ
EV ; change delay event
IF ACTION="EV"
Begin DoDot:1
+1 IF ORDSTS'=10
IF ORDSTS'=11
SET ERROR="This order has been released!"
QUIT
+2 IF DG="NV RX"
SET ERROR="Non-VA Med orders do not support this action!"
QUIT
+3 IF DG="C RX"!(DG="CI RX")
SET ERROR="Clinic Med/IV orders do not support this action!"
QUIT
+4 IF $$EVTORDER^OREVNTX(IFN)
SET ERROR="The release event for this order may not be changed!"
QUIT
+5 SET X=$PIECE(ORA0,U,4)
IF X'=2
IF X'=3
SET ERROR="Signed orders may not be delayed to another event!"
QUIT
End DoDot:1
GOTO VQ
DC2 ; DC released order
IF ACTION="DC"
IF ACTSTS=""
Begin DoDot:1
+1 IF $GET(NATR)="A"
Begin DoDot:2
+2 SET X=$ORDER(^ORE(100.2,"AO",+IFN,0))
IF X
if '$GET(^ORE(100.2,X,1))
SET ERROR="Future event orders may not be auto-discontinued!"
QUIT
+3 ;177 If admission auto-dc and order is outpt med then no further checking needed
IF $$GET1^DIQ(9.4,+$PIECE(OR0,U,14)_",",1)="PSO"
IF $GET(DGPMT)=1
QUIT
+4 IF $GET(DGPMT)=1
IF $PIECE($GET(^SC(+$PIECE(OR0,U,10),0)),U,3)'="C"
SET ERROR="Only outpatient orders may be auto-discontinued!"
QUIT
+5 IF $GET(DGPMT)'=1
IF $PIECE($GET(^SC(+$PIECE(OR0,U,10),0)),U,3)="C"
IF PKG'="PS"
SET ERROR="Only inpatient orders may be auto-discontinued!"
QUIT
End DoDot:2
if $DATA(ERROR)
QUIT
+6 IF PKG="RA"
IF ORDSTS=6
SET ERROR="Active Radiology orders cannot be discontinued!"
QUIT
+7 IF PKG="VBEC"
IF ORDSTS=6
SET ERROR="Active Blood Product orders cannot be discontinued!"
QUIT
+8 IF PKG="LR"
Begin DoDot:2
+9 IF $$COLLECTD
SET ERROR="Lab orders that have been collected may not be discontinued!"
QUIT
+10 IF $GET(NATR)="A"
IF "^12^38^"'[(U_$PIECE($GET(DGPMA),U,18)_U)
IF $$VALUE^ORX8(+IFN,"COLLECT")="SP"
IF $PIECE(OR0,U,8)'<DT
SET ERROR="Future Send Patient orders may not be auto-discontinued!"
QUIT
End DoDot:2
QUIT
+11 IF PKG="GMRC"
IF ORDSTS=9
SET ERROR="Consults orders with partial results cannot be discontinued!"
QUIT
+12 IF DG="DO"
IF $GET(DGPMT)'=3
IF ORDSTS=6
SET ERROR="Active Diets cannot be discontinued; please order a new diet!"
QUIT
End DoDot:1
GOTO VQ
RL ; release hold
IF ACTION="RL"
Begin DoDot:1
+1 IF ORDSTS'=3
Begin DoDot:2
+2 IF $PIECE(ORA0,U,4)=2
SET ERROR="Providers has not yet signed the hold order and therefor it cannot yet be released"
QUIT
+3 SET ERROR="Orders not on hold cannot be released!"
QUIT
End DoDot:2
QUIT
+4 IF ACTSTS
SET ERROR=$$ACTION($PIECE(ORA0,U,2))_" orders cannot be released from hold!"
QUIT
+5 NEW NATR,ACT
SET ACT=$SELECT($PIECE(ORA0,U,2)="HD":AIFN,1:+$PIECE(OR3,U,7))
+6 SET NATR=+$PIECE($GET(^OR(100,+IFN,8,ACT,0)),U,12)
SET ACT=$PIECE($GET(^(0)),U,2)
+7 IF PKG="RA"!(ACT'="HD")!($PIECE($GET(^ORD(100.02,NATR,0)),U,2)="S")
SET ERROR="Orders held by a service must be released from hold through the service!"
QUIT
End DoDot:1
GOTO VQ
AIFN SET X=$PIECE(ORA0,U,2)
IF AIFN>1
IF ACTSTS
SET ERROR="This action is not allowed on a "_$$ACTION(X)_" order!"
GOTO VQ
RF IF ACTION="RF"
Begin DoDot:1
+1 IF DG'="O RX"
IF DG'="SPLY"
SET ERROR="Only Outpatient Med and Supply orders may be refilled!"
QUIT
+2 IF ORDSTS=5
SET ERROR="Pending orders may not be refilled!"
QUIT
+3 IF ORDSTS=7
SET ERROR="Expired orders may not be refilled!"
QUIT
+4 NEW X,PSIFN
SET PSIFN=$GET(^OR(100,+IFN,4))
+5 SET X=$$REFILL^PSOREF(PSIFN)
IF X'>0
SET ERROR=$PIECE(X,U,2)
QUIT
End DoDot:1
GOTO VQ
CP ; complete
IF ACTION="CP"
Begin DoDot:1
+1 IF PKG'="OR"
SET ERROR="Only generic text orders may be completed through this option!"
QUIT
+2 IF ORDSTS=11!(ORDSTS=10)
SET ERROR="This order has not been released!"
QUIT
End DoDot:1
GOTO VQ
AL IF ACTION="AL"
Begin DoDot:1
+1 IF PKG'="LR"
IF PKG'="RA"
IF PKG'="GMRC"
SET ERROR="This order does not generate results!"
QUIT
+2 IF $PIECE(OR3,U,10)
SET ERROR="This order is already flagged to alert the provider when resulted!"
QUIT
End DoDot:1
GOTO VQ
XX ; edit/change
IF ACTION="XX"
Begin DoDot:1
+1 IF PKG="SD"
IF ORDSTS'=11
SET ERROR="Change action not allowed on Scheduling orders!"
QUIT
+2 IF ORDSTS=7
SET ERROR="Expired orders may not be changed!"
QUIT
+3 DO XX^ORCACT01
End DoDot:1
GOTO VQ
HD ; hold
IF ACTION="HD"
Begin DoDot:1
+1 IF PKG="FH"
SET ERROR="Diet orders cannot be held!"
QUIT
+2 IF PKG="LR"
SET ERROR="Lab orders cannot be held!"
QUIT
+3 IF PKG="RA"
SET ERROR="Radiology orders cannot be held!"
QUIT
+4 IF PKG="GMRC"
SET ERROR="Consult orders cannot be held!"
QUIT
+5 IF DG="NV RX"
SET ERROR="Non-VA Med orders cannot be held!"
QUIT
+6 IF PKG="SD"
SET ERROR="Scheduling orders cannot be held!"
QUIT
+7 IF ORDSTS=3
SET ERROR="This order is already on hold!"
QUIT
+8 IF ORDSTS'=6
IF PKG="PS"
SET ERROR="Only active Pharmacy orders may be held!"
QUIT
+9 IF (ORDSTS=11)!(ORDSTS=10)
SET ERROR="This order has not been released to the service."
QUIT
End DoDot:1
GOTO VQ
VQ SET Y=$SELECT($DATA(ERROR):0,1:1)
+1 QUIT Y
+2 ;
ACTION(X) ; -- Return text of action X
+1 NEW Y
SET Y=$SELECT(X="NW":"New",X="DC":"Discontinue",X="HD":"Hold",X="RL":"Release Hold",X="RN":"Renew",1:X)
+2 QUIT Y
+3 ;
NPO(ORIFN) ; -- Returns 1 or 0, if order ORIFN is for NPO
+1 NEW X,Y
SET X=$$VALUE^ORX8(+ORIFN,"ORDERABLE",1,"E")
+2 SET Y=$SELECT($EXTRACT(X,1,3)="NPO":1,1:0)
+3 QUIT Y
+4 ;
COLLECTD() ; -- Lab order collected/active (incl all children)?
+1 ; unreleased or discontinued
IF "^1^10^11^12^13^"[(U_ORDSTS_U)
QUIT 0
+2 IF '$ORDER(^OR(100,+IFN,2,0))
QUIT (ORDSTS'=5)
+3 ;I ORDSTS'=6 Q 1 ; Parent -> active instead of pending
+4 NEW Y,Z
SET Y=1
SET Z=0
+5 FOR
SET Z=$ORDER(^OR(100,+IFN,2,Z))
if Z'>0
QUIT
IF $PIECE($GET(^OR(100,Z,3)),U,3)=5
SET Y=0
QUIT
+6 QUIT Y
+7 ;
DONE() ; -- sets ERROR if terminal status
+1 IF ORDSTS=1
SET ERROR="This order has been discontinued!"
QUIT 1
+2 IF ORDSTS=2
SET ERROR="This order has been completed!"
QUIT 1
+3 IF ORDSTS=7
IF DG'="O RX"
SET ERROR="This order has expired!"
QUIT 1
+4 IF ORDSTS=12
SET ERROR="This order has been changed!"
QUIT 1
+5 IF ORDSTS=13
SET ERROR="This order has been cancelled!"
QUIT 1
+6 IF ORDSTS=14
SET ERROR="This order has lapsed!"
QUIT 1
+7 IF ORDSTS=15
SET ERROR="This order has been renewed!"
QUIT 1
+8 QUIT 0
+9 ;
DISABLED() ; -- Order dialog [or protocol] disabled?
+1 NEW X,DLG
SET DLG=$PIECE(OR0,U,5)
SET X=0
IF +DLG'>0
QUIT X
+2 IF VER'<3
IF DLG?1.N1";ORD(101.41,"
SET X=$$MSG^ORXD(+DLG)
QUIT X
+3 SET DLG=$SELECT(PKG="RA":"RA OERR EXAM",PKG="GMRC":"GMRCOR CONSULT",1:"")
+4 IF $LENGTH(DLG)
SET DLG=+$ORDER(^ORD(101.41,"AB",DLG,0))
SET X=$$MSG^ORXD(DLG)
+5 QUIT X
