- 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 Jan 18, 2025@03:28:31 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