Annotation of freem_fileman/DDW2.m, revision 1.1.1.1
1.1 snw 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>