1 | ORCACT01 ;SLC/MKB-Validate order actions cont ;03/28/2008
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,141,163,187,190,213,243**;Dec 17, 1997;Build 242
|
---|
3 | ;
|
---|
4 | ES ; -- sign [on chart]
|
---|
5 | I ORDSTS=11,VER<3,PKG'="OR" S ERROR="This order cannot be released and must be discontinued!" Q
|
---|
6 | N X I ACTSTS=11!(ACTSTS=10) D Q:$L($G(ERROR))
|
---|
7 | . I $P(ORA0,U,2)="DC",$$DONE^ORCACT0 D CANCEL^ORCSEND(+IFN),UNOTIF^ORCSIGN S OREBUILD=1 Q
|
---|
8 | . S X=$$DISABLED^ORCACT0 I X S ERROR=$P(X,U,2) Q
|
---|
9 | I ACTION="OC",$G(DG)="NV RX" S:MEDPARM<2 ERROR="You are not authorized to release non-VA med orders!" Q
|
---|
10 | S X=$P(ORA0,U,4) I X=3 S:ACTSTS'=11&(ACTSTS'=10) ERROR="This order does not require a signature!" Q
|
---|
11 | I X'=2 S ERROR="This order has been signed!" Q
|
---|
12 | I DG="O RX",ACTION'="ES",ACTION'="DS",$G(NATR)'="I" S ERROR="Outpatient meds may not be released without a clinician's signature!" Q
|
---|
13 | I (ACTION="ES"!(ACTION="DS")),$D(^XUSEC("ORELSE",DUZ)),$P(OR0,U,16)'<2 S ERROR="You are not privileged to sign this order!" Q
|
---|
14 | I ACTION="OC" S:MEDPARM<2 ERROR="You are not authorized to release med orders!" Q
|
---|
15 | I ACTION="RS" D Q:$D(ERROR) Q:$G(NATR)'="I"
|
---|
16 | . Q:ACTSTS=11 Q:ACTSTS=10 ;unreleased - ok
|
---|
17 | . S ERROR="This order has already been released!"
|
---|
18 | ES1 I PKG="PS" D ;authorized to write meds?
|
---|
19 | . N TYPE,OI,PSOI,DEAFLG,PKI,IVERROR
|
---|
20 | . S X=$G(^VA(200,DUZ,"PS"))
|
---|
21 | . I '$P(X,U) S ERROR="You are not authorized to sign med orders!" Q
|
---|
22 | . I $P(X,U,4),$$NOW^XLFDT>$P(X,U,4) S ERROR="You are no longer authorized to sign med orders!" Q
|
---|
23 | . ;Q:DG="IV RX" Q:$P(ORA0,U,2)="DC" ;don't need to ck DEA#
|
---|
24 | . Q:$P(ORA0,U,2)="DC"
|
---|
25 | . I DG="IV RX" D Q
|
---|
26 | . .I $$IVDEACHK(+IFN)=1 S ERROR="You must have a valid DEA# or VA# to sign this order!"
|
---|
27 | . S OI=+$$VALUE^ORX8(+IFN,"ORDERABLE")
|
---|
28 | . S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2) Q:PSOI'>0
|
---|
29 | . S TYPE=$S($P(DG," ")="O":"O",1:"I"),DEAFLG=$$OIDEA^PSSUTLA1(PSOI,TYPE)
|
---|
30 | . I (DEAFLG>0||$$ISCLOZ^ORALWORD(OI)),'$L($$DEA^XUSER()) S ERROR="You must have a valid DEA# or VA# to sign this order!" Q
|
---|
31 | . D PKISITE^ORWOR(.PKI)
|
---|
32 | . I $G(PKI),ACTION="RS",DEAFLG=1 S ERROR="This order cannot be released without a Digital Signature" Q
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | IVDEACHK(IFN) ; -- Returns value of prompt by ID
|
---|
36 | I '$G(IFN)!('$D(^OR(100,+$G(IFN),0))) Q ""
|
---|
37 | N I,DIAL,DIALTYP,FAIL,PATCLASS,RESULT,Y
|
---|
38 | S PATCLASS=$P(^OR(100,+IFN,0),U,12)
|
---|
39 | S RESULT=0
|
---|
40 | ;if ORNP is not set then assume this is called from VistA not CPRS
|
---|
41 | I $G(ORNP)="" S ORNP=DUZ
|
---|
42 | S I=0,Y="" S:'$G(INST) INST=1
|
---|
43 | F S I=$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I'>0!(RESULT=1) D
|
---|
44 | .S Y=$G(^OR(100,+IFN,4.5,I,1)) Q:Y'>0
|
---|
45 | .;S PSOI=+$P($G(^ORD(101.43,Y,0)),U,2) Q:PSOI'>0
|
---|
46 | .I PATCLASS="I" D Q
|
---|
47 | ..D FAILDEA^ORWDPS1(.FAIL,Y,ORNP,"I") I FAIL=1 S RESULT=1
|
---|
48 | .S DIAL=+$P(^OR(100,+IFN,4.5,I,0),U,2)
|
---|
49 | .S DIALTYP=$S($P(^ORD(101.41,DIAL,0),U)["ADDITIVE":"A",1:"S")
|
---|
50 | .D FDEA1^ORWDPS1(.FAIL,Y,DIALTYP,ORNP)
|
---|
51 | .I FAIL=1 S RESULT=1
|
---|
52 | .;I $$OIDEA^PSSUTLA1(PSOI,"I")>0 S RESULT=1 Q
|
---|
53 | Q RESULT
|
---|
54 | ;
|
---|
55 | XFR ; -- transfer to inpt/outpt [IFN=order to be transferred]
|
---|
56 | N OI,PS I DG="TPN" S ERROR="TPN orders may not be copied!" Q
|
---|
57 | I $$INACTIVE^ORCACT03 S ERROR="Orders for inactive orderables may not be transferred; please enter a new order!" Q
|
---|
58 | S OI=+$O(^OR(100,+IFN,.1,"B",0)),ORPS=$G(^ORD(101.43,OI,"PS"))
|
---|
59 | I DG="UD RX",'$P(ORPS,U,2) S ERROR="This drug may not be ordered for an outpatient!" Q
|
---|
60 | I DG="O RX" D Q:$L($G(ERROR))
|
---|
61 | . I '$P(ORPS,U) S ERROR="This drug may not be ordered for an inpatient!" Q
|
---|
62 | . D:$O(^OR(100,+IFN,4.5,"ID","MISC",0)) DOSES^ORCACT02(+IFN)
|
---|
63 | Q
|
---|
64 | ;
|
---|
65 | RW ; -- rewrite/copy
|
---|
66 | I ACTSTS=12 S ERROR="Orders that have been dc'd due to editing may not be copied!" Q
|
---|
67 | I DG="NV RX" S ERROR="Non-VA Med orders cannot be copied!" Q
|
---|
68 | I DG="TPN" S ERROR="TPN orders may not be rewritten!" Q
|
---|
69 | I DG="UD RX",$$NTBG^ORCACT03(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be rewritten!" Q
|
---|
70 | I $$INACTIVE^ORCACT03 S ERROR="Orders for inactive orderables may not be copied; please enter a new order!" Q
|
---|
71 | I PKG="PS",'$$MEDOK^ORCACT03 S ERROR="This drug may not be ordered!" Q
|
---|
72 | I DG="O RX",$O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old form
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | RN ; -- renew
|
---|
76 | I PKG'="PS",PKG'="OR" S ERROR="This order may not be renewed!" Q
|
---|
77 | I (ORDSTS=11)!(ORDSTS=10) S ERROR="This order has not been released to the service." Q
|
---|
78 | I ACTSTS=12 S ERROR="Orders that have been dc'd due to editing may not be renewed!" Q
|
---|
79 | I $P(OR3,U,6) S ERROR="This order has already been "_$S($P($G(^OR(100,+$P(OR3,U,6),3)),U,11)=1:"changed!",1:"renewed!") Q
|
---|
80 | I PKG="OR" D Q ;Generic orders
|
---|
81 | . I $$INACTIVE^ORCACT03 S ERROR="Orders for inactive orderables may not be renewed!" Q
|
---|
82 | . I DG="ADT" S ERROR="M.A.S. orders may not be renewed!" Q
|
---|
83 | . I "^1^2^6^7^"[(U_ORDSTS_U) Q ;ok
|
---|
84 | . S ERROR="This order may not be renewed!"
|
---|
85 | I (PKG="PS"),$$INACTIVE^ORCACT03 S ERROR="Orders for inactive orderables may not be renewed!" Q
|
---|
86 | I '$$MEDOK^ORCACT03 S ERROR="This drug may not be ordered!" Q
|
---|
87 | RN1 N PSIFN S PSIFN=$G(^OR(100,+IFN,4))
|
---|
88 | I PSIFN<1,'$O(^OR(100,+IFN,2,0)) S ERROR="Missing or invalid order number!" Q
|
---|
89 | I DG="O RX" D Q ;Outpt Meds
|
---|
90 | . N ORZ,ORD S ORZ=$L($T(RENEW^PSORENW),",")
|
---|
91 | . I ORZ>1 S ORD=+$$VALUE^ORX8(+IFN,"DRUG"),X=$$RENEW^PSORENW(PSIFN,ORD)
|
---|
92 | . S:ORZ'>1 X=$$RENEW^PSORENW(PSIFN) I X<1 S ERROR=$P(X,U,2) Q
|
---|
93 | . S X=+$P(X,U,2) D:X RESET^ORCACT03(+IFN,X)
|
---|
94 | . I $O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old format
|
---|
95 | I DG="UD RX",$$NTBG^ORCACT03(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be renewed!" Q
|
---|
96 | I ORDSTS=7,'$$IV^ORCACT03,$P(OR0,U,9)<$$FMADD^XLFDT(DT,-4) S ERROR="Inpatient med orders may not be renewed more than 4 days after expiration!" Q
|
---|
97 | I ORDSTS'=6,ORDSTS'=7 S ERROR="This order may not be renewed!" Q
|
---|
98 | RN2 I $O(^OR(100,+IFN,2,0))!$P(OR3,U,9) D Q:$D(ERROR)!'PSIFN
|
---|
99 | . I $P(OR3,U,9),$$VALUE^ORX8(+IFN,"SCHEDULE",1,"E")="NOW" S ERROR="One-time NOW orders may not be renewed!" Q
|
---|
100 | . N DAD,ORD3,I,Y S DAD=$S($P(OR3,U,9):+$P(OR3,U,9),1:+IFN),Y=0
|
---|
101 | . S ORD3=$G(^OR(100,DAD,3)) I $P(ORD3,U,6) S ERROR="This complex order has already been renewed!" Q
|
---|
102 | . I $P(ORD3,U,3)'=6 S ERROR="This complex order is not active and may not be renewed!" Q
|
---|
103 | . I '$$AND^ORX8(DAD) S ERROR="Complex orders with sequential doses may not be renewed!" Q
|
---|
104 | . S I=0 F S I=+$O(^OR(100,DAD,2,I)) Q:I<1 D Q:Y
|
---|
105 | .. I I=+$O(^OR(100,DAD,2,0)),$$VALUE^ORX8(I,"SCHEDULE",1,"E")="NOW",$$VALUE^ORX8(DAD,"NOW") Q ;ignore NOW orders
|
---|
106 | .. I $P($G(^OR(100,I,3)),U,3)'=6 S Y=1,ERROR="Complex orders with terminated doses may not be renewed!" Q
|
---|
107 | .. I PSIFN<1 S X=$$ACTIVE^PSJORREN(+ORVP,$G(^OR(100,I,4))) I +X'=1 S ERROR="This order may not be renewed: "_$S(+X>1:"Inactive orderable item",1:$P(X,U,2)) Q
|
---|
108 | ;I DG="TPN" S ERROR="TPN orders may not be renewed!" Q
|
---|
109 | S X=$$ACTIVE^PSJORREN(+ORVP,PSIFN) Q:+X=1 ;Ok
|
---|
110 | I +X>1,$P(X,U,2) D RESET^ORCACT03(+IFN,+$P(X,U,2)) Q ;replace OI
|
---|
111 | S ERROR="This order may not be renewed: "_$P(X,U,2)
|
---|
112 | Q
|
---|
113 | ;
|
---|
114 | XX ; -- edit/change--
|
---|
115 | I PKG="RA",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Radiology cannot be changed!" Q
|
---|
116 | I PKG="LR",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Lab cannot be changed!" Q
|
---|
117 | I PKG="FH",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Dietetics cannot be changed!" Q
|
---|
118 | I PKG="GMRC",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Consults cannot be changed!" Q
|
---|
119 | I DG="TPN" S ERROR="TPN orders may not be changed!" Q
|
---|
120 | I ORDSTS=3 S ERROR="Orders on hold may not be changed!" Q
|
---|
121 | I DG="UD RX",$$NTBG^ORCACT03(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be changed!" Q
|
---|
122 | I $O(^OR(100,+IFN,2,0)) S ERROR="Complex orders may not be changed!" Q
|
---|
123 | I $P(OR3,U,9) D Q:$D(ERROR)
|
---|
124 | . Q:$$VALUE^ORX8(+IFN,"SCHEDULE",1,"E")="NOW" ;NOW ok
|
---|
125 | . Q:'$O(^OR(100,+$P(OR3,U,9),4.5,"ID","CONJ",0)) ;no conj=1dose/ok
|
---|
126 | . S ERROR="Complex orders may not be changed!" Q
|
---|
127 | I $P(OR3,U,6) S ERROR="This order may not be changed - a "_$S($P($G(^OR(100,+$P(OR3,U,6),3)),U,11)=1:"change",1:"renewal")_" order already exists!" Q
|
---|
128 | I $P(OR3,U,11)=2 D Q:$D(ERROR)
|
---|
129 | . I (ORDSTS=10!(ORDSTS=11)),DG'="O RX" S ERROR="Unreleased renewals may not be changed!" Q
|
---|
130 | . I PKG="PS",ORDSTS=5 S ERROR="Pending renewals may not be changed!" Q
|
---|
131 | I $$INACTIVE^ORCACT03 S ERROR="Orders for inactive orderables may not be changed; please enter a new order!" Q
|
---|
132 | I PKG="PS",'$$MEDOK^ORCACT03 S ERROR="This drug may not be ordered!" Q
|
---|
133 | I DG="O RX",$O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old form
|
---|
134 | Q
|
---|
135 | ;
|
---|