Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMTIM02.m

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