| 1 | DIR0W ;SFISC/MKO-WORD FUNCTIONS FOR FIELD EDITOR ;09:45 AM 12 Dec 1994
|
---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | WRT N DIR0I
|
---|
| 6 | Q:DIR0C>$L(DIR0A)
|
---|
| 7 | S DIR0I=$$WRPOS(DIR0A)
|
---|
| 8 | ;
|
---|
| 9 | I DIR0C-DX+DIR0S+DIR0L>DIR0I S DX=DX+DIR0I-DIR0C,DIR0C=DIR0I Q
|
---|
| 10 | S DIR0C=DIR0I,DX=DIR0S X IOXY
|
---|
| 11 | I $L(DIR0A)-DIR0L<DIR0C D
|
---|
| 12 | . W $E(DIR0A,$L(DIR0A)-DIR0L+1,$L(DIR0A))
|
---|
| 13 | . S DX=DIR0S+DIR0C-$L(DIR0A)+DIR0L-1
|
---|
| 14 | E W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
|
---|
| 15 | Q
|
---|
| 16 | ;
|
---|
| 17 | WLT N DIR0D,DIR0I,DIR0T
|
---|
| 18 | Q:DIR0C=1
|
---|
| 19 | S DIR0T=$$PUNC(DIR0A)
|
---|
| 20 | ;
|
---|
| 21 | S DIR0I=DIR0C-1
|
---|
| 22 | I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
|
---|
| 23 | I $E(DIR0T,DIR0I)="!" D
|
---|
| 24 | . F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
|
---|
| 25 | E I DIR0I D
|
---|
| 26 | . F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
|
---|
| 27 | S DIR0I=DIR0I+1
|
---|
| 28 | ;
|
---|
| 29 | I DIR0C-DX+DIR0S'>DIR0I S DX=DX-DIR0C+DIR0I,DIR0C=DIR0I Q
|
---|
| 30 | S DIR0C=DIR0I,DX=DIR0S X IOXY
|
---|
| 31 | I DIR0L'<DIR0C W $E(DIR0A,1,DIR0L) S DX=DIR0S+DIR0C-1 Q
|
---|
| 32 | S DX=DIR0L*2\3+DIR0S W $E(DIR0A,DIR0C-DX+DIR0S,DIR0C+DIR0F-DX-1)
|
---|
| 33 | Q
|
---|
| 34 | ;
|
---|
| 35 | DLW N DIR0I,DIR0X
|
---|
| 36 | Q:DIR0C>$L(DIR0A)
|
---|
| 37 | S DIR0CHG=1
|
---|
| 38 | ;
|
---|
| 39 | S DIR0I=$$WRPOS(DIR0A)
|
---|
| 40 | S $E(DIR0A,DIR0C,DIR0I-1)=""
|
---|
| 41 | ;
|
---|
| 42 | S DIR0X=DIR0L\3+DIR0S
|
---|
| 43 | I DX>DIR0X,$L($E(DIR0A,DIR0C,$L(DIR0A)))+DIR0X>DIR0F D
|
---|
| 44 | . S DX=DIR0S X IOXY
|
---|
| 45 | . W $E(DIR0A,DIR0C-DIR0X+DIR0S,DIR0C+DIR0F-DIR0X-1)
|
---|
| 46 | . S DX=DIR0X
|
---|
| 47 | E D
|
---|
| 48 | . S DIR0X=$E(DIR0A,DIR0C,DIR0C+DIR0F-DX-1)
|
---|
| 49 | . S DIR0X=DIR0X_$J("",DIR0F-DX-$L(DIR0X))
|
---|
| 50 | . W DIR0X
|
---|
| 51 | Q
|
---|
| 52 | ;
|
---|
| 53 | WRT2 Q:DIR0C>$L(DIR0A)
|
---|
| 54 | S DIR0C=$$WRPOS(DIR0A)
|
---|
| 55 | ;
|
---|
| 56 | I DIR0C>$L(DIR0A) S DIR0C=0 D FDE^DIR03 Q
|
---|
| 57 | S DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
|
---|
| 58 | S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
|
---|
| 59 | S DY=DIR0R+DIR0LN-1
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | WLT2 N DIR0D,DIR0I,DIR0T
|
---|
| 63 | Q:DIR0C=1
|
---|
| 64 | S DIR0T=$$PUNC(DIR0A)
|
---|
| 65 | ;
|
---|
| 66 | S DIR0I=DIR0C-1
|
---|
| 67 | I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
|
---|
| 68 | I $E(DIR0T,DIR0I)="!" D
|
---|
| 69 | . F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
|
---|
| 70 | E I DIR0I D
|
---|
| 71 | . F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
|
---|
| 72 | S DIR0I=DIR0I+1
|
---|
| 73 | ;
|
---|
| 74 | I DIR0I=1 D FDB^DIR03 Q
|
---|
| 75 | S DIR0C=DIR0I,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
|
---|
| 76 | S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
|
---|
| 77 | S DY=DIR0R+DIR0LN-1
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | DLW2 N DIR0I,DIR0X
|
---|
| 81 | Q:DIR0C>$L(DIR0A)
|
---|
| 82 | S DIR0CHG=1
|
---|
| 83 | ;
|
---|
| 84 | S DIR0I=$$WRPOS(DIR0A)
|
---|
| 85 | S $E(DIR0A,DIR0C,DIR0I-1)=""
|
---|
| 86 | ;
|
---|
| 87 | S DIR0X=DIR0A_$J("",DIR0I-DIR0C)
|
---|
| 88 | W $E(DIR0X,DIR0C,DIR0C+DIR0F-DX)
|
---|
| 89 | D
|
---|
| 90 | . N DY,DX
|
---|
| 91 | . S DX=DIR0S
|
---|
| 92 | . F DIR0I=DIR0C\DIR0L+2:1:$L(DIR0X)\DIR0L+1 D
|
---|
| 93 | .. S DY=DIR0R+DIR0I-1 X IOXY
|
---|
| 94 | .. W $E(DIR0X,DIR0I-1*DIR0L+1,DIR0I*DIR0L)
|
---|
| 95 | Q
|
---|
| 96 | ;
|
---|
| 97 | WRPOS(DIR0T) ;
|
---|
| 98 | N DIR0I,DIR0P,DIR0S
|
---|
| 99 | S DIR0T=$$PUNC(DIR0T)
|
---|
| 100 | S DIR0S=$F(DIR0T," ",DIR0C+1),DIR0P=$F(DIR0T,"!",DIR0C+1)
|
---|
| 101 | S:'DIR0S DIR0S=999 S:'DIR0P DIR0P=999
|
---|
| 102 | ;
|
---|
| 103 | I DIR0S=999,DIR0P=999 D
|
---|
| 104 | . S DIR0I=$L(DIR0T)+1
|
---|
| 105 | E I $E(DIR0T,DIR0C)="!" D
|
---|
| 106 | . F DIR0I=DIR0C+1:1 Q:$E(DIR0T,DIR0I)'="!"
|
---|
| 107 | . F DIR0I=DIR0I:1 Q:$E(DIR0T,DIR0I)'=" "
|
---|
| 108 | E I DIR0S<DIR0P D
|
---|
| 109 | . F DIR0I=DIR0S:1 Q:$E(DIR0T,DIR0I)'=" "
|
---|
| 110 | E S DIR0I=DIR0P-1
|
---|
| 111 | Q DIR0I
|
---|
| 112 | ;
|
---|
| 113 | PUNC(X) ;
|
---|
| 114 | Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))
|
---|