Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORB3F1

ORB3F1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. FIREFLOI(ORNUM,ORLOC,ORDT,IOPT) ;
  1. ;get all flagged OIs from order
  1. N OILST,ORI,ORFLST
  1. S ORI=""
  1. S IOPT=$$ISCLORIP(ORNUM,IOPT)
  1. D OIM^ORQOR2(.OILST,ORNUM)
  1. Q:+$G(OILST)<1
  1. F S ORI=$O(OILST(ORI)) Q:'ORI D
  1. . N ORBLST,ORBERR,ORBI,ORBFLAG,ORBE
  1. . S ORBE=""
  1. . I IOPT="I" D
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$G(OILST(ORI)),.ORBERR)
  1. . . Q:$G(ORBLST)>0
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$G(OILST(ORI)),.ORBERR)
  1. . I IOPT="O" D
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$G(OILST(ORI)),.ORBERR)
  1. . . Q:$G(ORBLST)>0
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$G(OILST(ORI)),.ORBERR)
  1. . I 'ORBERR,$G(ORBLST)>0 D
  1. . . F ORBI=1:1:ORBLST D
  1. . . . S ORBE=$O(ORBLST(ORBE))
  1. . . . I $D(ORBLST(ORBE,$G(OILST(ORI)))) S ORFLST(OILST(ORI))=""
  1. ;foreach flagged OI in order fire alert
  1. N ORANUM,ORDFN
  1. S ORDFN=+$P($G(^OR(100,+ORNUM,0)),U,2)
  1. S ORANUM=41 I IOPT="O" S ORANUM=61
  1. S ORI="" F S ORI=$O(ORFLST(ORI)) Q:'ORI D
  1. . N ORMSG
  1. . S ORMSG="Order placed: "_$P($G(^ORD(101.43,ORI,0)),U,1)_" "_ORDT
  1. . I $L(ORLOC)>0 S ORMSG="["_ORLOC_"] "_ORMSG
  1. . I '$D(^TMP("ORB3 FIREFLOI",$J,ORDFN,+ORNUM,ORANUM,ORI,ORDT)) D
  1. . . D EN^ORB3(ORANUM,ORDFN,+ORNUM,"",ORMSG,ORI)
  1. . . S ^TMP("ORB3 FIREFLOI",$J,ORDFN,+ORNUM,ORANUM,ORI,ORDT)=$$NOW^XLFDT
  1. Q
  1. XQAKILL(ORN) ;extrinsic function to return the delete mechanism for the notification based on definition in PARAM DEF file
  1. N ORBKILL S ORBKILL=1
  1. Q:$G(ORN)="" ORBKILL
  1. S ORBKILL=$$GET^XPAR("DIV^SYS^PKG","ORB DELETE MECHANISM",ORN,"I")
  1. I ORBKILL="A" S ORBKILL=0 ;delete for all recipients
  1. E S ORBKILL=1 ;default for delete mechanism is 1 (delete only for this recipient)
  1. Q ORBKILL
  1. 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
  1. ; notification when ordered
  1. S IOPT=$$ISCLORIP(ORNUM,IOPT)
  1. N ORBFLAG,ORI,ORBLST,ORBERR,ORBI,ORBE,OILST
  1. S ORBFLAG=0,ORI="",ORBE="",ORBERR=""
  1. Q:+$G(ORNUM)<1 ORBFLAG
  1. D OIM^ORQOR2(.OILST,ORNUM)
  1. Q:+$G(OILST)<1 ORBFLAG
  1. F S ORI=$O(OILST(ORI)) Q:'ORI!ORBFLAG D
  1. . I IOPT="I" D
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_$G(OILST(ORI)),.ORBERR)
  1. . . Q:$G(ORBLST)>0
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_$G(OILST(ORI)),.ORBERR)
  1. . I IOPT="O" D
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_$G(OILST(ORI)),.ORBERR)
  1. . . Q:$G(ORBLST)>0
  1. . . D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_$G(OILST(ORI)),.ORBERR)
  1. . I 'ORBERR,$G(ORBLST)>0 D
  1. . . F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
  1. . . . S ORBE=$O(ORBLST(ORBE))
  1. . . . I $D(ORBLST(ORBE,$G(OILST(ORI)))) S ORBFLAG=1
  1. Q ORBFLAG
  1. 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
  1. ; notification when resulted
  1. N ORBFLAG,OI,ORBLST,ORBERR,ORBI,ORBE
  1. S ORBFLAG=0,OI="",ORBE="",ORBERR=""
  1. Q:+$G(ORNUM)<1 ORBFLAG
  1. S OI=$$OI^ORQOR2(ORNUM)
  1. Q:+$G(OI)<1 ORBFLAG
  1. I IOPT="I" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - INPT","`"_OI,.ORBERR)
  1. I IOPT="O" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - OUTPT","`"_OI,.ORBERR)
  1. I 'ORBERR,$G(ORBLST)>0 D
  1. .F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
  1. ..S ORBE=$O(ORBLST(ORBE))
  1. ..I $D(ORBLST(ORBE,OI)) S ORBFLAG=1
  1. Q ORBFLAG
  1. 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")
  1. N OITEXT,ORBFLAG
  1. S ORBFLAG=""
  1. Q:+$G(OI)<1 ORBFLAG
  1. Q:'$L($G(^ORD(101.43,OI,0))) ORBFLAG
  1. S OITEXT=$P(^ORD(101.43,OI,0),U)
  1. S OITEXT=$$UP^XLFSTR(OITEXT)
  1. Q:$D(^ORD(101.43,"S.CH",OITEXT)) 1
  1. Q:$D(^ORD(101.43,"S.XRAY",OITEXT)) 1
  1. Q:$D(^ORD(101.43,"S.CSLT",OITEXT)) 1
  1. Q ORBFLAG
  1. ;
  1. EXP(ORDT,ORNUM) ;set up ^XTMP("ORAE" to store expired orders
  1. N ORNOW,X0
  1. S ORNOW=$$NOW^XLFDT
  1. S ^XTMP("ORAE",0)=$$FMADD^XLFDT(ORNOW,30,"","","")_U_ORNOW
  1. S X0=^OR(100,ORNUM,0)
  1. S ^XTMP("ORAE",$P(X0,U,2),$P(X0,U,11),ORDT,ORNUM)=""
  1. Q
  1. ;
  1. DELEXP ; delete ^XTMP("ORAE" entries older than param value + 48 hours
  1. ; or have been replaced by another order
  1. N ORNOW,OREXDT,OREXPAR,ORDELDT,ORPT,ORDG,ORN,ORREP
  1. S ORNOW=$$NOW^XLFDT
  1. S OREXPAR=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")
  1. S OREXPAR=$S($G(OREXPAR):OREXPAR,1:72)
  1. S ORDELDT=$$FMADD^XLFDT(ORNOW,"",-(OREXPAR+48),"","")
  1. S ORPT=0 F S ORPT=$O(^XTMP("ORAE",ORPT)) Q:'ORPT D
  1. .S ORDG=0 F S ORDG=$O(^XTMP("ORAE",ORPT,ORDG)) Q:'ORDG D
  1. ..S OREXDT=0 F S OREXDT=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT)) Q:'OREXDT D
  1. ...I OREXDT<ORDELDT K ^XTMP("ORAE",ORPT,ORDG,OREXDT) Q
  1. ...S ORN=0 F S ORN=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)) Q:'ORN D
  1. ....Q:'$D(^OR(100,ORN,3))
  1. ....S ORREP=$P(^OR(100,ORN,3),U,6)
  1. ....I +$G(ORREP)>0 K ^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)
  1. Q
  1. ISCLORIP(ORNUM,ORTYPE) ; returns 1 if the order is an inpatient med or a clinic med/inf
  1. N ORRET,ORCLMED,ORCLINF,ORIPMED,ORIPMED2,ORTO
  1. S ORNUM=+ORNUM
  1. S ORRET=ORTYPE
  1. Q:'$D(^OR(100,ORNUM)) ORRET
  1. S ORTO=$P(^OR(100,ORNUM,0),U,11)
  1. I ORTO=$O(^ORD(100.98,"B","CLINIC MEDICATIONS",0)) S ORRET="I"
  1. I ORTO=$O(^ORD(100.98,"B","CLINIC INFUSIONS",0)) S ORRET="I"
  1. I ORTO=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS",0)) S ORRET="I"
  1. I ORTO=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS",0)) S ORRET="I"
  1. I ORTO=$O(^ORD(100.98,"B","OUTPATIENT MEDICATIONS",0)) S ORRET="O"
  1. I ORTO=$O(^ORD(100.98,"B","SPLY",0)) S ORRET="O"
  1. Q ORRET