Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPUYN

PRCPUYN.m

Go to the documentation of this file.
  1. PRCPUYN ;WISC/RFJ-yes,no reader ;29 Dec 93
  1. ;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. YN(%) ; yes, no reader
  1. ; %=default answer [1=yes,2=no];
  1. ; XP=prompt array [none,1,2,3...];
  1. ; XH=help array [none,1,2,3...]
  1. N I,X
  1. I '$G(%) S %=3
  1. F D Q:$D(X)
  1. . W:$D(XP) !,XP F I=1:1 Q:'$D(XP(I)) W !,XP(I)
  1. . W "? ",$P("YES// ^NO// ^<YES/NO> ","^",%)
  1. . R X:$S($D(DTIME):DTIME,1:300) E W " <<timeout>>" S X=0 Q
  1. . I X["^" S X=0 Q
  1. . S:X="" X=% S X=$TR($E(X),"yYnN","1122"),X=+X
  1. . I X'=1,X'=2 D HELP K X Q
  1. . W:$X>73 ! W $P(" (YES)^ (NO)","^",X)
  1. K XH,XP
  1. Q X
  1. ;
  1. HELP I '$D(XH) W !,"You must enter a 'Yes' or a 'No', or you may enter an '^' to Quit",!! Q
  1. W:$L($G(XH)) !,XH F I=1:1 Q:'$D(XH(I)) W !,XH(I)
  1. W !
  1. Q