ORIMO.m

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 ---ORIMO   1444     printed  Apr 09, 2024@21:38:19                                                                                                                                                                                                       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