| [613] | 1 | LRAPH ;AVAMC/REG/CYM - HISTOLOGY RECORD ;7/28-97 07:19
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,173**;Sep 27, 1994
|
|---|
| 3 | S LRDICS="SPCYEM" D ^LRAP G:'$D(Y) END W !!,LRO(68)," HISTOPATHOLOGY DATA SHEET"
|
|---|
| 4 | ASK S %DT="AEX",%DT(0)="-N",%DT("A")="Select ACCESSION DATE: " D ^%DT K %DT G:Y<1 END S LRSDT=Y-.0001,LRLDT=Y+.99 D D^LRU S LRD=Y
|
|---|
| 5 | S ZTRTN="QUE^LRAPH",ZTDESC="Histology Data Sheet",ZTSAVE("LR*")="" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 6 | QUE U IO K ^TMP($J) D XR^LRU,L^LRU,S^LRU,H S LR("F")=1
|
|---|
| 7 | F A=LRSDT:0 S A=$O(^LR(LRXR,A)) Q:'A!(A>LRLDT) S A(1)=$E(A,2,3) F B=0:0 S B=$O(^LR(LRXR,A,B)) Q:'B F C=0:0 S C=$O(^LR(LRXR,A,B,C)) Q:'C D A
|
|---|
| 8 | S A=0 F B=0:1 S A=$O(^TMP($J,A)) Q:A=""!(LR("Q")) S C="" F S C=$O(^TMP($J,A,C)) Q:C=""!(LR("Q")) S X=^(C),LRDFN=+X,LRI=$P(X,"^",2) D W
|
|---|
| 9 | W:'B !!,"NO ACCESSIONS FOR ",LRD D END^LRUTL,END Q
|
|---|
| 10 | W F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,.1,E)) Q:'E S F=$P(^(E,0),U) D:$Y>(IOSL-6) H Q:LR("Q") W !,C,?10,"|",$E(F,1,30),?41,"|",?51,"|",?61,"|",?71,"|",!,LR("%")
|
|---|
| 11 | Q
|
|---|
| 12 | A I '$D(^LR(B,LRSS,C,0)) K ^LR(LRXR,A,B,C) Q
|
|---|
| 13 | S X=^LR(B,LRSS,C,0),Y=$P(X,"^",6) Q:$P(Y," ")'=LRABV S ^TMP($J,A(1),Y)=B_"^"_C Q
|
|---|
| 14 | ;
|
|---|
| 15 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 16 | D F^LRU W !,LRO(68)," (",LRABV,") SHEET ",?37,"ACCESSION DATE: ",LRD
|
|---|
| 17 | W !,LR("%"),!,"Accession",?10,"| SPECIMEN",?41,"|CASSETTE",?51,"| BLOCKS",?61,"| SLIDES",?71,"| STAINS",!,LR("%")
|
|---|
| 18 | Q
|
|---|
| 19 | END D V^LRU Q
|
|---|
