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 ---[H[J[2J[HLRAC8 657 printed Dec 13, 2024@02: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
