LRBLAB.m

LRBLAB ; IHS/DIR/FJE - BB ADM DATA 07:45 ; [ 4/18/93 ]

 ;;5.2;LR;;NOV 01, 1997

 ;

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

 S X(1)=$P($G(^LRD(65,C,9,0)),"^",4) Q:'X(1)  I X(1)>1 S X=X(1) Q

 S X(1)=$O(^LRD(65,C,9,0)),X(1)=^(X(1),0),X(2)=$P(X(1),"^",2),X(1)=+X(1),(X(5),X(3))=0

 F  S X(3)=$O(^LRD(65,"B",X(2),X(3))) Q:'X(3)  I $P($G(^LRD(65,X(3),0)),"^",4)=X(1) S X(5)=1 Q

 Q:'X(5)  S X(4)=$P($G(^LRD(65,X(3),9,0)),"^",4)-1 S:X(4)>1 X=X(4) Q:X(4)'=1

 S X(1)=$G(^LRD(65,X(3),9,1,0)) Q:$P(X(1),"^",3)'=1  S X(2)=$P(X(1),"^",2),X(1)=+X(1)

 S (X(3),X(5))=0 F  S X(3)=$O(^LRD(65,"B",X(2),X(3))) Q:'X(3)  I $P($G(^LRD(65,X(3),0)),"^",4)=X(1) S X(5)=1 Q

 Q:'X(5)  S X(4)=$P($G(^LRD(65,X(3),9,0)),"^",4)-1 S:X(4)>1 X=X(4) Q

LRBLAB    ; IHS/DIR/FJE - BB ADM DATA 07:45 ; [ 4/18/93 ]

 +1       ;;5.2;LR;;NOV 01, 1997

 +2       ;

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

 +4        SET X(1)=$PIECE($GET(^LRD(65,C,9,0)),"^",4)

           IF 'X(1)

               QUIT 

           IF X(1)>1

               SET X=X(1)

               QUIT 

 +5        SET X(1)=$ORDER(^LRD(65,C,9,0))

           SET X(1)=^(X(1),0)

           SET X(2)=$PIECE(X(1),"^",2)

           SET X(1)=+X(1)

           SET (X(5),X(3))=0

 +6        FOR 

               SET X(3)=$ORDER(^LRD(65,"B",X(2),X(3)))

               IF 'X(3)

                   QUIT 

               IF $PIECE($GET(^LRD(65,X(3),0)),"^",4)=X(1)

                   SET X(5)=1

                   QUIT 

 +7        IF 'X(5)

               QUIT 

           SET X(4)=$PIECE($GET(^LRD(65,X(3),9,0)),"^",4)-1

           IF X(4)>1

               SET X=X(4)

           IF X(4)'=1

               QUIT 

 +8        SET X(1)=$GET(^LRD(65,X(3),9,1,0))

           IF $PIECE(X(1),"^",3)'=1

               QUIT 

           SET X(2)=$PIECE(X(1),"^",2)

           SET X(1)=+X(1)

 +9        SET (X(3),X(5))=0

           FOR 

               SET X(3)=$ORDER(^LRD(65,"B",X(2),X(3)))

               IF 'X(3)

                   QUIT 

               IF $PIECE($GET(^LRD(65,X(3),0)),"^",4)=X(1)

                   SET X(5)=1

                   QUIT 

 +10       IF 'X(5)

               QUIT 

           SET X(4)=$PIECE($GET(^LRD(65,X(3),9,0)),"^",4)-1

           IF X(4)>1

               SET X=X(4)

           QUIT