| 1 | LRAPBS2 ;AVAMC/REG - BLOCK/SLIDE DATA ENTRY ;2/6/92 19:19 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | ;put date stained/block prepared/gross cutting in lab data file
|
|---|
| 4 | I $D(LRF) D C Q
|
|---|
| 5 | F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A F B=0:0 S B=$O(^LR(LRDFN,LRSS,LRI,.1,A,B)) Q:'B F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,.1,A,B,C)) Q:'C D:$D(LRK(1)) BLK D X
|
|---|
| 6 | Q
|
|---|
| 7 | X F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,.1,A,B,C,1,E)) Q:'E S:'$P(^(E,0),"^",4) $P(^(0),"^",4)=LRK
|
|---|
| 8 | Q
|
|---|
| 9 | BLK S:'$P(^LR(LRDFN,LRSS,LRI,.1,A,B,C,0),"^",2) $P(^(0),"^",2)=LRK(1) Q
|
|---|
| 10 | ;
|
|---|
| 11 | C F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A S:'$P(^(A,0),"^",3) $P(^(0),"^",3)=LRK
|
|---|
| 12 | Q
|
|---|
| 13 | EN ;
|
|---|
| 14 | G:LRSS'="AU" LRAPBS2
|
|---|
| 15 | ;put date autopsy blocks/stains prepared in lab data file
|
|---|
| 16 | F A=0:0 S A=$O(^LR(LRDFN,33,A)) Q:'A F B=0:0 S B=$O(^LR(LRDFN,33,A,B)) Q:'B F C=0:0 S C=$O(^LR(LRDFN,33,A,B,C)) Q:'C D:$D(LRK(1)) AUBLK D AUX
|
|---|
| 17 | Q
|
|---|
| 18 | AUX F E=0:0 S E=$O(^LR(LRDFN,33,A,B,C,1,E)) Q:'E S:'$P(^(E,0),"^",4) $P(^(0),"^",4)=LRK
|
|---|
| 19 | Q
|
|---|
| 20 | AUBLK S:'$P(^LR(LRDFN,33,A,B,C,0),"^",2) $P(^(0),"^",2)=LRK(1) Q
|
|---|
