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