Return to DDW4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDW4	;SFISC/PD KELTZ-OTHER NAVIGATION, DEL ;09:00 AM  23 Jun 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
TAB	N DDWX
	S DDWX=$F(DDWRUL,"T",DDWC+1) G:'DDWX ERR
	D POS(DDWRW,DDWX-1,"R")
	Q
	;
DEOL	S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
	W $P(DDGLCLR,DDGLDEL)
	Q
	;
DELW	N DDWI,DDWW
	I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
	I DDWC>$L(DDWN) D  Q
	. I DDWN?." " D
	.. D XLINE^DDW5()
	. E  D
	.. N DDWY,DDWX
	.. S DDWY=DDWRW+DDWA,DDWX=DDWC
	.. D JOIN^DDW6
	.. D POS(DDWY-DDWA,DDWX,"RN")
	;
	S DDWI=$$WRPOS(DDWN)
	S DDWW=$E(DDWN,DDWC,DDWI-1)
	S $E(DDWN,DDWC,DDWI-1)="",DDWL(DDWRW)=DDWN
	I $P(DDGLED,DDGLDEL,6)]"" D
	. F DDWI=1:1:$L(DDWW) W $P(DDGLED,DDGLDEL,6)
	. S DDWI=$E(DDWN,IOM-$L(DDWW)+1+DDWOFS,IOM+DDWOFS)
	. I DDWI]"" D CUP(DDWRW,IOM-$L(DDWW)+1) W DDWI D CUP(DDWRW,DDWC-DDWOFS)
	E  D
	. W $E(DDWN_$J("",$L(DDWW)),DDWC,IOM+DDWOFS)
	. D CUP(DDWRW,DDWC-DDWOFS)
	Q
	;
WORDR	N DDWI
	S DDWI=$$WRPOS(DDWN)
	D POS(DDWRW,DDWI,"R")
	Q
	;
WRPOS(DDWT)	;
	N DDWP,DDWS
	S DDWT=$$PUNC(DDWT)
	S DDWS=$F(DDWT," ",DDWC+1),DDWP=$F(DDWT,"!",DDWC+1)
	S:'DDWS DDWS=999 S:'DDWP DDWP=999
	;
	I DDWC>$L(DDWT) D
	. I DDWRW+DDWA'<DDWCNT S DDWI=$L(DDWT)+1
	. E  D DN^DDWT1 S DDWI=1
	E  I DDWS=999,DDWP=999 D
	. S DDWI=$L(DDWT)+1
	E  I $E(DDWT,DDWC)="!" D
	. F DDWI=DDWC+1:1 Q:$E(DDWT,DDWI)'="!"
	. F DDWI=DDWI:1 Q:$E(DDWT,DDWI)'=" "
	E  I DDWS<DDWP D
	. F DDWI=DDWS:1 Q:$E(DDWT,DDWI)'=" "
	E  S DDWI=DDWP-1
	Q DDWI
	;
WORDL	N DDWD,DDWI,DDWT
	S DDWT=$$PUNC(DDWN)
	;
	I DDWC=1 D
	. I DDWRW=1,'DDWA S DDWI=1
	. E  D UP^DDWT1 S DDWI=$L(DDWN)+1
	E  D
	. S DDWI=DDWC-1
	. S:$E(DDWT,DDWI)="" DDWI=$L(DDWT)
	. I $E(DDWT,DDWI)=" " F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'=" "
	. I $E(DDWT,DDWI)="!" D
	.. F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'="!"
	. E  I DDWI D
	.. F DDWI=DDWI-1:-1:0 Q:" !"[$E(DDWT,DDWI)
	. S DDWI=DDWI+1
	D POS(DDWRW,DDWI,"R")
	Q
	;
PGDN	N DDWX
	I DDWRW<DDWMR D
	. D POS($$MIN(DDWCNT-DDWA,DDWMR),DDWC,"RN")
	E  D
	. S DDWX=$$MIN(DDWSTB,DDWMR)
	. D:DDWX MVFWD^DDW3(DDWX)
	Q
	;
PGUP	N DDWX
	I DDWRW>1 D
	. D POS(1,DDWC,"RN")
	E  D
	. S DDWX=$$MIN(DDWA,DDWMR)
	. D:DDWX MVBCK^DDW3(DDWX)
	Q
	;
JLEFT	N DDWX
	I DDWN?." " S DDWX=1
	E  F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
	I DDWC-DDWOFS=1,DDWC>1 D POS(DDWRW,DDWC-1,"R") Q:DDWC=DDWX
	S DDWC=$$MAX($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:0),1+DDWOFS)
	D POS(DDWRW,DDWC,"R")
	Q
JRIGHT	N DDWX
	S DDWX=$L(DDWN)+1
	I DDWC-DDWOFS=IOM,DDWC<246 D POS(DDWRW,DDWC+1,"R") Q:DDWC=DDWX
	S DDWC=$$MIN($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:999),$$MIN(IOM+DDWOFS,246))
	D POS(DDWRW,DDWC,"R")
	Q
	;
LBEG	N DDWX
	F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
	D POS(DDWRW,DDWX,"R")
	Q
LEND	D POS(DDWRW,"E","R")
	Q
	;
ERR	;Beep
	W $C(7)
	Q
	;
CUP(Y,X)	;Cursor positioning
	S DY=IOTM+Y-2,DX=X-1 X IOXY
	Q
	;
POS(R,C,F)	;Pos cursor based on char pos C
	N DDWX
	S:$G(C)="E" C=$L($G(DDWL(R)))+1
	S:$G(F)["N" DDWN=$G(DDWL(R))
	S:$G(F)["R" DDWRW=R,DDWC=C
	;
	S DDWX=C-DDWOFS
	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
	Q
	;
SCR(C)	;Screen #
	Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
	;
MIN(X,Y)	;
	Q $S(X<Y:X,1:Y)
MAX(X,Y)	;
	Q $S(X>Y:X,1:Y)
PUNC(X)	;
	Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))