source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORB3F1.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1ORB3F1 ; 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 ;
4XQAKILL(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
11SITEORD(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
32SITERES(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
47LRRAD(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 ;
60EXP(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 ;
68DELEXP ; 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
Note: See TracBrowser for help on using the repository browser.