- DDGFBSEL ;SFISC/MKO-SELECT BLOCK ;07:50 AM 23 Aug 1993
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;Sets:
- ; DDGFORIG(B) = original $Y^original $X for all blocks that were
- ; selected, since they were potentially moved
- SELECT ;
- N B,C,C1,C2,C3
- N B1,X1,X2
- ;
- ;Which element is the cursor on?
- ;Set B=Block
- S X1="" K B
- F S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1)) Q:X1=""!(DX<X1) D
- . S X2=""
- . F S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2)) Q:X2="" D Q:$G(B)
- .. Q:DX>X2
- .. S B=$O(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,""))
- .. I @DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,B)="H",$O(^(B)) S B=$O(^(B))
- Q:'$G(B)
- ;
- ;Get caption and coordinates
- S B1=$G(@DDGFREF@("F",DDGFPG,B)) Q:B1=""
- S C1=$P(B1,U),C2=$P(B1,U,2),C3=$P(B1,U,3),C=$P(B1,U,4)
- ;
- S:@DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)="H" DDGFHDR=1
- D COVER
- ;
- K B1,X1,X2
- G ^DDGF4
- ;
- COVER ;
- N H,O,L
- ;Clear and/or kill portions of DDGFREF
- K @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)
- ;
- ;Remember original block coordinates
- S:$D(DDGFORIG(B))[0 DDGFORIG(B)=C1_U_C2
- ;
- ;Look for covered (hidden) fields
- ;Set H(B) - array of hidden fields
- S X1=""
- F S X1=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1)) Q:X1="" D
- . S X2=""
- . F S X2=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2)) Q:X2="" D
- .. S H=$O(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2,""))
- .. I H]"",$D(H(H))[0,$$OVERLAP(C2,C3,X1,X2) S H(H)=""
- ;
- ;Clear in buffer area occupied by element(s) selected
- ;If block on the page border, redraw the lines
- S L=$J("",$L(C)-$S(C3>$P(DDGFLIM,U,4):C3-$P(DDGFLIM,U,4),1:0))
- D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"",1)
- ;
- I $P(@DDGFREF@("F",DDGFPG),U,3) D
- . I C1=$P(DDGFLIM,U)!(C1=$P(DDGFLIM,U,3)) D
- .. S L=$TR(L," ",$P(DDGLGRA,DDGLDEL,3))
- .. S:C2=$P(DDGFLIM,U,2) $E(L)=$P(DDGLGRA,DDGLDEL,$S(C1=$P(DDGFLIM,U):5,1:7))
- .. S:C3'<$P(DDGFLIM,U,4) $E(L,$L(L))=$P(DDGLGRA,DDGLDE,$S(C1=$P(DDGFLIM,U):6,1:8))
- .. D WRITE^DDGLIBW(DDGFWIDB,L,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
- . E I C2=$P(DDGFLIM,U,2) D
- .. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2),"G",1)
- . E I C3'<$P(DDGFLIM,U,4) D
- .. D WRITE^DDGLIBW(DDGFWIDB,$P(DDGLGRA,DDGLDEL,4),C1-$P(DDGFLIM,U),$P(DDGFLIM,U,4)-$P(DDGFLIM,U,2),"G",1)
- ;
- ;Write to buffer the overlapped blocks(s)
- I $D(H)>1 S H="" F S H=$O(H(H)) Q:H="" D
- . S B1=$G(@DDGFREF@("F",DDGFPG,H)) Q:B1=""
- . D WRITE^DDGLIBW(DDGFWIDB,$P(B1,U,4),$P(B1,U)-$P(DDGFLIM,U),$P(B1,U,2)-$P(DDGFLIM,U,2),"",1)
- Q
- ;
- OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
- N T
- I A1<B1 S T=A1,A1=B1,B1=T,T=A2,A2=B2,B2=T
- Q A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
- DDGFBSEL ;SFISC/MKO-SELECT BLOCK ;07:50 AM 23 Aug 1993
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;Sets:
- +4 ; DDGFORIG(B) = original $Y^original $X for all blocks that were
- +5 ; selected, since they were potentially moved
- SELECT ;
- +1 NEW B,C,C1,C2,C3
- +2 NEW B1,X1,X2
- +3 ;
- +4 ;Which element is the cursor on?
- +5 ;Set B=Block
- +6 SET X1=""
- KILL B
- +7 FOR
- SET X1=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,DY,X1))
- IF X1=""!(DX<X1)
- QUIT
- Begin DoDot:1
- +8 SET X2=""
- +9 FOR
- SET X2=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2))
- IF X2=""
- QUIT
- Begin DoDot:2
- +10 IF DX>X2
- QUIT
- +11 SET B=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,""))
- +12 IF @DDGFREF@("BKRC",DDGFWIDB,DY,X1,X2,B)="H"
- IF $ORDER(^(B))
- SET B=$ORDER(^(B))
- End DoDot:2
- IF $GET(B)
- QUIT
- End DoDot:1
- +13 IF '$GET(B)
- QUIT
- +14 ;
- +15 ;Get caption and coordinates
- +16 SET B1=$GET(@DDGFREF@("F",DDGFPG,B))
- IF B1=""
- QUIT
- +17 SET C1=$PIECE(B1,U)
- SET C2=$PIECE(B1,U,2)
- SET C3=$PIECE(B1,U,3)
- SET C=$PIECE(B1,U,4)
- +18 ;
- +19 IF @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)="H"
- SET DDGFHDR=1
- +20 DO COVER
- +21 ;
- +22 KILL B1,X1,X2
- +23 GOTO ^DDGF4
- +24 ;
- COVER ;
- +1 NEW H,O,L
- +2 ;Clear and/or kill portions of DDGFREF
- +3 KILL @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)
- +4 ;
- +5 ;Remember original block coordinates
- +6 IF $DATA(DDGFORIG(B))[0
- SET DDGFORIG(B)=C1_U_C2
- +7 ;
- +8 ;Look for covered (hidden) fields
- +9 ;Set H(B) - array of hidden fields
- +10 SET X1=""
- +11 FOR
- SET X1=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,C1,X1))
- IF X1=""
- QUIT
- Begin DoDot:1
- +12 SET X2=""
- +13 FOR
- SET X2=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2))
- IF X2=""
- QUIT
- Begin DoDot:2
- +14 SET H=$ORDER(@DDGFREF@("BKRC",DDGFWIDB,C1,X1,X2,""))
- +15 IF H]""
- IF $DATA(H(H))[0
- IF $$OVERLAP(C2,C3,X1,X2)
- SET H(H)=""
- End DoDot:2
- End DoDot:1
- +16 ;
- +17 ;Clear in buffer area occupied by element(s) selected
- +18 ;If block on the page border, redraw the lines
- +19 SET L=$JUSTIFY("",$LENGTH(C)-$SELECT(C3>$PIECE(DDGFLIM,U,4):C3-$PIECE(DDGFLIM,U,4),1:0))
- +20 DO WRITE^DDGLIBW(DDGFWIDB,L,C1-$PIECE(DDGFLIM,U),C2-$PIECE(DDGFLIM,U,2),"",1)
- +21 ;
- +22 IF $PIECE(@DDGFREF@("F",DDGFPG),U,3)
- Begin DoDot:1
- +23 IF C1=$PIECE(DDGFLIM,U)!(C1=$PIECE(DDGFLIM,U,3))
- Begin DoDot:2
- +24 SET L=$TRANSLATE(L," ",$PIECE(DDGLGRA,DDGLDEL,3))
- +25 IF C2=$PIECE(DDGFLIM,U,2)
- SET $EXTRACT(L)=$PIECE(DDGLGRA,DDGLDEL,$SELECT(C1=$PIECE(DDGFLIM,U):5,1:7))
- +26 IF C3'<$PIECE(DDGFLIM,U,4)
- SET $EXTRACT(L,$LENGTH(L))=$PIECE(DDGLGRA,DDGLDE,$SELECT(C1=$PIECE(DDGFLIM,U):6,1:8))
- +27 DO WRITE^DDGLIBW(DDGFWIDB,L,C1-$PIECE(DDGFLIM,U),C2-$PIECE(DDGFLIM,U,2),"G",1)
- End DoDot:2
- +28 IF '$TEST
- IF C2=$PIECE(DDGFLIM,U,2)
- Begin DoDot:2
- +29 DO WRITE^DDGLIBW(DDGFWIDB,$PIECE(DDGLGRA,DDGLDEL,4),C1-$PIECE(DDGFLIM,U),C2-$PIECE(DDGFLIM,U,2),"G",1)
- End DoDot:2
- +30 IF '$TEST
- IF C3'<$PIECE(DDGFLIM,U,4)
- Begin DoDot:2
- +31 DO WRITE^DDGLIBW(DDGFWIDB,$PIECE(DDGLGRA,DDGLDEL,4),C1-$PIECE(DDGFLIM,U),$PIECE(DDGFLIM,U,4)-$PIECE(DDGFLIM,U,2),"G",1)
- End DoDot:2
- End DoDot:1
- +32 ;
- +33 ;Write to buffer the overlapped blocks(s)
- +34 IF $DATA(H)>1
- SET H=""
- FOR
- SET H=$ORDER(H(H))
- IF H=""
- QUIT
- Begin DoDot:1
- +35 SET B1=$GET(@DDGFREF@("F",DDGFPG,H))
- IF B1=""
- QUIT
- +36 DO WRITE^DDGLIBW(DDGFWIDB,$PIECE(B1,U,4),$PIECE(B1,U)-$PIECE(DDGFLIM,U),$PIECE(B1,U,2)-$PIECE(DDGFLIM,U,2),"",1)
- End DoDot:1
- +37 QUIT
- +38 ;
- OVERLAP(A1,A2,B1,B2) ;Does line with X-coords A1,A2 overlap B1,B2
- +1 NEW T
- +2 IF A1<B1
- SET T=A1
- SET A1=B1
- SET B1=T
- SET T=A2
- SET A2=B2
- SET B2=T
- +3 QUIT A1'<B1&(A1'>B2)!(A2'<B1&(A2'>B2))
