LRBLY.m

LRBLY ;AVAMC/REG - STUFF DATA IN LAB LETTERS ;2/20/89  16:15 ;

 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

I S A=$P(X,"[",2) Q:'+A  S X(1)=$P(X,"["),X(2)=$P(X,"]",2,99) D R G I

 ;

R S A=$P(A,"]"),A=$S($D(@("^TMP("_"""LRBLY"""_","_A_")")):@("^TMP("_"""LRBLY"""_","_A_")"),1:"") S X=X(1)_A_X(2) Q

EN ;

 I '$D(^LRO(69.2,LRAA,8,65.9,1,LRQ,0)) S ^(0)=LRP,^LRO(69.2,LRAA,8,65.9,1,"B",LRP,LRQ)="" L +^LRO(69.2,LRAA,8,65.9,1,0) S X=^LRO(69.2,LRAA,8,65.9,1,0),^(0)=$P(X,"^",1,2)_"^"_LRQ_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,8,65.9,1,0)

 Q

EN1 ;

 S:'$D(^LRO(69.2,LRAA,8,0)) ^(0)="^69.31A^^" I '$D(^(65.9,0)) S ^(0)=65.9 L +^LRO(69.2,LRAA,8,0) S X=^LRO(69.2,LRAA,8,0),^(0)=$P(X,"^",1,2)_"^"_65.9_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,8,0)

 S:'$D(^LRO(69.2,LRAA,8,65.9,1,0)) ^(0)="^69.32A^^" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLY   882     printed  Apr 09, 2024@21:22:16                                                                                                                                                                                                        Page 2

LRBLY     ;AVAMC/REG - STUFF DATA IN LAB LETTERS ;2/20/89  16:15 ;

 +1       ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

I          SET A=$PIECE(X,"[",2)

           if '+A

               QUIT 

           SET X(1)=$PIECE(X,"[")

           SET X(2)=$PIECE(X,"]",2,99)

           DO R

           GOTO I

 +1       ;

R          SET A=$PIECE(A,"]")

           SET A=$SELECT($DATA(@("^TMP("_"""LRBLY"""_","_A_")")):@("^TMP("_"""LRBLY"""_","_A_")"),1:"")

           SET X=X(1)_A_X(2)

           QUIT 

EN        ;

 +1        IF '$DATA(^LRO(69.2,LRAA,8,65.9,1,LRQ,0))

               SET ^(0)=LRP

               SET ^LRO(69.2,LRAA,8,65.9,1,"B",LRP,LRQ)=""

               LOCK +^LRO(69.2,LRAA,8,65.9,1,0)

               SET X=^LRO(69.2,LRAA,8,65.9,1,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_LRQ_"^"_($PIECE(X,"^",4)+1)

               LOCK -^LRO(69.2,LRAA,8,65.9,1,0)

 +2        QUIT 

EN1       ;

 +1        if '$DATA(^LRO(69.2,LRAA,8,0))

               SET ^(0)="^69.31A^^"

           IF '$DATA(^(65.9,0))

               SET ^(0)=65.9

               LOCK +^LRO(69.2,LRAA,8,0)

               SET X=^LRO(69.2,LRAA,8,0)

               SET ^(0)=$PIECE(X,"^",1,2)_"^"_65.9_"^"_($PIECE(X,"^",4)+1)

               LOCK -^LRO(69.2,LRAA,8,0)

 +2        if '$DATA(^LRO(69.2,LRAA,8,65.9,1,0))

               SET ^(0)="^69.32A^^"

           QUIT