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

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1DDW3 ;SFISC/MKO-TOP, BOTTOM, SCROLL ;9:08 AM 13 Feb 1996
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5TOP N DDWI
6 I DDWA=0 D POS(1,1,"RN") Q
7 D SHFTUP(1),POS(1,1,"RN")
8 Q
9 ;
10SHFTUP(DDWFL) ;
11 N DDWSH,DDWI
12 S DDWSH=DDWA+1-DDWFL
13 D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
14 ;
15 F DDWI=DDWMR:-1:$$MAX(1,DDWMR-DDWSH+1) D:DDWI+DDWA'>DDWCNT
16 . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
17 . S ^TMP("DDW",$J,DDWA+DDWI)=DDWL(DDWI)
18 ;
19 I $E(DDWBF,2) F DDWI=DDWA:-1:DDWFL+DDWMR D
20 . S DDWSTB=DDWSTB+1
21 . S ^TMP("DDW1",$J,DDWSTB)=^TMP("DDW",$J,DDWI)
22 E S DDWSTB=$$MAX(DDWCNT-DDWFL+1-DDWMR,0)
23 ;
24 S DDWA=DDWFL-1
25 I DDWSH>DDWMR D
26 . F DDWI=1:1:DDWMR S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
27 . I $P(DDWOFS,U,4)=1 D
28 .. D CUP(1,1)
29 .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
30 . D MSG^DDW()
31 E D
32 . F DDWI=DDWMR:-1:DDWSH+1 S DDWL(DDWI)=DDWL(DDWI-DDWSH)
33 . F DDWI=DDWSH:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
34 . D:$P(DDWOFS,U,4)=1 SCRDN(DDWSH)
35 ;
36 S:'DDWA $E(DDWBF,2)=0
37 Q
38 ;
39BOT N DDWI
40 I DDWSTB=0 D POS($$MIN(DDWMR,DDWCNT-DDWA),"E","RN") Q
41 D SHFTDN($$MAX(1,DDWCNT-DDWMR+1))
42 D POS(DDWMR,"E","RN")
43 Q
44 ;
45SHFTDN(DDWFL,DDWCOL) ;
46 N DDWNSTB,DDWSH,DDWI
47 S DDWSH=DDWFL-DDWA-1,DDWNSTB=DDWCNT-DDWFL+1
48 D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
49 ;
50 F DDWI=1:1:$$MIN(DDWSH,DDWMR) D
51 . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
52 . S ^TMP("DDW1",$J,DDWSTB+DDWMR-DDWI+1)=DDWL(DDWI)
53 .
54 ;
55 I $E(DDWBF,3) F DDWI=DDWSTB:-1:DDWNSTB+1 D
56 . S DDWA=DDWA+1
57 . S ^TMP("DDW",$J,DDWA)=^TMP("DDW1",$J,DDWI)
58 E S DDWA=DDWFL-1
59 ;
60 I DDWSH>DDWMR D
61 . F DDWI=1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
62 . I $P(DDWOFS,U,4)=$$SCR($S($D(DDWCOL):DDWCOL,1:$L(DDWL(DDWMR))+1)) D
63 .. D CUP(1,1)
64 .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
65 . D MSG^DDW()
66 E D
67 . F DDWI=1:1:DDWMR-DDWSH S DDWL(DDWI)=DDWL(DDWI+DDWSH)
68 . F DDWI=DDWMR-DDWSH+1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
69 . D:$P(DDWOFS,U,4)=$$SCR($L(DDWL(DDWMR))+1) SCRUP(DDWSH)
70 ;
71 S DDWSTB=$$MAX(0,DDWNSTB-DDWMR)
72 S:'DDWSTB $E(DDWBF,3)=0
73 Q
74 ;
75MVFWD(DDWNUM) ;
76 N DDWI
77 F DDWI=1:1:DDWNUM D
78 . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
79 . S ^TMP("DDW1",$J,DDWSTB+DDWMR-DDWI+1)=DDWL(DDWI)
80 F DDWI=1:1:DDWMR-DDWNUM S DDWL(DDWI)=DDWL(DDWI+DDWNUM)
81 F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
82 . S DDWL(DDWI)=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
83 D SCRUP(DDWNUM)
84 Q
85 ;
86SCRUP(DDWNUM) ;
87 N DDWI
88 D CUP(DDWMR,1)
89 F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
90 . I $P(DDGLED,DDGLDEL,2)]"" W $C(10)
91 . E D
92 .. D CUP(1,1) W $P(DDGLED,DDGLDEL,4)
93 .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
94 . I DDWL(DDWI)'?." " D
95 .. D CUP(DDWMR,1)
96 .. W $$LINE(DDWI,$G(DDWMARK))
97 D POS(DDWMR,DDWC,"RN")
98 Q
99 ;
100MVBCK(DDWNUM) ;
101 N DDWI
102 F DDWI=DDWMR:-1:DDWMR-DDWNUM+1 D:DDWI+DDWA'>DDWCNT
103 . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
104 . S ^TMP("DDW",$J,DDWA+DDWI)=DDWL(DDWI)
105 F DDWI=DDWMR:-1:DDWNUM+1 S DDWL(DDWI)=DDWL(DDWI-DDWNUM)
106 F DDWI=DDWNUM:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWA),DDWA=DDWA-1
107 D SCRDN(DDWNUM)
108 Q
109 ;
110SCRDN(DDWNUM) ;
111 N DDWI
112 D CUP(1,1)
113 F DDWI=DDWNUM:-1:1 D
114 . I $P(DDGLED,DDGLDEL,2)]"" W $P(DDGLED,DDGLDEL)
115 . E D
116 .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4)
117 .. D CUP(1,1) W $P(DDGLED,DDGLDEL,3)
118 . I DDWL(DDWI)'?." " D
119 .. D CUP(1,1)
120 .. W $$LINE(DDWI,$G(DDWMARK))
121 D POS(1,DDWC,"RN")
122 Q
123 ;
124ERR ;
125 W $C(7)
126 Q
127 ;
128CUP(Y,X) ;
129 S DY=IOTM+Y-2,DX=X-1 X IOXY
130 Q
131 ;
132POS(R,C,F) ;Pos cursor based on char pos C
133 N DDWX
134 S:$G(C)="E" C=$L($G(DDWL(R)))+1
135 S:$G(F)["N" DDWN=$G(DDWL(R))
136 S:$G(F)["R" DDWRW=R,DDWC=C
137 ;
138 S DDWX=C-DDWOFS
139 I DDWX>IOM!(DDWX<1) D SHIFT(C,.DDWOFS)
140 S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
141 Q
142 ;
143SHIFT(C,DDWOFS) ;
144 N DDWI,N,M,S
145 S N=$P(DDWOFS,U,2),M=$P(DDWOFS,U,3)
146 S S=$$SCR(C)
147 S DDWOFS=S-1*M_U_N_U_M_U_S
148 D RULER
149 F DDWI=1:1:$$MIN(DDWMR,DDWCNT) D
150 . S DY=IOTM+DDWI-2,DX=0 X IOXY
151 . W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))
152 Q
153 ;
154RULER ;Write ruler
155 D CUP(DDWMR+1,1)
156 W $P(DDGLCLR,DDGLDEL)_$E(DDWRUL,1+DDWOFS,IOM+DDWOFS)
157 I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
158 . D CUP(DDWMR+1,DDWLMAR-DDWOFS) W "<"
159 I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
160 . D CUP(DDWMR+1,DDWRMAR-DDWOFS) W ">"
161 Q
162 ;
163LINE(DDWI,DDWMARK) ;
164 N DDWX
165 S DDWX=$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
166 Q:$G(DDWMARK)="" DDWX
167 ;
168 N DDWR1,DDWC1,DDWR2,DDWC2
169 S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
170 S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
171 ;
172 I DDWI'<(DDWR1-DDWA),DDWI'>(DDWR2-DDWA) D
173 . N DDWX1,DDWX2
174 . S DDWX1=$S(DDWI=(DDWR1-DDWA):DDWC1,1:1)
175 . S DDWX2=$S(DDWI=(DDWR2-DDWA):DDWC2,1:999)
176 . S DDWX=$E(DDWL(DDWI),1+DDWOFS,DDWX1-1)_$P(DDGLVID,DDGLDEL,6)_$E(DDWL(DDWI),$$MAX(DDWX1,1+DDWOFS),$$MIN(DDWX2,IOM+DDWOFS))_$P(DDGLVID,DDGLDEL,10)_$E(DDWL(DDWI),$$MAX(DDWX2+1,1+DDWOFS),IOM+DDWOFS)
177 Q DDWX
178 ;
179SCR(C) ;
180 Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
181 ;
182MIN(X,Y) ;
183 Q $S(X<Y:X,1:Y)
184 ;
185MAX(X,Y) ;
186 Q $S(X>Y:X,1:Y)
Note: See TracBrowser for help on using the repository browser.