| 1 | PRCPUYN ;WISC/RFJ-yes,no reader                                    ;29 Dec 93
 | 
|---|
| 2 |  ;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
 | 
|---|
| 3 |  ;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |  Q
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | YN(%) ;  yes, no reader
 | 
|---|
| 8 |  ;  %=default answer [1=yes,2=no];
 | 
|---|
| 9 |  ;  XP=prompt array [none,1,2,3...];
 | 
|---|
| 10 |  ;  XH=help array [none,1,2,3...]
 | 
|---|
| 11 |  N I,X
 | 
|---|
| 12 |  I '$G(%) S %=3
 | 
|---|
| 13 |  F  D  Q:$D(X)
 | 
|---|
| 14 |  .   W:$D(XP) !,XP F I=1:1 Q:'$D(XP(I))  W !,XP(I)
 | 
|---|
| 15 |  .   W "? ",$P("YES// ^NO// ^<YES/NO> ","^",%)
 | 
|---|
| 16 |  .   R X:$S($D(DTIME):DTIME,1:300) E  W "  <<timeout>>" S X=0 Q
 | 
|---|
| 17 |  .   I X["^" S X=0 Q
 | 
|---|
| 18 |  .   S:X="" X=% S X=$TR($E(X),"yYnN","1122"),X=+X
 | 
|---|
| 19 |  .   I X'=1,X'=2 D HELP K X Q
 | 
|---|
| 20 |  .   W:$X>73 ! W $P("  (YES)^  (NO)","^",X)
 | 
|---|
| 21 |  K XH,XP
 | 
|---|
| 22 |  Q X
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | HELP I '$D(XH) W !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!! Q
 | 
|---|
| 25 |  W:$L($G(XH)) !,XH F I=1:1 Q:'$D(XH(I))  W !,XH(I)
 | 
|---|
| 26 |  W !
 | 
|---|
| 27 |  Q
 | 
|---|