DDGFUPDB ;SFISC/MKO-UPDATE BLOCK COORDINATES ;03:28 PM 17 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.
;
BLK(DDGFORIG) ;
;Update image with adjusted block coordinates
; DDGFORIG(B) : defined for all blocks that changed coordinates
; = original $Y^original $X
N P,P1,P2,B,B1,B2,F,C1,C2,C3,C,D1,D2,D3,L,X1,Y1,N,I
;
;Get page coordinates
S P=DDGFPG
S P1=$P(@DDGFREF@("F",P),U),P2=$P(@DDGFREF@("F",P),U,2)
;
;Loop through all blocks on page
S B="" F S B=$O(@DDGFREF@("F",P,B)) Q:B="" D BK
Q
;
BK ;Get block coordinates
S B2=@DDGFREF@("F",P,B)
S B1=$P(B2,U),B2=$P(B2,U,2)
;
;Get Y1=delta $Y, X1=delta $X
I $D(DDGFORIG(B)) S Y1=B1-$P(DDGFORIG(B),U),X1=B2-$P(DDGFORIG(B),U,2)
E S (Y1,X1)=0
I 'Y1,'X1 K DDGFORIG(B)
;
;Loop through all fields on block
S F="" F S F=$O(@DDGFREF@("F",P,B,F)) Q:F="" D FD
Q
;
FD ;
;Get field data
S N=@DDGFREF@("F",P,B,F)
S C1=$P(N,U),C2=$P(N,U,2),C3=$P(N,U,3),C=$P(N,U,4)
S D1=$P(N,U,5),D2=$P(N,U,6),D3=$P(N,U,7),L=$P(N,U,8)
;
I $D(DDGFORIG(B)) D
. I Y1 S:C1]"" $P(N,U)=C1+Y1 S:L $P(N,U,5)=D1+Y1
. I X1 D
.. I C]"" F I=2,3 S $P(N,U,I)=$P(N,U,I)+X1
.. I L F I=6,7 S $P(N,U,I)=$P(N,U,I)+X1
. S @DDGFREF@("F",P,B,F)=N
. ;
. I C]"" D
.. K @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")
.. S @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,3),B,F,"C")=""
. I L D
.. K @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")
.. S @DDGFREF@("RC",DDGFWID,$P(N,U,5),$P(N,U,6),$P(N,U,7),B,F,"D")=""
;
I C]"" D WRITE^DDGLIBW(DDGFWID,C,$P(N,U)-P1,$P(N,U,2)-P2)
I L D WRITE^DDGLIBW(DDGFWID,$TR($J("",L)," ","_"),$P(N,U,5)-P1,$P(N,U,6)-P2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFUPDB 1919 printed Jan 18, 2025@03:43:29 Page 2
DDGFUPDB ;SFISC/MKO-UPDATE BLOCK COORDINATES ;03:28 PM 17 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 ;
BLK(DDGFORIG) ;
+1 ;Update image with adjusted block coordinates
+2 ; DDGFORIG(B) : defined for all blocks that changed coordinates
+3 ; = original $Y^original $X
+4 NEW P,P1,P2,B,B1,B2,F,C1,C2,C3,C,D1,D2,D3,L,X1,Y1,N,I
+5 ;
+6 ;Get page coordinates
+7 SET P=DDGFPG
+8 SET P1=$PIECE(@DDGFREF@("F",P),U)
SET P2=$PIECE(@DDGFREF@("F",P),U,2)
+9 ;
+10 ;Loop through all blocks on page
+11 SET B=""
FOR
SET B=$ORDER(@DDGFREF@("F",P,B))
if B=""
QUIT
DO BK
+12 QUIT
+13 ;
BK ;Get block coordinates
+1 SET B2=@DDGFREF@("F",P,B)
+2 SET B1=$PIECE(B2,U)
SET B2=$PIECE(B2,U,2)
+3 ;
+4 ;Get Y1=delta $Y, X1=delta $X
+5 IF $DATA(DDGFORIG(B))
SET Y1=B1-$PIECE(DDGFORIG(B),U)
SET X1=B2-$PIECE(DDGFORIG(B),U,2)
+6 IF '$TEST
SET (Y1,X1)=0
+7 IF 'Y1
IF 'X1
KILL DDGFORIG(B)
+8 ;
+9 ;Loop through all fields on block
+10 SET F=""
FOR
SET F=$ORDER(@DDGFREF@("F",P,B,F))
if F=""
QUIT
DO FD
+11 QUIT
+12 ;
FD ;
+1 ;Get field data
+2 SET N=@DDGFREF@("F",P,B,F)
+3 SET C1=$PIECE(N,U)
SET C2=$PIECE(N,U,2)
SET C3=$PIECE(N,U,3)
SET C=$PIECE(N,U,4)
+4 SET D1=$PIECE(N,U,5)
SET D2=$PIECE(N,U,6)
SET D3=$PIECE(N,U,7)
SET L=$PIECE(N,U,8)
+5 ;
+6 IF $DATA(DDGFORIG(B))
Begin DoDot:1
+7 IF Y1
if C1]""
SET $PIECE(N,U)=C1+Y1
if L
SET $PIECE(N,U,5)=D1+Y1
+8 IF X1
Begin DoDot:2
+9 IF C]""
FOR I=2,3
SET $PIECE(N,U,I)=$PIECE(N,U,I)+X1
+10 IF L
FOR I=6,7
SET $PIECE(N,U,I)=$PIECE(N,U,I)+X1
End DoDot:2
+11 SET @DDGFREF@("F",P,B,F)=N
+12 ;
+13 IF C]""
Begin DoDot:2
+14 KILL @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")
+15 SET @DDGFREF@("RC",DDGFWID,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,3),B,F,"C")=""
End DoDot:2
+16 IF L
Begin DoDot:2
+17 KILL @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")
+18 SET @DDGFREF@("RC",DDGFWID,$PIECE(N,U,5),$PIECE(N,U,6),$PIECE(N,U,7),B,F,"D")=""
End DoDot:2
End DoDot:1
+19 ;
+20 IF C]""
DO WRITE^DDGLIBW(DDGFWID,C,$PIECE(N,U)-P1,$PIECE(N,U,2)-P2)
+21 IF L
DO WRITE^DDGLIBW(DDGFWID,$TRANSLATE($JUSTIFY("",L)," ","_"),$PIECE(N,U,5)-P1,$PIECE(N,U,6)-P2)
+22 QUIT
