source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUTELL.m@ 846

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

initial load of WorldVistAEHR

File size: 531 bytes
RevLine 
[613]1LRUTELL ;AVAMC/REG - FIND EXISTING ACCESSION NUMBER ; 6/2/86 9:13 AM ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 S Y=+^LRO(68,LRAA,1,LRAD,1,X,0),LRSPEC=$S($D(^(5,1,0)):+^(0),1:LRU) I 'Y K ^LRO(68,LRAA,LRAD,1,X),Y Q
4 S Y(1)=^DIC($P(^LR(Y,0),"^",2),0,"GL"),Y=$P(^LR(Y,0),"^",3)
5 W $C(7),!!,"Sorry, Accession # ",X," assigned to ",$P(@(Y(1)_Y_",0)"),"^") I "CYEMSPAU"'[LRSS W " Specimen type: ",$S(LRSPEC'=0:$P(^LAB(61,LRSPEC,0),"^"),1:"NOT ENTERED")
6 W !,"Specimen(s) Taken " S Y=$P(^LRO(68,LRAA,1,LRAD,1,X,0),U,3) D D^LRU W:Y'[1700 Y,!! Q
Note: See TracBrowser for help on using the repository browser.