source: WorldVistAEHR/trunk/r/PHARMACY_PRESCRIPTION_PRACTICE-PPP/PPPGET5.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PPPGET5 ;alb/dmb - MISC GET ROUTINES ; 3/16/92
2 ;;V1.0;PHARMACY PRESCRIPTION PRACTICE;;APR 7,1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETRANGE(MIN,MAX,PROMPT) ;
6 ;
7 ; This function will get a string of values from the user, check
8 ; them for out-of-range values, and return a string containing the
9 ; values delimited with ;. You should not use this routine if the
10 ; returned string length may exceed acceptable limits (i.e. 245).
11 ;
12 ; Parameters: MIN,MAX - The minimum and maximum acceptable values.
13 ;
14 ; Return: The full string of values selected or
15 ; -1 - User Timeout
16 ; -2 - User Abort
17 ; -3 - Format Error
18 ; -4 - Range Error
19 ;
20 N USRTMOUT,USRABORT,FMTERR,RNGERR
21 N INRANGE,RANGE,ERR,HLP1,HLP2
22 ;
23 S USRTMOUT=-1,USRABORT=-2,FMTERR=-3,RNGERR=-4
24 ;
25 ; Get the desired range
26 ;
27 S HLP1="Enter single value, range of numbers or the letter A for ALL."
28 S HLP2="D RNGHLP^PPPGET5"
29 S INRANGE=$$GETRESP^PPPGET6(PROMPT,HLP1,HLP2,"","","")
30 ;
31 ; If response is -2 then the user timed out
32 ;
33 I INRANGE=-2 Q USRTMOUT
34 ;
35 ; If it a -1 or null then it's a user abort
36 ;
37 I (INRANGE=-1)!(INRANGE="") Q USRABORT
38 ;
39 ; If it an A then return all of the possible values
40 ;
41 I ($E(INRANGE)="A")!($E(INRANGE)="a") Q $$ALL(MIN,MAX)
42 ;
43 ; Check for proper format and return an error if incorrect
44 ;
45 I (INRANGE'?.NP)!(INRANGE<0) Q FMTERR
46 ;
47 ; If we're here then we must have a string of values. Break them
48 ; up and check for values out of range.
49 ;
50 S RANGE=$$XTRCTRNG(INRANGE,MIN,MAX)
51 ;
52 ; Check for errors and return
53 ;
54 I RANGE="" Q FMTERR
55 I RANGE<0 S ERR=RANGE-2 Q ERR
56 Q RANGE
57 ;
58ALL(MIN,MAX) ; Return the full range
59 ;
60 N I,RANGE
61 ;
62 S RANGE=""
63 F I=MIN:1:MAX D
64 .S RANGE=RANGE_I_","
65 Q $E(RANGE,1,($L(RANGE)-1))
66 ;
67XTRCTRNG(INRANGE,MIN,MAX) ; Build the selected range string
68 ;
69 N FMTERR,RNGERR,ERR,RANGE,I,PC,TMIN,TMAX
70 ;
71 S FMTERR=-1,RNGERR=-2
72 S RANGE=""
73 S ERR=0
74 ;
75 ; For each piece of the string, check for range and format.
76 ; Then concatonate each piece to the rest.
77 ;
78 F I=1:1:$L(INRANGE,",") D Q:ERR<0
79 .S PC=$P(INRANGE,",",I)
80 .I (PC'?.N)&(PC'?1.N1"-"1.N) S ERR=FMTERR Q
81 .I PC?1.N D Q
82 ..I (PC<MIN)!(PC>MAX) S ERR=RNGERR Q
83 ..S RANGE=RANGE_PC_","
84 .I PC?1.N1"-"1.N D
85 ..S TMIN=$P(PC,"-"),TMAX=$P(PC,"-",2)
86 ..I (TMIN<MIN)!(TMAX>MAX) S ERR=RNGERR Q
87 ..S PC=$$ALL(TMIN,TMAX)
88 ..S RANGE=RANGE_PC_","
89 I ERR<0 Q ERR
90 Q $E(RANGE,1,($L(RANGE)-1))
91 ;
92RNGHLP ;
93 W !,*7
94 W !,"You may respond to this prompt with a single value or"
95 W !,"with a range of values in the form of 1,2,3,4-9,10 or"
96 W !,"with the letter A for ALL possible values.",!!
97 Q
Note: See TracBrowser for help on using the repository browser.