LRACFIX ;SLC/DCM - REBUILD ^LRO(68,"AC") FROM A GIVEN DATE AFTER ALL LRAC X-REF ARE REINITIALIZED. ; 5/30/86 2:47 PM ;
;;5.2;LAB SERVICE;;Sep 27, 1994
S %DT("A")="ENTER STARTING DATE FOR REINITIALIZATION: ",%DT="QEA" D ^%DT Q:Y<1 S LRXDT=9999999-Y D LRDFN
END W !!,"DONE" Q
LRDFN S LRDFN=0 F S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1 D LRIDT
Q:'$D(^LR(LRDFN,"MI")) S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LRXDT) S:'$D(^LRO(68,"MI",LRDFN,LRIDT)) ^(LRIDT)="" W ":"
Q
LRIDT Q:'$D(^LR(LRDFN,"CH")) S LRIDT=0 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D LRSB
Q
LRSB S $P(^LR(LRDFN,"CH",LRIDT,0),U,9)=$S(LRIDT>LRXDT:"1:0",1:"") Q:LRIDT>LRXDT
S LRSB=1 F S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1 D SB1
Q
SB1 I '$D(^LRO(68,"AC",LRDFN,LRIDT,LRSB)) S ^(LRSB)="" W "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRACFIX 816 printed Nov 22, 2024@17:16:23 Page 2
LRACFIX ;SLC/DCM - REBUILD ^LRO(68,"AC") FROM A GIVEN DATE AFTER ALL LRAC X-REF ARE REINITIALIZED. ; 5/30/86 2:47 PM ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 SET %DT("A")="ENTER STARTING DATE FOR REINITIALIZATION: "
SET %DT="QEA"
DO ^%DT
if Y<1
QUIT
SET LRXDT=9999999-Y
DO LRDFN
END WRITE !!,"DONE"
QUIT
LRDFN SET LRDFN=0
FOR
SET LRDFN=$ORDER(^LR(LRDFN))
if LRDFN<1
QUIT
DO LRIDT
+1 if '$DATA(^LR(LRDFN,"MI"))
QUIT
SET LRIDT=0
FOR
SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))
if LRIDT<1!(LRIDT>LRXDT)
QUIT
if '$DATA(^LRO(68,"MI",LRDFN,LRIDT))
SET ^(LRIDT)=""
WRITE ":"
+2 QUIT
LRIDT if '$DATA(^LR(LRDFN,"CH"))
QUIT
SET LRIDT=0
FOR
SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))
if LRIDT<1
QUIT
DO LRSB
+1 QUIT
LRSB SET $PIECE(^LR(LRDFN,"CH",LRIDT,0),U,9)=$SELECT(LRIDT>LRXDT:"1:0",1:"")
if LRIDT>LRXDT
QUIT
+1 SET LRSB=1
FOR
SET LRSB=$ORDER(^LR(LRDFN,"CH",LRIDT,LRSB))
if LRSB<1
QUIT
DO SB1
+2 QUIT
SB1 IF '$DATA(^LRO(68,"AC",LRDFN,LRIDT,LRSB))
SET ^(LRSB)=""
WRITE "."
+1 QUIT
