Return to DIR0W.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIR0W.m, revision 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)," ","!"))