| 1 | LRAPAUA ;AVAMC/REG/CYM - AUTOPSY LIST ; 2/9/98 10:26 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
|
|---|
| 3 | S LRDICS="AU" D ^LRAP G:'$D(Y) END D XR^LRU,B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99,ZTRTN="QUE^LRAPAUA" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 4 | QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1
|
|---|
| 5 | F LRSDT=LRSDT:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D SET
|
|---|
| 6 | D W,END^LRUTL,END Q
|
|---|
| 7 | SET Q:'$D(^LR(LRDFN,"AU"))!('$D(^(0))#2) S Z=^("AU"),LRAC=$P(Z,U,6) Q:$P(LRAC," ")'=LRABV S X=^(0),DFN=$P(X,"^",3),(LRDPF,X)=+$P(X,"^",2) Q:'X S P(0)=$P(^DIC(X,0),"^"),X=^DIC(X,0,"GL") D PT^LRX Q:$G(VAERR) S LRP=PNM
|
|---|
| 8 | I $L(LRP),LRDFN S ^TMP($J,LRP,LRDFN)=SSN_"^"_+Z_"^"_LRAC_"^"_$S(P(0)="PATIENT":"",1:P(0))
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | W S LRP="" F A=0:0 S LRP=$O(^TMP($J,LRP)) Q:LRP=""!(LR("Q")) F LRDFN=0:0 S LRDFN=$O(^TMP($J,LRP,LRDFN)) Q:'LRDFN!(LR("Q")) S LRX=^(LRDFN) D:$Y>(IOSL-6) H Q:LR("Q") D W1
|
|---|
| 12 | Q
|
|---|
| 13 | W1 S LRAUDT=$P(LRX,"^",2),LRAUDT=$P(LRAUDT,".") W !,LRP,?31,$P(LRX,"^"),?46,$P(LRX,"^",3),?58,$$Y2K^LRX(LRAUDT),?70,$E($P(LRX,"^",4),1,10) Q
|
|---|
| 14 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 15 | D F^LRU W !,LRO(68)," list from ",LRSTR," to ",LRLST,!,"Patient",?35,"SSN",?46,"Autopsy#",?58,"Autopsy Date",!,LR("%") Q
|
|---|
| 16 | ;
|
|---|
| 17 | END K LRAUDT D V^LRU Q
|
|---|
