| [613] | 1 | LRAPST1 ;AVAMC/REG/WTY - AUTOPSY TISSUE STAIN LOOK-UP ;9/25/00
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,248**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | F A=0:0 S A=$O(^LR(LRDFN,33,A)) Q:'A!(LRM[U) S LRB=^(A,0) D:$Y>(IOSL-3) M^LRAPST Q:LRM[U W !,$P(LRB,U) D A
|
|---|
| 5 | W ! Q
|
|---|
| 6 | A F E=0:0 S E=$O(^LR(LRDFN,33,A,E)) Q:'E!(LRM[U) S B=0 F F=1:1 S B=$O(^LR(LRDFN,33,A,E,B)) Q:'B!(LRM[U) S LRB(1)=^(B,0) D:$Y>(IOSL-3) M^LRAPST Q:LRM[U D T
|
|---|
| 7 | Q
|
|---|
| 8 | T W:F=1 !,LRSS(LRSS,E) W !?3,$P(LRB(1),U),?21,"Stain/Procedure" S Y=$P(LRB(1),U,2) D D^LRU W ?59,Y
|
|---|
| 9 | F C=0:0 S C=$O(^LR(LRDFN,33,A,E,B,1,C)) Q:'C!(LRM[U) S Y=^(C,0),X=$P(Y,U,2),Z=$P(Y,U,3) D:$Y>(IOSL-3) M^LRAPST Q:LRM[U D W
|
|---|
| 10 | Q
|
|---|
| 11 | W W !?16,$S($D(^LAB(60,C,0)):$P(^(0),U),1:C),?47 W:X $J(X,5) W:Z ?52,"/",Z S Y=$P(Y,U,4) D:Y D^LRU W ?59,Y Q
|
|---|
| 12 | ;
|
|---|
| 13 | AU I $P($P($G(^LR(LRDFN,"AU")),U,6)," ")'=LRABV D Q
|
|---|
| 14 | .W $C(7),!!,"No autopsy entry for ",LRP,!! S A=1
|
|---|
| 15 | S LRA=^LR(LRDFN,"AU"),LREP=$P(LRA,U,6)
|
|---|
| 16 | I LREP']"" W $C(7),!!,"No autopsy # for ",LRP S A=1 Q
|
|---|
| 17 | S Y=+LRA D D^LRU W !,"Autopsy performed: ",Y," Acc # ",LREP
|
|---|
| 18 | W !!,"Is this the patient " S %=1 D YN^LRU S:%'=1 A=1
|
|---|
| 19 | Q
|
|---|
