| [613] | 1 | LRUCLR ;SLC/CJS/AVAMC/REG - CLEAN UP WORKLIST FILE ; 11/12/88 07:55 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | S U="^",%DT="",X="T-90" D ^%DT S LRSAVE=Y,LRAA=0
|
|---|
| 4 | W !!?20,"CLEAR WORKLISTS OVER 90 DAYS",!
|
|---|
| 5 | WKL S LRAA=$O(^LRO(68,LRAA)) Q:'LRAA D ASK Q:X["^" G WKL
|
|---|
| 6 | Q
|
|---|
| 7 | ASK Q:$P(^LRO(68,LRAA,0),U,3)'="D" W !,"CLEAR ",$P(^LRO(68,LRAA,0),U)," WORKLIST " S %=2 Q:%'=1 S LRAA(1)=$P(^LRO(68,LRAA,0),U,1)
|
|---|
| 8 | S DA=0 F B=0:1 S DA=$O(^LRO(68,LRAA,1,DA)) Q:'DA!(DA>LRSAVE) S Y=DA D D^LRU W !?5,Y," DELETED" K ^LRO(68,LRAA,1,DA)
|
|---|
| 9 | S:$D(^LRO(68,LRAA,1,0))#2 ^LRO(68,LRAA,1,0)=$P(^LRO(68,LRAA,1,0),U,1,2)_"^^"_($P(^LRO(68,LRAA,1,0),U,4)-B)
|
|---|
| 10 | Q
|
|---|
