LRACFIX.m

LRACFIX ; IHS/DIR/FJE - REBUILD ^LRO(68,"AC") FROM A GIVEN DATE AFTER ALL LRAC X-REF ARE REINITIALIZED. 5/30/86 2:47 PM ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;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

LRACFIX   ; IHS/DIR/FJE - REBUILD ^LRO(68,"AC") FROM A GIVEN DATE AFTER ALL LRAC X-REF ARE REINITIALIZED. 5/30/86 2:47 PM ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        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