[613] | 1 | KMPDUTL3 ;OAK/RAK - CM Tools Utility ;2/17/04 10:53
|
---|
| 2 | ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
|
---|
| 3 | ;
|
---|
| 4 | PURGE(KMPDT) ;-- purge data in file #8973.1
|
---|
| 5 | ;-----------------------------------------------------------------------
|
---|
| 6 | ; KMPDT.. Date to begin purge in internal fileman format. Purge will
|
---|
| 7 | ; reverse $order and delete entries 'EARLIER' than KMPDT.
|
---|
| 8 | ;-----------------------------------------------------------------------
|
---|
| 9 | ;
|
---|
| 10 | Q:'$G(KMPDT)
|
---|
| 11 | ;
|
---|
| 12 | N DA,DATE,DIK,IEN
|
---|
| 13 | W:'$D(ZTQUEUED) !!,"Purging old records..."
|
---|
| 14 | S DATE=KMPDT
|
---|
| 15 | F S DATE=$O(^KMPD(8973.1,"B",DATE),-1) Q:'DATE!(DATE>KMPDT) D
|
---|
| 16 | .F IEN=0:0 S IEN=$O(^KMPD(8973.1,"B",DATE,IEN)) Q:'IEN D
|
---|
| 17 | ..; quit if not 'sent to cm database'.
|
---|
| 18 | ..Q:'$P($G(^KMPD(8973.1,IEN,0)),U,2)
|
---|
| 19 | ..I '$D(ZTQUEUED) W:$X>78 !?16 W "."
|
---|
| 20 | ..; Delete entry.
|
---|
| 21 | ..S DA=IEN,DIK="^KMPD(8973.1," D ^DIK
|
---|
| 22 | ;
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | PURGE1 ;-- purge data in file #8973.2
|
---|
| 26 | ;
|
---|
| 27 | N DA,DATE,DAYS,DIK,IEN,PURGE
|
---|
| 28 | ;
|
---|
| 29 | ; days to keep data (weeks * 7)
|
---|
| 30 | S DAYS=$P($G(^KMPD(8973,1,4)),U,11)
|
---|
| 31 | S:'DAYS DAYS=4 S DAYS=DAYS*7
|
---|
| 32 | ; determine date to start purge
|
---|
| 33 | S PURGE=$$FMADD^XLFDT(DT,-DAYS) Q:'PURGE
|
---|
| 34 | W:'$D(ZTQUEUED) !!,"Purging old records..."
|
---|
| 35 | S DATE=PURGE-.1
|
---|
| 36 | F S DATE=$O(^KMPD(8973.2,"C",DATE),-1) Q:'DATE!(DATE>PURGE) D
|
---|
| 37 | .F IEN=0:0 S IEN=$O(^KMPD(8973.2,"C",DATE,IEN)) Q:'IEN D
|
---|
| 38 | ..Q:'$D(^KMPD(8973.2,IEN,0))
|
---|
| 39 | ..W:'$D(ZTQUEUED)&('(IEN#10)) "."
|
---|
| 40 | ..; delete entry.
|
---|
| 41 | ..S DA=IEN,DIK="^KMPD(8973.2," D ^DIK
|
---|
| 42 | ;
|
---|
| 43 | Q
|
---|