- DDGFUPDP ;SFISC/MKO-UPDATE PAGE COORDINATES ;01:37 PM 19 Jan 1994
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- 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
- DDGFUPDP ;SFISC/MKO-UPDATE PAGE COORDINATES ;01:37 PM 19 Jan 1994
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- 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
