7 lines
531 B
Mathematica
7 lines
531 B
Mathematica
LRUTELL ;AVAMC/REG - FIND EXISTING ACCESSION NUMBER ; 6/2/86 9:13 AM ;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
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
|
|
S Y(1)=^DIC($P(^LR(Y,0),"^",2),0,"GL"),Y=$P(^LR(Y,0),"^",3)
|
|
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")
|
|
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
|