1 | ORCACT03 ;SLC/MKB-Validate order actions cont ;02/06/2007
|
---|
2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
|
---|
3 | ;
|
---|
4 | INACTIVE() ; -- Returns 1 or 0, if OI is now inactive
|
---|
5 | N I,OI,PREOI,PREOIX,X,Y,ORNOW,DD,PSOI S Y=0,ORNOW=$$NOW^XLFDT
|
---|
6 | S I=0 F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I'>0 D Q:Y
|
---|
7 | . S OI=+$G(^OR(100,+IFN,4.5,I,1))
|
---|
8 | . I OI S X=$G(^ORD(101.43,OI,.1)) I X,X<ORNOW S Y=1
|
---|
9 | I Y,PKG="PS",DG'="IV RX" D ;replacement OI?
|
---|
10 | . S I=+$O(^OR(100,+IFN,4.5,"ID","DRUG",0)) Q:I'>0 ;first
|
---|
11 | . S DD=+$G(^OR(100,+IFN,4.5,I,1)) Q:DD'>0 Q:$G(OI)'>0
|
---|
12 | . S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2),X=$$ITEM^PSSUTIL1(PSOI,DD)
|
---|
13 | . Q:X'>0 S X=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:X'>0
|
---|
14 | . I $G(^ORD(101.43,X,.1)),$G(^(.1))<ORNOW Q ;make sure new OI is active
|
---|
15 | . S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
---|
16 | . IF I D
|
---|
17 | . . S PREOI=$G(^OR(100,+IFN,4.5,I,1))
|
---|
18 | . . S PREOIX=$O(^OR(100,+IFN,.1,"B",PREOI,0))
|
---|
19 | . . K ^OR(100,+IFN,.1,"B",PREOI,PREOIX)
|
---|
20 | . . S ^OR(100,+IFN,.1,"B",X,PREOIX)=""
|
---|
21 | . . S ^OR(100,+IFN,.1,PREOIX,0)=X
|
---|
22 | . . S ^OR(100,+IFN,4.5,I,1)=X
|
---|
23 | . . S Y=0 ;reset
|
---|
24 | Q Y
|
---|
25 | ;
|
---|
26 | MEDOK() ; -- Returns 1 or 0, if med OI usage=Y
|
---|
27 | N Y,OI,ORPS,X S Y=1,X=$P(OR0,U,12)
|
---|
28 | I (DG="SPLY")!(DG="O RX")!(DG="I RX")!(DG="UD RX") D
|
---|
29 | . S OI=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
---|
30 | . S OI=+$G(^OR(100,+IFN,4.5,OI,1))
|
---|
31 | . S ORPS=$G(^ORD(101.43,OI,"PS"))
|
---|
32 | I DG="SPLY",'$P(ORPS,U,5) S Y=0
|
---|
33 | I DG="O RX",'(X="O"&$P(ORPS,U,2)),'(X="I"&($P(ORPS,U)=2)) S Y=0
|
---|
34 | I DG="I RX"!(DG="UD RX"),'$P(ORPS,U) S Y=0
|
---|
35 | I DG="IV RX" D
|
---|
36 | . N I,X0,X1 S I=0
|
---|
37 | . F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I<1 D Q:Y<1
|
---|
38 | .. S X0=$G(^OR(100,+IFN,4.5,I,0)),X1=+$G(^(1))
|
---|
39 | .. 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
|
---|
40 | .. S:'$P($G(^ORD(101.43,X1,"PS")),U,3) Y=0
|
---|
41 | Q Y
|
---|
42 | ;
|
---|
43 | IV() ; -- IV order, either Inpt or Fluid?
|
---|
44 | I DG="IV RX" Q 1
|
---|
45 | N I,OI,X S I=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0))
|
---|
46 | S OI=+$G(^OR(100,IFN,4.5,+I,1)),X=$P($G(^ORD(101.43,+OI,"PS")),U)
|
---|
47 | Q (X>1)
|
---|
48 | ;
|
---|
49 | NTBG(ORIFN) ; -- Inpt order marked as 'Not to be Given'?
|
---|
50 | N PSIFN,Y,ORI,ORCH S Y=""
|
---|
51 | S PSIFN=$G(^OR(100,+ORIFN,4)) I PSIFN>0 Q $$ENNG^PSJORUT2(+ORVP,PSIFN)
|
---|
52 | 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
|
---|
53 | Q Y
|
---|
54 | ;
|
---|
55 | RESET(IFN,NEWOI) ; -- Update OI if changed before renewing
|
---|
56 | Q:'$G(IFN) Q:'$D(^OR(100,+IFN,0)) Q:'$G(NEWOI)
|
---|
57 | N I,ORIT S ORIT=+$O(^ORD(101.43,"ID",NEWOI_";99PSP",0)) Q:ORIT'>0
|
---|
58 | S I=$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
|
---|
59 | S:I ^OR(100,+IFN,4.5,I,1)=ORIT
|
---|
60 | Q
|
---|