ORMTIM01 ; SLC-ISC/RJS - PROCESS TIME BASED EVENT ;2/01/00 10:30 [8/3/05 7:19am]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,40,190,232**;Dec 17, 1997;Build 19
;
SCAN ;
S OCXORMTR="ORMTIME: scan"
N OCXNOW,OCXDATE,OCXTMT,OCXORD S OCXNOW=$$IDATE("NOW"),OCXTMT=$$IDATE("N+1H")
;
; Expire orders
;
S OCXORMTR="ORMTIME: scan expiring orders"
S OCXDATE=0 F S OCXDATE=$O(^OR(100,"AE",OCXDATE)) Q:'OCXDATE I '((+OCXDATE)>OCXNOW) D
.S OCXORD=0 F S OCXORD=$O(^OR(100,"AE",OCXDATE,OCXORD)) Q:'OCXORD D
..D EXP^OCXOTIME(OCXDATE,OCXORD)
..I $G(^OR(100,"AE",OCXDATE,OCXORD)),(^OR(100,"AE",OCXDATE,OCXORD)>OCXNOW) Q
..S ^OR(100,"AE",OCXDATE,OCXORD)=OCXTMT
..N OCXORMTR S OCXORMTR=" Executing: D EXP^ORMEVNT("_OCXORD_","_OCXDATE_")"
..D EXP^ORB3F1(OCXDATE,OCXORD)
..D EXP^ORMEVNT(OCXORD,OCXDATE)
..S:$D(^OR(100,"AE",OCXDATE,OCXORD)) ^OR(100,"AE",OCXDATE,OCXORD)=""
D DELEXP^ORB3F1 ;delete old expired orders from ^XTMP("ORAE"
;
; Activate orders
;
S OCXORMTR="ORMTIME: scan activating orders"
S OCXDATE=0 F S OCXDATE=$O(^OR(100,"AD",OCXDATE)) Q:'OCXDATE I '((+OCXDATE)>OCXNOW) D
.S OCXORD=0 F S OCXORD=$O(^OR(100,"AD",OCXDATE,OCXORD)) Q:'OCXORD D
..D ACT^OCXOTIME(OCXDATE,OCXORD)
..I $G(^OR(100,"AD",OCXDATE,OCXORD)),(^OR(100,"AD",OCXDATE,OCXORD)>OCXNOW) Q
..S ^OR(100,"AD",OCXDATE,OCXORD)=OCXTMT
..N OCXORMTR S OCXORMTR=" Executing: D ACTIVE^ORMEVNT("_OCXORD_","_OCXDATE_")"
..D ACTIVE^ORMEVNT(OCXORD,OCXDATE)
..S:$D(^OR(100,"AD",OCXDATE,OCXORD)) ^OR(100,"AD",OCXDATE,OCXORD)=""
;
; Trigger Task/Time-driven Notifications
;
S OCXORMTR=" Executing: D TNOTIFS^ORB3TIM1"
D TNOTIFS^ORB3TIM1
;
; Run Order Check Purges
;
I $L($T(^OCXOPURG)) D
.S OCXORMTR="ORMTIME: Run purge for order checking"
.D EN^OCXOPURG
;
; ^ORYX("ORERR" CPRS Errors Purge
;
I $O(^ORYX("ORERR",0)) D
.N %DT,ORD0,ORDATE,ORKILL,ORLIMIT,ORNODE,X,Y
.;
.S ORLIMIT=$$GET^XPAR("ALL","ORPF ERROR DAYS") S:(ORLIMIT<1) ORLIMIT=2
.S X="TODAY-"_ORLIMIT,%DT="" D ^%DT S ORLIMIT=Y
.;
.I '$O(^ORYX("ORERR","B",0)) S ORD0=0 F S ORD0=$O(^ORYX("ORERR",ORD0)) Q:'ORD0 D
..S ^ORYX("ORERR","B",+$G(^ORYX("ORERR",ORD0,0)),ORD0)=""
.;
.S ORDATE="" F S ORDATE=$O(^ORYX("ORERR","B",ORDATE)) Q:'$L(ORDATE) D
..S ORD0=0 F S ORD0=$O(^ORYX("ORERR","B",ORDATE,ORD0)) Q:'ORD0 D
...S ORNODE=$G(^ORYX("ORERR",ORD0,0))
...I (+ORNODE<ORLIMIT) K ^ORYX("ORERR",ORD0) S ORKILL=1
..I (ORDATE<ORLIMIT) K ^ORYX("ORERR","B",ORDATE) S ORKILL=1
.;
.S ORLIMIT=10000 ; **NOTE** This limit is on the number of entries in the CPRS error log
.;
.I $G(ORKILL)!($P(^ORYX("ORERR",0),U,4)>ORLIMIT) D
..N ORD0,ORD1,ORPREV,ORCNT
..S ORD0=0 F ORCNT=0:1 S ORPREV=ORD0,ORD0=$O(^ORYX("ORERR",ORD0)) Q:'ORD0
..S $P(^ORYX("ORERR",0),U,3,4)=ORPREV_U_ORCNT
..;
..S ORD0=0 F ORD1=ORLIMIT:1:ORCNT S ORPREV=ORD0,ORD0=$O(^ORYX("ORERR",ORD0)) Q:'ORD0 D
...S ORNODE=$G(^ORYX("ORERR",ORD0,0))
...K ^ORYX("ORERR",ORD0),^ORYX("ORERR","B",+ORNODE)
..S $P(^ORYX("ORERR",0),U,3,4)=ORPREV_U_ORLIMIT
;
; Time Based Events for Order Checking
;
I $L($T(^OCXOTIME)) D
.S OCXORMTR="ORMTIME: scan time based events for order checking"
.D EN^OCXOTIME
;
S OCXORMTR="Finish Job #: "_$J_" at: "_$$EDATE($$IDATE("N"))
;
; Clean up cache of Remote Order Checking Data
;
D CLEANUP^ORRDI2
;
Q
;
EDATE(Y) X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2) Q Y
;
IDATE(X) N %DT,Y S %DT="TF" D ^%DT Q Y
;
TIME(X) N M,H S M=$E(100+(X#60),2,3),H=$E(100+(X\60),2,3) Q H_M
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMTIM01 3540 printed Apr 09, 2024@21:32:08 Page 2
ORMTIM01 ; SLC-ISC/RJS - PROCESS TIME BASED EVENT ;2/01/00 10:30 [8/3/05 7:19am]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**31,40,190,232**;Dec 17, 1997;Build 19
+2 ;
SCAN ;
+1 SET OCXORMTR="ORMTIME: scan"
+2 NEW OCXNOW,OCXDATE,OCXTMT,OCXORD
SET OCXNOW=$$IDATE("NOW")
SET OCXTMT=$$IDATE("N+1H")
+3 ;
+4 ; Expire orders
+5 ;
+6 SET OCXORMTR="ORMTIME: scan expiring orders"
+7 SET OCXDATE=0
FOR
SET OCXDATE=$ORDER(^OR(100,"AE",OCXDATE))
if 'OCXDATE
QUIT
IF '((+OCXDATE)>OCXNOW)
Begin DoDot:1
+8 SET OCXORD=0
FOR
SET OCXORD=$ORDER(^OR(100,"AE",OCXDATE,OCXORD))
if 'OCXORD
QUIT
Begin DoDot:2
+9 DO EXP^OCXOTIME(OCXDATE,OCXORD)
+10 IF $GET(^OR(100,"AE",OCXDATE,OCXORD))
IF (^OR(100,"AE",OCXDATE,OCXORD)>OCXNOW)
QUIT
+11 SET ^OR(100,"AE",OCXDATE,OCXORD)=OCXTMT
+12 NEW OCXORMTR
SET OCXORMTR=" Executing: D EXP^ORMEVNT("_OCXORD_","_OCXDATE_")"
+13 DO EXP^ORB3F1(OCXDATE,OCXORD)
+14 DO EXP^ORMEVNT(OCXORD,OCXDATE)
+15 if $DATA(^OR(100,"AE",OCXDATE,OCXORD))
SET ^OR(100,"AE",OCXDATE,OCXORD)=""
End DoDot:2
End DoDot:1
+16 ;delete old expired orders from ^XTMP("ORAE"
DO DELEXP^ORB3F1
+17 ;
+18 ; Activate orders
+19 ;
+20 SET OCXORMTR="ORMTIME: scan activating orders"
+21 SET OCXDATE=0
FOR
SET OCXDATE=$ORDER(^OR(100,"AD",OCXDATE))
if 'OCXDATE
QUIT
IF '((+OCXDATE)>OCXNOW)
Begin DoDot:1
+22 SET OCXORD=0
FOR
SET OCXORD=$ORDER(^OR(100,"AD",OCXDATE,OCXORD))
if 'OCXORD
QUIT
Begin DoDot:2
+23 DO ACT^OCXOTIME(OCXDATE,OCXORD)
+24 IF $GET(^OR(100,"AD",OCXDATE,OCXORD))
IF (^OR(100,"AD",OCXDATE,OCXORD)>OCXNOW)
QUIT
+25 SET ^OR(100,"AD",OCXDATE,OCXORD)=OCXTMT
+26 NEW OCXORMTR
SET OCXORMTR=" Executing: D ACTIVE^ORMEVNT("_OCXORD_","_OCXDATE_")"
+27 DO ACTIVE^ORMEVNT(OCXORD,OCXDATE)
+28 if $DATA(^OR(100,"AD",OCXDATE,OCXORD))
SET ^OR(100,"AD",OCXDATE,OCXORD)=""
End DoDot:2
End DoDot:1
+29 ;
+30 ; Trigger Task/Time-driven Notifications
+31 ;
+32 SET OCXORMTR=" Executing: D TNOTIFS^ORB3TIM1"
+33 DO TNOTIFS^ORB3TIM1
+34 ;
+35 ; Run Order Check Purges
+36 ;
+37 IF $LENGTH($TEXT(^OCXOPURG))
Begin DoDot:1
+38 SET OCXORMTR="ORMTIME: Run purge for order checking"
+39 DO EN^OCXOPURG
End DoDot:1
+40 ;
+41 ; ^ORYX("ORERR" CPRS Errors Purge
+42 ;
+43 IF $ORDER(^ORYX("ORERR",0))
Begin DoDot:1
+44 NEW %DT,ORD0,ORDATE,ORKILL,ORLIMIT,ORNODE,X,Y
+45 ;
+46 SET ORLIMIT=$$GET^XPAR("ALL","ORPF ERROR DAYS")
if (ORLIMIT<1)
SET ORLIMIT=2
+47 SET X="TODAY-"_ORLIMIT
SET %DT=""
DO ^%DT
SET ORLIMIT=Y
+48 ;
+49 IF '$ORDER(^ORYX("ORERR","B",0))
SET ORD0=0
FOR
SET ORD0=$ORDER(^ORYX("ORERR",ORD0))
if 'ORD0
QUIT
Begin DoDot:2
+50 SET ^ORYX("ORERR","B",+$GET(^ORYX("ORERR",ORD0,0)),ORD0)=""
End DoDot:2
+51 ;
+52 SET ORDATE=""
FOR
SET ORDATE=$ORDER(^ORYX("ORERR","B",ORDATE))
if '$LENGTH(ORDATE)
QUIT
Begin DoDot:2
+53 SET ORD0=0
FOR
SET ORD0=$ORDER(^ORYX("ORERR","B",ORDATE,ORD0))
if 'ORD0
QUIT
Begin DoDot:3
+54 SET ORNODE=$GET(^ORYX("ORERR",ORD0,0))
+55 IF (+ORNODE<ORLIMIT)
KILL ^ORYX("ORERR",ORD0)
SET ORKILL=1
End DoDot:3
+56 IF (ORDATE<ORLIMIT)
KILL ^ORYX("ORERR","B",ORDATE)
SET ORKILL=1
End DoDot:2
+57 ;
+58 ; **NOTE** This limit is on the number of entries in the CPRS error log
SET ORLIMIT=10000
+59 ;
+60 IF $GET(ORKILL)!($PIECE(^ORYX("ORERR",0),U,4)>ORLIMIT)
Begin DoDot:2
+61 NEW ORD0,ORD1,ORPREV,ORCNT
+62 SET ORD0=0
FOR ORCNT=0:1
SET ORPREV=ORD0
SET ORD0=$ORDER(^ORYX("ORERR",ORD0))
if 'ORD0
QUIT
+63 SET $PIECE(^ORYX("ORERR",0),U,3,4)=ORPREV_U_ORCNT
+64 ;
+65 SET ORD0=0
FOR ORD1=ORLIMIT:1:ORCNT
SET ORPREV=ORD0
SET ORD0=$ORDER(^ORYX("ORERR",ORD0))
if 'ORD0
QUIT
Begin DoDot:3
+66 SET ORNODE=$GET(^ORYX("ORERR",ORD0,0))
+67 KILL ^ORYX("ORERR",ORD0),^ORYX("ORERR","B",+ORNODE)
End DoDot:3
+68 SET $PIECE(^ORYX("ORERR",0),U,3,4)=ORPREV_U_ORLIMIT
End DoDot:2
End DoDot:1
+69 ;
+70 ; Time Based Events for Order Checking
+71 ;
+72 IF $LENGTH($TEXT(^OCXOTIME))
Begin DoDot:1
+73 SET OCXORMTR="ORMTIME: scan time based events for order checking"
+74 DO EN^OCXOTIME
End DoDot:1
+75 ;
+76 SET OCXORMTR="Finish Job #: "_$JOB_" at: "_$$EDATE($$IDATE("N"))
+77 ;
+78 ; Clean up cache of Remote Order Checking Data
+79 ;
+80 DO CLEANUP^ORRDI2
+81 ;
+82 QUIT
+83 ;
EDATE(Y) XECUTE ^DD("DD")
if (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
QUIT Y
+1 ;
IDATE(X) NEW %DT,Y
SET %DT="TF"
DO ^%DT
QUIT Y
+1 ;
TIME(X) NEW M,H
SET M=$EXTRACT(100+(X#60),2,3)
SET H=$EXTRACT(100+(X\60),2,3)
QUIT H_M
+1 ;
