| 1 | PPPGET6 ;ALB/DMB - PPP UTILITIES ; 4/23/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 | GETRESP(PROMPT,HELP1,HELP2,DFLTRESP,PATTERN,LEN) ;
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; This function queries the user with the prompt passed in the
 | 
|---|
| 8 |  ; parameter list.
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ; Parameters:
 | 
|---|
| 11 |  ;   PROMPT - Text string to prompt user with (may be NULL)
 | 
|---|
| 12 |  ;   HELP1 - Help string to display if user enters "?" (may be NULL)
 | 
|---|
| 13 |  ;   HELP2 - Help string to be executed if user enters "??" (may be NULL)
 | 
|---|
| 14 |  ;   DFLTRESP - Default response (may be NULL)
 | 
|---|
| 15 |  ;   PATTERN - Pattern to verify users response with (may be NULL)
 | 
|---|
| 16 |  ;   LEN - Maximum length of response (may be NULL)
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 |  ; Returns:
 | 
|---|
| 19 |  ;   User Response - Guarranteed to conform to Pattern ans length
 | 
|---|
| 20 |  ;   -1 - User Responded with up-arrow
 | 
|---|
| 21 |  ;   -2 - User Timed out
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  N RESP,GOTRESP
 | 
|---|
| 24 |  ;
 | 
|---|
| 25 |  F GOTRESP=0:0 D  Q:GOTRESP
 | 
|---|
| 26 |  .W PROMPT
 | 
|---|
| 27 |  .I DFLTRESP'="" W DFLTRESP_" // "
 | 
|---|
| 28 |  .R RESP:DTIME
 | 
|---|
| 29 |  .I '$T S RESP=-2,GOTRESP=1 Q
 | 
|---|
| 30 |  .I RESP["^" S RESP=-1,GOTRESP=1 Q
 | 
|---|
| 31 |  .I RESP="?" D  Q
 | 
|---|
| 32 |  ..I HELP1="" D
 | 
|---|
| 33 |  ...W *7,"  ??",!!
 | 
|---|
| 34 |  ..E  D
 | 
|---|
| 35 |  ...W !!,*7,HELP1,!!
 | 
|---|
| 36 |  ..S GOTRESP=0
 | 
|---|
| 37 |  .I RESP="??" D  Q
 | 
|---|
| 38 |  ..I HELP2="" D
 | 
|---|
| 39 |  ...W *7,"  ??",!!
 | 
|---|
| 40 |  ..E  D
 | 
|---|
| 41 |  ...X HELP2
 | 
|---|
| 42 |  ..S GOTRESP=0
 | 
|---|
| 43 |  .I RESP="" S RESP=DFLTRESP W RESP
 | 
|---|
| 44 |  .I PATTERN'="" D  Q:GOTRESP=0
 | 
|---|
| 45 |  ..I RESP'?@PATTERN D
 | 
|---|
| 46 |  ...W !!,*7,"Invalid Format... Please Re-enter.",!!
 | 
|---|
| 47 |  ...S GOTRESP=0
 | 
|---|
| 48 |  ..E  D
 | 
|---|
| 49 |  ...S GOTRESP=1
 | 
|---|
| 50 |  .I LEN'="" D  Q:GOTRESP=0
 | 
|---|
| 51 |  ..I RESP>LEN D
 | 
|---|
| 52 |  ...W !!,*7,"Response too long... Please Re-enter.",!!
 | 
|---|
| 53 |  ...S GOTRESP=0
 | 
|---|
| 54 |  ..E  D
 | 
|---|
| 55 |  ...S GOTRESP=1
 | 
|---|
| 56 |  .S GOTRESP=1
 | 
|---|
| 57 |  Q RESP
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 | SAMPLE ; Sample routine using GETRESP -- SAMPLE CODE -- NOT USED BY PPP
 | 
|---|
| 60 |  ;
 | 
|---|
| 61 |  S PROMPT="Enter Your Name: "
 | 
|---|
| 62 |  S DFLTRESP="SMITH,FRED"
 | 
|---|
| 63 |  S HELP1="Enter as LASTNAME,FIRSTNAME 30 characters max."
 | 
|---|
| 64 |  S HELP2="D EXTHLP"
 | 
|---|
| 65 |  S PATTERN="1.30U1"",""1.30U"
 | 
|---|
| 66 |  S LEN=30
 | 
|---|
| 67 |  S ANSWER=$$GETRESP(PROMPT,HELP1,HELP2,DFLTRESP,PATTERN,LEN)
 | 
|---|
| 68 |  I ANSWER'<0 W !!,"Response = ",ANSWER
 | 
|---|
| 69 |  I ANSWER=-1 W !!,"You entered ^"
 | 
|---|
| 70 |  I ANSWER=-2 W !!,"You timed out"
 | 
|---|
| 71 |  K PROMPT,DFLTRESP,HELP1,HELP2,PATTERN,LEN,ANSWER
 | 
|---|
| 72 |  Q
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | EXTHLP ;
 | 
|---|
| 75 |  W !!,*7,"Sample of extented help, this could be any text!",!!
 | 
|---|
| 76 |  Q
 | 
|---|