| 1 | ORCACT01 ;SLC/MKB-Validate order actions cont ;5/6/04 20:39
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,134,141,163,187,190,213**;Dec 17, 1997
|
|---|
| 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
|
|---|
| 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 | . S OI=+$$VALUE^ORX8(+IFN,"ORDERABLE")
|
|---|
| 25 | . S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2) Q:PSOI'>0
|
|---|
| 26 | . S TYPE=$S($P(DG," ")="O":"O",1:"I"),DEAFLG=$$OIDEA^PSSUTLA1(PSOI,TYPE)
|
|---|
| 27 | . I DEAFLG>0,'$L($$DEA^XUSER()) S ERROR="You must have a valid DEA# or VA# to sign this order!" Q
|
|---|
| 28 | . D PKISITE^ORWOR(.PKI)
|
|---|
| 29 | . I $G(PKI),ACTION="RS",DEAFLG=1 S ERROR="This order cannot be released without a Digital Signature" Q
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | XFR ; -- transfer to inpt/outpt [IFN=order to be transferred]
|
|---|
| 33 | N OI,PS I DG="TPN" S ERROR="TPN orders may not be copied!" Q
|
|---|
| 34 | I $$INACTIVE S ERROR="Orders for inactive orderables may not be transferred; please enter a new order!" Q
|
|---|
| 35 | S OI=+$O(^OR(100,+IFN,.1,"B",0)),ORPS=$G(^ORD(101.43,OI,"PS"))
|
|---|
| 36 | I DG="UD RX",'$P(ORPS,U,2) S ERROR="This drug may not be ordered for an outpatient!" Q
|
|---|
| 37 | I DG="O RX" D Q:$L($G(ERROR))
|
|---|
| 38 | . I '$P(ORPS,U) S ERROR="This drug may not be ordered for an inpatient!" Q
|
|---|
| 39 | . D:$O(^OR(100,+IFN,4.5,"ID","MISC",0)) DOSES^ORCACT02(+IFN)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | RW ; -- rewrite/copy
|
|---|
| 43 | I ACTSTS=12 S ERROR="Orders that have been dc'd due to editing may not be copied!" Q
|
|---|
| 44 | I DG="NV RX" S ERROR="Non-VA Med orders cannot be copied!" Q
|
|---|
| 45 | I DG="TPN" S ERROR="TPN orders may not be rewritten!" Q
|
|---|
| 46 | I DG="UD RX",$$NTBG(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be rewritten!" Q
|
|---|
| 47 | I $$INACTIVE S ERROR="Orders for inactive orderables may not be copied; please enter a new order!" Q
|
|---|
| 48 | I PKG="PS",'$$MEDOK S ERROR="This drug may not be ordered!" Q
|
|---|
| 49 | I DG="O RX",$O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old form
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | RN ; -- renew
|
|---|
| 53 | I PKG'="PS",PKG'="OR" S ERROR="This order may not be renewed!" Q
|
|---|
| 54 | I (ORDSTS=11)!(ORDSTS=10) S ERROR="This order has not been released to the service." Q
|
|---|
| 55 | I ACTSTS=12 S ERROR="Orders that have been dc'd due to editing may not be renewed!" Q
|
|---|
| 56 | 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
|
|---|
| 57 | I PKG="OR" D Q ;Generic orders
|
|---|
| 58 | . I $$INACTIVE S ERROR="Orders for inactive orderables may not be renewed!" Q
|
|---|
| 59 | . I DG="ADT" S ERROR="M.A.S. orders may not be renewed!" Q
|
|---|
| 60 | . I "^1^2^6^7^"[(U_ORDSTS_U) Q ;ok
|
|---|
| 61 | . S ERROR="This order may not be renewed!"
|
|---|
| 62 | I (PKG="PS"),$$INACTIVE S ERROR="Orders for inactive orderables may not be renewed!" Q
|
|---|
| 63 | I '$$MEDOK S ERROR="This drug may not be ordered!" Q
|
|---|
| 64 | RN1 N PSIFN S PSIFN=$G(^OR(100,+IFN,4))
|
|---|
| 65 | I PSIFN<1,'$O(^OR(100,+IFN,2,0)) S ERROR="Missing or invalid order number!" Q
|
|---|
| 66 | I DG="O RX" D Q ;Outpt Meds
|
|---|
| 67 | . N ORZ,ORD S ORZ=$L($T(RENEW^PSORENW),",")
|
|---|
| 68 | . I ORZ>1 S ORD=+$$VALUE^ORX8(+IFN,"DRUG"),X=$$RENEW^PSORENW(PSIFN,ORD)
|
|---|
| 69 | . S:ORZ'>1 X=$$RENEW^PSORENW(PSIFN) I X<1 S ERROR=$P(X,U,2) Q
|
|---|
| 70 | . S X=+$P(X,U,2) D:X RESET(+IFN,X)
|
|---|
| 71 | . I $O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old format
|
|---|
| 72 | I DG="UD RX",$$NTBG(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be renewed!" Q
|
|---|
| 73 | I ORDSTS=7,'$$IV,$P(OR0,U,9)<$$FMADD^XLFDT(DT,-4) S ERROR="Inpatient med orders may not be renewed more than 4 days after expiration!" Q
|
|---|
| 74 | I ORDSTS'=6,ORDSTS'=7 S ERROR="This order may not be renewed!" Q
|
|---|
| 75 | RN2 I $O(^OR(100,+IFN,2,0))!$P(OR3,U,9) D Q:$D(ERROR)!'PSIFN
|
|---|
| 76 | . I $P(OR3,U,9),$$VALUE^ORX8(+IFN,"SCHEDULE",1,"E")="NOW" S ERROR="One-time NOW orders may not be renewed!" Q
|
|---|
| 77 | . N DAD,ORD3,I,Y S DAD=$S($P(OR3,U,9):+$P(OR3,U,9),1:+IFN),Y=0
|
|---|
| 78 | . S ORD3=$G(^OR(100,DAD,3)) I $P(ORD3,U,6) S ERROR="This complex order has already been renewed!" Q
|
|---|
| 79 | . I $P(ORD3,U,3)'=6 S ERROR="This complex order is not active and may not be renewed!" Q
|
|---|
| 80 | . I '$$AND^ORX8(DAD) S ERROR="Complex orders with sequential doses may not be renewed!" Q
|
|---|
| 81 | . S I=0 F S I=+$O(^OR(100,DAD,2,I)) Q:I<1 D Q:Y
|
|---|
| 82 | .. I I=+$O(^OR(100,DAD,2,0)),$$VALUE^ORX8(I,"SCHEDULE",1,"E")="NOW",$$VALUE^ORX8(DAD,"NOW") Q ;ignore NOW orders
|
|---|
| 83 | .. I $P($G(^OR(100,I,3)),U,3)'=6 S Y=1,ERROR="Complex orders with terminated doses may not be renewed!" Q
|
|---|
| 84 | .. 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
|
|---|
| 85 | ;I DG="TPN" S ERROR="TPN orders may not be renewed!" Q
|
|---|
| 86 | S X=$$ACTIVE^PSJORREN(+ORVP,PSIFN) Q:+X=1 ;Ok
|
|---|
| 87 | I +X>1,$P(X,U,2) D RESET(+IFN,+$P(X,U,2)) Q ;replace OI
|
|---|
| 88 | S ERROR="This order may not be renewed: "_$P(X,U,2)
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | XX ; -- edit/change--
|
|---|
| 92 | I PKG="RA",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Radiology cannot be changed!" Q
|
|---|
| 93 | I PKG="LR",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Lab cannot be changed!" Q
|
|---|
| 94 | I PKG="FH",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Dietetics cannot be changed!" Q
|
|---|
| 95 | I PKG="GMRC",ORDSTS'=11,ORDSTS'=10 S ERROR="Orders released to Consults cannot be changed!" Q
|
|---|
| 96 | I DG="TPN" S ERROR="TPN orders may not be changed!" Q
|
|---|
| 97 | I ORDSTS=3 S ERROR="Orders on hold may not be changed!" Q
|
|---|
| 98 | I DG="UD RX",$$NTBG(+IFN) S ERROR="This order has been marked 'Not to be Given' and may not be changed!" Q
|
|---|
| 99 | I $O(^OR(100,+IFN,2,0)) S ERROR="Complex orders may not be changed!" Q
|
|---|
| 100 | I $P(OR3,U,9) D Q:$D(ERROR)
|
|---|
| 101 | . Q:$$VALUE^ORX8(+IFN,"SCHEDULE",1,"E")="NOW" ;NOW ok
|
|---|
| 102 | . Q:'$O(^OR(100,+$P(OR3,U,9),4.5,"ID","CONJ",0)) ;no conj=1dose/ok
|
|---|
| 103 | . S ERROR="Complex orders may not be changed!" Q
|
|---|
| 104 | 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
|
|---|
| 105 | I $P(OR3,U,11)=2 D Q:$D(ERROR)
|
|---|
| 106 | . I (ORDSTS=10!(ORDSTS=11)),DG'="O RX" S ERROR="Unreleased renewals may not be changed!" Q
|
|---|
| 107 | . I PKG="PS",ORDSTS=5 S ERROR="Pending renewals may not be changed!" Q
|
|---|
| 108 | I $$INACTIVE S ERROR="Orders for inactive orderables may not be changed; please enter a new order!" Q
|
|---|
| 109 | I PKG="PS",'$$MEDOK S ERROR="This drug may not be ordered!" Q
|
|---|
| 110 | I DG="O RX",$O(^OR(100,+IFN,4.5,"ID","MISC",0)) D DOSES^ORCACT02(+IFN) ;old form
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | INACTIVE() ; -- Returns 1 or 0, if OI is now inactive
|
|---|
| 114 | N I,OI,PREOI,PREOIX,X,Y,ORNOW,DD,PSOI S Y=0,ORNOW=$$NOW^XLFDT
|
|---|
| 115 | S I=0 F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I'>0 D Q:Y
|
|---|
| 116 | . S OI=+$G(^OR(100,+IFN,4.5,I,1))
|
|---|
| 117 | . I OI S X=$G(^ORD(101.43,OI,.1)) I X,X<ORNOW S Y=1
|
|---|
| 118 | I Y,PKG="PS",DG'="IV RX" D ;replacement OI?
|
|---|
| 119 | . S I=+$O(^OR(100,+IFN,4.5,"ID","DRUG",0)) Q:I'>0 ;first
|
|---|
| 120 | . S DD=+$G(^OR(100,+IFN,4.5,I,1)) Q:DD'>0 Q:$G(OI)'>0
|
|---|
| 121 | . S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2),X=$$ITEM^PSSUTIL1(PSOI,DD)
|
|---|
| 122 | . Q:X'>0 S X=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:X'>0
|
|---|
| 123 | . I $G(^ORD(101.43,X,.1)),$G(^(.1))<ORNOW Q ;make sure new OI is active
|
|---|
| 124 | . S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
|---|
| 125 | . IF I D
|
|---|
| 126 | . . S PREOI=$G(^OR(100,+IFN,4.5,I,1))
|
|---|
| 127 | . . S PREOIX=$O(^OR(100,+IFN,.1,"B",PREOI,0))
|
|---|
| 128 | . . K ^OR(100,+IFN,.1,"B",PREOI,PREOIX)
|
|---|
| 129 | . . S ^OR(100,+IFN,.1,"B",X,PREOIX)=""
|
|---|
| 130 | . . S ^OR(100,+IFN,.1,PREOIX,0)=X
|
|---|
| 131 | . . S ^OR(100,+IFN,4.5,I,1)=X
|
|---|
| 132 | . . S Y=0 ;reset
|
|---|
| 133 | Q Y
|
|---|
| 134 | ;
|
|---|
| 135 | MEDOK() ; -- Returns 1 or 0, if med OI usage=Y
|
|---|
| 136 | N Y,OI,ORPS,X S Y=1,X=$P(OR0,U,12)
|
|---|
| 137 | I (DG="SPLY")!(DG="O RX")!(DG="I RX")!(DG="UD RX") D
|
|---|
| 138 | . S OI=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
|---|
| 139 | . S OI=+$G(^OR(100,+IFN,4.5,OI,1))
|
|---|
| 140 | . S ORPS=$G(^ORD(101.43,OI,"PS"))
|
|---|
| 141 | I DG="SPLY",'$P(ORPS,U,5) S Y=0
|
|---|
| 142 | I DG="O RX",'(X="O"&$P(ORPS,U,2)),'(X="I"&($P(ORPS,U)=2)) S Y=0
|
|---|
| 143 | I DG="I RX"!(DG="UD RX"),'$P(ORPS,U) S Y=0
|
|---|
| 144 | I DG="IV RX" D
|
|---|
| 145 | . N I,X0,X1 S I=0
|
|---|
| 146 | . F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I<1 D Q:Y<1
|
|---|
| 147 | .. S X0=$G(^OR(100,+IFN,4.5,I,0)),X1=+$G(^(1))
|
|---|
| 148 | .. I $P($G(^ORD(101.41,+$P(X0,U,2),0)),U)["ADDITIVE" S:'$P($G(^ORD(101.43,X1,"PS")),U,4) Y=0 Q
|
|---|
| 149 | .. S:'$P($G(^ORD(101.43,X1,"PS")),U,3) Y=0
|
|---|
| 150 | Q Y
|
|---|
| 151 | ;
|
|---|
| 152 | IV() ; -- IV order, either Inpt or Fluid?
|
|---|
| 153 | I DG="IV RX" Q 1
|
|---|
| 154 | N I,OI,X S I=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0))
|
|---|
| 155 | S OI=+$G(^OR(100,IFN,4.5,+I,1)),X=$P($G(^ORD(101.43,+OI,"PS")),U)
|
|---|
| 156 | Q (X>1)
|
|---|
| 157 | ;
|
|---|
| 158 | NTBG(ORIFN) ; -- Inpt order marked as 'Not to be Given'?
|
|---|
| 159 | N PSIFN,Y,ORI,ORCH S Y=""
|
|---|
| 160 | S PSIFN=$G(^OR(100,+ORIFN,4)) I PSIFN>0 Q $$ENNG^PSJORUT2(+ORVP,PSIFN)
|
|---|
| 161 | S ORI=0 F S ORI=$O(^OR(100,+ORIFN,2,ORI)) Q:ORI'>0 S ORCH=+$G(^(ORI,0)),PSIFN=$G(^OR(100,ORCH,4)) I PSIFN>0 S Y=$$ENNG^PSJORUT2(+ORVP,PSIFN) Q:Y
|
|---|
| 162 | Q Y
|
|---|
| 163 | ;
|
|---|
| 164 | RESET(IFN,NEWOI) ; -- Update OI if changed before renewing
|
|---|
| 165 | Q:'$G(IFN) Q:'$D(^OR(100,+IFN,0)) Q:'$G(NEWOI)
|
|---|
| 166 | N I,ORIT S ORIT=+$O(^ORD(101.43,"ID",NEWOI_";99PSP",0)) Q:ORIT'>0
|
|---|
| 167 | S I=$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
|---|
| 168 | S:I ^OR(100,+IFN,4.5,I,1)=ORIT
|
|---|
| 169 | Q
|
|---|
