Return to DIR0W.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIR0W.m, revision 1.1.1.1

1.1       snw         1: DIR0W  ;SFISC/MKO-WORD FUNCTIONS FOR FIELD EDITOR ;09:45 AM  12 Dec 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      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)," ","!"))