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

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DDGF4 ;SFISC/MKO-ACTIONS AFTER BLOCK SELECTION ;02:49 PM 12 Oct 1994
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Input:
5 ; B = Block number
6 ; C = Block name
7 ; C1 = Block $Y
8 ; C2 = Block $X1
9 ; C3 = Block $X2
10 ; DDGFHDR = 1, if block is immobile (header block)
11 ;
12 N DDGFE
13 S:'$G(DDGFHDR) DDGFHDR=0
14 D PAINTS
15 ;
16 S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
17 D CLEANUP
18 Q
19 ;
20LNU Q:C1'>$P(DDGFLIM,U)!DDGFHDR
21 D REDRAW
22 S C1=C1-1,DY=DY-1
23 D PAINTS
24 Q
25LND Q:C1'<$P(DDGFLIM,U,3)!DDGFHDR
26 D REDRAW
27 S C1=C1+1,DY=DY+1
28 D PAINTS
29 Q
30CHR Q:C2'<$P(DDGFLIM,U,4)!DDGFHDR
31 D REDRAW
32 S C2=C2+1,DX=DX+1
33 D PAINTS
34 Q
35CHL Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
36 D REDRAW
37 S C2=C2-1,DX=DX-1
38 D PAINTS
39 Q
40TBR N X
41 Q:C2+$L(C)>$P(DDGFLIM,U,4)!DDGFHDR
42 D REDRAW
43 S X=$$MIN(5,$P(DDGFLIM,U,4)-C2-$L(C)+1)
44 S C2=C2+X,DX=DX+X
45 D PAINTS
46 Q
47TBL N X
48 Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
49 D REDRAW
50 S X=$$MIN(5,C2-$P(DDGFLIM,U,2))
51 S C2=C2-X,DX=DX-X
52 D PAINTS
53 Q
54SCT Q:C1'>$P(DDGFLIM,U)!DDGFHDR
55 D REDRAW
56 S (C1,DY)=$P(DDGFLIM,U)
57 D PAINTS
58 Q
59SCB Q:C1'<$P(DDGFLIM,U,3)!DDGFHDR
60 D REDRAW
61 S (C1,DY)=$P(DDGFLIM,U,3)
62 D PAINTS
63 Q
64SCR N X
65 Q:C2+$L(C)>$P(DDGFLIM,U,4)!DDGFHDR
66 D REDRAW
67 S X=$P(DDGFLIM,U,4)-C2-$L(C)+1
68 S C2=C2+X,DX=DX+X
69 D PAINTS
70 Q
71SCL N X
72 Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
73 D REDRAW
74 S X=C2-$P(DDGFLIM,U,2)
75 S C2=C2-X,DX=DX-X
76 D PAINTS
77 Q
78 ;
79EDIT ;Edit block parameters
80 G:'$G(DDGFHDR) EDIT^DDGFBK
81 G EDIT^DDGFHBK
82 ;
83REORDER ;Reorder fields on block
84 D EN^DDGFORD(B)
85 Q
86 ;
87TO ;Time-out
88 W $C(7)
89 G DESELECT
90 ;
91DESELECT ;
92 S DDGFE=1
93 Q
94 ;
95CLEANUP ;
96 I '$G(DDGFBDEL) D
97 . S C3=C2+$L(C)-1
98 . S @DDGFREF@("F",DDGFPG,B)=C1_U_C2_U_C3_U_C_U_1,DDGFCHG=1
99 . S @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)=$S($G(DDGFHDR):"H",1:"")
100 ;
101 I '$G(DDGFEBV),'$G(DDGFBDEL) D
102 . D WRITE^DDGLIBW(DDGFWIDB,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2))
103 . X IOXY
104 K DDGFHDR,DDGFBDEL
105 Q
106 ;
107RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
108 N S
109 I DDGFR D
110 . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
111 . X IOXY W S_$J("",7-$L(S))
112 S DY=DDGFY,DX=DDGFX X IOXY
113 Q
114 ;
115REDRAW ;
116 D REPAINT^DDGLIBW(DDGFWIDB,(C1-$P(DDGFLIM,U))_U_(C2-$P(DDGFLIM,U,2))_U_1_U_$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))
117 Q
118 ;
119PAINTS ;
120 N Y,X
121 S Y=DY,X=DX
122 S DY=C1,DX=C2 X IOXY
123 W $P(DDGLVID,DDGLDEL,6)_$E(C,1,$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))_$P(DDGLVID,DDGLDEL,10)
124 D RC(Y,X)
125 Q
126 ;
127MIN(X,Y,Z) ;Return the minimum of two or three numbers
128 N A
129 S A=$S(X<Y:X,1:Y)
130 Q:$G(Z)="" A
131 Q $S(A<Z:A,1:Z)
132 ;
133READ() N S,Y
134 F R *Y:DTIME D C Q:Y'=-1
135 Q Y
136 ;
137C I Y<0 S Y="TO" Q
138 S S=""
139C1 S S=S_$C(Y)
140 I DDGF("SIN")'[(U_S) D I Y=-1 W $C(7) Q
141 . I $C(Y)'?1L S Y=-1 Q
142 . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
143 ;
144 I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
145 R *Y:5 G:Y'=-1 C1 W $C(7)
146 Q
Note: See TracBrowser for help on using the repository browser.