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