ORB3F1 ; slc/CLA - Extrinsic functions to support OE/RR 3 notifications ;5/8/95 15:16 [2/24/05 1:23pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,139,190,220**;Dec 17, 1997
;
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
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
.D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_OI,.ORBERR)
.Q:$G(ORBLST)>0
.D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_OI,.ORBERR)
I IOPT="O" D
.D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_OI,.ORBERR)
.Q:$G(ORBLST)>0
.D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_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
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
ORB3F1 ; slc/CLA - Extrinsic functions to support OE/RR 3 notifications ;5/8/95 15:16 [2/24/05 1:23pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,139,190,220**;Dec 17, 1997
+2 ;
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 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"
Begin DoDot:1
+9 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_OI,.ORBERR)
+10 IF $GET(ORBLST)>0
QUIT
+11 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_OI,.ORBERR)
End DoDot:1
+12 IF IOPT="O"
Begin DoDot:1
+13 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_OI,.ORBERR)
+14 IF $GET(ORBLST)>0
QUIT
+15 DO ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_OI,.ORBERR)
End DoDot:1
+16 IF 'ORBERR
IF $GET(ORBLST)>0
Begin DoDot:1
+17 FOR ORBI=1:1:ORBLST
IF ORBFLAG=1
QUIT
Begin DoDot:2
+18 SET ORBE=$ORDER(ORBLST(ORBE))
+19 IF $DATA(ORBLST(ORBE,OI))
SET ORBFLAG=1
End DoDot:2
End DoDot:1
+20 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
