source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPAUA.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1LRAPAUA ;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
4QUE 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
7SET 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 ;
11W 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
13W1 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
14H 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 ;
17END K LRAUDT D V^LRU Q
Note: See TracBrowser for help on using the repository browser.