Annotation of freem_fileman/DIR03.m, revision 1.1.1.1

1.1       snw         1: DIR03  ;SFISC/MKO-MULTILINE FIELD EDITOR ;03:37 PM  12 Oct 1994
                      2:        ;;21.0;VA FileMan;;Dec 28, 1994
                      3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
                      4:        F  D E X IOXY Q:DIR0DN
                      5:        Q
                      6:        ;
                      7: E      I $G(DIR0("REP"))&DIR0C>1!DIR0C>$L(DIR0A),$S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)>DX D
                      8:        . D PREAD^DIR01($S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)-DX,.DIR0ST,.DIR0CH)
                      9:        . Q:'$L(DIR0ST)
                     10:        . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
                     11:        . E  S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
                     12:        . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
                     13:        E  D READ^DIR01(.DIR0CH)
                     14:        Q:DIR0CH=""
                     15:        ;
                     16:        I "?^"[DIR0CH,DIR0C=1,'DIR0QU D  Q
                     17:        . D DEOF X IOXY
                     18:        . S DIR0A="",DIR0QU=1 D REP
                     19:        D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
                     20:        I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
                     21:        Q
                     22:        ;
                     23: REP    I DIR0C>DIR0M W $C(7) Q
                     24:        S DIR0CHG=1
                     25:        S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C+1,999)
                     26:        S DIR0C=DIR0C+1
                     27:        W DIR0CH
                     28:        I DX<DIR0F S DX=DX+1 Q
                     29:        S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S Q
                     30:        Q
                     31:        ;
                     32: INS    I $L(DIR0A)'<DIR0M W $C(7) Q
                     33:        S DIR0CHG=1
                     34:        S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999)
                     35:        W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
                     36:        D
                     37:        . N DIR0LN,DY,DX
                     38:        . S DX=DIR0S
                     39:        . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
                     40:        .. S DY=DIR0R+DIR0LN-1 X IOXY
                     41:        .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
                     42:        S DIR0C=DIR0C+1
                     43:        I DX<DIR0F S DX=DX+1 Q
                     44:        S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
                     45:        Q
                     46:        ;
                     47: RIGHT  Q:DIR0C>$L(DIR0A)
                     48:        S DIR0C=DIR0C+1
                     49:        I DX<DIR0F!(DIR0LN=DIR0NL) S DX=DX+1 Q
                     50:        S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
                     51:        Q
                     52:        ;
                     53: LEFT   Q:DIR0C'>1
                     54:        S DIR0C=DIR0C-1
                     55:        I DX>DIR0S S DX=DX-1 Q
                     56:        S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
                     57:        Q
                     58:        ;
                     59: JRT    Q:DIR0C>$L(DIR0A)
                     60:        Q:DX=DIR0F
                     61:        S DIR0C=DIR0LN*DIR0L S:DIR0C>$L(DIR0A) DIR0C=$L(DIR0A)+1
                     62:        S DX=DIR0C#DIR0L-1+DIR0S S:DX<DIR0S DX=DIR0F
                     63:        Q
                     64:        ;
                     65: JLT    Q:DIR0C'>1
                     66:        Q:DX=DIR0S
                     67:        S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
                     68:        Q
                     69:        ;
                     70: UP     Q:DIR0LN=1
                     71:        S DIR0C=DIR0C-DIR0L,DIR0LN=DIR0LN-1,DY=DY-1
                     72:        Q
                     73:        ;
                     74: DOWN   Q:DIR0LN=DIR0NL
                     75:        Q:$L(DIR0A)\DIR0L<DIR0LN
                     76:        S DIR0C=DIR0C+DIR0L,DIR0LN=DIR0LN+1,DY=DY+1
                     77:        S:DIR0C>($L(DIR0A)+1) DIR0C=$L(DIR0A)+1,DX=DIR0C#DIR0L+DIR0S-1
                     78:        Q
                     79:        ;
                     80: FDE    ;
                     81: NP     Q:DIR0C>$L(DIR0A)
                     82:        S DIR0C=$L(DIR0A)+1,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
                     83:        S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
                     84:        S DY=DIR0R+DIR0LN-1
                     85:        Q
                     86:        ;
                     87: FDB    ;
                     88: PP     Q:DIR0C'>1
                     89:        S DIR0LN=1,DY=DIR0R,DX=DIR0S,DIR0C=1
                     90:        Q
                     91:        ;
                     92: BS     Q:DIR0C'>1
                     93:        S DIR0CHG=1
                     94:        S DX=DX-1,DIR0C=DIR0C-1
                     95:        S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
                     96:        I DX<DIR0S S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
                     97:        X IOXY W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
                     98:        D
                     99:        . N DIR0LN,DY,DX
                    100:        . S DX=DIR0S
                    101:        . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
                    102:        .. S DY=DIR0R+DIR0LN-1 X IOXY
                    103:        .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
                    104:        S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
                    105:        Q
                    106:        ;
                    107: DEL    Q:DIR0C>$L(DIR0A)
                    108:        S DIR0CHG=1
                    109:        S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
                    110:        W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
                    111:        D
                    112:        . N DIR0LN,DY,DX
                    113:        . S DX=DIR0S
                    114:        . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
                    115:        .. S DY=DIR0R+DIR0LN-1 X IOXY
                    116:        .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
                    117:        S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
                    118:        Q
                    119:        ;
                    120: CLR    N %X
                    121:        S DIR0CHG=1
                    122:        S %X=DIR0A
                    123:        I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
                    124:        S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
                    125:        S %X=DIR0A_$J("",$L(%X)-$L(DIR0A))
                    126:        S DX=DIR0S
                    127:        F DIR0LN=1:1:$L(%X)\DIR0L+1 D
                    128:        . S DY=DIR0R+DIR0LN-1 X IOXY
                    129:        . W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
                    130:        S (DIR0C,DIR0LN)=1,DY=DIR0R
                    131:        Q
                    132:        ;
                    133: DEOF   N %X
                    134:        Q:DIR0C>$L(DIR0A)
                    135:        S DIR0CHG=1
                    136:        S %X=DIR0A,DIR0A=$E(DIR0A,1,DIR0C-1),%X=DIR0A_$J("",$L(%X)-$L(DIR0A))
                    137:        W $E(%X,DIR0C,DIR0C+DIR0F-DX)
                    138:        D
                    139:        . N DIR0LN,DY,DX
                    140:        . S DX=DIR0S
                    141:        . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(%X)\DIR0L+1 D
                    142:        .. S DY=DIR0R+DIR0LN-1 X IOXY
                    143:        .. W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
                    144:        Q
                    145:        ;
                    146: RPM    N DX,DY
                    147:        I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
                    148:        I $G(DIR0("REP")) W "Insert " K DIR0("REP")
                    149:        E  W "Replace" S DIR0("REP")=1
                    150:        Q
                    151:        ;
                    152: KPM    I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
                    153:        E  S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
                    154:        Q
                    155:        ;
                    156: WRT    G WRT2^DIR0W
                    157: WLT    ;
                    158: FDL    G WLT2^DIR0W
                    159: DLW    G DLW2^DIR0W
                    160:        ;
                    161: HLP    ;
                    162: NB     ;
                    163: SEL    ;
                    164: SV     ;
                    165: RF     ;
                    166: NOP    W $C(7)
                    167:        Q
                    168: TO     S DTOUT=1,DIR0A=DIR0D
                    169: ZM     ;
                    170: QT     ;
                    171: EX     ;
                    172: CL     ;
                    173: TAB    ;
                    174: CR     S DIR0DN=1
                    175:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>