DDGFBSEL ;SFISC/MKO-SELECT BLOCK ;07:50 AM 23 Aug 1993
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;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))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFBSEL 2939 printed Oct 16, 2024@18:42:53 Page 2
DDGFBSEL ;SFISC/MKO-SELECT BLOCK ;07:50 AM 23 Aug 1993
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;Sets:
+8 ; DDGFORIG(B) = original $Y^original $X for all blocks that were
+9 ; 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))
