DDGFUPDP ;SFISC/MKO-UPDATE PAGE COORDINATES ;01:37 PM 19 Jan 1994
;;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.
;
PAGE(P1,P2,P3,P4,T,A) ;
;
D DESTROY^DDGLIBW(DDGFWID,1),DESTROY^DDGLIBW(DDGFWIDB,1)
I P3]"" D
. D REPALL^DDGLIBW($G(A))
. D CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1),1)
. S DDGFLIM=P1_U_P2_U_P3_U_P4
E D
. D CLOSEALL^DDGLIBW()
. D CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(IOSL-7-P1)_U_(IOM-1-P2))
. S DDGFLIM=P1_U_P2_U_(IOSL-8)_U_(IOM-2)
D:T="PTOP" TOP(P1,P2,P3,P4)
D:T="PBRC" BRC(P1,P2,P3,P4)
Q
;
TOP(P1,P2,P3,P4) ;Update page image
;
N B,C,C1,C2,C3,D1,D2,D3,F,I,L,N,P,X1,Y1
;
S P=DDGFPG
S N=@DDGFREF@("F",P)
S Y1=P1-$P(N,U),X1=P2-$P(N,U,2)
I 'Y1,'X1 Q
;
I $P(N,U,3)]"" D
. K @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,4),"P","P","PTOP")
. K @DDGFREF@("RC",DDGFWID,$P(N,U,3),$P(N,U,4),$P(N,U,4),"P","P","PBRC")
I $G(P3)]"" D
. S @DDGFREF@("RC",DDGFWID,P1,P2,P4,"P","P","PTOP")=""
. S @DDGFREF@("RC",DDGFWID,P3,P4,P4,"P","P","PBRC")=""
;
S $P(N,U,1,4)=P1_U_P2_U_P3_U_P4,$P(N,U,7)=1,DDGFCHG=1
S @DDGFREF@("F",P)=N
;
;Loop through all blocks on page
S B="" F S B=$O(@DDGFREF@("F",P,B)) Q:B="" D
. S N=@DDGFREF@("F",P,B)
. S @DDGFREF@("BKRC",DDGFWIDB,$P(N,U)+Y1,$P(N,U,2)+X1,$P(N,U,3)+X1,B)=@DDGFREF@("BKRC",DDGFWIDB,$P(N,U),$P(N,U,2),$P(N,U,3),B)
. K @DDGFREF@("BKRC",DDGFWIDB,$P(N,U),$P(N,U,2),$P(N,U,3),B)
. S $P(N,U,1,3)=$P(N,U)+Y1_U_($P(N,U,2)+X1)_U_($P(N,U,3)+X1)
. S @DDGFREF@("F",P,B)=N
. ;
. S F="" F S F=$O(@DDGFREF@("F",P,B,F)) Q:F="" D
.. 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 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")=""
.. ;
.. D:C]"" WRITE^DDGLIBW(DDGFWID,C,$P(N,U)-P1,$P(N,U,2)-P2)
.. D:L WRITE^DDGLIBW(DDGFWID,$TR($J("",L)," ","_"),$P(N,U,5)-P1,$P(N,U,6)-P2)
Q
;
BRC(P1,P2,P3,P4) ;Change bottom right coordinate of page
N B,C,F,L,N,P
S P=DDGFPG
S N=@DDGFREF@("F",P)
I $P(N,U,3)]"" D
. K @DDGFREF@("RC",DDGFWID,$P(N,U),$P(N,U,2),$P(N,U,4),"P","P","PTOP")
. K @DDGFREF@("RC",DDGFWID,$P(N,U,3),$P(N,U,4),$P(N,U,4),"P","P","PBRC")
I $G(P3)]"" D
. S @DDGFREF@("RC",DDGFWID,P1,P2,P4,"P","P","PTOP")=""
. S @DDGFREF@("RC",DDGFWID,P3,P4,P4,"P","P","PBRC")=""
;
S $P(N,U,1,4)=P1_U_P2_U_P3_U_P4,$P(N,U,7)=1,DDGFCHG=1
S @DDGFREF@("F",P)=N
;
;Loop through all blocks/fields on page
S B="" F S B=$O(@DDGFREF@("F",P,B)) Q:B="" D
. S F="" F S F=$O(@DDGFREF@("F",P,B,F)) Q:F="" D
.. S N=@DDGFREF@("F",P,B,F)
.. S C=$P(N,U,4),L=$P(N,U,8)
.. ;
.. 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[HDDGFUPDP 3440 printed Apr 09, 2024@21:55:08 Page 2
DDGFUPDP ;SFISC/MKO-UPDATE PAGE COORDINATES ;01:37 PM 19 Jan 1994
+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 ;
PAGE(P1,P2,P3,P4,T,A) ;
+1 ;
+2 DO DESTROY^DDGLIBW(DDGFWID,1)
DO DESTROY^DDGLIBW(DDGFWIDB,1)
+3 IF P3]""
Begin DoDot:1
+4 DO REPALL^DDGLIBW($GET(A))
+5 DO CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1),1)
+6 SET DDGFLIM=P1_U_P2_U_P3_U_P4
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 DO CLOSEALL^DDGLIBW()
+9 DO CREATE^DDGLIBW(DDGFWID,P1_U_P2_U_(IOSL-7-P1)_U_(IOM-1-P2))
+10 SET DDGFLIM=P1_U_P2_U_(IOSL-8)_U_(IOM-2)
End DoDot:1
+11 if T="PTOP"
DO TOP(P1,P2,P3,P4)
+12 if T="PBRC"
DO BRC(P1,P2,P3,P4)
+13 QUIT
+14 ;
TOP(P1,P2,P3,P4) ;Update page image
+1 ;
+2 NEW B,C,C1,C2,C3,D1,D2,D3,F,I,L,N,P,X1,Y1
+3 ;
+4 SET P=DDGFPG
+5 SET N=@DDGFREF@("F",P)
+6 SET Y1=P1-$PIECE(N,U)
SET X1=P2-$PIECE(N,U,2)
+7 IF 'Y1
IF 'X1
QUIT
+8 ;
+9 IF $PIECE(N,U,3)]""
Begin DoDot:1
+10 KILL @DDGFREF@("RC",DDGFWID,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,4),"P","P","PTOP")
+11 KILL @DDGFREF@("RC",DDGFWID,$PIECE(N,U,3),$PIECE(N,U,4),$PIECE(N,U,4),"P","P","PBRC")
End DoDot:1
+12 IF $GET(P3)]""
Begin DoDot:1
+13 SET @DDGFREF@("RC",DDGFWID,P1,P2,P4,"P","P","PTOP")=""
+14 SET @DDGFREF@("RC",DDGFWID,P3,P4,P4,"P","P","PBRC")=""
End DoDot:1
+15 ;
+16 SET $PIECE(N,U,1,4)=P1_U_P2_U_P3_U_P4
SET $PIECE(N,U,7)=1
SET DDGFCHG=1
+17 SET @DDGFREF@("F",P)=N
+18 ;
+19 ;Loop through all blocks on page
+20 SET B=""
FOR
SET B=$ORDER(@DDGFREF@("F",P,B))
if B=""
QUIT
Begin DoDot:1
+21 SET N=@DDGFREF@("F",P,B)
+22 SET @DDGFREF@("BKRC",DDGFWIDB,$PIECE(N,U)+Y1,$PIECE(N,U,2)+X1,$PIECE(N,U,3)+X1,B)=@DDGFREF@("BKRC",DDGFWIDB,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,3),B)
+23 KILL @DDGFREF@("BKRC",DDGFWIDB,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,3),B)
+24 SET $PIECE(N,U,1,3)=$PIECE(N,U)+Y1_U_($PIECE(N,U,2)+X1)_U_($PIECE(N,U,3)+X1)
+25 SET @DDGFREF@("F",P,B)=N
+26 ;
+27 SET F=""
FOR
SET F=$ORDER(@DDGFREF@("F",P,B,F))
if F=""
QUIT
Begin DoDot:2
+28 SET N=@DDGFREF@("F",P,B,F)
+29 SET C1=$PIECE(N,U)
SET C2=$PIECE(N,U,2)
SET C3=$PIECE(N,U,3)
SET C=$PIECE(N,U,4)
+30 SET D1=$PIECE(N,U,5)
SET D2=$PIECE(N,U,6)
SET D3=$PIECE(N,U,7)
SET L=$PIECE(N,U,8)
+31 ;
+32 IF Y1
if C1]""
SET $PIECE(N,U)=C1+Y1
if L
SET $PIECE(N,U,5)=D1+Y1
+33 IF X1
Begin DoDot:3
+34 IF C]""
FOR I=2,3
SET $PIECE(N,U,I)=$PIECE(N,U,I)+X1
+35 IF L
FOR I=6,7
SET $PIECE(N,U,I)=$PIECE(N,U,I)+X1
End DoDot:3
+36 SET @DDGFREF@("F",P,B,F)=N
+37 ;
+38 IF C]""
Begin DoDot:3
+39 KILL @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")
+40 SET @DDGFREF@("RC",DDGFWID,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,3),B,F,"C")=""
End DoDot:3
+41 IF L
Begin DoDot:3
+42 KILL @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")
+43 SET @DDGFREF@("RC",DDGFWID,$PIECE(N,U,5),$PIECE(N,U,6),$PIECE(N,U,7),B,F,"D")=""
End DoDot:3
+44 ;
+45 if C]""
DO WRITE^DDGLIBW(DDGFWID,C,$PIECE(N,U)-P1,$PIECE(N,U,2)-P2)
+46 if L
DO WRITE^DDGLIBW(DDGFWID,$TRANSLATE($JUSTIFY("",L)," ","_"),$PIECE(N,U,5)-P1,$PIECE(N,U,6)-P2)
End DoDot:2
End DoDot:1
+47 QUIT
+48 ;
BRC(P1,P2,P3,P4) ;Change bottom right coordinate of page
+1 NEW B,C,F,L,N,P
+2 SET P=DDGFPG
+3 SET N=@DDGFREF@("F",P)
+4 IF $PIECE(N,U,3)]""
Begin DoDot:1
+5 KILL @DDGFREF@("RC",DDGFWID,$PIECE(N,U),$PIECE(N,U,2),$PIECE(N,U,4),"P","P","PTOP")
+6 KILL @DDGFREF@("RC",DDGFWID,$PIECE(N,U,3),$PIECE(N,U,4),$PIECE(N,U,4),"P","P","PBRC")
End DoDot:1
+7 IF $GET(P3)]""
Begin DoDot:1
+8 SET @DDGFREF@("RC",DDGFWID,P1,P2,P4,"P","P","PTOP")=""
+9 SET @DDGFREF@("RC",DDGFWID,P3,P4,P4,"P","P","PBRC")=""
End DoDot:1
+10 ;
+11 SET $PIECE(N,U,1,4)=P1_U_P2_U_P3_U_P4
SET $PIECE(N,U,7)=1
SET DDGFCHG=1
+12 SET @DDGFREF@("F",P)=N
+13 ;
+14 ;Loop through all blocks/fields on page
+15 SET B=""
FOR
SET B=$ORDER(@DDGFREF@("F",P,B))
if B=""
QUIT
Begin DoDot:1
+16 SET F=""
FOR
SET F=$ORDER(@DDGFREF@("F",P,B,F))
if F=""
QUIT
Begin DoDot:2
+17 SET N=@DDGFREF@("F",P,B,F)
+18 SET C=$PIECE(N,U,4)
SET L=$PIECE(N,U,8)
+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)
End DoDot:2
End DoDot:1
+22 QUIT
