LRUTELL ;DALOI/REG - FIND EXISTING ACCESSION NUMBER ;04/23/10 12:55
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
N LRSPEC,Y
;
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)=$$GET1^DID($P(^LR(Y,0),"^",2),"","","GLOBAL NAME")
S 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,!!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUTELL 609 printed Dec 13, 2024@02:22:13 Page 2
LRUTELL ;DALOI/REG - FIND EXISTING ACCESSION NUMBER ;04/23/10 12:55
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 NEW LRSPEC,Y
+4 ;
+5 SET Y=+^LRO(68,LRAA,1,LRAD,1,X,0)
SET LRSPEC=$SELECT($DATA(^(5,1,0)):+^(0),1:LRU)
+6 IF 'Y
KILL ^LRO(68,LRAA,LRAD,1,X),Y
QUIT
+7 ;
+8 SET Y(1)=$$GET1^DID($PIECE(^LR(Y,0),"^",2),"","","GLOBAL NAME")
+9 SET Y=$PIECE(^LR(Y,0),"^",3)
+10 WRITE $CHAR(7),!!,"Sorry, Accession # ",X," assigned to ",$PIECE(@(Y(1)_Y_",0)"),"^")
+11 ;
+12 IF "CYEMSPAU"'[LRSS
WRITE " Specimen type: ",$SELECT(LRSPEC'=0:$PIECE(^LAB(61,LRSPEC,0),"^"),1:"NOT ENTERED")
+13 ;
+14 WRITE !,"Specimen(s) Taken "
+15 SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,X,0),U,3)
DO D^LRU
+16 WRITE Y,!!
+17 QUIT
