source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUOPT4.m@ 952

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1HLUOPT4 ;OIFO-O/LJA - Purging Entries in file #772 and #773 ;02/04/2004 16:37
2 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13, 1995
3 ;
4 ; This routine was created by patch HL*1.6*109
5 ;
6SHOW120 ; Call SHOWXTMP with 30 second redisplay...
7 D SHOWXTMP(120)
8 QUIT
9 ;
10ASKSHOW ; Ask whether want to monitor purging job progress...
11 N ACTION,XTMP
12 S XTMP=$O(^XTMP("HLUOPT1 9999999.999999"),-1) QUIT:XTMP'["HLUOPT1 " ;->
13 W !!,"As purging jobs run, they record critical information in the ^XTMP global for"
14 W !,"later review. (This information is updated every two minutes.) You can view"
15 W !,"purge information now..."
16 F S ACTION=$$ACTION QUIT:'ACTION D
17 . I ACTION=1 D SHOWALL^HLUOPT5(XTMP)
18 . I ACTION=2 D SHOWXTMP(120)
19 . I ACTION=3 D
20 . . W @IOF
21 . . D GRAPH^HLUOPT5
22 . . S X=$$BTE^HLCSMON("Press RETURN to continue... ",1)
23 QUIT
24 ;
25ACTION() ;
26 N DIR,DIRUT,DTOUT,DUOUT,X,Y
27 S DIR(0)="S^1:Display all available purging data (full screen);2:Display purging summary (single line);3:Display purging graph;4:Exit."
28 S DIR("?",1)="Option #1 displays all available purging data, for the last job."
29 S DIR("?",2)=""
30 S DIR("?",3)="Option #2 displays the most valuable purging data, but not all data. This"
31 S DIR("?",4)="option includes data for the last purging job, plus previous puring jobs."
32 S DIR("?",5)=""
33 S DIR("?")="Option #3 displays purging times and totals in a graphic representation."
34 D ^DIR
35 QUIT $S(+Y=1:1,+Y=2:2,+Y=3:3,1:"")
36 ;
37SHOWXTMP(SEC) ; Continual redisplay of purging progress ever SEC seconds...
38 N ABORT,ACTIVE,HDR,IOINHI,IOINORM,X,XTMP
39 ;
40 S X="IOINHI;IOINORM" D ENDR^%ZISS
41 S HDR=" Task-Number Start-Time Timestamp Finish-time 772@ 773@ Time-NOW"
42 ;
43 ; Get last purging process' XTMP...
44 S XTMP=$O(^XTMP("HLUOPT1 9999999.999999"),-1)
45 S ACTIVE=0 ; Default...
46 I XTMP]"" S X=$P($G(^XTMP(XTMP,"RUN")),U,4) I X'?7N.E S ACTIVE=1
47 ;
48 ; Show last 10 runs...
49 D SHOWNUM($S(ACTIVE:9,1:18))
50 ;
51 ; Redisplay SEC defaults to 30...
52 S SEC=$S($G(SEC)>0:+SEC,1:30)
53 ;
54 ; What if no purging process exists?
55 I XTMP']""!('ACTIVE) D QUIT ;->
56 . W !!,"There is no currently running purge job..."
57 . S X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
58 ;
59 W !!,"Any old jobs that exist will be shown above. The current (or last) purge job"
60 W !,"is shown below. The information on each line will automatically refresh"
61 W !,"every ",SEC," seconds (or whenever you press RETURN.)"
62 W !!,IOINHI,"Note!!",IOINORM," Enter '^' when you are ready to exit."
63 W !!,"Current (or last) purge job..."
64 W !
65 S CT=0
66 ;
67 F D QUIT:ABORT
68 . S ABORT=1,CT=CT+1
69 . D LINERUN(XTMP)
70 . R X:SEC QUIT:X]"" ;-> Quit if they enter anything
71 . I CT>17 W ! S CT=0
72 . S ABORT=0
73 ;
74 QUIT
75 ;
76SHOWNUM(NUM) ; Show last NUM entries...
77 N CT,HOLD,XTMP
78 ; ACTIVE -- req
79 S XTMP="HLUOPT1 9999999.99999"
80 ; If last job is active, don't include it in array...
81 I ACTIVE S XTMP=$O(^XTMP(XTMP),-1) QUIT:XTMP'["HLUOPT1 " ;->
82 S CT=0
83 F S XTMP=$O(^XTMP(XTMP),-1) Q:(CT>(NUM-1))!(XTMP'["HLUOPT1 ") D
84 . S CT=CT+1
85 . S HOLD(XTMP)=""
86 QUIT:'$D(HOLD) ;->
87 W !!,"Recent purge runs..."
88 W !!,HDR,!,$$REPEAT^XLFSTR("-",IOM)
89 S XTMP=""
90 F S XTMP=$O(HOLD(XTMP)) Q:XTMP']"" D
91 . D LINERUN(XTMP)
92 QUIT
93 ;
94LINERUN(XTMP) ; Display one line...
95 N I,PCE1,PCE2,PCE3,PCE4,PCE5,PCE6,PCE7,PCE8,PCE9,PCE10,PCE11
96 N PCE12,PCE13,PCE14
97 S RUN=$G(^XTMP(XTMP,"RUN"))
98 F I=1:1:14 S @("PCE"_I)=$P(RUN,U,I)
99 S PCE2=$$SDT(PCE2),PCE3=$$SDT(PCE3),PCE4=$$SDT(PCE4)
100 I ($P(PCE2,"@"))=$$SDT(DT) S PCE3=" "_$P(PCE3,"@",2)
101 I ($P(PCE2,"@"))=$$SDT(DT) S PCE4=" "_$P(PCE4,"@",2)
102 I CT=1 W !,HDR,!,$$REPEAT^XLFSTR("-",IOM)
103 W !,$J(PCE1,12),?14,PCE2,?26,PCE3,?38,PCE4,?50,$J(PCE8,8)
104 W ?59,$J(PCE10,8)
105 W ?69,$$SDT($$NOW^XLFDT)
106 QUIT
107 ;
108SDT(DATE) ; Return shortened form of date...
109 I DATE?7N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7) ;->
110 I DATE?7N1"."1.N QUIT $E(DATE,4,5)_"/"_$E(DATE,6,7)_"@"_$E($P($$FMTE^XLFDT(DATE),"@",2),1,5)
111 QUIT ""
112 ;
113XTMPBEGN ; Initialize ^XTMP nodes for use in purging monitoring...
114 N NOW
115 S NOW=$$NOW^XLFDT,XTMP="HLUOPT1 "_NOW
116 S ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,14)_U_NOW_U_$G(DUZ)_U_"HLUOPT1 Purging"
117 S ^XTMP(XTMP,"RUN")=$G(ZTSK)_U_NOW_U_NOW_U_U_"RUNNING"_U_"XTMPBEGN"
118 QUIT
119 ;
120XTMPUPD(XTMP,STATUS,WHERE) ; Update the data in purging's ^XTMP...
121 N NOW,RUN
122 ;
123 ; Required variables...
124 S NOW=$$NOW^XLFDT
125 ;
126 ; Update node...
127 S RUN=$G(^XTMP(XTMP,"RUN"))
128 S $P(RUN,U,3)=$$NOW^XLFDT ; Timestamp
129 I STATUS="FINISHED"!(STATUS["ABORTED") S $P(RUN,U,4)=NOW ; Finish time
130 S $P(RUN,U,5)=STATUS ; Status
131 S $P(RUN,U,6)=WHERE ; Whereabouts
132 S $P(RUN,U,7)=$G(XTMP(772,"REV")) ; # 772 reviewed
133 S $P(RUN,U,8)=$G(XTMP(772,"DEL")) ; # 772 deleted
134 S $P(RUN,U,9)=$G(XTMP(773,"REV")) ; # 773 reviewed
135 S $P(RUN,U,10)=$G(XTMP(773,"DEL")) ;# 773 deleted
136 S $P(RUN,U,11)=$G(XTMP(772,"LAST")) ; Last 772 IEN
137 S $P(RUN,U,12)=$G(XTMP(772,"FAIL")) ; # failed purge check (in a row)
138 S $P(RUN,U,13)=$G(XTMP(773,"LAST")) ; Last 773 IEN
139 S $P(RUN,U,14)=$G(XTMP(773,"FAIL")) ; # failed purge check (in a row)
140 S $P(RUN,U,15)=$G(XTMP(772,"LAST","TIME")) ; Last 772s .01 time
141 S $P(RUN,U,16)=$G(XTMP(773,"LAST","TIME")) ; Last 773's 772s .01 time
142 S ^XTMP(XTMP,"RUN")=RUN
143 ;
144 QUIT
145 ;
146LOCKTELL ; Process is locked, so new purge job can't be started...
147 N X
148 W !!,"The '^HL(""HLUOPT1"")' lock is already owned by another purge job! So, this"
149 W !,"purge job cannot be started."
150 S X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
151 QUIT
152 ;
153INIT ; Moved here from HLUOPT1 (ran out of room)
154 ; If no data are stored in file 869.3, fields 41, 42, and 43,
155 ; the default number for these fields is 7, 30, 90, respectively.
156 N I,HLIEN,HLREC,HLDEF
157 S HLDEF="7^30^90^90"
158 S HLIEN=+$O(^HLCS(869.3,0))
159 S HLREC=$S(HLIEN:$G(^HLCS(869.3,HLIEN,4)),1:"")
160 F I=1:1:4 I '$P(HLREC,U,I) S $P(HLREC,U,I)=$P(HLDEF,U,I)
161 ;
162 ; If AWAITING ACK<COMPLETED -- or -- AWAITING ACK > ALL -- or -- PURGE < ALL use the default values (for an invalid date(s) has been entered into the paramters)
163 I $P(HLREC,U,2)<$P(HLREC,U,1)!($P(HLREC,U,3)<$P(HLREC,U,2))!($P(HLREC,U,3)>$P(HLREC,U,4)) D
164 . S HLREC=HLDEF
165 ;
166 I $D(ZTQUEUED) D Q
167 . S HLPDT("COMP")=$$FMADD^XLFDT(DT,-$P(HLREC,U,1))_.9
168 . S HLPDT("WAIT")=$$FMADD^XLFDT(DT,-$P(HLREC,U,2))_.9
169 . S HLPDT("ALL")=$$FMADD^XLFDT(DT,-$P(HLREC,U,3))_.9
170 . S HLPDT("ERR")=$$FMADD^XLFDT(DT,-$P(HLREC,U,4))_.9
171 ;
172 ; get input data from user
173 N DIR,X,Y,DIRUT
174 ; input cutoff date for "Successfully Completed" messages
175 S DIR(0)="D^:"_$$FMADD^XLFDT(DT,-1)_":EX"
176 S DIR("A",1)=" Enter inclusive date up to which to purge SUCCESSFULLY COMPLETED"
177 S DIR("A")=" messages"
178 S DIR("B")="T"_-$P(HLREC,U,1)
179 S DIR("?",1)=" The suggested cutoff date to purge 'Successfully Completed' messages"
180 S DIR("?",2)=" is seven days prior to today."
181 S DIR("?")=" Must be on or before "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-1),2)_"."
182 W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
183 S HLPDT("COMP")=Y
184 K DIR
185 ;
186 ; input cutoff date for "Awaiting Acknowledgement" messages
187 S DIR(0)="D^:"_HLPDT("COMP")_":EX"
188 S DIR("A",1)=" Enter inclusive date up to which to purge AWAITING ACK"
189 S DIR("A")=" messages"
190 S DIR("B")="T"_-$P(HLREC,U,2)
191 S DIR("?",1)=" The suggested cutoff date to purge 'Awaiting Acknowledgment' messages"
192 S DIR("?",2)=" is thirty days prior to today."
193 S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("COMP"),2)_"."
194 W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
195 S HLPDT("WAIT")=Y
196 K DIR
197 ;
198 ; Input for Vaporization Date
199 S DIR(0)="D^:"_HLPDT("WAIT")_":EX"
200 S DIR("A",1)=" Enter inclusive date up to which to purge all messages, regardless"
201 S DIR("A")=" of status (except ERROR status)"
202 S DIR("B")="T"_-$P(HLREC,U,3)
203 S DIR("?",1)=" The suggested cutoff date to purge all messages (except for 'Error' messages)"
204 S DIR("?",2)=" is 90 days prior to today."
205 S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
206 W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
207 S HLPDT("ALL")=Y+.9
208 K DIR
209 ;
210 ; prompt whether to purge "Error" messages
211 S DIR(0)="Y"
212 S DIR("A")=" Do you also want to purge messages with an ERROR status"
213 S DIR("B")="NO"
214 S DIR("?",1)=" Enter 'Yes' to purge entries whose status is 'error'."
215 S DIR("?",2)=" If you have reviewed/resolved the cause of the problem of those",DIR("?")=" entries with an 'error' status answer 'Yes'. Otherwise answer 'No'."
216 W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
217 K DIR
218 I 'Y S HLPDT("ERR")=0
219 E D Q:HLEXIT
220 . ; input cutoff date for "Error" messages
221 . S DIR(0)="D^:"_HLPDT("WAIT")_":EX"
222 . S DIR("A",1)=" WARNING: You should have investigated all errors because purging"
223 . S DIR("A",2)=" these messages permanently removes them from the system."
224 . S DIR("A",3)=" "
225 . S DIR("A",4)=" Enter inclusive date up to which to purge ERROR"
226 . S DIR("A")=" messages"
227 . S DIR("B")="T"_-$P(HLREC,U,4)
228 . S DIR("?",1)=" The suggested cutoff date to purge 'Error' messages"
229 . S DIR("?",2)=" is 90 days prior to today."
230 . S DIR("?")=" Must be on or before "_$$FMTE^XLFDT(HLPDT("WAIT"),2)_"."
231 . W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
232 . S HLPDT("ERR")=Y+.9
233 . K DIR
234 ;
235 ; prompt whether to run this purge in the background
236 S DIR(0)="YA"
237 S DIR("A")=" Would you like to queue this purge? "
238 S DIR("B")="YES"
239 S DIR("?")=" If run in the foreground, you will see dots and a total count."
240 W ! D ^DIR I $D(DIRUT) S HLEXIT=1 Q
241 S HLTASK=Y
242 K DIR
243 W !," "
244 ;
245 S HLPDT("COMP")=HLPDT("COMP")+.9,HLPDT("WAIT")=HLPDT("WAIT")+.9
246 Q
247 ;
248EOR ;HLUOPT4 - Purging Entries in file #772 and #773 ;12/10/02 16:37
Note: See TracBrowser for help on using the repository browser.