LRAC8.m

LRAC8 ;SLC/DCM/MILW/JMC - REFORMAT ^LAC WHEN FILE 64.5 IS CHANGED ; 10/2/87  11:30 ;

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

 ;Routine will only go thru LAC global once instead of for each header changed.

ENT S LRDFN=0

 F  S LRDFN=$O(^LAC("LRAC",LRDFN)) Q:'LRDFN  D

 . S LRMH=0

 . F  S LRMH=$O(^LAB(64.5,"AZ",LRMH)) Q:'LRMH  D

 . . S LRSH=0

 . . F  S LRSH=$O(^LAB(64.5,"AZ",LRMH,LRSH)) Q:'LRSH  I $D(^LAC("LRAC",LRDFN,1,LRMH,1,LRSH)) D 

 . . . K ^LAC("LRAC",LRDFN,1,LRMH,1,LRSH)

 . . . I $O(^LAC("LRAC",LRDFN,1,LRMH,1,0))<1 K ^LAC("LRAC",LRDFN,1,LRMH) S $P(^LAC("LRAC",LRDFN,1,0),"^",3,4)=""

 K LRMH,LRSH,LRDFN,LRIDT,LRFDT,LRTF

 K ^LAB(64.5,"AZ")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAC8   657     printed  Apr 09, 2024@21:06:12                                                                                                                                                                                                        Page 2

LRAC8     ;SLC/DCM/MILW/JMC - REFORMAT ^LAC WHEN FILE 64.5 IS CHANGED ; 10/2/87  11:30 ;

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

 +2       ;Routine will only go thru LAC global once instead of for each header changed.

ENT        SET LRDFN=0

 +1        FOR 

               SET LRDFN=$ORDER(^LAC("LRAC",LRDFN))

               if 'LRDFN

                   QUIT 

               Begin DoDot:1

 +2                SET LRMH=0

 +3                FOR 

                       SET LRMH=$ORDER(^LAB(64.5,"AZ",LRMH))

                       if 'LRMH

                           QUIT 

                       Begin DoDot:2

 +4                        SET LRSH=0

 +5                        FOR 

                               SET LRSH=$ORDER(^LAB(64.5,"AZ",LRMH,LRSH))

                               if 'LRSH

                                   QUIT 

                               IF $DATA(^LAC("LRAC",LRDFN,1,LRMH,1,LRSH))

                                   Begin DoDot:3

 +6                                    KILL ^LAC("LRAC",LRDFN,1,LRMH,1,LRSH)

 +7                                    IF $ORDER(^LAC("LRAC",LRDFN,1,LRMH,1,0))<1

                                           KILL ^LAC("LRAC",LRDFN,1,LRMH)

                                           SET $PIECE(^LAC("LRAC",LRDFN,1,0),"^",3,4)=""

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +8        KILL LRMH,LRSH,LRDFN,LRIDT,LRFDT,LRTF

 +9        KILL ^LAB(64.5,"AZ")

 +10       QUIT