Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORMTIM02

ORMTIM02.m

Go to the documentation of this file. 
  1. ORMTIM02 ; JM/SLC-ISC - PERFORM MISC TIME BASED ACTIVITIES ;04/30/13  05:29
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**253,243,371**;Dec 17, 1997;Build 9
  1.  ;
  1.  Q
  1. MISC ; Perform misc time based activities
  1.  ;
  1.  D UNSIGNED ; Generate alerts for unsigned orders that have slipped through the cracks
  1.  D INIT^ORWGTASK(0) ; check to run rebuild of cache for graphing
  1.  ;
  1.  Q
  1.  ;
  1. UNSIGNED ; Generate alerts for unsigned orders that were not alerted by CPRS
  1.  ; This happens when CPRS crashes - through network connection drops or other causes
  1.  N ORZPAT,ORZDATE,ORZIEN,ORZSUB,ORZSDATE,%DT,X,Y,ORZTIME,ORZNOW,ORZPURGE
  1.  N ORN,ORBDFN,ORNUM,ORBADUZ,ORBPMSG,ORBPDATA,ORZREC8,ORZSIGDT,ORZSTS,ORZWHEN,ORMARKID,ORMINTIM
  1.  N MINTIME,XTMPDAYS,XTMPHOUR,MINDAYS
  1.  S ORN=12,ORMARKID="ORMTIME_UNSGNORD"
  1.  ;
  1.  S MINTIME=60 ; Order must be unsigned for 60 Minutes before generating an alert
  1.  S MINDAYS=90 ; Order must have been generated within the last 90 days
  1.  ;
  1.  S XTMPDAYS=10 ; Keep ^XTMP record for 10 days - reset timeframe with each run
  1.  S XTMPHOUR=48 ; Each order that's verified as having generated an alert has a flag set in
  1.  ;               ^XTMP that's kept for 48 hours.  When flag is gone, must recheck alert status
  1.  ;
  1.  S ORMINTIM=MINTIME
  1.  S X="T-"_MINDAYS
  1.  D ^%DT S ORZSDATE=9999999-Y
  1.  S %DT="ST",X="NOW" D ^%DT
  1.  S ORZNOW=Y
  1.  S ORZPURGE=$$FMADD^XLFDT(ORZNOW,XTMPDAYS,0,0,0) ; Purge all marked flags if not run in XTMPDAYS days
  1.  S ^XTMP(ORMARKID,0)=ORZPURGE_U_ORZNOW_U_"Unsigned Orders Reviewed by ORMTIME"
  1.  S ORZPURGE=$$FMADD^XLFDT(ORZNOW,0,XTMPHOUR,0,0) ; Purge each marked flag XTMPHOUR hours after creation
  1.  K MINTIME,MINDAYS,XTMPDAYS,XTMPHOUR,X,Y,%DT ; Kill non-namespaced vars
  1.  S ORZPAT="" F  S ORZPAT=$O(^OR(100,"AS",ORZPAT)) Q:'ORZPAT  D
  1.  . Q:$P(^DPT(+ORZPAT,0),U,21)  ; Quit if test patient
  1.  . S ORZDATE=0 F  S ORZDATE=$O(^OR(100,"AS",ORZPAT,ORZDATE)) Q:'ORZDATE  I ORZDATE<ORZSDATE D
  1.  . . S ORZIEN=0 F  S ORZIEN=$O(^OR(100,"AS",ORZPAT,ORZDATE,ORZIEN)) Q:'ORZIEN  D
  1.  . . . S ORZSUB=0 F  S ORZSUB=$O(^OR(100,"AS",ORZPAT,ORZDATE,ORZIEN,ORZSUB)) Q:'ORZSUB  D
  1.  . . . . I $D(^OR(100,ORZIEN,8,ORZSUB,0)) D
  1.  . . . . . S ORZREC8=^OR(100,ORZIEN,8,ORZSUB,0)
  1.  . . . . . S ORZSIGDT=$P(ORZREC8,U,6) I $L(ORZSIGDT)>0 Q  ; Can't have a sign date/time
  1.  . . . . . S ORZSTS=$P(ORZREC8,U,4) I ORZSTS'=2 Q  ; must be in an unsigned state
  1.  . . . . . N ORMINT,ORCSVAL
  1.  . . . . . D CSVALUE^ORDEA(.ORCSVAL,ORZIEN)
  1.  . . . . . S ORMINT=ORMINTIM
  1.  . . . . . I +ORCSVAL S ORMINT=5 ;ONLY WAIT 5 MINUTES FOR CS ORDERS
  1.  . . . . . S ORZTIME=$$FMADD^XLFDT(ORZNOW,0,0,-ORMINT,0) ; Order must have existed for ORZTIME minutes
  1.  . . . . . S ORZWHEN=$P(ORZREC8,U) I ORZWHEN>ORZTIME Q  ; must have been unsigned for MINTIME
  1.  . . . . . S ORBDFN=+ORZPAT
  1.  . . . . . S ORNUM=ORZIEN_";"_ORZSUB
  1.  . . . . . I $$NEEDALRT($P(ORZREC8,U,3),ORBDFN,ORNUM) D  ; must not have already generated an alert
  1.  . . . . . . S (ORBADUZ,ORBPMSG,ORBPDATA)=""
  1.  . . . . . . D DOALERT^ORB3
  1.  . . . . . . D MARK(ORNUM) ; Alert sent, don't send another one
  1.  D CLEAN
  1.  Q
  1.  ;
  1. NEEDALRT(PROVIDER,DFN,ORNUM) ; Returns true if order needs an alert
  1.  ;
  1.  I $$MARKED(ORNUM) Q 0 ; If already checked, return
  1.  ;
  1.  N RESULT,SUROGATE
  1.  S RESULT=1
  1.  I $$HASALERT(PROVIDER,DFN) S RESULT=0 I 1
  1.  E  D
  1.  . S SUROGATE=$P($$GETSURO^XQALSURO(PROVIDER),U,1)
  1.  . I +SUROGATE,$$HASALERT(SUROGATE,DFN) S RESULT=0
  1.  I 'RESULT D MARK(ORNUM)
  1.  Q RESULT
  1.  ;
  1. HASALERT(USER,PATIENT) ; Returns true if alert exists for user and patient
  1.  N RESULT,ALERTID,DATE
  1.  S RESULT=0,ALERTID="OR,"_PATIENT_",12"
  1.  I $D(^XTV(8992,"AXQAN",ALERTID,USER)) D  ;DBIA# 2689
  1.  . S DATE=$O(^XTV(8992,"AXQAN",ALERTID,USER,0))
  1.  . I $G(DATE)>0 S RESULT=1
  1.  Q RESULT
  1.  ;
  1. MARKED(ORNUM) ; Returns true if the order has been marked as not needing an alert
  1.  I $D(^XTMP(ORMARKID,"A",ORNUM))>0 Q 1
  1.  Q 0
  1.  ;
  1. MARK(ORNUM) ; Marks an order as already having been alerted
  1.  S ^XTMP(ORMARKID,"A",ORNUM)=""
  1.  S ^XTMP(ORMARKID,"B",ORZPURGE,ORNUM)=""
  1.  Q
  1. CLEAN ; Clean up old entries in ^XTMP
  1.  N IDX,ORNUM
  1.  S IDX=0
  1.  F  S IDX=$O(^XTMP(ORMARKID,"B",IDX)) Q:((+IDX=0)!(IDX>ORZNOW))  D
  1.  . S ORNUM=0
  1.  . F  S ORNUM=$O(^XTMP(ORMARKID,"B",IDX,ORNUM)) Q:+ORNUM=0  D
  1.  . . K ^XTMP(ORMARKID,"A",ORNUM)
  1.  . . K ^XTMP(ORMARKID,"B",IDX,ORNUM)
  1.  Q