ORCACT03 ;SLC/MKB-Validate order actions cont ;02/06/2007
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
INACTIVE() ; -- Returns 1 or 0, if OI is now inactive
N I,OI,PREOI,PREOIX,X,Y,ORNOW,DD,PSOI S Y=0,ORNOW=$$NOW^XLFDT
S I=0 F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I'>0 D Q:Y
. S OI=+$G(^OR(100,+IFN,4.5,I,1))
. I OI S X=$G(^ORD(101.43,OI,.1)) I X,X<ORNOW S Y=1
I Y,PKG="PS",DG'="IV RX" D ;replacement OI?
. S I=+$O(^OR(100,+IFN,4.5,"ID","DRUG",0)) Q:I'>0 ;first
. S DD=+$G(^OR(100,+IFN,4.5,I,1)) Q:DD'>0 Q:$G(OI)'>0
. S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2),X=$$ITEM^PSSUTIL1(PSOI,DD)
. Q:X'>0 S X=+$O(^ORD(101.43,"ID",+$P(X,U,2)_";99PSP",0)) Q:X'>0
. I $G(^ORD(101.43,X,.1)),$G(^(.1))<ORNOW Q ;make sure new OI is active
. S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
. IF I D
. . S PREOI=$G(^OR(100,+IFN,4.5,I,1))
. . S PREOIX=$O(^OR(100,+IFN,.1,"B",PREOI,0))
. . K ^OR(100,+IFN,.1,"B",PREOI,PREOIX)
. . S ^OR(100,+IFN,.1,"B",X,PREOIX)=""
. . S ^OR(100,+IFN,.1,PREOIX,0)=X
. . S ^OR(100,+IFN,4.5,I,1)=X
. . S Y=0 ;reset
Q Y
;
MEDOK() ; -- Returns 1 or 0, if med OI usage=Y
N Y,OI,ORPS,X S Y=1,X=$P(OR0,U,12)
I (DG="SPLY")!(DG="O RX")!(DG="I RX")!(DG="UD RX") D
. S OI=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
. S OI=+$G(^OR(100,+IFN,4.5,OI,1))
. S ORPS=$G(^ORD(101.43,OI,"PS"))
I DG="SPLY",'$P(ORPS,U,5) S Y=0
I DG="O RX",'(X="O"&$P(ORPS,U,2)),'(X="I"&($P(ORPS,U)=2)) S Y=0
I DG="I RX"!(DG="UD RX"),'$P(ORPS,U) S Y=0
I DG="IV RX" D
. N I,X0,X1 S I=0
. F S I=+$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",I)) Q:I<1 D Q:Y<1
.. S X0=$G(^OR(100,+IFN,4.5,I,0)),X1=+$G(^(1))
.. 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
.. S:'$P($G(^ORD(101.43,X1,"PS")),U,3) Y=0
Q Y
;
IV() ; -- IV order, either Inpt or Fluid?
I DG="IV RX" Q 1
N I,OI,X S I=+$O(^OR(100,IFN,4.5,"ID","ORDERABLE",0))
S OI=+$G(^OR(100,IFN,4.5,+I,1)),X=$P($G(^ORD(101.43,+OI,"PS")),U)
Q (X>1)
;
NTBG(ORIFN) ; -- Inpt order marked as 'Not to be Given'?
N PSIFN,Y,ORI,ORCH S Y=""
S PSIFN=$G(^OR(100,+ORIFN,4)) I PSIFN>0 Q $$ENNG^PSJORUT2(+ORVP,PSIFN)
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
Q Y
;
RESET(IFN,NEWOI) ; -- Update OI if changed before renewing
Q:'$G(IFN) Q:'$D(^OR(100,+IFN,0)) Q:'$G(NEWOI)
N I,ORIT S ORIT=+$O(^ORD(101.43,"ID",NEWOI_";99PSP",0)) Q:ORIT'>0
S I=$O(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
S:I ^OR(100,+IFN,4.5,I,1)=ORIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCACT03 2617 printed Dec 13, 2024@02:27:48 Page 2
ORCACT03 ;SLC/MKB-Validate order actions cont ;02/06/2007
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
INACTIVE() ; -- Returns 1 or 0, if OI is now inactive
+1 NEW I,OI,PREOI,PREOIX,X,Y,ORNOW,DD,PSOI
SET Y=0
SET ORNOW=$$NOW^XLFDT
+2 SET I=0
FOR
SET I=+$ORDER(^OR(100,+IFN,4.5,"ID","ORDERABLE",I))
if I'>0
QUIT
Begin DoDot:1
+3 SET OI=+$GET(^OR(100,+IFN,4.5,I,1))
+4 IF OI
SET X=$GET(^ORD(101.43,OI,.1))
IF X
IF X<ORNOW
SET Y=1
End DoDot:1
if Y
QUIT
+5 ;replacement OI?
IF Y
IF PKG="PS"
IF DG'="IV RX"
Begin DoDot:1
+6 ;first
SET I=+$ORDER(^OR(100,+IFN,4.5,"ID","DRUG",0))
if I'>0
QUIT
+7 SET DD=+$GET(^OR(100,+IFN,4.5,I,1))
if DD'>0
QUIT
if $GET(OI)'>0
QUIT
+8 SET PSOI=+$PIECE($GET(^ORD(101.43,OI,0)),U,2)
SET X=$$ITEM^PSSUTIL1(PSOI,DD)
+9 if X'>0
QUIT
SET X=+$ORDER(^ORD(101.43,"ID",+$PIECE(X,U,2)_";99PSP",0))
if X'>0
QUIT
+10 ;make sure new OI is active
IF $GET(^ORD(101.43,X,.1))
IF $GET(^(.1))<ORNOW
QUIT
+11 SET I=+$ORDER(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
+12 IF I
Begin DoDot:2
+13 SET PREOI=$GET(^OR(100,+IFN,4.5,I,1))
+14 SET PREOIX=$ORDER(^OR(100,+IFN,.1,"B",PREOI,0))
+15 KILL ^OR(100,+IFN,.1,"B",PREOI,PREOIX)
+16 SET ^OR(100,+IFN,.1,"B",X,PREOIX)=""
+17 SET ^OR(100,+IFN,.1,PREOIX,0)=X
+18 SET ^OR(100,+IFN,4.5,I,1)=X
+19 ;reset
SET Y=0
End DoDot:2
End DoDot:1
+20 QUIT Y
+21 ;
MEDOK() ; -- Returns 1 or 0, if med OI usage=Y
+1 NEW Y,OI,ORPS,X
SET Y=1
SET X=$PIECE(OR0,U,12)
+2 IF (DG="SPLY")!(DG="O RX")!(DG="I RX")!(DG="UD RX")
Begin DoDot:1
+3 SET OI=+$ORDER(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
+4 SET OI=+$GET(^OR(100,+IFN,4.5,OI,1))
+5 SET ORPS=$GET(^ORD(101.43,OI,"PS"))
End DoDot:1
+6 IF DG="SPLY"
IF '$PIECE(ORPS,U,5)
SET Y=0
+7 IF DG="O RX"
IF '(X="O"&$PIECE(ORPS,U,2))
IF '(X="I"&($PIECE(ORPS,U)=2))
SET Y=0
+8 IF DG="I RX"!(DG="UD RX")
IF '$PIECE(ORPS,U)
SET Y=0
+9 IF DG="IV RX"
Begin DoDot:1
+10 NEW I,X0,X1
SET I=0
+11 FOR
SET I=+$ORDER(^OR(100,+IFN,4.5,"ID","ORDERABLE",I))
if I<1
QUIT
Begin DoDot:2
+12 SET X0=$GET(^OR(100,+IFN,4.5,I,0))
SET X1=+$GET(^(1))
+13 IF $PIECE($GET(^ORD(101.41,+$PIECE(X0,U,2),0)),U)["ADDITIVE"
if '$PIECE($GET(^ORD(101.43,X1,"PS")),U,4)
SET Y=0
QUIT
+14 if '$PIECE($GET(^ORD(101.43,X1,"PS")),U,3)
SET Y=0
End DoDot:2
if Y<1
QUIT
End DoDot:1
+15 QUIT Y
+16 ;
IV() ; -- IV order, either Inpt or Fluid?
+1 IF DG="IV RX"
QUIT 1
+2 NEW I,OI,X
SET I=+$ORDER(^OR(100,IFN,4.5,"ID","ORDERABLE",0))
+3 SET OI=+$GET(^OR(100,IFN,4.5,+I,1))
SET X=$PIECE($GET(^ORD(101.43,+OI,"PS")),U)
+4 QUIT (X>1)
+5 ;
NTBG(ORIFN) ; -- Inpt order marked as 'Not to be Given'?
+1 NEW PSIFN,Y,ORI,ORCH
SET Y=""
+2 SET PSIFN=$GET(^OR(100,+ORIFN,4))
IF PSIFN>0
QUIT $$ENNG^PSJORUT2(+ORVP,PSIFN)
+3 SET ORI=0
FOR
SET ORI=$ORDER(^OR(100,+ORIFN,2,ORI))
if ORI'>0
QUIT
SET ORCH=+$GET(^(ORI,0))
SET PSIFN=$GET(^OR(100,ORCH,4))
IF PSIFN>0
SET Y=$$ENNG^PSJORUT2(+ORVP,PSIFN)
if Y
QUIT
+4 QUIT Y
+5 ;
RESET(IFN,NEWOI) ; -- Update OI if changed before renewing
+1 if '$GET(IFN)
QUIT
if '$DATA(^OR(100,+IFN,0))
QUIT
if '$GET(NEWOI)
QUIT
+2 NEW I,ORIT
SET ORIT=+$ORDER(^ORD(101.43,"ID",NEWOI_";99PSP",0))
if ORIT'>0
QUIT
+3 SET I=$ORDER(^OR(100,+IFN,4.5,"ID","ORDERABLE",0))
+4 if I
SET ^OR(100,+IFN,4.5,I,1)=ORIT
+5 QUIT
