source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCACT03.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1ORCACT03 ;SLC/MKB-Validate order actions cont ;02/06/2007
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4INACTIVE() ; -- 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 ;
26MEDOK() ; -- 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 ;
43IV() ; -- 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 ;
49NTBG(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 ;
55RESET(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
Note: See TracBrowser for help on using the repository browser.