LRUDIT ; IHS/DIR/FJE - DATA CHANGE AUDIT 4/19/89 14:25 ;
;;5.2;LR;**1013**;JUL 15, 2002
;
;;5.2;LAB SERVICE;;Sep 27, 1994
EN D END S (BY,FLDS)="[LRUCNG]",L=0,DIC="^LRO(69.2," K IOP G EN1^DIP
;
EN1 ;from LRBLS,LRMIS
G:'$D(LRAA)#2 END W !!,"Delete ",LRAA(1)," data change audits",!
D B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.00001
W !!,"OK to delete audits" S %=2 D YN^LRU G:%'=1 END
W ! S X=LRSDT F A=0:1 S X=$O(^LRO(69.2,LRAA,999,X)) Q:'X!(X>LRLDT) W:A#10=0 "." K ^LRO(69.2,LRAA,999,X)
I A S X(1)=$O(^LRO(69.2,LRAA,999,0)) S:'X(1) X(1)=0 L +^LRO(69.2,LRAA,999) S X=^LRO(69.2,LRAA,999,0),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)=0:X(1),1:($P(X,"^",4)-A)) L -^LRO(69.2,LRAA,999)
W $C(7),!,"DONE" G END
;
END D V^LRU Q
LRUDIT ; IHS/DIR/FJE - DATA CHANGE AUDIT 4/19/89 14:25 ;
+1 ;;5.2;LR;**1013**;JUL 15, 2002
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN DO END
SET (BY,FLDS)="[LRUCNG]"
SET L=0
SET DIC="^LRO(69.2,"
KILL IOP
GOTO EN1^DIP
+1 ;
EN1 ;from LRBLS,LRMIS
+1 IF '$DATA(LRAA)#2
GOTO END
WRITE !!,"Delete ",LRAA(1)," data change audits",!
+2 DO B^LRU
IF Y<0
GOTO END
SET LRLDT=LRLDT+.99
SET LRSDT=LRSDT-.00001
+3 WRITE !!,"OK to delete audits"
SET %=2
DO YN^LRU
IF %'=1
GOTO END
+4 WRITE !
SET X=LRSDT
FOR A=0:1
SET X=$ORDER(^LRO(69.2,LRAA,999,X))
IF 'X!(X>LRLDT)
QUIT
IF A#10=0
WRITE "."
KILL ^LRO(69.2,LRAA,999,X)
+5 IF A
SET X(1)=$ORDER(^LRO(69.2,LRAA,999,0))
IF 'X(1)
SET X(1)=0
LOCK +^LRO(69.2,LRAA,999)
SET X=^LRO(69.2,LRAA,999,0)
SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(1)_"^"_$SELECT(X(1)=0:X(1),1:($PIECE(X,"^",4)-A))
LOCK -^LRO(69.2,LRAA,999)
+6 WRITE $CHAR(7),!,"DONE"
GOTO END
+7 ;
END DO V^LRU
QUIT