LRUTELL.m

LRUTELL ; IHS/DIR/FJE - FIND EXISTING ACCESSION NUMBER 6/2/86 9:13 AM ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;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

LRUTELL   ; IHS/DIR/FJE - FIND EXISTING ACCESSION NUMBER 6/2/86 9:13 AM ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        SET Y=+^LRO(68,LRAA,1,LRAD,1,X,0)

           SET LRSPEC=$SELECT($DATA(^(5,1,0)):+^(0),1:LRU)

           IF 'Y

               KILL ^LRO(68,LRAA,LRAD,1,X),Y

               QUIT 

 +5        SET Y(1)=^DIC($PIECE(^LR(Y,0),"^",2),0,"GL")

           SET Y=$PIECE(^LR(Y,0),"^",3)

 +6        WRITE $CHAR(7),!!,"Sorry, Accession # ",X," assigned to ",$PIECE(@(Y(1)_Y_",0)"),"^")

           IF "CYEMSPAU"'[LRSS

               WRITE " Specimen type: ",$SELECT(LRSPEC'=0:$PIECE(^LAB(61,LRSPEC,0),"^"),1:"NOT ENTERED")

 +7        WRITE !,"Specimen(s) Taken "

           SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,X,0),U,3)

           DO D^LRU

           IF Y'[1700

               WRITE Y,!!

           QUIT