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 (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDW2	;SFISC/MKO-SETTINGS, MODES ;08:17 AM  30 Aug 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: TSET	N DDWX
    6: 	S DDWX=$E(DDWRUL,DDWC)
    7: 	S DDWX=$S(DDWX="T":"=",DDWX="=":"T",1:DDWX)
    8: 	S $E(DDWRUL,DDWC)=DDWX
    9: 	I DDWC'=DDWLMAR,DDWC'=DDWRMAR D
   10: 	. D CUP(DDWMR+1,DDWC-DDWOFS) W DDWX
   11: 	. D POS(DDWRW,DDWC)
   12: 	Q
   13: 	;
   14: LSET	I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
   15: 	I DDWC>231 D ERR("Left margin cannot be set beyond column 231") Q
   16: 	I DDWC'<DDWRMAR D ERR("Left margin must be left of right margin") Q
   17: 	I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
   18: 	. D CUP(DDWMR+1,DDWLMAR-DDWOFS) W $E(DDWRUL,DDWLMAR)
   19: 	D CUP(DDWMR+1,DDWC-DDWOFS) W "<" D POS(DDWRW,DDWC)
   20: 	S DDWLMAR=DDWC
   21: 	Q
   22: 	;
   23: RSET	I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
   24: 	I DDWC>245 D ERR("Right margin cannot be set beyond column 245") Q
   25: 	I DDWC'>DDWLMAR D ERR("Right margin must be right of left margin") Q
   26: 	I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
   27: 	. D CUP(DDWMR+1,DDWRMAR-DDWOFS) W $E(DDWRUL,DDWRMAR)
   28: 	D CUP(DDWMR+1,DDWC-DDWOFS) W ">" D POS(DDWRW,DDWC)
   29: 	S DDWRMAR=DDWC
   30: 	Q
   31: 	;
   32: WRAPM	S DDWRAP=DDWRAP+1#2
   33: 	D CUP(0,3) W $S(DDWRAP:"[ WRAP ]",1:"========")
   34: 	I 'DDWRAP D
   35: 	. S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
   36: 	. S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
   37: 	E  D
   38: 	. S DDWLMAR=DDWLMAR(1) K DDWLMAR(1)
   39: 	. S DDWRMAR=DDWRMAR(1) K DDWRMAR(1)
   40: 	D RULER^DDW3,POS(DDWRW,DDWC)
   41: 	Q
   42: 	;
   43: REPLM	S DDWREP=DDWREP+1#2
   44: 	D CUP(0,13) W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
   45: 	D POS(DDWRW,DDWC)
   46: 	Q
   47: 	;
   48: STAT	S DDWSTAT=DDWSTAT+1#2
   49: 	I DDWSTAT D
   50: 	. S DDWTO=1,DDWTC=1
   51: 	E  D
   52: 	. D CUP(DDWMR+2,1)
   53: 	. W $P(DDGLCLR,DDGLDEL) D POS(DDWRW,DDWC)
   54: 	. S DDWTO=DTIME
   55: 	Q
   56: 	;
   57: CUP(Y,X)	;Cursor positioning
   58: 	S DY=IOTM+Y-2,DX=X-1 X IOXY
   59: 	Q
   60: 	;
   61: POS(R,C,F)	;Pos cursor based on char pos C
   62: 	N DDWX
   63: 	S:$G(C)="E" C=$L($G(DDWL(R)))+1
   64: 	S:$G(F)["N" DDWN=$G(DDWL(R))
   65: 	S:$G(F)["R" DDWRW=R,DDWC=C
   66: 	;
   67: 	S DDWX=C-DDWOFS
   68: 	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
   69: 	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
   70: 	Q
   71: 	;
   72: SCR(C)	;Return screen number
   73: 	Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
   74: 	;
   75: ERR(DDWX)	;Error
   76: 	W $C(7)
   77: 	D MSG^DDW(DDWX) H 2 D MSG^DDW()
   78: 	F  R *DDWX:0 E  Q
   79: 	Q

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