ORIMO.m

ORIMO ;SLC/JDL - Inpatient medication on outpatient. ;31-Aug-2012 13:30;PLS

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,243,1010**;Dec 17, 1997;Build 47

 ; Modified - IHS/MSC/MGH - 08/31/2012 - Line IMOLOC+7

IMOLOC(ORY,ORLOC,ORDFN) ;ORY>=0: LOC is an IMO authorized location

 S ORY=-1

 N PACH

 S PACH=$$PATCH^XPDUTL("PSJ*5.0*111")

 Q:'PACH

 I $L($TEXT(SDIMO^SDAMA203)) D

 . ;#DBIA 4133

 .;IHS/MSC/MGH - 08/31/2012 - Next line add and next line commented out

 . S ORY=-3  ;IHS/MSC/MGH - 08/31/2012

 . ;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)

 Q

 ;

IMOOD(ORY,ORDERID) ;Is it an IMO order?

 Q:'$D(^OR(100,+ORDERID,0))

 N PIMO,DGRP,IMOGRP,ISIMO

 S (PIMO,DGRP,ISIMO)=0

 I $P($G(^OR(100,+ORDERID,0)),U,18)>0 S PIMO=1

 S DGRP=$P($G(^OR(100,+ORDERID,0)),U,11)

 S IMOGRP=$O(^ORD(100.98,"B","CLINIC ORDERS",""))

 I DGRP=IMOGRP S ISIMO=1

 I PIMO,ISIMO 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

ORIMO     ;SLC/JDL - Inpatient medication on outpatient. ;31-Aug-2012 13:30;PLS

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215,243,1010**;Dec 17, 1997;Build 47

 +2       ; Modified - IHS/MSC/MGH - 08/31/2012 - Line IMOLOC+7

IMOLOC(ORY,ORLOC,ORDFN) ;ORY>=0: LOC is an IMO authorized location

 +1        SET ORY=-1

 +2        NEW PACH

 +3        SET PACH=$$PATCH^XPDUTL("PSJ*5.0*111")

 +4        IF 'PACH

               QUIT 

 +5        IF $LENGTH($TEXT(SDIMO^SDAMA203))

               Begin DoDot:1

 +6       ;#DBIA 4133

 +7       ;IHS/MSC/MGH - 08/31/2012 - Next line add and next line commented out

 +8       ;IHS/MSC/MGH - 08/31/2012

                   SET ORY=-3

 +9       ;S ORY=$$SDIMO^SDAMA203(ORLOC,ORDFN)

 +10      ;if RSA returns an error then check against Clinic Loc.

 +11               IF ORY=-3

                       Begin DoDot:2

 +12                       IF $PIECE($GET(^SC(ORLOC,0)),U,3)'="C"

                               QUIT 

 +13                       IF $DATA(^SC("AE",1,ORLOC))=1

                               SET ORY=1

                       End DoDot:2

 +14               KILL SDIMO(1)

               End DoDot:1

 +15       QUIT 

 +16      ;

IMOOD(ORY,ORDERID) ;Is it an IMO order?

 +1        IF '$DATA(^OR(100,+ORDERID,0))

               QUIT 

 +2        NEW PIMO,DGRP,IMOGRP,ISIMO

 +3        SET (PIMO,DGRP,ISIMO)=0

 +4        IF $PIECE($GET(^OR(100,+ORDERID,0)),U,18)>0

               SET PIMO=1

 +5        SET DGRP=$PIECE($GET(^OR(100,+ORDERID,0)),U,11)

 +6        SET IMOGRP=$ORDER(^ORD(100.98,"B","CLINIC ORDERS",""))

 +7        IF DGRP=IMOGRP

               SET ISIMO=1

 +8        IF PIMO

               IF ISIMO

                   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