RARD.m

RARD ;HISC/CAH,FPT,GJC AISC/MJK-Read Processor ;9/12/94  11:26

 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

SET S:'$D(RARD(0)) RARD(0)="" W:RARD(0)'["S" !?2,"Choose one of the following:"

 F I=0:0 S I=$O(RARD(I)) Q:'I  W:RARD(0)'["S" !?10,$P(RARD(I),"^") S V=$P(RARD(I),"^") D UPPER S $P(RARD(I),"^",3)=S

READ K S,I,J,L,I W !!?2,$S($D(RARD("A")):RARD("A"),1:"Enter Response: ")

 I $D(RARD("B")),$D(RARD(RARD("B"))) W $P(RARD(RARD("B")),"^"),"// "

 R X:$S($D(RARD("DTIME")):+RARD("DTIME"),1:DTIME) S X1=X G HELP:X="?" S DTOUT='$T,L=$L(X) I X["^" S X="^" G Q

 I DTOUT S X=$S('$D(RARD("DTOUT")):"^",'$D(RARD(+RARD("DTOUT"))):"^",1:$P(RARD(+RARD("DTOUT")),"^")) G Q

 I 'L S X=$S('$D(RARD("B")):"",'$D(RARD(+RARD("B"))):"",1:$P(RARD(+RARD("B")),"^")) G Q

 S V=X D UPPER

 F I=0:0 S I=$O(RARD(I)) Q:'I  I S=$E($P(RARD(I),"^",3),1,L) S X=$P(RARD(I),"^") W $E(X,L+1,99) G Q

 W *7

HELP ;

 I $D(RARD("XQH")) S XQH=RARD("XQH") D EN^XQH W ! G SET

 W !!?2,"Enter one of the following:"

 F I=0:0 S I=$O(RARD(I)) Q:'I  W !?5,"'",$P(RARD(I),"^"),"'",?25,"to ",$E($P(RARD(I),"^",2),1,79-$X)

 W !?5,"^",?25,"to stop." G READ

 ;

Q K DTOUT,S,C,I,L Q

 ;

UPPER ;

 S S="" F J=1:1 S C=$E($P(V,"^"),J) Q:C=""  S:$A(C)>96&($A(C)<123) C=$C($A(C)-32) S S=S_C

 K C,V Q

RARD      ;HISC/CAH,FPT,GJC AISC/MJK-Read Processor ;9/12/94  11:26

 +1       ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998

SET        IF '$DATA(RARD(0))

               SET RARD(0)=""

           IF RARD(0)'["S"

               WRITE !?2,"Choose one of the following:"

 +1        FOR I=0:0

               SET I=$ORDER(RARD(I))

               IF 'I

                   QUIT 

               IF RARD(0)'["S"

                   WRITE !?10,$PIECE(RARD(I),"^")

               SET V=$PIECE(RARD(I),"^")

               DO UPPER

               SET $PIECE(RARD(I),"^",3)=S

READ       KILL S,I,J,L,I

           WRITE !!?2,$SELECT($DATA(RARD("A")):RARD("A"),1:"Enter Response: ")

 +1        IF $DATA(RARD("B"))

               IF $DATA(RARD(RARD("B")))

                   WRITE $PIECE(RARD(RARD("B")),"^"),"// "

 +2        READ X:$SELECT($DATA(RARD("DTIME")):+RARD("DTIME"),1:DTIME)

           SET X1=X

           IF X="?"

               GOTO HELP

           SET DTOUT='$TEST

           SET L=$LENGTH(X)

           IF X["^"

               SET X="^"

               GOTO Q

 +3        IF DTOUT

               SET X=$SELECT('$DATA(RARD("DTOUT")):"^",'$DATA(RARD(+RARD("DTOUT"))):"^",1:$PIECE(RARD(+RARD("DTOUT")),"^"))

               GOTO Q

 +4        IF 'L

               SET X=$SELECT('$DATA(RARD("B")):"",'$DATA(RARD(+RARD("B"))):"",1:$PIECE(RARD(+RARD("B")),"^"))

               GOTO Q

 +5        SET V=X

           DO UPPER

 +6        FOR I=0:0

               SET I=$ORDER(RARD(I))

               IF 'I

                   QUIT 

               IF S=$EXTRACT($PIECE(RARD(I),"^",3),1,L)

                   SET X=$PIECE(RARD(I),"^")

                   WRITE $EXTRACT(X,L+1,99)

                   GOTO Q

 +7        WRITE *7

HELP      ;

 +1        IF $DATA(RARD("XQH"))

               SET XQH=RARD("XQH")

               DO EN^XQH

               WRITE !

               GOTO SET

 +2        WRITE !!?2,"Enter one of the following:"

 +3        FOR I=0:0

               SET I=$ORDER(RARD(I))

               IF 'I

                   QUIT 

               WRITE !?5,"'",$PIECE(RARD(I),"^"),"'",?25,"to ",$EXTRACT($PIECE(RARD(I),"^",2),1,79-$X)

 +4        WRITE !?5,"^",?25,"to stop."

           GOTO READ

 +5       ;

Q          KILL DTOUT,S,C,I,L

           QUIT 

 +1       ;

UPPER     ;

 +1        SET S=""

           FOR J=1:1

               SET C=$EXTRACT($PIECE(V,"^"),J)

               IF C=""

                   QUIT 

               IF $ASCII(C)>96&($ASCII(C)<123)

                   SET C=$CHAR($ASCII(C)-32)

               SET S=S_C

 +2        KILL C,V

           QUIT