Return to DIR0W.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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)," ","!"))