LRUB.m

LRUB ; IHS/DIR/FJE - GET 62.5 ENTRIES 11/12/88 07:45 ;

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

 ;

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

 I $D(L)'=11 S L=80

 S:'$D(L(1))#2 L(1)="DRXZJT"

 S L(2)="" F L(6)=1:1 Q:$P(X," ",L(6),99)=""  S L(3)=$P(X," ",L(6)),L(5)="" D:L(3)]"" P S L(4)=$L(L(2))+$L(L(3)) S:L(4)'>L L(2)=L(2)_L(3)_" " I L(4)>L W "  too long",! G OUT

 W:X]"" "  (",$E(L(2),1,$L(L(2))-1),")" S X=$E(L(2),1,$L(L(2))-1) K L Q

P F L(5)=0:0 S L(5)=$O(^LAB(62.5,"B",L(3),L(5))) Q:'L(5)  I L(1)[$P(^LAB(62.5,L(5),0),U,4) S L(3)=$P(^LAB(62.5,L(5),0),"^",2) Q:'$D(^(9))  S L(5)=$P(X," ",L(6)-1) S:L(5)>1 L(3)=^(9) Q

 Q

OUT K L,X Q

Q ;

 I $L(L(1))>1,$E(L(1))="J" S L(1)=$E(L(1),2,$L(L(1)))

 W !!,"CHOOSE FROM:",!

 S L(2)="A"_L(1),L(3)=0 F L(5)=1:1 S L(3)=$O(^LAB(62.5,L(2),L(3))) Q:L(3)=""  S L(4)=$O(^LAB(62.5,L(2),L(3),0)) D W Q:'$D(X)

 Q

W Q:'L(4)  I '$D(^LAB(62.5,L(4),0)) K ^LAB(62.5,L(2),L(3),L(4)) Q

 D:L(5)#21=0 ASK Q:'$D(X)  S X=^LAB(62.5,L(4),0) W $P(X,"^"),"   ",$P(X,"^",2),! Q

 ;

ASK R "'^' TO STOP: ",X:DTIME W $C(13),$J("",15),$C(13) K:X[U!('$T) X Q

 ;

 ;L=length of entry  ;L(1)=Screen (set this in input transform/xecutable help)

LRUB      ; IHS/DIR/FJE - GET 62.5 ENTRIES 11/12/88 07:45 ;

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

 +2       ;

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

 +4        IF $DATA(L)'=11

               SET L=80

 +5        IF '$DATA(L(1))#2

               SET L(1)="DRXZJT"

 +6        SET L(2)=""

           FOR L(6)=1:1

               IF $PIECE(X," ",L(6),99)=""

                   QUIT 

               SET L(3)=$PIECE(X," ",L(6))

               SET L(5)=""

               IF L(3)]""

                   DO P

               SET L(4)=$LENGTH(L(2))+$LENGTH(L(3))

               IF L(4)'>L

                   SET L(2)=L(2)_L(3)_" "

               IF L(4)>L

                   WRITE "  too long",!

                   GOTO OUT

 +7        IF X]""

               WRITE "  (",$EXTRACT(L(2),1,$LENGTH(L(2))-1),")"

           SET X=$EXTRACT(L(2),1,$LENGTH(L(2))-1)

           KILL L

           QUIT 

P          FOR L(5)=0:0

               SET L(5)=$ORDER(^LAB(62.5,"B",L(3),L(5)))

               IF 'L(5)

                   QUIT 

               IF L(1)[$PIECE(^LAB(62.5,L(5),0),U,4)

                   SET L(3)=$PIECE(^LAB(62.5,L(5),0),"^",2)

                   IF '$DATA(^(9))

                       QUIT 

                   SET L(5)=$PIECE(X," ",L(6)-1)

                   IF L(5)>1

                       SET L(3)=^(9)

                   QUIT 

 +1        QUIT 

OUT        KILL L,X

           QUIT 

Q         ;

 +1        IF $LENGTH(L(1))>1

               IF $EXTRACT(L(1))="J"

                   SET L(1)=$EXTRACT(L(1),2,$LENGTH(L(1)))

 +2        WRITE !!,"CHOOSE FROM:",!

 +3        SET L(2)="A"_L(1)

           SET L(3)=0

           FOR L(5)=1:1

               SET L(3)=$ORDER(^LAB(62.5,L(2),L(3)))

               IF L(3)=""

                   QUIT 

               SET L(4)=$ORDER(^LAB(62.5,L(2),L(3),0))

               DO W

               IF '$DATA(X)

                   QUIT 

 +4        QUIT 

W          IF 'L(4)

               QUIT 

           IF '$DATA(^LAB(62.5,L(4),0))

               KILL ^LAB(62.5,L(2),L(3),L(4))

               QUIT 

 +1        IF L(5)#21=0

               DO ASK

           IF '$DATA(X)

               QUIT 

           SET X=^LAB(62.5,L(4),0)

           WRITE $PIECE(X,"^"),"   ",$PIECE(X,"^",2),!

           QUIT 

 +2       ;

ASK        READ "'^' TO STOP: ",X:DTIME

           WRITE $CHAR(13),$JUSTIFY("",15),$CHAR(13)

           IF X[U!('$TEST)

               KILL X

           QUIT 

 +1       ;

 +2       ;L=length of entry  ;L(1)=Screen (set this in input transform/xecutable help)