PRCPUYN ;WISC/RFJ-yes,no reader ;29 Dec 93
;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
YN(%) ; yes, no reader
; %=default answer [1=yes,2=no];
; XP=prompt array [none,1,2,3...];
; XH=help array [none,1,2,3...]
N I,X
I '$G(%) S %=3
F D Q:$D(X)
. W:$D(XP) !,XP F I=1:1 Q:'$D(XP(I)) W !,XP(I)
. W "? ",$P("YES// ^NO// ^<YES/NO> ","^",%)
. R X:$S($D(DTIME):DTIME,1:300) E W " <<timeout>>" S X=0 Q
. I X["^" S X=0 Q
. S:X="" X=% S X=$TR($E(X),"yYnN","1122"),X=+X
. I X'=1,X'=2 D HELP K X Q
. W:$X>73 ! W $P(" (YES)^ (NO)","^",X)
K XH,XP
Q X
;
HELP I '$D(XH) W !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!! Q
W:$L($G(XH)) !,XH F I=1:1 Q:'$D(XH(I)) W !,XH(I)
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPUYN 867 printed Dec 13, 2024@02:16:34 Page 2
PRCPUYN ;WISC/RFJ-yes,no reader ;29 Dec 93
+1 ;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
YN(%) ; yes, no reader
+1 ; %=default answer [1=yes,2=no];
+2 ; XP=prompt array [none,1,2,3...];
+3 ; XH=help array [none,1,2,3...]
+4 NEW I,X
+5 IF '$GET(%)
SET %=3
+6 FOR
Begin DoDot:1
+7 if $DATA(XP)
WRITE !,XP
FOR I=1:1
if '$DATA(XP(I))
QUIT
WRITE !,XP(I)
+8 WRITE "? ",$PIECE("YES// ^NO// ^<YES/NO> ","^",%)
+9 READ X:$SELECT($DATA(DTIME):DTIME,1:300)
IF '$TEST
WRITE " <<timeout>>"
SET X=0
QUIT
+10 IF X["^"
SET X=0
QUIT
+11 if X=""
SET X=%
SET X=$TRANSLATE($EXTRACT(X),"yYnN","1122")
SET X=+X
+12 IF X'=1
IF X'=2
DO HELP
KILL X
QUIT
+13 if $X>73
WRITE !
WRITE $PIECE(" (YES)^ (NO)","^",X)
End DoDot:1
if $DATA(X)
QUIT
+14 KILL XH,XP
+15 QUIT X
+16 ;
HELP IF '$DATA(XH)
WRITE !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!!
QUIT
+1 if $LENGTH($GET(XH))
WRITE !,XH
FOR I=1:1
if '$DATA(XH(I))
QUIT
WRITE !,XH(I)
+2 WRITE !
+3 QUIT
