File:  [Coherent Logic Development] / freem_fileman / USER / DDW2.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

DDW2	;SFISC/MKO-SETTINGS, MODES ;08:17 AM  30 Aug 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	;
TSET	N DDWX
	S DDWX=$E(DDWRUL,DDWC)
	S DDWX=$S(DDWX="T":"=",DDWX="=":"T",1:DDWX)
	S $E(DDWRUL,DDWC)=DDWX
	I DDWC'=DDWLMAR,DDWC'=DDWRMAR D
	. D CUP(DDWMR+1,DDWC-DDWOFS) W DDWX
	. D POS(DDWRW,DDWC)
	Q
	;
LSET	I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
	I DDWC>231 D ERR("Left margin cannot be set beyond column 231") Q
	I DDWC'<DDWRMAR D ERR("Left margin must be left of right margin") Q
	I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
	. D CUP(DDWMR+1,DDWLMAR-DDWOFS) W $E(DDWRUL,DDWLMAR)
	D CUP(DDWMR+1,DDWC-DDWOFS) W "<" D POS(DDWRW,DDWC)
	S DDWLMAR=DDWC
	Q
	;
RSET	I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
	I DDWC>245 D ERR("Right margin cannot be set beyond column 245") Q
	I DDWC'>DDWLMAR D ERR("Right margin must be right of left margin") Q
	I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
	. D CUP(DDWMR+1,DDWRMAR-DDWOFS) W $E(DDWRUL,DDWRMAR)
	D CUP(DDWMR+1,DDWC-DDWOFS) W ">" D POS(DDWRW,DDWC)
	S DDWRMAR=DDWC
	Q
	;
WRAPM	S DDWRAP=DDWRAP+1#2
	D CUP(0,3) W $S(DDWRAP:"[ WRAP ]",1:"========")
	I 'DDWRAP D
	. S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
	. S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
	E  D
	. S DDWLMAR=DDWLMAR(1) K DDWLMAR(1)
	. S DDWRMAR=DDWRMAR(1) K DDWRMAR(1)
	D RULER^DDW3,POS(DDWRW,DDWC)
	Q
	;
REPLM	S DDWREP=DDWREP+1#2
	D CUP(0,13) W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
	D POS(DDWRW,DDWC)
	Q
	;
STAT	S DDWSTAT=DDWSTAT+1#2
	I DDWSTAT D
	. S DDWTO=1,DDWTC=1
	E  D
	. D CUP(DDWMR+2,1)
	. W $P(DDGLCLR,DDGLDEL) D POS(DDWRW,DDWC)
	. S DDWTO=DTIME
	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)	;Return screen number
	Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
	;
ERR(DDWX)	;Error
	W $C(7)
	D MSG^DDW(DDWX) H 2 D MSG^DDW()
	F  R *DDWX:0 E  Q
	Q

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