| 1 | PPPGET5 ;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 | ;
|
|---|
| 5 | GETRANGE(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 | ;
|
|---|
| 58 | ALL(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 | ;
|
|---|
| 67 | XTRCTRNG(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 | ;
|
|---|
| 92 | RNGHLP ;
|
|---|
| 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
|
|---|
