- 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 Feb 18, 2025@23:52:16 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 ;
