ORCACT0 ;SLC/MKB-Validate order action ;03-Apr-2012 11:51;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,86,92,94,141,165,177,173,190,1002,1003,1004,1005,1006,215,243,289,1010**;Dec 17, 1997;Build 47
;
;Reference to REFILL^PSOREF supported by IA #2399
;Modified - IHS/MSC/PLS - 08/06/2010 - Line HD+5,VALID+2,VALID+4
; 08/09/2010 - Line VR+3, EP CHKVF, RL+5, RW, EV+2
; 10/06/2010 - Line HD+7
;Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening
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 K ERROR
N NV ;IHS/MSC/REC/PLS - 08/09/10
S OR0=$G(^OR(100,+IFN,0)),OR3=$G(^(3)),PKG=$$NMSP^ORCD($P(OR0,U,14))
;S DG=$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,3)
S DG=$G(^ORD(100.98,+$P(OR0,U,11),0)),NV=$S($P(DG,U,3)="NV RX":$P(DG,U,2),1:""),DG=$P(DG,U,3)
;IHS/MSC/REC/PLS - 08/09/2010
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 +$G(^OR(100,+IFN,8,AIFN,3)) S ERROR="This order is already flagged!" Q
UF I ACTION="UF" D G VQ ; unflag
. I '+$G(^OR(100,+IFN,8,AIFN,3)) S ERROR="This order is not flagged!" Q
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
. I $G(ORVER)="C",$P(ORA0,U,11) S ERROR="This order has been verified!" Q
. ;IHS/MSC/REC/PLS - 08/09/10
. ;I $G(ORVER)="R",$P(ORA0,U,19) S ERROR="This order has been reviewed!" Q
. I $G(ORVER)="R" D CHKVF Q:$L($G(ERROR))
. 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 ;IHS/MSC/REC/PLS - 08/09/2010
;I ACTION="RW" D RW^ORCACT01 G VQ ; rewrite/copy
I ACTION="RW",NV=""!(ACTSTS=12) 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
. 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
. ;IHS/MSC/REC/PLS - 08/09/10
. ;I DG="NV RX" S ERROR="Outside med orders do not support this action!" Q
. I $L(NV) S ERROR=NV_" 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,'$$NPO(+IFN) 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)
. ;IHS/MSC/REC/PLS - 08/09/10
. ;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
. I PKG="RA"!(ACT'="HD")!($P($G(^ORD(100.02,NATR,0)),U,2)="S") I $G(NV)="" 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" S ERROR="Only Outpatient Med 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
. I (DG="NV RX")!($T(SCREEN^APSPMULT)="") Q
. N DFN,Y S Y=$$VALUE^ORX8(+ORIFN,"DRUG",1,"I"),DFN=+$P($G(^OR(100,+ORIFN,0)),U,2)
. I '$$SCREEN^APSPMULT(+Y,,1) S ERROR="Invalid Drug for refill on this patient"
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 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="Outside med orders cannot be held!" Q ;IHS/MSC/PLS - 08/06/10 Available for hold
. 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-6,ORDSTS-21400,ORDSTS-21401,PKG="PS" S ERROR="Only active Pharmacy orders may be held!" Q ;Allow hold for transfer to IP/OP
. I ORDSTS=6,PKG="PS",$P($G(^PSRX(+$G(^OR(100,+IFN,4)),999999921)),U,3) S ERROR="Outside pharmacy prescriptions can't be placed on hold!" ;IHS/MSC/PLS - 10/17/07
. 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 (ORDSTS=11)!(ORDSTS=10) Q 0 ; unreleased
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
;Check for verified state
CHKVF ;EP - IHS/MSC/REC/PLS - 08/09/10
N RD,LST,NOW,DTCMP
S RD=$P(ORA0,U,19)
I RD D
.S LST=$O(^OR(100,+IFN,8,AIFN,"MSC",""),-1) Q:'LST
.S LST=+$O(^OR(100,+IFN,8,AIFN,"MSC",LST),-1)
.S RD=$S(LST:$P($G(^(LST,0)),U,2),1:RD)
.S NOW=$$NOW^XLFDT()
.S DTCMP=$$FMDIFF^XLFDT(NOW,RD)
.I $S(DTCMP>1:1,DTCMP=1:$E(NOW,8,99)>$E(RD,8,99),1:0) Q
.S ERROR="This order cannot be reviewed more than twice within 24 hours!"
Q
ORCACT0 ;SLC/MKB-Validate order action ;03-Apr-2012 11:51;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,27,48,72,86,92,94,141,165,177,173,190,1002,1003,1004,1005,1006,215,243,289,1010**;Dec 17, 1997;Build 47
+2 ;
+3 ;Reference to REFILL^PSOREF supported by IA #2399
+4 ;Modified - IHS/MSC/PLS - 08/06/2010 - Line HD+5,VALID+2,VALID+4
+5 ; 08/09/2010 - Line VR+3, EP CHKVF, RL+5, RW, EV+2
+6 ; 10/06/2010 - Line HD+7
+7 ;Modified - IHS/MSC/JDS - 03/12/12 - exclude home med from screening
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
KILL ERROR
+2 ;IHS/MSC/REC/PLS - 08/09/10
NEW NV
+3 SET OR0=$GET(^OR(100,+IFN,0))
SET OR3=$GET(^(3))
SET PKG=$$NMSP^ORCD($PIECE(OR0,U,14))
+4 ;S DG=$P($G(^ORD(100.98,+$P(OR0,U,11),0)),U,3)
+5 SET DG=$GET(^ORD(100.98,+$PIECE(OR0,U,11),0))
SET NV=$SELECT($PIECE(DG,U,3)="NV RX":$PIECE(DG,U,2),1:"")
SET DG=$PIECE(DG,U,3)
+6 ;IHS/MSC/REC/PLS - 08/09/2010
+7 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"))
+8 SET AIFN=$PIECE(IFN,";",2)
IF 'AIFN
SET AIFN=+$PIECE(OR3,U,7)
+9 SET ORA0=$GET(^OR(100,+IFN,8,AIFN,0))
SET ACTSTS=$PIECE(ORA0,U,15)
+10 SET ORDSTS=$PIECE(OR3,U,3)
SET VER=$SELECT($PIECE(OR0,U,5)["101.41":3,1:2)
CM ; ward comments - no restrictions
IF ACTION="CM"
SET ERROR="This action is no longer available!"
GOTO VQ
FL ; flag
IF ACTION="FL"
Begin DoDot:1
+1 IF +$GET(^OR(100,+IFN,8,AIFN,3))
SET ERROR="This order is already flagged!"
QUIT
End DoDot:1
GOTO VQ
UF ; unflag
IF ACTION="UF"
Begin DoDot:1
+1 IF '+$GET(^OR(100,+IFN,8,AIFN,3))
SET ERROR="This order is not flagged!"
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 IF $GET(ORVER)="C"
IF $PIECE(ORA0,U,11)
SET ERROR="This order has been verified!"
QUIT
+3 ;IHS/MSC/REC/PLS - 08/09/10
+4 ;I $G(ORVER)="R",$P(ORA0,U,19) S ERROR="This order has been reviewed!" Q
+5 IF $GET(ORVER)="R"
DO CHKVF
IF $LENGTH($GET(ERROR))
QUIT
+6 IF (ACTSTS=11)!(ACTSTS=10)
SET ERROR="This order has not been released to the service."
QUIT
+7 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 IF $PIECE(OR0,U,12)="I"
IF '$GET(^DPT(+ORVP,.105))
SET 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 ;IHS/MSC/REC/PLS - 08/09/2010
+1 ;I ACTION="RW" D RW^ORCACT01 G VQ ; rewrite/copy
+2 ; rewrite/copy
IF ACTION="RW"
IF NV=""!(ACTSTS=12)
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 IF $GET(ERROR)]""
QUIT
+5 ; 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 ;IHS/MSC/REC/PLS - 08/09/10
+3 ;I DG="NV RX" S ERROR="Outside med orders do not support this action!" Q
+4 IF $LENGTH(NV)
SET ERROR=NV_" orders do not support this action!"
QUIT
+5 IF $$EVTORDER^OREVNTX(IFN)
SET ERROR="The release event for this order may not be changed!"
QUIT
+6 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
IF '$$NPO(+IFN)
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 ;IHS/MSC/REC/PLS - 08/09/10
+8 ;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
+9 IF PKG="RA"!(ACT'="HD")!($PIECE($GET(^ORD(100.02,NATR,0)),U,2)="S")
IF $GET(NV)=""
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"
SET ERROR="Only Outpatient Med 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
+6 IF (DG="NV RX")!($TEXT(SCREEN^APSPMULT)="")
QUIT
+7 NEW DFN,Y
SET Y=$$VALUE^ORX8(+ORIFN,"DRUG",1,"I")
SET DFN=+$PIECE($GET(^OR(100,+ORIFN,0)),U,2)
+8 IF '$$SCREEN^APSPMULT(+Y,,1)
SET ERROR="Invalid Drug for refill on this patient"
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 ORDSTS=7
SET ERROR="Expired orders may not be changed!"
QUIT
+2 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 ;I DG="NV RX" S ERROR="Outside med orders cannot be held!" Q ;IHS/MSC/PLS - 08/06/10 Available for hold
+6 IF ORDSTS=3
SET ERROR="This order is already on hold!"
QUIT
+7 ;I ORDSTS'=6,PKG="PS" S ERROR="Only active Pharmacy orders may be held!" Q
+8 ;Allow hold for transfer to IP/OP
IF ORDSTS-6
IF ORDSTS-21400
IF ORDSTS-21401
IF PKG="PS"
SET ERROR="Only active Pharmacy orders may be held!"
QUIT
+9 ;IHS/MSC/PLS - 10/17/07
IF ORDSTS=6
IF PKG="PS"
IF $PIECE($GET(^PSRX(+$GET(^OR(100,+IFN,4)),999999921)),U,3)
SET ERROR="Outside pharmacy prescriptions can't be placed on hold!"
+10 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
IF (ORDSTS=11)!(ORDSTS=10)
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
+6 ;Check for verified state
CHKVF ;EP - IHS/MSC/REC/PLS - 08/09/10
+1 NEW RD,LST,NOW,DTCMP
+2 SET RD=$PIECE(ORA0,U,19)
+3 IF RD
Begin DoDot:1
+4 SET LST=$ORDER(^OR(100,+IFN,8,AIFN,"MSC",""),-1)
IF 'LST
QUIT
+5 SET LST=+$ORDER(^OR(100,+IFN,8,AIFN,"MSC",LST),-1)
+6 SET RD=$SELECT(LST:$PIECE($GET(^(LST,0)),U,2),1:RD)
+7 SET NOW=$$NOW^XLFDT()
+8 SET DTCMP=$$FMDIFF^XLFDT(NOW,RD)
+9 IF $SELECT(DTCMP>1:1,DTCMP=1:$EXTRACT(NOW,8,99)>$EXTRACT(RD,8,99),1:0)
QUIT
+10 SET ERROR="This order cannot be reviewed more than twice within 24 hours!"
End DoDot:1
+11 QUIT
