Return to DIR03.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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