ORIMO ;SLC/JDL - Inpatient medication on outpatient. ;02/23/16 10:15
;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,243,350,424,377**;Dec 17, 1997;Build 582
IMOLOC(ORY,ORLOC,ORDFN,ORDLL) ;ORY>=0: LOC is an IMO authorized location
S ORY=-1
N PACH,A
K ^TMP($J,"ORIMO")
S PACH=$$PATCH^XPDUTL("PSJ*5.0*111")
Q:'PACH
I $L($TEXT(SDIMO^SDAMA203)) D
. ;#DBIA 4133
. S ORY=$$SDIMO^SDAMA203(ORLOC,ORDFN)
. ;if RSA returns an error then check against Clinic Loc.
. I ORY=-3 D
. .I $P($G(^SC(ORLOC,0)),U,3)'="C" Q
. .I $D(^SC("AE",1,ORLOC))=1 S ORY=1
. K SDIMO(1)
I $G(ORDLL) D ALL^PSJ53P46(+ORLOC,"ORIMO") S A=$G(^TMP($J,"ORIMO",0)) I A'>0!(+$G(^TMP($J,"ORIMO",A,3))=0) S ORY=-1
Q
;
IMOOD(ORY,ORDERID) ;Is it an IMO order?
Q:'$D(^OR(100,+ORDERID,0))
N PIMO,DGRP,CMGRP,CIGRP
S (DGRP,CMGRP,CIGRP,ORY)=0
S DGRP=$P($G(^OR(100,+ORDERID,0)),U,11)
S CMGRP=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",""))
S CIGRP=$O(^ORD(100.98,"B","CLINIC INFUSIONS",""))
I DGRP=CMGRP S ORY=1
I DGRP=CIGRP S ORY=1
Q
;
ISCLOC(ORY,ALOC) ;Is it a clinical location
S ORY=0
Q:'$D(^SC(+ALOC,0))
I $P(^SC(+ALOC,0),U,3)="C" S ORY=1
Q
ISIVQO(ORY,DLGID) ;Is it an IV quick order
S ORY=0
Q:'$D(^ORD(101.41,DLGID,0))
N IVGRP,DLGTYP,DLGGRP
S IVGRP=$O(^ORD(100.98,"B","IV RX",0))
S DLGTYP=$P($G(^ORD(101.41,DLGID,0)),U,4)
S DLGGRP=$P($G(^ORD(101.41,DLGID,0)),U,5)
I (DLGTYP="Q"),(DLGGRP=IVGRP) S ORY=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORIMO 1444 printed Dec 13, 2024@02:30:57 Page 2
ORIMO ;SLC/JDL - Inpatient medication on outpatient. ;02/23/16 10:15
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,243,350,424,377**;Dec 17, 1997;Build 582
IMOLOC(ORY,ORLOC,ORDFN,ORDLL) ;ORY>=0: LOC is an IMO authorized location
+1 SET ORY=-1
+2 NEW PACH,A
+3 KILL ^TMP($JOB,"ORIMO")
+4 SET PACH=$$PATCH^XPDUTL("PSJ*5.0*111")
+5 if 'PACH
QUIT
+6 IF $LENGTH($TEXT(SDIMO^SDAMA203))
Begin DoDot:1
+7 ;#DBIA 4133
+8 SET ORY=$$SDIMO^SDAMA203(ORLOC,ORDFN)
+9 ;if RSA returns an error then check against Clinic Loc.
+10 IF ORY=-3
Begin DoDot:2
+11 IF $PIECE($GET(^SC(ORLOC,0)),U,3)'="C"
QUIT
+12 IF $DATA(^SC("AE",1,ORLOC))=1
SET ORY=1
End DoDot:2
+13 KILL SDIMO(1)
End DoDot:1
+14 IF $GET(ORDLL)
DO ALL^PSJ53P46(+ORLOC,"ORIMO")
SET A=$GET(^TMP($JOB,"ORIMO",0))
IF A'>0!(+$GET(^TMP($JOB,"ORIMO",A,3))=0)
SET ORY=-1
+15 QUIT
+16 ;
IMOOD(ORY,ORDERID) ;Is it an IMO order?
+1 if '$DATA(^OR(100,+ORDERID,0))
QUIT
+2 NEW PIMO,DGRP,CMGRP,CIGRP
+3 SET (DGRP,CMGRP,CIGRP,ORY)=0
+4 SET DGRP=$PIECE($GET(^OR(100,+ORDERID,0)),U,11)
+5 SET CMGRP=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",""))
+6 SET CIGRP=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",""))
+7 IF DGRP=CMGRP
SET ORY=1
+8 IF DGRP=CIGRP
SET ORY=1
+9 QUIT
+10 ;
ISCLOC(ORY,ALOC) ;Is it a clinical location
+1 SET ORY=0
+2 if '$DATA(^SC(+ALOC,0))
QUIT
+3 IF $PIECE(^SC(+ALOC,0),U,3)="C"
SET ORY=1
+4 QUIT
ISIVQO(ORY,DLGID) ;Is it an IV quick order
+1 SET ORY=0
+2 if '$DATA(^ORD(101.41,DLGID,0))
QUIT
+3 NEW IVGRP,DLGTYP,DLGGRP
+4 SET IVGRP=$ORDER(^ORD(100.98,"B","IV RX",0))
+5 SET DLGTYP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,4)
+6 SET DLGGRP=$PIECE($GET(^ORD(101.41,DLGID,0)),U,5)
+7 IF (DLGTYP="Q")
IF (DLGGRP=IVGRP)
SET ORY=1
+8 QUIT
