- DDGFUPDB ;SFISC/MKO-UPDATE BLOCK COORDINATES ;03:28 PM 17 Aug 1993
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- DDGFUPDB ;SFISC/MKO-UPDATE BLOCK COORDINATES ;03:28 PM 17 Aug 1993
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
