OCXOPURG ;SLC/RJS,CLA - Purge old Log and Patient Data ;4/02/02 08:38
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,143**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
EN ;
;
N OCXE0,OCXE1,OCXE2,OCXS,OCXDFN,OCXCNT,OCXDATE,OCXRUL,OCXKEEP,OCXFILE
N OCXFIRST,OCXLAST,OCXOVER
;
; Purge OCX namespaced entries in ^TMP that have expired.
;
S OCXS="OCX" F S OCXS=$O(^TMP(OCXS)) Q:'$L(OCXS) Q:'($E(OCXS,1,3)="OCX") D
.S OCXE0=0 F S OCXE0=$O(^TMP(OCXS,OCXE0)) Q:'$L(OCXE0) D
..K:($G(^TMP(OCXS,OCXE0))<($P($H,",",2)+($H*86400))) ^TMP(OCXS,OCXE0)
;
D PURGE^OCXCACHE
;
S OCXDATE=0 F S OCXDATE=$O(^OCXD(860.7,"AT",OCXDATE)) Q:'OCXDATE I (OCXDATE<($H-5)) D
.S OCXDFN=0 F S OCXDFN=$O(^OCXD(860.7,"AT",OCXDATE,OCXDFN)) Q:'OCXDFN D
..S OCXRUL=0 F S OCXRUL=$O(^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL)) Q:'OCXRUL D
...N OCXNODE
...S OCXNODE=$G(^OCXD(860.7,OCXDFN,1,OCXRUL,0))
...I ($P(OCXNODE,U,2)=OCXDATE) D
....K ^OCXD(860.7,OCXDFN,1,OCXRUL)
....K ^OCXD(860.7,OCXDFN,"B",OCXRUL,OCXRUL)
....I '$O(^OCXD(860.7,OCXDFN,1,0)) D
.....K ^OCXD(860.7,OCXDFN)
.....K ^OCXD(860.7,"B",OCXDFN,OCXDFN)
...K ^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL)
;
I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
;
I '($P($G(^OCXD(861,1,0)),U,2)=(+$H)) D
.I $L($T(LOG^OCXOZ01)),$$LOG^OCXOZ01 S OCXKEEP=$$DT("TODAY-"_(+$$LOG^OCXOZ01)) I 1
.E S OCXKEEP=$$DT("TODAY-3")
.K ^OCXD(861,"B")
.S OCXE1=0,OCXE0=1 F S OCXE0=$O(^OCXD(861,OCXE0)) Q:'OCXE0 D
..S OCXDATE=+$G(^OCXD(861,OCXE0,0))
..I 'OCXDATE K ^OCXD(861,OCXE0) Q
..I (OCXDATE<OCXKEEP) K ^OCXD(861,OCXE0) Q
..S ^OCXD(861,"B",OCXDATE,OCXE0)="",OCXE1=$G(OCXE1)+1
.S $P(^OCXD(861,1,0),U,2)=(+$H)
;
S OCXFIRST=$O(^OCXD(861,1))
S OCXLAST=$O(^OCXD(861," "),-1)
S OCXOVER=((OCXLAST-OCXFIRST)-200000)
;
I (OCXOVER>0) D
.S OCXE0=1 F OCXE1=1:1:OCXOVER S OCXE0=$O(^OCXD(861,OCXE0)) Q:'OCXE0 D
..S OCXDATE=$G(^OCXD(861,OCXE0,0))
..K ^OCXD(861,OCXE0)
..K ^OCXD(861,"B",OCXDATE,OCXE0)
;
F OCXFILE=860.7,861 I $L($G(^OCXD(OCXFILE,0))) D
.S OCXE0=0 F OCXCNT=0:1 S OCXE1=OCXE0,OCXE0=$O(^OCXD(OCXFILE,OCXE0)) Q:'OCXE0
.S ^OCXD(OCXFILE,0)=$P(^OCXD(OCXFILE,0),U,1,2)_U_OCXE1_U_OCXCNT
;
I '$O(^OCXD(860.7,0)) S ^OCXD(860.7,0)=$P(^OCXD(860.7,0),U,1,2)
I '$O(^OCXD(861,0)) S ^OCXD(861,0)=$P(^OCXD(861,0),U,1,2)
I $G(OCXE1),$O(^OCXD(861,0)) S ^OCXD(861,0)=$P(^OCXD(861,0),U,1,2)_U_$O(^OCXD(861," "),-1)_U_OCXE1
;
Q
;
DATE() ;
;
N X,Y,%DT
S X="N",%DT="T" D ^%DT X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2)
Q Y
;
DT(X) N Y,%DT S %DT="" D ^%DT Q Y+17000000
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOPURG 2679 printed Apr 09, 2024@21:28:29 Page 2
OCXOPURG ;SLC/RJS,CLA - Purge old Log and Patient Data ;4/02/02 08:38
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,143**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
EN ;
+1 ;
+2 NEW OCXE0,OCXE1,OCXE2,OCXS,OCXDFN,OCXCNT,OCXDATE,OCXRUL,OCXKEEP,OCXFILE
+3 NEW OCXFIRST,OCXLAST,OCXOVER
+4 ;
+5 ; Purge OCX namespaced entries in ^TMP that have expired.
+6 ;
+7 SET OCXS="OCX"
FOR
SET OCXS=$ORDER(^TMP(OCXS))
if '$LENGTH(OCXS)
QUIT
if '($EXTRACT(OCXS,1,3)="OCX")
QUIT
Begin DoDot:1
+8 SET OCXE0=0
FOR
SET OCXE0=$ORDER(^TMP(OCXS,OCXE0))
if '$LENGTH(OCXE0)
QUIT
Begin DoDot:2
+9 if ($GET(^TMP(OCXS,OCXE0))<($PIECE($HOROLOG,",",2)+($HOROLOG*86400)))
KILL ^TMP(OCXS,OCXE0)
End DoDot:2
End DoDot:1
+10 ;
+11 DO PURGE^OCXCACHE
+12 ;
+13 SET OCXDATE=0
FOR
SET OCXDATE=$ORDER(^OCXD(860.7,"AT",OCXDATE))
if 'OCXDATE
QUIT
IF (OCXDATE<($HOROLOG-5))
Begin DoDot:1
+14 SET OCXDFN=0
FOR
SET OCXDFN=$ORDER(^OCXD(860.7,"AT",OCXDATE,OCXDFN))
if 'OCXDFN
QUIT
Begin DoDot:2
+15 SET OCXRUL=0
FOR
SET OCXRUL=$ORDER(^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL))
if 'OCXRUL
QUIT
Begin DoDot:3
+16 NEW OCXNODE
+17 SET OCXNODE=$GET(^OCXD(860.7,OCXDFN,1,OCXRUL,0))
+18 IF ($PIECE(OCXNODE,U,2)=OCXDATE)
Begin DoDot:4
+19 KILL ^OCXD(860.7,OCXDFN,1,OCXRUL)
+20 KILL ^OCXD(860.7,OCXDFN,"B",OCXRUL,OCXRUL)
+21 IF '$ORDER(^OCXD(860.7,OCXDFN,1,0))
Begin DoDot:5
+22 KILL ^OCXD(860.7,OCXDFN)
+23 KILL ^OCXD(860.7,"B",OCXDFN,OCXDFN)
End DoDot:5
End DoDot:4
+24 KILL ^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL)
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 IF '($PIECE($GET(^OCXD(861,1,0)),U,1)="SITE PREFERENCES")
KILL ^OCXD(861,1)
SET ^OCXD(861,1,0)="SITE PREFERENCES"
+27 ;
+28 IF '($PIECE($GET(^OCXD(861,1,0)),U,2)=(+$HOROLOG))
Begin DoDot:1
+29 IF $LENGTH($TEXT(LOG^OCXOZ01))
IF $$LOG^OCXOZ01
SET OCXKEEP=$$DT("TODAY-"_(+$$LOG^OCXOZ01))
IF 1
+30 IF '$TEST
SET OCXKEEP=$$DT("TODAY-3")
+31 KILL ^OCXD(861,"B")
+32 SET OCXE1=0
SET OCXE0=1
FOR
SET OCXE0=$ORDER(^OCXD(861,OCXE0))
if 'OCXE0
QUIT
Begin DoDot:2
+33 SET OCXDATE=+$GET(^OCXD(861,OCXE0,0))
+34 IF 'OCXDATE
KILL ^OCXD(861,OCXE0)
QUIT
+35 IF (OCXDATE<OCXKEEP)
KILL ^OCXD(861,OCXE0)
QUIT
+36 SET ^OCXD(861,"B",OCXDATE,OCXE0)=""
SET OCXE1=$GET(OCXE1)+1
End DoDot:2
+37 SET $PIECE(^OCXD(861,1,0),U,2)=(+$HOROLOG)
End DoDot:1
+38 ;
+39 SET OCXFIRST=$ORDER(^OCXD(861,1))
+40 SET OCXLAST=$ORDER(^OCXD(861," "),-1)
+41 SET OCXOVER=((OCXLAST-OCXFIRST)-200000)
+42 ;
+43 IF (OCXOVER>0)
Begin DoDot:1
+44 SET OCXE0=1
FOR OCXE1=1:1:OCXOVER
SET OCXE0=$ORDER(^OCXD(861,OCXE0))
if 'OCXE0
QUIT
Begin DoDot:2
+45 SET OCXDATE=$GET(^OCXD(861,OCXE0,0))
+46 KILL ^OCXD(861,OCXE0)
+47 KILL ^OCXD(861,"B",OCXDATE,OCXE0)
End DoDot:2
End DoDot:1
+48 ;
+49 FOR OCXFILE=860.7,861
IF $LENGTH($GET(^OCXD(OCXFILE,0)))
Begin DoDot:1
+50 SET OCXE0=0
FOR OCXCNT=0:1
SET OCXE1=OCXE0
SET OCXE0=$ORDER(^OCXD(OCXFILE,OCXE0))
if 'OCXE0
QUIT
+51 SET ^OCXD(OCXFILE,0)=$PIECE(^OCXD(OCXFILE,0),U,1,2)_U_OCXE1_U_OCXCNT
End DoDot:1
+52 ;
+53 IF '$ORDER(^OCXD(860.7,0))
SET ^OCXD(860.7,0)=$PIECE(^OCXD(860.7,0),U,1,2)
+54 IF '$ORDER(^OCXD(861,0))
SET ^OCXD(861,0)=$PIECE(^OCXD(861,0),U,1,2)
+55 IF $GET(OCXE1)
IF $ORDER(^OCXD(861,0))
SET ^OCXD(861,0)=$PIECE(^OCXD(861,0),U,1,2)_U_$ORDER(^OCXD(861," "),-1)_U_OCXE1
+56 ;
+57 QUIT
+58 ;
DATE() ;
+1 ;
+2 NEW X,Y,%DT
+3 SET X="N"
SET %DT="T"
DO ^%DT
XECUTE ^DD("DD")
if (Y["@")
SET Y=$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
+4 QUIT Y
+5 ;
DT(X) NEW Y,%DT
SET %DT=""
DO ^%DT
QUIT Y+17000000
+1 ;
