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

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

initial load of WorldVistAEHR
File size: 2.8 KB
Line 
1DIR0W ;SFISC/MKO-WORD FUNCTIONS FOR FIELD EDITOR ;09:45 AM 12 Dec 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5WRT N DIR0I
6 Q:DIR0C>$L(DIR0A)
7 S DIR0I=$$WRPOS(DIR0A)
8 ;
9 I DIR0C-DX+DIR0S+DIR0L>DIR0I S DX=DX+DIR0I-DIR0C,DIR0C=DIR0I Q
10 S DIR0C=DIR0I,DX=DIR0S X IOXY
11 I $L(DIR0A)-DIR0L<DIR0C D
12 . W $E(DIR0A,$L(DIR0A)-DIR0L+1,$L(DIR0A))
13 . S DX=DIR0S+DIR0C-$L(DIR0A)+DIR0L-1
14 E W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
15 Q
16 ;
17WLT N DIR0D,DIR0I,DIR0T
18 Q:DIR0C=1
19 S DIR0T=$$PUNC(DIR0A)
20 ;
21 S DIR0I=DIR0C-1
22 I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
23 I $E(DIR0T,DIR0I)="!" D
24 . F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
25 E I DIR0I D
26 . F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
27 S DIR0I=DIR0I+1
28 ;
29 I DIR0C-DX+DIR0S'>DIR0I S DX=DX-DIR0C+DIR0I,DIR0C=DIR0I Q
30 S DIR0C=DIR0I,DX=DIR0S X IOXY
31 I DIR0L'<DIR0C W $E(DIR0A,1,DIR0L) S DX=DIR0S+DIR0C-1 Q
32 S DX=DIR0L*2\3+DIR0S W $E(DIR0A,DIR0C-DX+DIR0S,DIR0C+DIR0F-DX-1)
33 Q
34 ;
35DLW N DIR0I,DIR0X
36 Q:DIR0C>$L(DIR0A)
37 S DIR0CHG=1
38 ;
39 S DIR0I=$$WRPOS(DIR0A)
40 S $E(DIR0A,DIR0C,DIR0I-1)=""
41 ;
42 S DIR0X=DIR0L\3+DIR0S
43 I DX>DIR0X,$L($E(DIR0A,DIR0C,$L(DIR0A)))+DIR0X>DIR0F D
44 . S DX=DIR0S X IOXY
45 . W $E(DIR0A,DIR0C-DIR0X+DIR0S,DIR0C+DIR0F-DIR0X-1)
46 . S DX=DIR0X
47 E D
48 . S DIR0X=$E(DIR0A,DIR0C,DIR0C+DIR0F-DX-1)
49 . S DIR0X=DIR0X_$J("",DIR0F-DX-$L(DIR0X))
50 . W DIR0X
51 Q
52 ;
53WRT2 Q:DIR0C>$L(DIR0A)
54 S DIR0C=$$WRPOS(DIR0A)
55 ;
56 I DIR0C>$L(DIR0A) S DIR0C=0 D FDE^DIR03 Q
57 S DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
58 S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
59 S DY=DIR0R+DIR0LN-1
60 Q
61 ;
62WLT2 N DIR0D,DIR0I,DIR0T
63 Q:DIR0C=1
64 S DIR0T=$$PUNC(DIR0A)
65 ;
66 S DIR0I=DIR0C-1
67 I $E(DIR0T,DIR0I)=" " F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'=" "
68 I $E(DIR0T,DIR0I)="!" D
69 . F DIR0I=DIR0I-1:-1:0 Q:$E(DIR0T,DIR0I)'="!"
70 E I DIR0I D
71 . F DIR0I=DIR0I-1:-1:0 Q:" !"[$E(DIR0T,DIR0I)
72 S DIR0I=DIR0I+1
73 ;
74 I DIR0I=1 D FDB^DIR03 Q
75 S DIR0C=DIR0I,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
76 S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
77 S DY=DIR0R+DIR0LN-1
78 Q
79 ;
80DLW2 N DIR0I,DIR0X
81 Q:DIR0C>$L(DIR0A)
82 S DIR0CHG=1
83 ;
84 S DIR0I=$$WRPOS(DIR0A)
85 S $E(DIR0A,DIR0C,DIR0I-1)=""
86 ;
87 S DIR0X=DIR0A_$J("",DIR0I-DIR0C)
88 W $E(DIR0X,DIR0C,DIR0C+DIR0F-DX)
89 D
90 . N DY,DX
91 . S DX=DIR0S
92 . F DIR0I=DIR0C\DIR0L+2:1:$L(DIR0X)\DIR0L+1 D
93 .. S DY=DIR0R+DIR0I-1 X IOXY
94 .. W $E(DIR0X,DIR0I-1*DIR0L+1,DIR0I*DIR0L)
95 Q
96 ;
97WRPOS(DIR0T) ;
98 N DIR0I,DIR0P,DIR0S
99 S DIR0T=$$PUNC(DIR0T)
100 S DIR0S=$F(DIR0T," ",DIR0C+1),DIR0P=$F(DIR0T,"!",DIR0C+1)
101 S:'DIR0S DIR0S=999 S:'DIR0P DIR0P=999
102 ;
103 I DIR0S=999,DIR0P=999 D
104 . S DIR0I=$L(DIR0T)+1
105 E I $E(DIR0T,DIR0C)="!" D
106 . F DIR0I=DIR0C+1:1 Q:$E(DIR0T,DIR0I)'="!"
107 . F DIR0I=DIR0I:1 Q:$E(DIR0T,DIR0I)'=" "
108 E I DIR0S<DIR0P D
109 . F DIR0I=DIR0S:1 Q:$E(DIR0T,DIR0I)'=" "
110 E S DIR0I=DIR0P-1
111 Q DIR0I
112 ;
113PUNC(X) ;
114 Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))
Note: See TracBrowser for help on using the repository browser.