OCXOTIME ;SLC/RJS,CLA - PROCESS TIME BASED EVENT ;10/29/98 12:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
;
Q
EN ;
;
Q:'$$RTEST
;
N OCXDATE,OCXDFN,OCXELEM,OCXRULE
S OCXRULE=0 F S OCXRULE=$O(^OCXD(860.1,"TIME",OCXRULE)) Q:'OCXRULE D
.S OCXDFN=0 F S OCXDFN=$O(^OCXD(860.1,"TIME",OCXRULE,OCXDFN)) Q:'OCXDFN D
..S OCXDATE=0 F S OCXDATE=$O(^OCXD(860.1,"TIME",OCXRULE,OCXDFN,OCXDATE)) Q:'OCXDATE I '((+OCXDATE)>OCXNOW) D
...N DFN,OCXOSRC,OUTMSG,OCXNOTIF,OCXELEM
...S OCXOSRC="TIMED ORDER CHECK",(OUTMSG,OCXNOTIF)=""
...S OCXORMTR="ORMTIME: Executing D UPDATE^OCXOZ01 DATE: "_OCXDATE
...D LOG(" "_OCXORMTR)
...S OCXORMTR=" RULE: "_(+OCXRULE)_" ("_$P($G(^OCXS(860.2,+OCXRULE,0)),U,1)
...D LOG(" "_OCXORMTR)
...S OCXORMTR=" Patient: "_OCXDFN_" ("_$P($G(^DPT(OCXDFN,0)),U,1)_")"
...D LOG(" "_OCXORMTR)
...S OCXELEM=0 F S OCXELEM=$O(^OCXS(860.2,OCXRULE,"C","C",OCXELEM)) Q:'OCXELEM D
....S:($P($G(^OCXS(860.6,+$P($G(^OCXS(860.3,+OCXELEM,0)),U,2),0)),U,1)="TIMED ORDER CHECK") OCXOSRC("ELEMENT",OCXELEM)=""
...K ^OCXD(860.1,"TIME",OCXRULE,OCXDFN,OCXDATE)
...K ^OCXD(860.1,OCXDFN,2,OCXDATE,1,OCXRULE)
...K ^OCXD(860.1,OCXDFN,2,OCXDATE,1,"B",OCXRULE,OCXRULE)
...I '$O(^OCXD(860.1,OCXDFN,2,0)) K ^OCXD(860.1,OCXDFN,2)
...D LOGOCX("TIMEOC")
...D UPDATE^OCXOZ01(OCXDFN,OCXOSRC,.OUTMSG)
;
Q
;
LOG(TEXT) ;
;
Q
;
LOGOCX(OCXSRC) ;
; Log Messages
Q
ERROR Q
;
ACT(OCXDATE,OCXORD) Q:'$$RTEST D CHECK("ACT") Q
;
EXP(OCXDATE,OCXORD) Q:'$$RTEST D CHECK("EXP") Q
;
CHECK(OCXMODE) ;
;
S OCXDATA("MODE")=OCXMODE
Q
;
RTEST() ;
N DATE,TMOUT
Q:'$L($T(^OCXOZ01)) 1
I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
S DATE=$P($G(^OCXD(861,1,0)),U,3)
I DATE,((+DATE)=(+$H)),(((+$P($H,",",2))-(+$P(DATE,",",2)))<1800) Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOTIME 1959 printed Apr 09, 2024@21:33:07 Page 2
OCXOTIME ;SLC/RJS,CLA - PROCESS TIME BASED EVENT ;10/29/98 12:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ;
+5 QUIT
EN ;
+1 ;
+2 if '$$RTEST
QUIT
+3 ;
+4 NEW OCXDATE,OCXDFN,OCXELEM,OCXRULE
+5 SET OCXRULE=0
FOR
SET OCXRULE=$ORDER(^OCXD(860.1,"TIME",OCXRULE))
if 'OCXRULE
QUIT
Begin DoDot:1
+6 SET OCXDFN=0
FOR
SET OCXDFN=$ORDER(^OCXD(860.1,"TIME",OCXRULE,OCXDFN))
if 'OCXDFN
QUIT
Begin DoDot:2
+7 SET OCXDATE=0
FOR
SET OCXDATE=$ORDER(^OCXD(860.1,"TIME",OCXRULE,OCXDFN,OCXDATE))
if 'OCXDATE
QUIT
IF '((+OCXDATE)>OCXNOW)
Begin DoDot:3
+8 NEW DFN,OCXOSRC,OUTMSG,OCXNOTIF,OCXELEM
+9 SET OCXOSRC="TIMED ORDER CHECK"
SET (OUTMSG,OCXNOTIF)=""
+10 SET OCXORMTR="ORMTIME: Executing D UPDATE^OCXOZ01 DATE: "_OCXDATE
+11 DO LOG(" "_OCXORMTR)
+12 SET OCXORMTR=" RULE: "_(+OCXRULE)_" ("_$PIECE($GET(^OCXS(860.2,+OCXRULE,0)),U,1)
+13 DO LOG(" "_OCXORMTR)
+14 SET OCXORMTR=" Patient: "_OCXDFN_" ("_$PIECE($GET(^DPT(OCXDFN,0)),U,1)_")"
+15 DO LOG(" "_OCXORMTR)
+16 SET OCXELEM=0
FOR
SET OCXELEM=$ORDER(^OCXS(860.2,OCXRULE,"C","C",OCXELEM))
if 'OCXELEM
QUIT
Begin DoDot:4
+17 if ($PIECE($GET(^OCXS(860.6,+$PIECE($GET(^OCXS(860.3,+OCXELEM,0)),U,2),0)),U,1)="TIMED ORDER CHECK")
SET OCXOSRC("ELEMENT",OCXELEM)=""
End DoDot:4
+18 KILL ^OCXD(860.1,"TIME",OCXRULE,OCXDFN,OCXDATE)
+19 KILL ^OCXD(860.1,OCXDFN,2,OCXDATE,1,OCXRULE)
+20 KILL ^OCXD(860.1,OCXDFN,2,OCXDATE,1,"B",OCXRULE,OCXRULE)
+21 IF '$ORDER(^OCXD(860.1,OCXDFN,2,0))
KILL ^OCXD(860.1,OCXDFN,2)
+22 DO LOGOCX("TIMEOC")
+23 DO UPDATE^OCXOZ01(OCXDFN,OCXOSRC,.OUTMSG)
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 QUIT
+26 ;
LOG(TEXT) ;
+1 ;
+2 QUIT
+3 ;
LOGOCX(OCXSRC) ;
+1 ; Log Messages
+2 QUIT
ERROR QUIT
+1 ;
ACT(OCXDATE,OCXORD) if '$$RTEST
QUIT
DO CHECK("ACT")
QUIT
+1 ;
EXP(OCXDATE,OCXORD) if '$$RTEST
QUIT
DO CHECK("EXP")
QUIT
+1 ;
CHECK(OCXMODE) ;
+1 ;
+2 SET OCXDATA("MODE")=OCXMODE
+3 QUIT
+4 ;
RTEST() ;
+1 NEW DATE,TMOUT
+2 if '$LENGTH($TEXT(^OCXOZ01))
QUIT 1
+3 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
KILL ^OCXD(861,1)
SET ^OCXD(861,1,0)="SITE PREFERENCES"
+4 SET DATE=$PIECE($GET(^OCXD(861,1,0)),U,3)
+5 IF DATE
IF ((+DATE)=(+$HOROLOG))
IF (((+$PIECE($HOROLOG,",",2))-(+$PIECE(DATE,",",2)))<1800)
QUIT 1
+6 QUIT 0
+7 ;
