LRUU.m

LRUU ;AVAMC/REG - FIND FIELD FOR A SUBSCRIPT & PIECE ; 9/2/87  09:35 ;

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRUU   508     printed  Apr 09, 2024@21:21:44                                                                                                                                                                                                         Page 2

LRUU      ;AVAMC/REG - FIND FIELD FOR A SUBSCRIPT & PIECE ; 9/2/87  09:35 ;

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

 +2        if '$DATA(DTIME)

               SET DTIME=300

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

 +4        READ X:DTIME

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

               QUIT 

 +5        FOR A=1:1:3

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

 +6        FOR A=1:1:3

               IF A(A)=""

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

                   GOTO LRUU

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

           IF X=""

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

               GOTO LRUU

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

           GOTO LRUU