- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCACT01.m
r613 r623 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 ; 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
Note:
See TracChangeset
for help on using the changeset viewer.
