| [613] | 1 | HLUOPT4 ;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 | ;
|
|---|
| 6 | SHOW120 ; Call SHOWXTMP with 30 second redisplay...
|
|---|
| 7 | D SHOWXTMP(120)
|
|---|
| 8 | QUIT
|
|---|
| 9 | ;
|
|---|
| 10 | ASKSHOW ; 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 | ;
|
|---|
| 25 | ACTION() ;
|
|---|
| 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 | ;
|
|---|
| 37 | SHOWXTMP(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 | ;
|
|---|
| 76 | SHOWNUM(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 | ;
|
|---|
| 94 | LINERUN(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 | ;
|
|---|
| 108 | SDT(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 | ;
|
|---|
| 113 | XTMPBEGN ; 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 | ;
|
|---|
| 120 | XTMPUPD(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 | ;
|
|---|
| 146 | LOCKTELL ; 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 | ;
|
|---|
| 153 | INIT ; 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 | ;
|
|---|
| 248 | EOR ;HLUOPT4 - Purging Entries in file #772 and #773 ;12/10/02 16:37
|
|---|
