source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTRD.m@ 1714

Last change on this file since 1714 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1RTRD ;MJK/TROY ISC;Read Processor Routine; ; 2/24/87 12:43 PM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3R R X:$S($D(RTRD("DTIME")):+RTRD("DTIME"),1:DTIME) Q
4SET S:'$D(RTRD(0)) RTRD(0)="" W:RTRD(0)'["S" !?2,"Choose one of the following:"
5 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
6READ K S,I,J,L,I W !!,$S($D(RTRD("A")):RTRD("A"),1:"Enter Response: ")
7 I $D(RTRD("B")),$D(RTRD(RTRD("B"))) W $P(RTRD(RTRD("B")),"^",1),"// "
8 D R S X1=X G HELP:X="?" S DTOUT='$T,L=$L(X) I X["^" S X="^" G Q
9 I DTOUT S X=$S('$D(RTRD("DTOUT")):"^",'$D(RTRD(+RTRD("DTOUT"))):"^",1:$P(RTRD(+RTRD("DTOUT")),"^")) G Q
10 I 'L S X=$S('$D(RTRD("B")):"",'$D(RTRD(+RTRD("B"))):"",1:$P(RTRD(+RTRD("B")),"^")) G Q
11 S V=X D UPPER
12 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
13 W *7
14HELP ;
15 I $D(RTRD("XQH")) S XQH=RTRD("XQH") D EN^XQH W ! G SET
16 W !!?2,"Enter one of the following:"
17 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)
18 W !?5,"^",?25,"to stop." G READ
19 ;
20Q K S,C,I,L,DTOUT Q
21 ;
22UPPER ;
23 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)
24 K C,V Q
25 ;
26SEL 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
27 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)
28SEL1 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
29 I X[","!(X["-"),RTSEL'["S" G ERR
30LOOP S I=I+1 S X1=$P(X,",",I) I 'X1,X1]"" G ERR
31 G SELQ:'X1 I RTSEL["S",X1["-" G RANGE
32 G ERR:'$D(RTS(X1))!(X1>RTC) S C=C+1,RTY(C)=RTS(X1) G LOOP
33RANGE 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)
34 G LOOP
35 ;
36ERR W !,*7,"Your input is invalid."
37QUES W !!,"Enter ",?6,$S(RTSEL["S":"a) ",1:""),"a single number between 1 and ",RTC
38 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)"
39 W !!?3,"...OR enter an '^' to stop."
40 G SEL1
41SELQ S RTC=C K X1,C Q
42 ;
43ESC W !!,"Press <Return> to continue or '^' to stop: " R X:DTIME S:'$T!(X["^") RTESC="" Q
Note: See TracBrowser for help on using the repository browser.