- 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 Feb 18, 2025@23:58:43 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 ;
