| 1 | ORB3F1 ; slc/CLA - Extrinsic functions to support OE/RR 3 notifications ;5/8/95 15:16 [2/24/05 1:23pm]
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,74,139,190,220**;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | XQAKILL(ORN) ;extrinsic function to return the delete mechanism for the notification based on definition in PARAM DEF file
|
---|
| 5 | N ORBKILL S ORBKILL=1
|
---|
| 6 | Q:$G(ORN)="" ORBKILL
|
---|
| 7 | S ORBKILL=$$GET^XPAR("DIV^SYS^PKG","ORB DELETE MECHANISM",ORN,"I")
|
---|
| 8 | I ORBKILL="A" S ORBKILL=0 ;delete for all recipients
|
---|
| 9 | E S ORBKILL=1 ;default for delete mechanism is 1 (delete only for this recipient)
|
---|
| 10 | Q ORBKILL
|
---|
| 11 | SITEORD(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
|
---|
| 12 | ; orderable item (determined from the order number ORNUM) to trigger a
|
---|
| 13 | ; notification when ordered
|
---|
| 14 | N ORBFLAG,OI,ORBLST,ORBERR,ORBI,ORBE
|
---|
| 15 | S ORBFLAG=0,OI="",ORBE="",ORBERR=""
|
---|
| 16 | Q:+$G(ORNUM)<1 ORBFLAG
|
---|
| 17 | S OI=$$OI^ORQOR2(ORNUM)
|
---|
| 18 | Q:+$G(OI)<1 ORBFLAG
|
---|
| 19 | I IOPT="I" D
|
---|
| 20 | .D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT","`"_OI,.ORBERR)
|
---|
| 21 | .Q:$G(ORBLST)>0
|
---|
| 22 | .D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - INPT PR","`"_OI,.ORBERR)
|
---|
| 23 | I IOPT="O" D
|
---|
| 24 | .D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT","`"_OI,.ORBERR)
|
---|
| 25 | .Q:$G(ORBLST)>0
|
---|
| 26 | .D ENVAL^XPAR(.ORBLST,"ORB OI ORDERED - OUTPT PR","`"_OI,.ORBERR)
|
---|
| 27 | I 'ORBERR,$G(ORBLST)>0 D
|
---|
| 28 | .F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
|
---|
| 29 | ..S ORBE=$O(ORBLST(ORBE))
|
---|
| 30 | ..I $D(ORBLST(ORBE,OI)) S ORBFLAG=1
|
---|
| 31 | Q ORBFLAG
|
---|
| 32 | SITERES(ORNUM,IOPT) ;Extrinsic function returns 1 (Yes) if the site has flagged the
|
---|
| 33 | ; orderable item (determined from the order number ORNUM) to trigger a
|
---|
| 34 | ; notification when resulted
|
---|
| 35 | N ORBFLAG,OI,ORBLST,ORBERR,ORBI,ORBE
|
---|
| 36 | S ORBFLAG=0,OI="",ORBE="",ORBERR=""
|
---|
| 37 | Q:+$G(ORNUM)<1 ORBFLAG
|
---|
| 38 | S OI=$$OI^ORQOR2(ORNUM)
|
---|
| 39 | Q:+$G(OI)<1 ORBFLAG
|
---|
| 40 | I IOPT="I" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - INPT","`"_OI,.ORBERR)
|
---|
| 41 | I IOPT="O" D ENVAL^XPAR(.ORBLST,"ORB OI RESULTS - OUTPT","`"_OI,.ORBERR)
|
---|
| 42 | I 'ORBERR,$G(ORBLST)>0 D
|
---|
| 43 | .F ORBI=1:1:ORBLST Q:ORBFLAG=1 D
|
---|
| 44 | ..S ORBE=$O(ORBLST(ORBE))
|
---|
| 45 | ..I $D(ORBLST(ORBE,OI)) S ORBFLAG=1
|
---|
| 46 | Q ORBFLAG
|
---|
| 47 | LRRAD(OI) ;Extrinsic function returns 1 (true) if Orderable Item is a
|
---|
| 48 | ;Chemistry Lab ("S.CH") or Imaging ("S.XRAY") proc or Consult ("S.CSLT")
|
---|
| 49 | N OITEXT,ORBFLAG
|
---|
| 50 | S ORBFLAG=""
|
---|
| 51 | Q:+$G(OI)<1 ORBFLAG
|
---|
| 52 | Q:'$L($G(^ORD(101.43,OI,0))) ORBFLAG
|
---|
| 53 | S OITEXT=$P(^ORD(101.43,OI,0),U)
|
---|
| 54 | S OITEXT=$$UP^XLFSTR(OITEXT)
|
---|
| 55 | Q:$D(^ORD(101.43,"S.CH",OITEXT)) 1
|
---|
| 56 | Q:$D(^ORD(101.43,"S.XRAY",OITEXT)) 1
|
---|
| 57 | Q:$D(^ORD(101.43,"S.CSLT",OITEXT)) 1
|
---|
| 58 | Q ORBFLAG
|
---|
| 59 | ;
|
---|
| 60 | EXP(ORDT,ORNUM) ;set up ^XTMP("ORAE" to store expired orders
|
---|
| 61 | N ORNOW,X0
|
---|
| 62 | S ORNOW=$$NOW^XLFDT
|
---|
| 63 | S ^XTMP("ORAE",0)=$$FMADD^XLFDT(ORNOW,30,"","","")_U_ORNOW
|
---|
| 64 | S X0=^OR(100,ORNUM,0)
|
---|
| 65 | S ^XTMP("ORAE",$P(X0,U,2),$P(X0,U,11),ORDT,ORNUM)=""
|
---|
| 66 | Q
|
---|
| 67 | ;
|
---|
| 68 | DELEXP ; delete ^XTMP("ORAE" entries older than param value + 48 hours
|
---|
| 69 | ; or have been replaced by another order
|
---|
| 70 | N ORNOW,OREXDT,OREXPAR,ORDELDT,ORPT,ORDG,ORN,ORREP
|
---|
| 71 | S ORNOW=$$NOW^XLFDT
|
---|
| 72 | S OREXPAR=$$GET^XPAR("ALL","ORWOR EXPIRED ORDERS",1,"I")
|
---|
| 73 | S OREXPAR=$S($G(OREXPAR):OREXPAR,1:72)
|
---|
| 74 | S ORDELDT=$$FMADD^XLFDT(ORNOW,"",-(OREXPAR+48),"","")
|
---|
| 75 | S ORPT=0 F S ORPT=$O(^XTMP("ORAE",ORPT)) Q:'ORPT D
|
---|
| 76 | .S ORDG=0 F S ORDG=$O(^XTMP("ORAE",ORPT,ORDG)) Q:'ORDG D
|
---|
| 77 | ..S OREXDT=0 F S OREXDT=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT)) Q:'OREXDT D
|
---|
| 78 | ...I OREXDT<ORDELDT K ^XTMP("ORAE",ORPT,ORDG,OREXDT) Q
|
---|
| 79 | ...S ORN=0 F S ORN=$O(^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)) Q:'ORN D
|
---|
| 80 | ....Q:'$D(^OR(100,ORN,3))
|
---|
| 81 | ....S ORREP=$P(^OR(100,ORN,3),U,6)
|
---|
| 82 | ....I +$G(ORREP)>0 K ^XTMP("ORAE",ORPT,ORDG,OREXDT,ORN)
|
---|
| 83 | Q
|
---|