44 lines
1.4 KiB
Mathematica
44 lines
1.4 KiB
Mathematica
|
KMPDUTL3 ;OAK/RAK - CM Tools Utility ;2/17/04 10:53
|
||
|
|
;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
|
||
|
|
;
|
||
|
|
PURGE(KMPDT) ;-- purge data in file #8973.1
|
||
|
|
;-----------------------------------------------------------------------
|
||
|
|
; KMPDT.. Date to begin purge in internal fileman format. Purge will
|
||
|
|
; reverse $order and delete entries 'EARLIER' than KMPDT.
|
||
|
|
;-----------------------------------------------------------------------
|
||
|
|
;
|
||
|
|
Q:'$G(KMPDT)
|
||
|
|
;
|
||
|
|
N DA,DATE,DIK,IEN
|
||
|
|
W:'$D(ZTQUEUED) !!,"Purging old records..."
|
||
|
|
S DATE=KMPDT
|
||
|
|
F S DATE=$O(^KMPD(8973.1,"B",DATE),-1) Q:'DATE!(DATE>KMPDT) D
|
||
|
|
.F IEN=0:0 S IEN=$O(^KMPD(8973.1,"B",DATE,IEN)) Q:'IEN D
|
||
|
|
..; quit if not 'sent to cm database'.
|
||
|
|
..Q:'$P($G(^KMPD(8973.1,IEN,0)),U,2)
|
||
|
|
..I '$D(ZTQUEUED) W:$X>78 !?16 W "."
|
||
|
|
..; Delete entry.
|
||
|
|
..S DA=IEN,DIK="^KMPD(8973.1," D ^DIK
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PURGE1 ;-- purge data in file #8973.2
|
||
|
|
;
|
||
|
|
N DA,DATE,DAYS,DIK,IEN,PURGE
|
||
|
|
;
|
||
|
|
; days to keep data (weeks * 7)
|
||
|
|
S DAYS=$P($G(^KMPD(8973,1,4)),U,11)
|
||
|
|
S:'DAYS DAYS=4 S DAYS=DAYS*7
|
||
|
|
; determine date to start purge
|
||
|
|
S PURGE=$$FMADD^XLFDT(DT,-DAYS) Q:'PURGE
|
||
|
|
W:'$D(ZTQUEUED) !!,"Purging old records..."
|
||
|
|
S DATE=PURGE-.1
|
||
|
|
F S DATE=$O(^KMPD(8973.2,"C",DATE),-1) Q:'DATE!(DATE>PURGE) D
|
||
|
|
.F IEN=0:0 S IEN=$O(^KMPD(8973.2,"C",DATE,IEN)) Q:'IEN D
|
||
|
|
..Q:'$D(^KMPD(8973.2,IEN,0))
|
||
|
|
..W:'$D(ZTQUEUED)&('(IEN#10)) "."
|
||
|
|
..; delete entry.
|
||
|
|
..S DA=IEN,DIK="^KMPD(8973.2," D ^DIK
|
||
|
|
;
|
||
|
|
Q
|