- 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 Feb 18, 2025@23:57:30 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
