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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRARD 1265 printed Oct 16, 2024@18:39:37 Page 2
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
