| 1 | OCXOPURG ;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 |  ;
 | 
|---|
| 5 | EN ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 64 | DATE() ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 70 | DT(X) N Y,%DT S %DT="" D ^%DT Q Y+17000000
 | 
|---|
| 71 |  ;
 | 
|---|