[613] | 1 | LRAC8 ;SLC/DCM/MILW/JMC - REFORMAT ^LAC WHEN FILE 64.5 IS CHANGED ; 10/2/87 11:30 ;
|
---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
---|
| 3 | ;Routine will only go thru LAC global once instead of for each header changed.
|
---|
| 4 | ENT S LRDFN=0
|
---|
| 5 | F S LRDFN=$O(^LAC("LRAC",LRDFN)) Q:'LRDFN D
|
---|
| 6 | . S LRMH=0
|
---|
| 7 | . F S LRMH=$O(^LAB(64.5,"AZ",LRMH)) Q:'LRMH D
|
---|
| 8 | . . S LRSH=0
|
---|
| 9 | . . F S LRSH=$O(^LAB(64.5,"AZ",LRMH,LRSH)) Q:'LRSH I $D(^LAC("LRAC",LRDFN,1,LRMH,1,LRSH)) D
|
---|
| 10 | . . . K ^LAC("LRAC",LRDFN,1,LRMH,1,LRSH)
|
---|
| 11 | . . . 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)=""
|
---|
| 12 | K LRMH,LRSH,LRDFN,LRIDT,LRFDT,LRTF
|
---|
| 13 | K ^LAB(64.5,"AZ")
|
---|
| 14 | Q
|
---|