- 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