RTRD ;MJK/TROY ISC;Read Processor Routine; ; 2/24/87 12:43 PM ;
;;v 2.0;Record Tracking;;10/22/91
R R X:$S($D(RTRD("DTIME")):+RTRD("DTIME"),1:DTIME) Q
SET S:'$D(RTRD(0)) RTRD(0)="" W:RTRD(0)'["S" !?2,"Choose one of the following:"
F I=0:0 S I=$O(RTRD(I)) Q:'I W:RTRD(0)'["S" !?10,$P(RTRD(I),"^",1) S V=$P(RTRD(I),"^",1) D UPPER S $P(RTRD(I),"^",3)=S
READ K S,I,J,L,I W !!,$S($D(RTRD("A")):RTRD("A"),1:"Enter Response: ")
I $D(RTRD("B")),$D(RTRD(RTRD("B"))) W $P(RTRD(RTRD("B")),"^",1),"// "
D R S X1=X G HELP:X="?" S DTOUT='$T,L=$L(X) I X["^" S X="^" G Q
I DTOUT S X=$S('$D(RTRD("DTOUT")):"^",'$D(RTRD(+RTRD("DTOUT"))):"^",1:$P(RTRD(+RTRD("DTOUT")),"^")) G Q
I 'L S X=$S('$D(RTRD("B")):"",'$D(RTRD(+RTRD("B"))):"",1:$P(RTRD(+RTRD("B")),"^")) G Q
S V=X D UPPER
F I=0:0 S I=$O(RTRD(I)) Q:'I I S=$E($P(RTRD(I),"^",3),1,L) S X=$P(RTRD(I),"^",1) W $E(X,L+1,99) G Q
W *7
HELP ;
I $D(RTRD("XQH")) S XQH=RTRD("XQH") D EN^XQH W ! G SET
W !!?2,"Enter one of the following:"
F I=0:0 S I=$O(RTRD(I)) Q:'I W !?5,"'",$P(RTRD(I),"^",1),"'",?25,"to ",$E($P(RTRD(I),"^",2),1,79-$X)
W !?5,"^",?25,"to stop." G READ
;
Q K S,C,I,L,DTOUT Q
;
UPPER ;
S S="" F J=1:1 S C=$E($P(V,"^",1),J) Q:C="" S S=S_$S(C?1L:$C($A(C)-32),1:C)
K C,V Q
;
SEL K RTY I $S(RTSEL["L":1,RTSEL'["O":0,RTC=1:1,1:0),$D(RTS) S RTY(1)=RTS(1) S (X,RTC)=1 Q
S C=0 I RTSEL["A" S X=1 F I=0:0 S I=$O(RTS(I)) G SELQ:'I S C=C+1,RTY(C)=RTS(I)
SEL1 K RTY S C=0 W !!,$S($D(RTRD("A")):RTRD("A"),1:"Select: ") W:$D(RTRD("B")) RTRD("B"),"// " D R G QUES:X["?" S:X=""&($D(RTRD("B"))) X=RTRD("B") G SELQ:"^"[X S I=0
I X[","!(X["-"),RTSEL'["S" G ERR
LOOP S I=I+1 S X1=$P(X,",",I) I 'X1,X1]"" G ERR
G SELQ:'X1 I RTSEL["S",X1["-" G RANGE
G ERR:'$D(RTS(X1))!(X1>RTC) S C=C+1,RTY(C)=RTS(X1) G LOOP
RANGE G ERR:X1'?1N.N1"-"1N.N!(+X1>$P(X1,"-",2)) F N=+X1:1:+$P(X1,"-",2) G ERR:'$D(RTS(N))!(N>RTC) S C=C+1,RTY(C)=RTS(N)
G LOOP
;
ERR W !,*7,"Your input is invalid."
QUES W !!,"Enter ",?6,$S(RTSEL["S":"a) ",1:""),"a single number between 1 and ",RTC
W:RTSEL["S" !?6,"b) more than one number by separating numbers by commas (ie. 1,3)",!?6,"c) a range of numbers (ie. 1-3)",!?6,"d) a combination of 'a','b' and 'c' (ie. 1,3,4-5)"
W !!?3,"...OR enter an '^' to stop."
G SEL1
SELQ S RTC=C K X1,C Q
;
ESC W !!,"Press <Return> to continue or '^' to stop: " R X:DTIME S:'$T!(X["^") RTESC="" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTRD 2390 printed Oct 16, 2024@18:35:18 Page 2
RTRD ;MJK/TROY ISC;Read Processor Routine; ; 2/24/87 12:43 PM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
R READ X:$SELECT($DATA(RTRD("DTIME")):+RTRD("DTIME"),1:DTIME)
QUIT
SET if '$DATA(RTRD(0))
SET RTRD(0)=""
if RTRD(0)'["S"
WRITE !?2,"Choose one of the following:"
+1 FOR I=0:0
SET I=$ORDER(RTRD(I))
if 'I
QUIT
if RTRD(0)'["S"
WRITE !?10,$PIECE(RTRD(I),"^",1)
SET V=$PIECE(RTRD(I),"^",1)
DO UPPER
SET $PIECE(RTRD(I),"^",3)=S
READ KILL S,I,J,L,I
WRITE !!,$SELECT($DATA(RTRD("A")):RTRD("A"),1:"Enter Response: ")
+1 IF $DATA(RTRD("B"))
IF $DATA(RTRD(RTRD("B")))
WRITE $PIECE(RTRD(RTRD("B")),"^",1),"// "
+2 DO R
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(RTRD("DTOUT")):"^",'$DATA(RTRD(+RTRD("DTOUT"))):"^",1:$PIECE(RTRD(+RTRD("DTOUT")),"^"))
GOTO Q
+4 IF 'L
SET X=$SELECT('$DATA(RTRD("B")):"",'$DATA(RTRD(+RTRD("B"))):"",1:$PIECE(RTRD(+RTRD("B")),"^"))
GOTO Q
+5 SET V=X
DO UPPER
+6 FOR I=0:0
SET I=$ORDER(RTRD(I))
if 'I
QUIT
IF S=$EXTRACT($PIECE(RTRD(I),"^",3),1,L)
SET X=$PIECE(RTRD(I),"^",1)
WRITE $EXTRACT(X,L+1,99)
GOTO Q
+7 WRITE *7
HELP ;
+1 IF $DATA(RTRD("XQH"))
SET XQH=RTRD("XQH")
DO EN^XQH
WRITE !
GOTO SET
+2 WRITE !!?2,"Enter one of the following:"
+3 FOR I=0:0
SET I=$ORDER(RTRD(I))
if 'I
QUIT
WRITE !?5,"'",$PIECE(RTRD(I),"^",1),"'",?25,"to ",$EXTRACT($PIECE(RTRD(I),"^",2),1,79-$X)
+4 WRITE !?5,"^",?25,"to stop."
GOTO READ
+5 ;
Q KILL S,C,I,L,DTOUT
QUIT
+1 ;
UPPER ;
+1 SET S=""
FOR J=1:1
SET C=$EXTRACT($PIECE(V,"^",1),J)
if C=""
QUIT
SET S=S_$SELECT(C?1L:$CHAR($ASCII(C)-32),1:C)
+2 KILL C,V
QUIT
+3 ;
SEL KILL RTY
IF $SELECT(RTSEL["L":1,RTSEL'["O":0,RTC=1:1,1:0)
IF $DATA(RTS)
SET RTY(1)=RTS(1)
SET (X,RTC)=1
QUIT
+1 SET C=0
IF RTSEL["A"
SET X=1
FOR I=0:0
SET I=$ORDER(RTS(I))
if 'I
GOTO SELQ
SET C=C+1
SET RTY(C)=RTS(I)
SEL1 KILL RTY
SET C=0
WRITE !!,$SELECT($DATA(RTRD("A")):RTRD("A"),1:"Select: ")
if $DATA(RTRD("B"))
WRITE RTRD("B"),"// "
DO R
if X["?"
GOTO QUES
if X=""&($DATA(RTRD("B")))
SET X=RTRD("B")
if "^"[X
GOTO SELQ
SET I=0
+1 IF X[","!(X["-")
IF RTSEL'["S"
GOTO ERR
LOOP SET I=I+1
SET X1=$PIECE(X,",",I)
IF 'X1
IF X1]""
GOTO ERR
+1 if 'X1
GOTO SELQ
IF RTSEL["S"
IF X1["-"
GOTO RANGE
+2 if '$DATA(RTS(X1))!(X1>RTC)
GOTO ERR
SET C=C+1
SET RTY(C)=RTS(X1)
GOTO LOOP
RANGE if X1'?1N.N1"-"1N.N!(+X1>$PIECE(X1,"-",2))
GOTO ERR
FOR N=+X1:1:+$PIECE(X1,"-",2)
if '$DATA(RTS(N))!(N>RTC)
GOTO ERR
SET C=C+1
SET RTY(C)=RTS(N)
+1 GOTO LOOP
+2 ;
ERR WRITE !,*7,"Your input is invalid."
QUES WRITE !!,"Enter ",?6,$SELECT(RTSEL["S":"a) ",1:""),"a single number between 1 and ",RTC
+1 if RTSEL["S"
WRITE !?6,"b) more than one number by separating numbers by commas (ie. 1,3)",!?6,"c) a range of numbers (ie. 1-3)",!?6,"d) a combination of 'a','b' and 'c' (ie. 1,3,4-5)"
+2 WRITE !!?3,"...OR enter an '^' to stop."
+3 GOTO SEL1
SELQ SET RTC=C
KILL X1,C
QUIT
+1 ;
ESC WRITE !!,"Press <Return> to continue or '^' to stop: "
READ X:DTIME
if '$TEST!(X["^")
SET RTESC=""
QUIT
