| 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 | 
|---|