Return to DIR0W.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DIR0W	;SFISC/MKO-WORD FUNCTIONS FOR FIELD EDITOR ;09:45 AM  12 Dec 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
WRT	N DIR0I
	Q:DIR0C>$L(DIR0A)
	S DIR0I=$$WRPOS(DIR0A)
	;
	I DIR0C-DX+DIR0S+DIR0L>DIR0I S DX=DX+DIR0I-DIR0C,DIR0C=DIR0I Q
	S DIR0C=DIR0I,DX=DIR0S X IOXY
	I $L(DIR0A)-DIR0L<DIR0C D
	. W $E(DIR0A,$L(DIR0A)-DIR0L+1,$L(DIR0A))
	. S DX=DIR0S+DIR0C-$L(DIR0A)+DIR0L-1
	E  W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
	Q
	;
WLT	N DIR0D,DIR0I,DIR0T
	Q:DIR0C=1
	S DIR0T=$$PUNC(DIR0A)
	;
	S DIR0I=DIR0C-1
	I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
	I $E(DIR0T,DIR0I)="!" D
	. F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
	E  I DIR0I D
	. F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
	S DIR0I=DIR0I+1
	;
	I DIR0C-DX+DIR0S'>DIR0I S DX=DX-DIR0C+DIR0I,DIR0C=DIR0I Q
	S DIR0C=DIR0I,DX=DIR0S X IOXY
	I DIR0L'<DIR0C W $E(DIR0A,1,DIR0L) S DX=DIR0S+DIR0C-1 Q
	S DX=DIR0L*2\3+DIR0S W $E(DIR0A,DIR0C-DX+DIR0S,DIR0C+DIR0F-DX-1)
	Q
	;
DLW	N DIR0I,DIR0X
	Q:DIR0C>$L(DIR0A)
	S DIR0CHG=1
	;
	S DIR0I=$$WRPOS(DIR0A)
	S $E(DIR0A,DIR0C,DIR0I-1)=""
	;
	S DIR0X=DIR0L\3+DIR0S
	I DX>DIR0X,$L($E(DIR0A,DIR0C,$L(DIR0A)))+DIR0X>DIR0F D
	. S DX=DIR0S X IOXY
	. W $E(DIR0A,DIR0C-DIR0X+DIR0S,DIR0C+DIR0F-DIR0X-1)
	. S DX=DIR0X
	E  D
	. S DIR0X=$E(DIR0A,DIR0C,DIR0C+DIR0F-DX-1)
	. S DIR0X=DIR0X_$J("",DIR0F-DX-$L(DIR0X))
	. W DIR0X
	Q
	;
WRT2	Q:DIR0C>$L(DIR0A)
	S DIR0C=$$WRPOS(DIR0A)
	;
	I DIR0C>$L(DIR0A) S DIR0C=0 D FDE^DIR03 Q
	S DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
	S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
	S DY=DIR0R+DIR0LN-1
	Q
	;
WLT2	N DIR0D,DIR0I,DIR0T
	Q:DIR0C=1
	S DIR0T=$$PUNC(DIR0A)
	;
	S DIR0I=DIR0C-1
	I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
	I $E(DIR0T,DIR0I)="!" D
	. F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
	E  I DIR0I D
	. F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
	S DIR0I=DIR0I+1
	;
	I DIR0I=1 D FDB^DIR03 Q
	S DIR0C=DIR0I,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
	S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
	S DY=DIR0R+DIR0LN-1
	Q
	;
DLW2	N DIR0I,DIR0X
	Q:DIR0C>$L(DIR0A)
	S DIR0CHG=1
	;
	S DIR0I=$$WRPOS(DIR0A)
	S $E(DIR0A,DIR0C,DIR0I-1)=""
	;
	S DIR0X=DIR0A_$J("",DIR0I-DIR0C)
	W $E(DIR0X,DIR0C,DIR0C+DIR0F-DX)
	D
	. N DY,DX
	. S DX=DIR0S
	. F DIR0I=DIR0C\DIR0L+2:1:$L(DIR0X)\DIR0L+1 D
	.. S DY=DIR0R+DIR0I-1 X IOXY
	.. W $E(DIR0X,DIR0I-1*DIR0L+1,DIR0I*DIR0L)
	Q
	;
WRPOS(DIR0T)	;
	N DIR0I,DIR0P,DIR0S
	S DIR0T=$$PUNC(DIR0T)
	S DIR0S=$F(DIR0T," ",DIR0C+1),DIR0P=$F(DIR0T,"!",DIR0C+1)
	S:'DIR0S DIR0S=999 S:'DIR0P DIR0P=999
	;
	I DIR0S=999,DIR0P=999 D
	. S DIR0I=$L(DIR0T)+1
	E  I $E(DIR0T,DIR0C)="!" D
	. F DIR0I=DIR0C+1:1 Q:$E(DIR0T,DIR0I)'="!"
	. F DIR0I=DIR0I:1 Q:$E(DIR0T,DIR0I)'=" "
	E  I DIR0S<DIR0P D
	. F DIR0I=DIR0S:1 Q:$E(DIR0T,DIR0I)'=" "
	E  S DIR0I=DIR0P-1
	Q DIR0I
	;
PUNC(X)	;
	Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))