ORB3F1 ; slc/CLA - Extrinsic functions to support OE/RR 3 notifications ;08/17/16 07:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,139,190,220,423**;Dec 17, 1997;Build 19
;
FIREFLOI(ORNUM,ORLOC,ORDT,IOPT) ;
;get all flagged OIs from order
N OILST,ORI,ORFLST
S ORI=""
S IOPT=$$ISCLORIP(ORNUM,IOPT)
D OIM^ORQOR2(.OILST,ORNUM)
Q:+$G(OILST)<1
F S ORI=$O(OILST(ORI)) Q:'ORI D
. N ORBLST,ORBERR,ORBI,ORBFLAG,ORBE
. S ORBE=""
. I IOPT="I" D
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$G(OILST(ORI)),.ORBERR)
. . Q:$G(ORBLST)>0
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$G(OILST(ORI)),.ORBERR)
. I IOPT="O" D
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$G(OILST(ORI)),.ORBERR)
. . Q:$G(ORBLST)>0
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$G(OILST(ORI)),.ORBERR)
. I 'ORBERR,$G(ORBLST)>0 D
. . F ORBI=1:1:ORBLST D
. . . S ORBE=$O(ORBLST(ORBE))
. . . I $D(ORBLST(ORBE,$G(OILST(ORI)))) S ORFLST(OILST(ORI))=""
;foreach flagged OI in order fire alert
N ORANUM,ORDFN
S ORDFN=+$P($G(^OR(100,+ORNUM,0)),U,2)
S ORANUM=41 I IOPT="O" S ORANUM=61
S ORI="" F S ORI=$O(ORFLST(ORI)) Q:'ORI D
. N ORMSG
. S ORMSG="Order placed: "_$P($G(^ORD(101.43,ORI,0)),U,1)_" "_ORDT
. I $L(ORLOC)>0 S ORMSG="["_ORLOC_"] "_ORMSG
. I '$D(^TMP("ORB3 FIREFLOI",$J,ORDFN,+ORNUM,ORANUM,ORI,ORDT)) D
. . D EN^ORB3(ORANUM,ORDFN,+ORNUM,"",ORMSG,ORI)
. . S ^TMP("ORB3 FIREFLOI",$J,ORDFN,+ORNUM,ORANUM,ORI,ORDT)=$$NOW^XLFDT
Q
XQAKILL(ORN) ;extrinsic function to return the delete mechanism for the notification based on definition in PARAM DEF file
N ORBKILL S ORBKILL=1
Q:$G(ORN)="" ORBKILL
S ORBKILL=$$GET^XPAR("DIV^SYS^PKG","ORB DELETE MECHANISM",ORN,"I")
I ORBKILL="A" S ORBKILL=0 ;delete for all recipients
E S ORBKILL=1 ;default for delete mechanism is 1 (delete only for this recipient)
Q ORBKILL
SITEORD(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
; orderable item (determined from the order number ORNUM) to trigger a
; notification when ordered
S IOPT=$$ISCLORIP(ORNUM,IOPT)
N ORBFLAG,ORI,ORBLST,ORBERR,ORBI,ORBE,OILST
S ORBFLAG=0,ORI="",ORBE="",ORBERR=""
Q:+$G(ORNUM)<1 ORBFLAG
D OIM^ORQOR2(.OILST,ORNUM)
Q:+$G(OILST)<1 ORBFLAG
F S ORI=$O(OILST(ORI)) Q:'ORI!ORBFLAG D
. I IOPT="I" D
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$G(OILST(ORI)),.ORBERR)
. . Q:$G(ORBLST)>0
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$G(OILST(ORI)),.ORBERR)
. I IOPT="O" D
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$G(OILST(ORI)),.ORBERR)
. . Q:$G(ORBLST)>0
. . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$G(OILST(ORI)),.ORBERR)
. I 'ORBERR,$G(ORBLST)>0 D
. . F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
. . . S ORBE=$O(ORBLST(ORBE))
. . . I $D(ORBLST(ORBE,$G(OILST(ORI)))) S ORBFLAG=1
Q ORBFLAG
SITERES(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
; orderable item (determined from the order number ORNUM) to trigger a
; notification when resulted
N ORBFLAG,OI,ORBLST,ORBERR,ORBI,ORBE
S ORBFLAG=0,OI="",ORBE="",ORBERR=""
Q:+$G(ORNUM)<1 ORBFLAG
S OI=$$OI^ORQOR2(ORNUM)
Q:+$G(OI)<1 ORBFLAG
I IOPT="I" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - INPT","`"_OI,.ORBERR)
I IOPT="O" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - OUTPT","`"_OI,.ORBERR)
I 'ORBERR,$G(ORBLST)>0 D
.F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
..S ORBE=$O(ORBLST(ORBE))
..I $D(ORBLST(ORBE,OI)) S ORBFLAG=1
Q ORBFLAG
LRRAD(OI) ;Extrinsic function returns 1 (true) if Orderable Item is a
;Chemistry Lab ("S.CH") or Imaging ("S.XRAY") proc or Consult ("S.CSLT")
N OITEXT,ORBFLAG
S ORBFLAG=""
Q:+$G(OI)<1 ORBFLAG
Q:'$L($G(^ORD(101.43,OI,0))) ORBFLAG
S OITEXT=$P(^ORD(101.43,OI,0),U)
S OITEXT=$$UP^XLFSTR(OITEXT)
Q:$D(^ORD(101.43,"S.CH",OITEXT)) 1
Q:$D(^ORD(101.43,"S.XRAY",OITEXT)) 1
Q:$D(^ORD(101.43,"S.CSLT",OITEXT)) 1
Q ORBFLAG
;
EXP(ORDT,ORNUM) ;set up ^XTMP("ORAE" to store expired orders
N ORNOW,X0
S ORNOW=$$NOW^XLFDT
S ^XTMP("ORAE",0)=$$FMADD^XLFDT(ORNOW,30,"","","")_U_ORNOW
S X0=^OR(100,ORNUM,0)
S ^XTMP("ORAE",$P(X0,U,2),$P(X0,U,11),ORDT,ORNUM)=""
Q
;
DELEXP ; delete ^XTMP("ORAE" entries older than param value + 48 hours
; or have been replaced by another order
N ORNOW,OREXDT,OREXPAR,ORDELDT,ORPT,ORDG,ORN,ORREP
S ORNOW=$$NOW^XLFDT
S OREXPAR=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")
S OREXPAR=$S($G(OREXPAR):OREXPAR,1:72)
S ORDELDT=$$FMADD^XLFDT(ORNOW,"",-(OREXPAR+48),"","")
S ORPT=0 F S ORPT=$O(^XTMP("ORAE",ORPT)) Q:'ORPT D
.S ORDG=0 F S ORDG=$O(^XTMP("ORAE",ORPT,ORDG)) Q:'ORDG D
..S OREXDT=0 F S OREXDT=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT)) Q:'OREXDT D
...I OREXDT<ORDELDT K ^XTMP("ORAE",ORPT,ORDG,OREXDT) Q
...S ORN=0 F S ORN=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)) Q:'ORN D
....Q:'$D(^OR(100,ORN,3))
....S ORREP=$P(^OR(100,ORN,3),U,6)
....I +$G(ORREP)>0 K ^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)
Q
ISCLORIP(ORNUM,ORTYPE) ; returns 1 if the order is an inpatient med or a clinic med/inf
N ORRET,ORCLMED,ORCLINF,ORIPMED,ORIPMED2,ORTO
S ORNUM=+ORNUM
S ORRET=ORTYPE
Q:'$D(^OR(100,ORNUM)) ORRET
S ORTO=$P(^OR(100,ORNUM,0),U,11)
I ORTO=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",0)) S ORRET="I"
I ORTO=$O(^ORD(100.98,"B","CLINIC INFUSIONS",0)) S ORRET="I"
I ORTO=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",0)) S ORRET="I"
I ORTO=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",0)) S ORRET="I"
I ORTO=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0)) S ORRET="O"
I ORTO=$O(^ORD(100.98,"B","SPLY",0)) S ORRET="O"
Q ORRET
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORB3F1 5627 printed Oct 16, 2024@18:27:56 Page 2
ORB3F1 ; slc/CLA - Extrinsic functions to support OE/RR 3 notifications ;08/17/16 07:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,139,190,220,423**;Dec 17, 1997;Build 19
+2 ;
FIREFLOI(ORNUM,ORLOC,ORDT,IOPT) ;
+1 ;get all flagged OIs from order
+2 NEW OILST,ORI,ORFLST
+3 SET ORI=""
+4 SET IOPT=$$ISCLORIP(ORNUM,IOPT)
+5 DO OIM^ORQOR2(.OILST,ORNUM)
+6 if +$GET(OILST)<1
QUIT
+7 FOR
SET ORI=$ORDER(OILST(ORI))
if 'ORI
QUIT
Begin DoDot:1
+8 NEW ORBLST,ORBERR,ORBI,ORBFLAG,ORBE
+9 SET ORBE=""
+10 IF IOPT="I"
Begin DoDot:2
+11 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$GET(OILST(ORI)),.ORBERR)
+12 if $GET(ORBLST)>0
QUIT
+13 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$GET(OILST(ORI)),.ORBERR)
End DoDot:2
+14 IF IOPT="O"
Begin DoDot:2
+15 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$GET(OILST(ORI)),.ORBERR)
+16 if $GET(ORBLST)>0
QUIT
+17 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$GET(OILST(ORI)),.ORBERR)
End DoDot:2
+18 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:2
+19 FOR ORBI=1:1:ORBLST
Begin DoDot:3
+20 SET ORBE=$ORDER(ORBLST(ORBE))
+21 IF $DATA(ORBLST(ORBE,$GET(OILST(ORI))))
SET ORFLST(OILST(ORI))=""
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;foreach flagged OI in order fire alert
+23 NEW ORANUM,ORDFN
+24 SET ORDFN=+$PIECE($GET(^OR(100,+ORNUM,0)),U,2)
+25 SET ORANUM=41
IF IOPT="O"
SET ORANUM=61
+26 SET ORI=""
FOR
SET ORI=$ORDER(ORFLST(ORI))
if 'ORI
QUIT
Begin DoDot:1
+27 NEW ORMSG
+28 SET ORMSG="Order placed: "_$PIECE($GET(^ORD(101.43,ORI,0)),U,1)_" "_ORDT
+29 IF $LENGTH(ORLOC)>0
SET ORMSG="["_ORLOC_"] "_ORMSG
+30 IF '$DATA(^TMP("ORB3 FIREFLOI",$JOB,ORDFN,+ORNUM,ORANUM,ORI,ORDT))
Begin DoDot:2
+31 DO EN^ORB3(ORANUM,ORDFN,+ORNUM,"",ORMSG,ORI)
+32 SET ^TMP("ORB3 FIREFLOI",$JOB,ORDFN,+ORNUM,ORANUM,ORI,ORDT)=$$NOW^XLFDT
End DoDot:2
End DoDot:1
+33 QUIT
XQAKILL(ORN) ;extrinsic function to return the delete mechanism for the notification based on definition in PARAM DEF file
+1 NEW ORBKILL
SET ORBKILL=1
+2 if $GET(ORN)=""
QUIT ORBKILL
+3 SET ORBKILL=$$GET^XPAR("DIV^SYS^PKG","ORB DELETE MECHANISM",ORN,"I")
+4 ;delete for all recipients
IF ORBKILL="A"
SET ORBKILL=0
+5 ;default for delete mechanism is 1 (delete only for this recipient)
IF '$TEST
SET ORBKILL=1
+6 QUIT ORBKILL
SITEORD(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
+1 ; orderable item (determined from the order number ORNUM) to trigger a
+2 ; notification when ordered
+3 SET IOPT=$$ISCLORIP(ORNUM,IOPT)
+4 NEW ORBFLAG,ORI,ORBLST,ORBERR,ORBI,ORBE,OILST
+5 SET ORBFLAG=0
SET ORI=""
SET ORBE=""
SET ORBERR=""
+6 if +$GET(ORNUM)<1
QUIT ORBFLAG
+7 DO OIM^ORQOR2(.OILST,ORNUM)
+8 if +$GET(OILST)<1
QUIT ORBFLAG
+9 FOR
SET ORI=$ORDER(OILST(ORI))
if 'ORI!ORBFLAG
QUIT
Begin DoDot:1
+10 IF IOPT="I"
Begin DoDot:2
+11 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$GET(OILST(ORI)),.ORBERR)
+12 if $GET(ORBLST)>0
QUIT
+13 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$GET(OILST(ORI)),.ORBERR)
End DoDot:2
+14 IF IOPT="O"
Begin DoDot:2
+15 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$GET(OILST(ORI)),.ORBERR)
+16 if $GET(ORBLST)>0
QUIT
+17 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$GET(OILST(ORI)),.ORBERR)
End DoDot:2
+18 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:2
+19 FOR ORBI=1:1:ORBLST
if ORBFLAG=1
QUIT
Begin DoDot:3
+20 SET ORBE=$ORDER(ORBLST(ORBE))
+21 IF $DATA(ORBLST(ORBE,$GET(OILST(ORI))))
SET ORBFLAG=1
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT ORBFLAG
SITERES(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
+1 ; orderable item (determined from the order number ORNUM) to trigger a
+2 ; notification when resulted
+3 NEW ORBFLAG,OI,ORBLST,ORBERR,ORBI,ORBE
+4 SET ORBFLAG=0
SET OI=""
SET ORBE=""
SET ORBERR=""
+5 if +$GET(ORNUM)<1
QUIT ORBFLAG
+6 SET OI=$$OI^ORQOR2(ORNUM)
+7 if +$GET(OI)<1
QUIT ORBFLAG
+8 IF IOPT="I"
DO ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - INPT","`"_OI,.ORBERR)
+9 IF IOPT="O"
DO ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - OUTPT","`"_OI,.ORBERR)
+10 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:1
+11 FOR ORBI=1:1:ORBLST
if ORBFLAG=1
QUIT
Begin DoDot:2
+12 SET ORBE=$ORDER(ORBLST(ORBE))
+13 IF $DATA(ORBLST(ORBE,OI))
SET ORBFLAG=1
End DoDot:2
End DoDot:1
+14 QUIT ORBFLAG
LRRAD(OI) ;Extrinsic function returns 1 (true) if Orderable Item is a
+1 ;Chemistry Lab ("S.CH") or Imaging ("S.XRAY") proc or Consult ("S.CSLT")
+2 NEW OITEXT,ORBFLAG
+3 SET ORBFLAG=""
+4 if +$GET(OI)<1
QUIT ORBFLAG
+5 if '$LENGTH($GET(^ORD(101.43,OI,0)))
QUIT ORBFLAG
+6 SET OITEXT=$PIECE(^ORD(101.43,OI,0),U)
+7 SET OITEXT=$$UP^XLFSTR(OITEXT)
+8 if $DATA(^ORD(101.43,"S.CH",OITEXT))
QUIT 1
+9 if $DATA(^ORD(101.43,"S.XRAY",OITEXT))
QUIT 1
+10 if $DATA(^ORD(101.43,"S.CSLT",OITEXT))
QUIT 1
+11 QUIT ORBFLAG
+12 ;
EXP(ORDT,ORNUM) ;set up ^XTMP("ORAE" to store expired orders
+1 NEW ORNOW,X0
+2 SET ORNOW=$$NOW^XLFDT
+3 SET ^XTMP("ORAE",0)=$$FMADD^XLFDT(ORNOW,30,"","","")_U_ORNOW
+4 SET X0=^OR(100,ORNUM,0)
+5 SET ^XTMP("ORAE",$PIECE(X0,U,2),$PIECE(X0,U,11),ORDT,ORNUM)=""
+6 QUIT
+7 ;
DELEXP ; delete ^XTMP("ORAE" entries older than param value + 48 hours
+1 ; or have been replaced by another order
+2 NEW ORNOW,OREXDT,OREXPAR,ORDELDT,ORPT,ORDG,ORN,ORREP
+3 SET ORNOW=$$NOW^XLFDT
+4 SET OREXPAR=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")
+5 SET OREXPAR=$SELECT($GET(OREXPAR):OREXPAR,1:72)
+6 SET ORDELDT=$$FMADD^XLFDT(ORNOW,"",-(OREXPAR+48),"","")
+7 SET ORPT=0
FOR
SET ORPT=$ORDER(^XTMP("ORAE",ORPT))
if 'ORPT
QUIT
Begin DoDot:1
+8 SET ORDG=0
FOR
SET ORDG=$ORDER(^XTMP("ORAE",ORPT,ORDG))
if 'ORDG
QUIT
Begin DoDot:2
+9 SET OREXDT=0
FOR
SET OREXDT=$ORDER(^XTMP("ORAE",ORPT,ORDG,OREXDT))
if 'OREXDT
QUIT
Begin DoDot:3
+10 IF OREXDT<ORDELDT
KILL ^XTMP("ORAE",ORPT,ORDG,OREXDT)
QUIT
+11 SET ORN=0
FOR
SET ORN=$ORDER(^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN))
if 'ORN
QUIT
Begin DoDot:4
+12 if '$DATA(^OR(100,ORN,3))
QUIT
+13 SET ORREP=$PIECE(^OR(100,ORN,3),U,6)
+14 IF +$GET(ORREP)>0
KILL ^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 QUIT
ISCLORIP(ORNUM,ORTYPE) ; returns 1 if the order is an inpatient med or a clinic med/inf
+1 NEW ORRET,ORCLMED,ORCLINF,ORIPMED,ORIPMED2,ORTO
+2 SET ORNUM=+ORNUM
+3 SET ORRET=ORTYPE
+4 if '$DATA(^OR(100,ORNUM))
QUIT ORRET
+5 SET ORTO=$PIECE(^OR(100,ORNUM,0),U,11)
+6 IF ORTO=$ORDER(^ORD(100.98,"B","CLINIC MEDICATIONS",0))
SET ORRET="I"
+7 IF ORTO=$ORDER(^ORD(100.98,"B","CLINIC INFUSIONS",0))
SET ORRET="I"
+8 IF ORTO=$ORDER(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",0))
SET ORRET="I"
+9 IF ORTO=$ORDER(^ORD(100.98,"B","INPATIENT MEDICATIONS",0))
SET ORRET="I"
+10 IF ORTO=$ORDER(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0))
SET ORRET="O"
+11 IF ORTO=$ORDER(^ORD(100.98,"B","SPLY",0))
SET ORRET="O"
+12 QUIT ORRET
