LRAPAUA ;AVAMC/REG/CYM - AUTOPSY LIST ; 2/9/98 10:26 ; ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994 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 QUE U IO K ^TMP($J) D L^LRU,S^LRU,H S LR("F")=1 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 D W,END^LRUTL,END Q 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 I $L(LRP),LRDFN S ^TMP($J,LRP,LRDFN)=SSN_"^"_+Z_"^"_LRAC_"^"_$S(P(0)="PATIENT":"",1:P(0)) Q ; 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 Q 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 H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q") D F^LRU W !,LRO(68)," list from ",LRSTR," to ",LRLST,!,"Patient",?35,"SSN",?46,"Autopsy#",?58,"Autopsy Date",!,LR("%") Q ; END K LRAUDT D V^LRU Q