source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMTIM02.m@ 613

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

initial load of WorldVistAEHR
File size: 3.8 KB
Line 
1ORMTIM02 ; JM/SLC-ISC - PERFORM MISC TIME BASED ACTIVITIES ;05/02/06
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**253,243**;Dec 17, 1997;Build 242
3 ;
4 Q
5MISC ; Perform misc time based activities
6 ;
7 D UNSIGNED ; Generate alerts for unsigned orders that have slipped through the cracks
8 D INIT^ORWGTASK(0) ; check to run rebuild of cache for graphing
9 ;
10 Q
11 ;
12UNSIGNED ; Generate alerts for unsigned orders that were not alerted by CPRS
13 ; This happens when CPRS crashes - through network connection drops or other causes
14 N ORZPAT,ORZDATE,ORZIEN,ORZSUB,ORZSDATE,%DT,X,Y,ORZTIME,ORZNOW,ORZPURGE
15 N ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA,ORZREC8,ORZSIGDT,ORZSTS,ORZWHEN,ORMARKID
16 N MINTIME,XTMPDAYS,XTMPHOUR,MINDAYS
17 S ORN=12,ORMARKID="ORMTIME_UNSGNORD"
18 ;
19 S MINTIME=60 ; Order must be unsigned for 60 Minutes before generating an alert
20 S MINDAYS=90 ; Order must have been generated within the last 90 days
21 ;
22 S XTMPDAYS=10 ; Keep ^XTMP record for 10 days - reset timeframe with each run
23 S XTMPHOUR=48 ; Each order that's verified as having generated an alert has a flag set in
24 ; ^XTMP that's kept for 48 hours. When flag is gone, must recheck alert status
25 ;
26 S X="T-"_MINDAYS
27 D ^%DT S ORZSDATE=9999999-Y
28 S %DT="ST",X="NOW" D ^%DT
29 S ORZNOW=Y
30 S ORZTIME=$$FMADD^XLFDT(ORZNOW,0,0,-MINTIME,0) ; Order must have existed for ORZTIME minutes
31 S ORZPURGE=$$FMADD^XLFDT(ORZNOW,XTMPDAYS,0,0,0) ; Purge all marked flags if not run in XTMPDAYS days
32 S ^XTMP(ORMARKID,0)=ORZPURGE_U_ORZNOW_U_"Unsigned Orders Reviewed by ORMTIME"
33 S ORZPURGE=$$FMADD^XLFDT(ORZNOW,0,XTMPHOUR,0,0) ; Purge each marked flag XTMPHOUR hours after creation
34 K MINTIME,MINDAYS,XTMPDAYS,XTMPHOUR,X,Y,%DT ; Kill non-namespaced vars
35 S ORZPAT="" F S ORZPAT=$O(^OR(100,"AS",ORZPAT)) Q:'ORZPAT D
36 . Q:$P(^DPT(+ORZPAT,0),U,21) ; Quit if test patient
37 . S ORZDATE=0 F S ORZDATE=$O(^OR(100,"AS",ORZPAT,ORZDATE)) Q:'ORZDATE I ORZDATE<ORZSDATE D
38 . . S ORZIEN=0 F S ORZIEN=$O(^OR(100,"AS",ORZPAT,ORZDATE,ORZIEN)) Q:'ORZIEN D
39 . . . S ORZSUB=0 F S ORZSUB=$O(^OR(100,"AS",ORZPAT,ORZDATE,ORZIEN,ORZSUB)) Q:'ORZSUB D
40 . . . . I $D(^OR(100,ORZIEN,8,ORZSUB,0)) D
41 . . . . . S ORZREC8=^OR(100,ORZIEN,8,ORZSUB,0)
42 . . . . . S ORZSIGDT=$P(ORZREC8,U,6) I $L(ORZSIGDT)>0 Q ; Can't have a sign date/time
43 . . . . . S ORZSTS=$P(ORZREC8,U,4) I ORZSTS'=2 Q ; must be in an unsigned state
44 . . . . . S ORZWHEN=$P(ORZREC8,U) I ORZWHEN>ORZTIME Q ; must have been unsigned for MINTIME
45 . . . . . S ORBDFN=+ORZPAT
46 . . . . . S ORNUM=ORZIEN_";"_ORZSUB
47 . . . . . I $$NEEDALRT($P(ORZREC8,U,3),ORBDFN,ORNUM) D ; must not have already generated an alert
48 . . . . . . S (ORBADUZ,ORBPMSG,ORBPDATA)=""
49 . . . . . . D DOALERT^ORB3
50 . . . . . . D MARK(ORNUM) ; Alert sent, don't send another one
51 D CLEAN
52 Q
53 ;
54NEEDALRT(PROVIDER,DFN,ORNUM) ; Returns true if order needs an alert
55 ;
56 I $$MARKED(ORNUM) Q 0 ; If already checked, return
57 ;
58 N RESULT,SUROGATE
59 S RESULT=1
60 I $$HASALERT(PROVIDER,DFN) S RESULT=0 I 1
61 E D
62 . S SUROGATE=$P($$GETSURO^XQALSURO(PROVIDER),U,1)
63 . I +SUROGATE,$$HASALERT(SUROGATE,DFN) S RESULT=0
64 I 'RESULT D MARK(ORNUM)
65 Q RESULT
66 ;
67HASALERT(USER,PATIENT) ; Returns true if alert exists for user and patient
68 N RESULT,ALERTID,DATE
69 S RESULT=0,ALERTID="OR,"_PATIENT_",12"
70 I $D(^XTV(8992,"AXQAN",ALERTID,USER)) D ;DBIA# 2689
71 . S DATE=$O(^XTV(8992,"AXQAN",ALERTID,USER,0))
72 . I $G(DATE)>0 S RESULT=1
73 Q RESULT
74 ;
75MARKED(ORNUM) ; Returns true if the order has been marked as not needing an alert
76 I $D(^XTMP(ORMARKID,"A",ORNUM))>0 Q 1
77 Q 0
78 ;
79MARK(ORNUM) ; Marks an order as already having been alerted
80 S ^XTMP(ORMARKID,"A",ORNUM)=""
81 S ^XTMP(ORMARKID,"B",ORZPURGE,ORNUM)=""
82 Q
83CLEAN ; Clean up old entries in ^XTMP
84 N IDX,ORNUM
85 S IDX=0
86 F S IDX=$O(^XTMP(ORMARKID,"B",IDX)) Q:((+IDX=0)!(IDX>ORZNOW)) D
87 . S ORNUM=0
88 . F S ORNUM=$O(^XTMP(ORMARKID,"B",IDX,ORNUM)) Q:+ORNUM=0 D
89 . . K ^XTMP(ORMARKID,"A",ORNUM)
90 . . K ^XTMP(ORMARKID,"B",IDX,ORNUM)
91 Q
Note: See TracBrowser for help on using the repository browser.