source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDW2.m@ 1806

Last change on this file since 1806 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1DDW2 ;SFISC/MKO-SETTINGS, MODES ;11:32 AM 25 Aug 2000
2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5TSET 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 ;
14TSALL ;Prompt for tab stops
15 N DDWHLP,DDWANS,DDWCOD
16 S DDWHLP(1)=" Specify in which column(s) you want to set tab stops. To set individual"
17 S DDWHLP(2)=" tab stops, type a series of numbers separated by commas, for example:"
18 S DDWHLP(3)=" 4,7,15,20. To set tab stops at repeated intervals after the last stop,"
19 S DDWHLP(4)=" or column 1, type the interval as +n, for example: 10,20,+5."
20 D ASK^DDWG(5,"Columns in which to set tab stops: ",30,$G(DDWTAB),"D TSALLVAL^DDW2",.DDWHLP,.DDWANS,.DDWCOD)
21 ;
22 Q:DDWCOD="TO"!(DDWANS=U)!(DDWANS=DDWTAB)
23 S DDWTAB=DDWANS
24 S DDWRUL=$$RULER(DDWTAB)
25 D RULER^DDW3,POS(DDWRW,DDWC)
26 Q
27 ;
28TSALLVAL ;Validate tab stops
29 K DDWERR
30 S:DDWX="@" DDWX=""
31 I DDWX?1."^"!($P($G(DDWCOD),U)="TO") S DDWX=U Q
32 I $TR(DDWX,"+,")?.E1.APC.E D
33 . S DDWERR=" Response can contain only commas (,), plus signs (+), and numbers."
34 Q
35 ;
36RULER(TAB) ;Return the ruler with tab stops
37 N C,INT,LAST,POS,RUL
38 S RUL=$TR($J("",255)," ","=")
39 ;
40 ;Process each comma piece in tab
41 S LAST=1
42 F C=1:1:$L(TAB,",") D
43 . S POS=$P(TAB,",",C) Q:POS'?.1"+"1.3N
44 . I $E(POS)="+" D
45 .. S INT=+$E(POS,2,999)
46 .. F POS=LAST+INT:INT:255 S $E(RUL,POS)="T"
47 . E S:POS<256 $E(RUL,POS)="T",LAST=POS
48 Q RUL
49 ;
50LSET I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
51 I DDWC>231 D ERR("Left margin cannot be set beyond column 231") Q
52 I DDWC'<DDWRMAR D ERR("Left margin must be left of right margin") Q
53 I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
54 . D CUP(DDWMR+1,DDWLMAR-DDWOFS) W $E(DDWRUL,DDWLMAR)
55 D CUP(DDWMR+1,DDWC-DDWOFS) W "<" D POS(DDWRW,DDWC)
56 S DDWLMAR=DDWC
57 Q
58 ;
59RSET I 'DDWRAP D ERR("Margins cannot be set when wrap is off") Q
60 I DDWC>245 D ERR("Right margin cannot be set beyond column 245") Q
61 I DDWC'>DDWLMAR D ERR("Right margin must be right of left margin") Q
62 I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
63 . D CUP(DDWMR+1,DDWRMAR-DDWOFS) W $E(DDWRUL,DDWRMAR)
64 D CUP(DDWMR+1,DDWC-DDWOFS) W ">" D POS(DDWRW,DDWC)
65 S DDWRMAR=DDWC
66 Q
67 ;
68WRAPM S DDWRAP=DDWRAP+1#2
69 D CUP(0,3) W $S(DDWRAP:"[ WRAP ]",1:"========")
70 I 'DDWRAP D
71 . S DDWLMAR(1)=DDWLMAR,DDWLMAR=1
72 . S DDWRMAR(1)=DDWRMAR,DDWRMAR=245
73 E D
74 . S DDWLMAR=DDWLMAR(1) K DDWLMAR(1)
75 . S DDWRMAR=DDWRMAR(1) K DDWRMAR(1)
76 D RULER^DDW3,POS(DDWRW,DDWC)
77 Q
78 ;
79REPLM S DDWREP=DDWREP+1#2
80 D CUP(0,13) W $S(DDWREP:"[ REPLACE ]",1:"[ INSERT ]=")
81 D POS(DDWRW,DDWC)
82 Q
83 ;
84STAT S DDWSTAT=DDWSTAT+1#2
85 I DDWSTAT S DDWTO=1
86 E D
87 . D CUP(DDWMR+2,1)
88 . W $P(DDGLCLR,DDGLDEL) D POS(DDWRW,DDWC)
89 . S DDWTO=DTIME
90 . K DDWTC
91 Q
92 ;
93CUP(Y,X) ;Cursor positioning
94 S DY=IOTM+Y-2,DX=X-1 X IOXY
95 Q
96 ;
97POS(R,C,F) ;Pos cursor based on char pos C
98 N DDWX
99 S:$G(C)="E" C=$L($G(DDWL(R)))+1
100 S:$G(F)["N" DDWN=$G(DDWL(R))
101 S:$G(F)["R" DDWRW=R,DDWC=C
102 ;
103 S DDWX=C-DDWOFS
104 I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
105 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
106 Q
107 ;
108SCR(C) ;Return screen number
109 Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
110 ;
111ERR(DDWX) ;Error
112 W $C(7)
113 D MSG^DDW(DDWX) H 2 D MSG^DDW()
114 F R *DDWX:0 E Q
115 D POS(DDWRW,DDWC)
116 Q
Note: See TracBrowser for help on using the repository browser.