source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOPURG.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1OCXOPURG ;SLC/RJS,CLA - Purge old Log and Patient Data ;4/02/02 08:38
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,143**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5EN ;
6 ;
7 N OCXE0,OCXE1,OCXE2,OCXS,OCXDFN,OCXCNT,OCXDATE,OCXRUL,OCXKEEP,OCXFILE
8 N OCXFIRST,OCXLAST,OCXOVER
9 ;
10 ; Purge OCX namespaced entries in ^TMP that have expired.
11 ;
12 S OCXS="OCX" F S OCXS=$O(^TMP(OCXS)) Q:'$L(OCXS) Q:'($E(OCXS,1,3)="OCX") D
13 .S OCXE0=0 F S OCXE0=$O(^TMP(OCXS,OCXE0)) Q:'$L(OCXE0) D
14 ..K:($G(^TMP(OCXS,OCXE0))<($P($H,",",2)+($H*86400))) ^TMP(OCXS,OCXE0)
15 ;
16 D PURGE^OCXCACHE
17 ;
18 S OCXDATE=0 F S OCXDATE=$O(^OCXD(860.7,"AT",OCXDATE)) Q:'OCXDATE I (OCXDATE<($H-5)) D
19 .S OCXDFN=0 F S OCXDFN=$O(^OCXD(860.7,"AT",OCXDATE,OCXDFN)) Q:'OCXDFN D
20 ..S OCXRUL=0 F S OCXRUL=$O(^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL)) Q:'OCXRUL D
21 ...N OCXNODE
22 ...S OCXNODE=$G(^OCXD(860.7,OCXDFN,1,OCXRUL,0))
23 ...I ($P(OCXNODE,U,2)=OCXDATE) D
24 ....K ^OCXD(860.7,OCXDFN,1,OCXRUL)
25 ....K ^OCXD(860.7,OCXDFN,"B",OCXRUL,OCXRUL)
26 ....I '$O(^OCXD(860.7,OCXDFN,1,0)) D
27 .....K ^OCXD(860.7,OCXDFN)
28 .....K ^OCXD(860.7,"B",OCXDFN,OCXDFN)
29 ...K ^OCXD(860.7,"AT",OCXDATE,OCXDFN,OCXRUL)
30 ;
31 I '($P($G(^OCXD(861,1,0)),U,1)="SITE PREFERENCES") K ^OCXD(861,1) S ^OCXD(861,1,0)="SITE PREFERENCES"
32 ;
33 I '($P($G(^OCXD(861,1,0)),U,2)=(+$H)) D
34 .I $L($T(LOG^OCXOZ01)),$$LOG^OCXOZ01 S OCXKEEP=$$DT("TODAY-"_(+$$LOG^OCXOZ01)) I 1
35 .E S OCXKEEP=$$DT("TODAY-3")
36 .K ^OCXD(861,"B")
37 .S OCXE1=0,OCXE0=1 F S OCXE0=$O(^OCXD(861,OCXE0)) Q:'OCXE0 D
38 ..S OCXDATE=+$G(^OCXD(861,OCXE0,0))
39 ..I 'OCXDATE K ^OCXD(861,OCXE0) Q
40 ..I (OCXDATE<OCXKEEP) K ^OCXD(861,OCXE0) Q
41 ..S ^OCXD(861,"B",OCXDATE,OCXE0)="",OCXE1=$G(OCXE1)+1
42 .S $P(^OCXD(861,1,0),U,2)=(+$H)
43 ;
44 S OCXFIRST=$O(^OCXD(861,1))
45 S OCXLAST=$O(^OCXD(861," "),-1)
46 S OCXOVER=((OCXLAST-OCXFIRST)-200000)
47 ;
48 I (OCXOVER>0) D
49 .S OCXE0=1 F OCXE1=1:1:OCXOVER S OCXE0=$O(^OCXD(861,OCXE0)) Q:'OCXE0 D
50 ..S OCXDATE=$G(^OCXD(861,OCXE0,0))
51 ..K ^OCXD(861,OCXE0)
52 ..K ^OCXD(861,"B",OCXDATE,OCXE0)
53 ;
54 F OCXFILE=860.7,861 I $L($G(^OCXD(OCXFILE,0))) D
55 .S OCXE0=0 F OCXCNT=0:1 S OCXE1=OCXE0,OCXE0=$O(^OCXD(OCXFILE,OCXE0)) Q:'OCXE0
56 .S ^OCXD(OCXFILE,0)=$P(^OCXD(OCXFILE,0),U,1,2)_U_OCXE1_U_OCXCNT
57 ;
58 I '$O(^OCXD(860.7,0)) S ^OCXD(860.7,0)=$P(^OCXD(860.7,0),U,1,2)
59 I '$O(^OCXD(861,0)) S ^OCXD(861,0)=$P(^OCXD(861,0),U,1,2)
60 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
61 ;
62 Q
63 ;
64DATE() ;
65 ;
66 N X,Y,%DT
67 S X="N",%DT="T" D ^%DT X ^DD("DD") S:(Y["@") Y=$P(Y,"@",1)_" at "_$P(Y,"@",2)
68 Q Y
69 ;
70DT(X) N Y,%DT S %DT="" D ^%DT Q Y+17000000
71 ;
Note: See TracBrowser for help on using the repository browser.