LRUCLR ;SLC/CJS/AVAMC/REG - CLEAN UP WORKLIST FILE ; 11/12/88  07:55 ;
 ;;5.2;LAB SERVICE;;Sep 27, 1994
 S U="^",%DT="",X="T-90" D ^%DT S LRSAVE=Y,LRAA=0
 W !!?20,"CLEAR WORKLISTS OVER 90 DAYS",!
WKL S LRAA=$O(^LRO(68,LRAA)) Q:'LRAA  D ASK Q:X["^"  G WKL
 Q
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)
 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)
 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)
 Q