| [613] | 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 | ;
|
|---|
