- 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 Jan 18, 2025@03:35:44 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