- 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 Feb 18, 2025@23:54:22 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
