source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGFBSEL.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.6 KB
RevLine 
[613]1DDGFBSEL ;SFISC/MKO-SELECT BLOCK ;07:50 AM 23 Aug 1993
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;Sets:
5 ; DDGFORIG(B) = original $Y^original $X for all blocks that were
6 ; selected, since they were potentially moved
7SELECT ;
8 N B,C,C1,C2,C3
9 N B1,X1,X2
10 ;
11 ;Which element is the cursor on?
12 ;Set B=Block
13 S X1="" K B
14 F S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1)) Q:X1=""!(DX<X1) D
15 . S X2=""
16 . F S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2)) Q:X2="" D Q:$G(B)
17 .. Q:DX>X2
18 .. S B=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,""))
19 .. I @DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,B)="H",$O(^(B)) S B=$O(^(B))
20 Q:'$G(B)
21 ;
22 ;Get caption and coordinates
23 S B1=$G(@DDGFREF@("F",DDGFPG,B)) Q:B1=""
24 S C1=$P(B1,U),C2=$P(B1,U,2),C3=$P(B1,U,3),C=$P(B1,U,4)
25 ;
26 S:@DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)="H" DDGFHDR=1
27 D COVER
28 ;
29 K B1,X1,X2
30 G ^DDGF4
31 ;
32COVER ;
33 N H,O,L
34 ;Clear and/or kill portions of DDGFREF
35 K @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)
36 ;
37 ;Remember original block coordinates
38 S:$D(DDGFORIG(B))[0 DDGFORIG(B)=C1_U_C2
39 ;
40 ;Look for covered (hidden) fields
41 ;Set H(B) - array of hidden fields
42 S X1=""
43 F S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1)) Q:X1="" D
44 . S X2=""
45 . F S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2)) Q:X2="" D
46 .. S H=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2,""))
47 .. I H]"",$D(H(H))[0,$$OVERLAP(C2,C3,X1,X2) S H(H)=""
48 ;
49 ;Clear in buffer area occupied by element(s) selected
50 ;If block on the page border, redraw the lines
51 S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
52 D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
53 ;
54 I $P(@DDGFREF@("F",DDGFPG),U,3) D
55 . I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
56 .. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
57 .. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
58 .. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDE,$S(C1=$P(DDGFLIM,U):6,1:8))
59 .. D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
60 . E I C2=$P(DDGFLIM,U,2) D
61 .. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
62 . E I C3'<$P(DDGFLIM,U,4) D
63 .. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
64 ;
65 ;Write to buffer the overlapped blocks(s)
66 I $D(H)>1 S H="" F S H=$O(H(H)) Q:H="" D
67 . S B1=$G(@DDGFREF@("F",DDGFPG,H)) Q:B1=""
68 . D WRITE^DDGLIBW(DDGFWIDB,$P(B1,U,4),$P(B1,U)-$P(DDGFLIM,U),$P(B1,U,2)-$P(DDGFLIM,U,2),"",1)
69 Q
70 ;
71OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
72 N T
73 I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
74 Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
Note: See TracBrowser for help on using the repository browser.