LRUU.m

LRUU ; IHS/DIR/FJE - FIND FIELD FOR A SUBSCRIPT & PIECE 9/2/87 09:35 ;

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

 ;

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

 S:'$D(DTIME) DTIME=300

 W !!?20,"Enter file/subfile #, subscript and piece",!?30,"separated by commas: "

 R X:DTIME Q:X=""!(X["^")

 F A=1:1:3 S A(A)=$P(X,",",A)

 F A=1:1:3 I A(A)="" W $C(7),!!,"File, subscript and piece must be entered and separated by commas (',')." G LRUU

 S X=$O(^DD(A(1),"GL",A(2),A(3),0)) I X="" W $C(7),!!,"Field not found.  Try again." G LRUU

 W !!,^DD(A(1),X,0) G LRUU

LRUU      ; IHS/DIR/FJE - FIND FIELD FOR A SUBSCRIPT & PIECE 9/2/87 09:35 ;

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

 +2       ;

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

 +4        IF '$DATA(DTIME)

               SET DTIME=300

 +5        WRITE !!?20,"Enter file/subfile #, subscript and piece",!?30,"separated by commas: "

 +6        READ X:DTIME

           IF X=""!(X["^")

               QUIT 

 +7        FOR A=1:1:3

               SET A(A)=$PIECE(X,",",A)

 +8        FOR A=1:1:3

               IF A(A)=""

                   WRITE $CHAR(7),!!,"File, subscript and piece must be entered and separated by commas (',')."

                   GOTO LRUU

 +9        SET X=$ORDER(^DD(A(1),"GL",A(2),A(3),0))

           IF X=""

               WRITE $CHAR(7),!!,"Field not found.  Try again."

               GOTO LRUU

 +10       WRITE !!,^DD(A(1),X,0)

           GOTO LRUU