source: FOIAVistA/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDFPRG.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1IBDFPRG ;ALB/AAS - AICS PURGE UTILITY ; 4-OCT-95
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
3 ;
4% ; -- purge utility for purging entries from the
5 ; Form Definition file (357.95)
6 ; Form Tracking file (357.96)
7 ; Form Specification file (359.2)
8 ; AICS Error Log file (359.3)
9 ;
10MANUAL ; -- Option to purge records, ask input
11 N IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBD,IBHOW,IBLDT,IBDAYS,IBPURGE,IBQUIT,DIR,DIRUT,DUOUT,X,Y,IBLOG,D0,DA,D,ZTSK
12 I '$D(DT) D DT^DICRW
13 ;
14 S IBQUIT=0
15 D ASK
16 Q:IBQUIT
17 S IBLDT=$$FMADD^XLFDT(DT,-IBDAYS)
18 S ZTSAVE("IB*")="",ZTRTN="DQ^IBDFPRG",ZTDESC="IBD - Manual Purge of form tracking",ZTIO="" D ^%ZTLOAD
19 W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS S IBQUIT=1 Q
20 Q
21 ;
22DQ ; -- entry point from manual task
23 S IBLOG=$$ADD
24 I IBPURGE("FT") D PURGFT^IBDFPRG1(IBLDT,IBHOW),PURGEL^IBDFPRG1(IBLDT)
25 I IBPURGE("FD") D PURGFD^IBDFPRG1(IBLDT)
26 D OUTPUT
27 G EXIT
28 Q
29 ;
30EXIT ; -- exit for all modes
31 I $D(ZTQUEUED) S ZTREQ="@"
32 Q
33 ;
34AUTO ; -- Background option to automatically purge records
35 N X,Y,IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBLDT,IBHOW,IBD,IBLOG,D0,DA,D
36 I '$D(DT) D DT^DICRW
37 ;
38 ; -- if parameters not defined don't run
39 I $P($G(^IBD(357.09,1,0)),"^",3)=""!($P($G(^IBD(357.09,1,0)),"^",2)="") G AUTOQ
40 S IBHOW=$P($G(^IBD(357.09,1,0)),"^",2)
41 ;
42 ; -- Compute last date to purge records
43 S IBLDT=$$FMADD^XLFDT(DT,-$P($G(^IBD(357.09,1,0)),"^",3))
44 S IBLOG=$$ADD
45 ;
46 ; -- purge all entries in form tracking according to parameters
47 D PURGFT^IBDFPRG1(IBLDT,+$P($G(^IBD(357.09,1,0)),"^",2))
48 ;
49 ; -- purge form definition entries only if marked for deletion
50 ; and all entries are complete
51 D PURGFD^IBDFPRG1(IBLDT)
52 ;
53 ; -- purge entries from AICS ERROR LOG (359.3)
54 D PURGEL^IBDFPRG1(IBLDT)
55 ;
56 D OUTPUT
57 G EXIT
58 ;
59AUTOQ Q
60 ;
61ADD() ; -- add new entry to purge log
62 N DIC,DLAYGO
63 S Y=-1
64 I $G(^IBD(357.08,0))'="" S X=$$NOW^XLFDT,DIC="^IBD(357.08,",DIC(0)="L",DLAYGO=357.08 D FILE^DICN
65ADDQ Q +Y
66 ;
67EDIT ; -- update entry after running
68 N DIC,DIE,DA,DR,X,Y
69 I IBLOG<1!($G(^IBD(357.08,+IBLOG,0))="") Q
70 S DIE="^IBD(357.08,",DA=IBLOG
71 S DR=".02////"_$G(IBHOW)_";.03////"_$G(IBLDT)_";.04////"_$G(IBCNT6)_";.05////"_$G(IBCNT5)_";.06////"_$G(IBCNT2)_";.07////"_$G(IBCNT7)
72 D ^DIE
73 Q
74 ;
75OUTPUT ; -- output results of purge
76 ;
77 S IBD(1)="Purge of Form Tracking Statistics"
78 S IBD(2)="Status of Form Tracking Entries Purged .......... "_$S(+$G(IBHOW)=0:"None",$G(IBHOW)=1:"Completed",$G(IBHOW)=2:"All",1:"None")
79 S IBD(3)="Form Tracking entries purged upto ............... "_$$FMTE^XLFDT($G(IBLDT))
80 S IBD(4)="Number of Form tracking Entries Deleted ......... "_$G(IBCNT6)
81 S IBD(5)="Number of Form Definition Entries Deleted ....... "_$G(IBCNT5)
82 S IBD(6)="Number of Form Specification Entries Deleted .... "_$G(IBCNT2)
83 S IBD(7)="Number of AICS Error Log Entries Deleted ........ "_$G(IBCNT7)
84 D EDIT,SEND
85 ;
86 I '$D(ZTQUEUED) S X="" F S X=$O(IBD(X)) Q:'X W !,IBD(X)
87 Q
88 ;
89ASK ; -- ask what to purge
90 ; Output : ibpurge("ft") := 1=yes purge form tracking, 0=no
91 ; ibpurge("fd") := 1=yes purge form definition, 0=no
92 ;
93 N DIR
94 S IBPURGE("FD")=0,IBPURGE("FT")=0
95 ;
96 S DIR(0)="Y"
97 S DIR("?")="Answer YES if you want to purge Form Tracking of unneeded records"
98 W !!!,"Do you want to purge Form Tracking?"
99 D ^DIR
100 I $D(DIRUT) S IBQUIT=1 Q
101 S IBPURGE("FT")=+Y
102 ;
103 K DIR
104 S DIR(0)="Y"
105 S DIR("?")="Answer YES if you want to purge Form Defintions of unneeded records"
106 W !!,"Do you want to purge Form Definitions and Form Specifications?"
107 D ^DIR
108 I $D(DIRUT) S IBQUIT=1 Q
109 S IBPURGE("FD")=+Y
110 ;
111 ; -- if the user wants to purge form tracking get needed parms
112 I IBPURGE("FT")!(IBPURGE("FD")) D ASKN,ASKH
113 I 'IBPURGE("FT"),'IBPURGE("FD") S IBQUIT=1
114 Q
115 ;
116ASKN ; -- ask number of days to retain
117 ; Output : IBDAYS := number of days to retain
118 ;
119 N DIR
120 S IBDAYS=-1
121 S DIR(0)="N^60:999:0"
122 S DIR("A")="Number of Days to Retain"
123 S DIR("B")=+$P($G(^IBD(357.09,1,0)),"^",3)
124 S DIR("?")="Enter the number of days of form tracking data to retain"
125 D ^DIR
126 I $D(DIRUT) S IBQUIT=1 Q
127 S IBDAYS=+Y
128 Q
129 ;
130ASKH ; -- ask how to purge
131 ; Output : IBHOW := 0=none, 1=complete, 2=all
132 ;
133 N DIR
134 S IBHOW=-1
135 S DIR(0)="S^0:None;1:Purge Completed Entries;2:Purge All Entries"
136 S DIR("A")="Purge what Entries"
137 S DIR("B")=+$P($G(^IBD(357.09,1,0)),"^",2)
138 S DIR("?")="Choose whether you want to purge only completed entries or whether to purge all entries"
139 D ^DIR
140 I $D(DIRUT) S IBQUIT=1 Q
141 S IBHOW=+Y
142 Q
143 ;
144SEND ; -- send mail message to group if defined
145 N IBDGRP,XMDUZ,XMTEXT,XMY,XMSUB,XMZ
146 S XMDUZ="AICS PACKAGE",XMTEXT="IBD(",XMSUB="AICS PURGE RESULTS"
147 K XMY S XMN=0
148 S IBDGRP=$$GET1^DIQ(3.8,+$P($G(^IBD(357.09,1,1)),"^"),.01)
149 ;S IBDGRP=$P($G(^XMB(3.8,+$P($G(^IBD(357.09,1,1)),"^"),0)),"^")
150 Q:IBDGRP=""
151 S XMY("G."_IBDGRP_"@"_^XMB("NETNAME"))=""
152 D ^XMD
153 Q
Note: See TracBrowser for help on using the repository browser.