DIWE11.m

DIWE11 ;SFISC/GFT,MWE-WORD PROCESSING UTILITY FUNCTION ;3/4/92  9:55 AM

 ;;22.0;VA FileMan;;Mar 30, 1999

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

 S DWOU="EFT"

1 R !,"UTILITY Option: ",X:DTIME S:'$T DTOUT=1 G QQ:U[X!(X=".")

LC I X?1L S X=$C($A(X)-32)

 S J="^DOPT(""DIWE11""," I X?1U S I=$F(DWOU,X)-1 I I>0 S ^DISV(DUZ,J)=I S I=I*2-1 G OPT

 I X=" ",$D(^DISV(DUZ,J)) S I=^(J),X=$E(DWOU,I) I X]"" W X S I=I*2-1 G OPT

 W !?5,"Choose, by first letter, a Utility Command"

 I X?2"?".E W " from the following:" F I=1:2 S Y=$T(OPT+I),J=$E(Y,1) Q:J=" "  I DWOU[J W !?10,$P(Y,";",4)

 G 1

 ;

OPT Q:$D(DTOUT)  S X1=$T(OPT+I),X=$P(X1,";",3) W $E(X,'$X)_$E(X,2,99) G @$E(X1,1)

E ;;Editor;Editor Change

 G ^DIWE12

F ;;File transfer;File Transfer from Foreign CPU

 G NA:'$D(^%ZOSF("EON"))!'$D(^("EOFF")) D X^DIWE5 G QQ

T ;;Text-Terminator;Text-Terminator-String Change

 D TT G QQ

 ;;

TT ;

 W !,"Text-Terminator: ",$S(DIWPT="":"<NULL-STRING>",1:DIWPT),"//"

 R X:DTIME S:'$T DTOUT=1 Q:U[X

 K:$L(X)>5!(X'?.ANP)!(X["?")!(X["^") X

 I '$D(X) W !?5,"Answer must be 1 to 5 Characters, no question marks or up-arrows,",!?5,"to go back to the Null-String just type ""@"" !",$C(7) G TT

 I X="@" W !?5,"Text-Terminator is now Null-String !" S X=""

 S DIWPT=X Q

QQ K DWOU Q

ASK W ! S DIR("A")="MAXIMUM string length? "

 S DIR("B")=75,DIR(0)="N^3:245:0" D ^DIR K DIR I $D(DIRUT) S X="" G XQ1

 W !!,"You have 30 seconds to start sending text."

 W !,"An End Of File is assumed on 30 second time-out."

 W !!,"TABs are converted to 1 thru 9 spaces to start the next character"

 W !,"at a column evenly divisable by 9 plus 1. (10,19,28,37...)"

 W !!,"End of Line = Carriage Return/$C(13) or Escape/$C(27)."

 W !,"All other control characters will be stripped.",!!

 Q

XQ X ^%ZOSF("EON") W !!,"File Transfer Complete",$C(7),!

XQ1 K %,%1,%2,%B,%0,DIWL,DIR,DIRUT,DIROUT,DTOUT,DUOUT

 Q

NA W !!,"This option is not available without the rest of the KERNEL"

 G QQ

DIWE11    ;SFISC/GFT,MWE-WORD PROCESSING UTILITY FUNCTION ;3/4/92  9:55 AM

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

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

 +3        SET DWOU="EFT"

1          READ !,"UTILITY Option: ",X:DTIME

           IF '$TEST

               SET DTOUT=1

           IF U[X!(X=".")

               GOTO QQ

LC         IF X?1L

               SET X=$CHAR($ASCII(X)-32)

 +1        SET J="^DOPT(""DIWE11"","

           IF X?1U

               SET I=$FIND(DWOU,X)-1

               IF I>0

                   SET ^DISV(DUZ,J)=I

                   SET I=I*2-1

                   GOTO OPT

 +2        IF X=" "

               IF $DATA(^DISV(DUZ,J))

                   SET I=^(J)

                   SET X=$EXTRACT(DWOU,I)

                   IF X]""

                       WRITE X

                       SET I=I*2-1

                       GOTO OPT

 +3        WRITE !?5,"Choose, by first letter, a Utility Command"

 +4        IF X?2"?".E

               WRITE " from the following:"

               FOR I=1:2

                   SET Y=$TEXT(OPT+I)

                   SET J=$EXTRACT(Y,1)

                   IF J=" "

                       QUIT 

                   IF DWOU[J

                       WRITE !?10,$PIECE(Y,";",4)

 +5        GOTO 1

 +6       ;

OPT        IF $DATA(DTOUT)

               QUIT 

           SET X1=$TEXT(OPT+I)

           SET X=$PIECE(X1,";",3)

           WRITE $EXTRACT(X,'$X)_$EXTRACT(X,2,99)

           GOTO @$EXTRACT(X1,1)

E         ;;Editor;Editor Change

 +1        GOTO ^DIWE12

F         ;;File transfer;File Transfer from Foreign CPU

 +1        IF '$DATA(^%ZOSF("EON"))!'$DATA(^("EOFF"))

               GOTO NA

           DO X^DIWE5

           GOTO QQ

T         ;;Text-Terminator;Text-Terminator-String Change

 +1        DO TT

           GOTO QQ

 +2       ;;

TT        ;

 +1        WRITE !,"Text-Terminator: ",$SELECT(DIWPT="":"<NULL-STRING>",1:DIWPT),"//"

 +2        READ X:DTIME

           IF '$TEST

               SET DTOUT=1

           IF U[X

               QUIT 

 +3        IF $LENGTH(X)>5!(X'?.ANP)!(X["?")!(X["^")

               KILL X

 +4        IF '$DATA(X)

               WRITE !?5,"Answer must be 1 to 5 Characters, no question marks or up-arrows,",!?5,"to go back to the Null-String just type ""@"" !",$CHAR(7)

               GOTO TT

 +5        IF X="@"

               WRITE !?5,"Text-Terminator is now Null-String !"

               SET X=""

 +6        SET DIWPT=X

           QUIT 

QQ         KILL DWOU

           QUIT 

ASK        WRITE !

           SET DIR("A")="MAXIMUM string length? "

 +1        SET DIR("B")=75

           SET DIR(0)="N^3:245:0"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET X=""

               GOTO XQ1

 +2        WRITE !!,"You have 30 seconds to start sending text."

 +3        WRITE !,"An End Of File is assumed on 30 second time-out."

 +4        WRITE !!,"TABs are converted to 1 thru 9 spaces to start the next character"

 +5        WRITE !,"at a column evenly divisable by 9 plus 1. (10,19,28,37...)"

 +6        WRITE !!,"End of Line = Carriage Return/$C(13) or Escape/$C(27)."

 +7        WRITE !,"All other control characters will be stripped.",!!

 +8        QUIT 

XQ         XECUTE ^%ZOSF("EON")

           WRITE !!,"File Transfer Complete",$CHAR(7),!

XQ1        KILL %,%1,%2,%B,%0,DIWL,DIR,DIRUT,DIROUT,DTOUT,DUOUT

 +1        QUIT 

NA         WRITE !!,"This option is not available without the rest of the KERNEL"

 +1        GOTO QQ