PRCFAUTL.m

PRCFAUTL ;WISC@ALTOONA/CTB-UTILITY ROUTINE FOR PRCFA ;10 Sep 89/3:08 PM

V ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

YN ;

 K DTOUT S U="^" S:'$D(%)#2 %=3 S %S=%

 W:$D(%A) !,%A

 F %I=1:1 Q:'$D(%A(%I))  W !,%A(%I)

 W "? ",$P("YES// ^NO// ^(YES/NO) ",U,%)

RX R %Y:$S($D(DTIME):DTIME,1:300) E  S DTOUT=1,%Y=U W $C(7)

 S:%Y]""!'% %=$A(%Y),%=$S(%=89:1,%=121:1,%=78:2,%=110:2,%=94:-1,1:0)

 I '%,%Y'?."?" W $C(7),"??",!?4,"ANSWER 'YES' OR 'NO' ('^' TO QUIT): " G RX

 W:$X>73 ! W $P("  (YES)^  (NO)",U,%)

 G:%'=0 Q I $D(%B),%B]"" W !!,%B D C G:'$D(%A) Q S %=%S G YN

 I $D(%B),%B="" W !,"You may enter a 'Yes', or a 'No', or you may enter an '^' to Quit.",!! S %=%S G YN

 I $D(%A),'$D(%B) S %=%S G YN

Q K %Y,%A,%B,%S,%I Q

 Q

C F %I=1:1 Q:'$D(%B(%I))  W !,%B(%I)

 W ! Q

 ;

WAIT ;

 W !,"..."

 W $P("WHOOPS^HMMM^EXCUSE ME^SORRY","^",$R(4)+1),", "

 W $P($T(LIST+$R(6)),";",3)_"..."

LIST ;;THIS MAY TAKE A FEW MOMENTS

 ;;LET ME PUT YOU ON 'HOLD' FOR A SECOND

 ;;HOLD ON

 ;;JUST A MOMENT PLEASE

 ;;I'M WORKING AS FAST AS I CAN

 ;;LET ME THINK ABOUT THAT A MOMENT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCFAUTL   1128     printed  Apr 09, 2024@21:16:07                                                                                                                                                                                                    Page 2

PRCFAUTL  ;WISC@ALTOONA/CTB-UTILITY ROUTINE FOR PRCFA ;10 Sep 89/3:08 PM

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

YN        ;

 +1        KILL DTOUT

           SET U="^"

           if '$DATA(%)#2

               SET %=3

           SET %S=%

 +2        if $DATA(%A)

               WRITE !,%A

 +3        FOR %I=1:1

               if '$DATA(%A(%I))

                   QUIT 

               WRITE !,%A(%I)

 +4        WRITE "? ",$PIECE("YES// ^NO// ^(YES/NO) ",U,%)

RX         READ %Y:$SELECT($DATA(DTIME):DTIME,1:300)

          IF '$TEST

               SET DTOUT=1

               SET %Y=U

               WRITE $CHAR(7)

 +1        if %Y]""!'%

               SET %=$ASCII(%Y)

               SET %=$SELECT(%=89:1,%=121:1,%=78:2,%=110:2,%=94:-1,1:0)

 +2        IF '%

               IF %Y'?."?"

                   WRITE $CHAR(7),"??",!?4,"ANSWER 'YES' OR 'NO' ('^' TO QUIT): "

                   GOTO RX

 +3        if $X>73

               WRITE !

           WRITE $PIECE("  (YES)^  (NO)",U,%)

 +4        if %'=0

               GOTO Q

           IF $DATA(%B)

               IF %B]""

                   WRITE !!,%B

                   DO C

                   if '$DATA(%A)

                       GOTO Q

                   SET %=%S

                   GOTO YN

 +5        IF $DATA(%B)

               IF %B=""

                   WRITE !,"You may enter a 'Yes', or a 'No', or you may enter an '^' to Quit.",!!

                   SET %=%S

                   GOTO YN

 +6        IF $DATA(%A)

               IF '$DATA(%B)

                   SET %=%S

                   GOTO YN

Q          KILL %Y,%A,%B,%S,%I

           QUIT 

 +1        QUIT 

C          FOR %I=1:1

               if '$DATA(%B(%I))

                   QUIT 

               WRITE !,%B(%I)

 +1        WRITE !

           QUIT 

 +2       ;

WAIT      ;

 +1        WRITE !,"..."

 +2        WRITE $PIECE("WHOOPS^HMMM^EXCUSE ME^SORRY","^",$RANDOM(4)+1),", "

 +3        WRITE $PIECE($TEXT(LIST+$RANDOM(6)),";",3)_"..."

LIST      ;;THIS MAY TAKE A FEW MOMENTS

 +1       ;;LET ME PUT YOU ON 'HOLD' FOR A SECOND

 +2       ;;HOLD ON

 +3       ;;JUST A MOMENT PLEASE

 +4       ;;I'M WORKING AS FAST AS I CAN

 +5       ;;LET ME THINK ABOUT THAT A MOMENT