source: WorldVistAEHR/trunk/r/CAPACITY_MANAGEMENT_TOOLS-KMPD-KMPL/KMPDUTL3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1KMPDUTL3 ;OAK/RAK - CM Tools Utility ;2/17/04 10:53
2 ;;2.0;CAPACITY MANAGEMENT TOOLS;;Mar 22, 2002
3 ;
4PURGE(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 ;
25PURGE1 ;-- 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
Note: See TracBrowser for help on using the repository browser.