DDGFAPC ;SFISC/MKO-ADJUST PAGE COORDINATES ;01:16 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.
;
;Input:
; T = PTOP: top of page
; PBRC: bottom right corner of page
;Returns:
; DDGFLIM
;
N DDGFE,P1,P2,P3,P4
;
D SETUP
S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
D CLEANUP
Q
;
DESELECT ;
S DDGFE=1
Q
;
LNU Q:DY'>$P(DDGFLIM,U)
D MV(DY-1,DX)
Q
LND Q:DY'<$P(DDGFLIM,U,3)
D MV(DY+1,DX)
Q
CHR Q:DX'<$P(DDGFLIM,U,4)
D MV(DY,DX+1)
Q
CHL Q:DX'>$P(DDGFLIM,U,2)
D MV(DY,DX-1)
Q
TBR Q:DX'<$P(DDGFLIM,U,4)
D MV(DY,DX+$$MIN(5,$P(DDGFLIM,U,4)-DX))
Q
TBL Q:DX'>$P(DDGFLIM,U,2)
D MV(DY,DX-$$MIN(5,DX-$P(DDGFLIM,U,2)))
Q
SCT Q:DY'>$P(DDGFLIM,U)
D MV($P(DDGFLIM,U),DX)
Q
SCB Q:DY'<$P(DDGFLIM,U,3)
D MV($P(DDGFLIM,U,3),DX)
Q
SCR Q:DX'<$P(DDGFLIM,U,4)
D MV(DY,$P(DDGFLIM,U,4))
Q
SCL Q:DX'>$P(DDGFLIM,U,2)
D MV(DY,$P(DDGFLIM,U,2))
Q
;
MV(DDGFY,DDGFX) ;
I T="PTOP" D
. F DDGFC=P1_U_P2,P1_U_P4,P3_U_P2,P3_U_P4 D REPALL^DDGLIBW(DDGFC_"^1^1")
. S P1=P1+DDGFY-DY,P2=P2+DDGFX-DX,P3=P3+DDGFY-DY,P4=P4+DDGFX-DX
;
I T="PBRC" D
. D:DDGFX'=DX REPALL^DDGLIBW(P1_U_P4_"^1^1")
. D:DDGFY'=DY REPALL^DDGLIBW(P3_U_P2_"^1^1")
. D REPALL^DDGLIBW(P3_U_P4_"^1^1")
. S P3=P3+DDGFY-DY,P4=P4+DDGFX-DX
;
D CORNER()
S DY=DDGFY,DX=DDGFX
K DDGFC
Q
;
CORNER(N) ;Draw corners of box
;In: P1,P2,P3,P4,T; if N:normal video
N DY,DX
S DY=P1,DX=P2 X IOXY
W $P(DDGLGRA,DDGLDEL)_$S($G(N):"",1:$P(DDGLVID,DDGLDEL,6))_$P(DDGLGRA,DDGLDEL,5)
S DY=P1,DX=P4 X IOXY W $P(DDGLGRA,DDGLDEL,6)
S DY=P3,DX=P2 X IOXY W $P(DDGLGRA,DDGLDEL,7)
S DX=P4 X IOXY
W $P(DDGLGRA,DDGLDEL,8)_$S($G(N):"",1:$P(DDGLVID,DDGLDEL,10))_$P(DDGLGRA,DDGLDEL,2)
Q
;
MIN(X,Y,Z) ;Return the minimum of two or three numbers
N A
S A=$S(X<Y:X,1:Y)
Q:$G(Z)="" A
Q $S(A<Z:A,1:Z)
;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
N S
I DDGFR D
. S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
. X IOXY W S_$J("",7-$L(S))
S DY=DDGFY,DX=DDGFX X IOXY
Q
;
SETUP ;Initial setup
S DDGFDY=DY,DDGFDX=DX
;
;Get page coordinates
S P4=@DDGFREF@("F",DDGFPG)
S P1=$P(P4,U),P2=$P(P4,U,2),P3=$P(P4,U,3),P4=$P(P4,U,4)
S DDGFAREA=P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1)
;
;Draw corners in reverse video, reset DDGFLIM
D CORNER()
I T="PTOP" S DDGFLIM=0_U_(DX-P2)_U_(DY+IOSL-8-P3)_U_(DX+IOM-2-P4)
I T="PBRC" S DDGFLIM=P1+2_U_(P2+2)_U_(IOSL-8)_U_(IOM-2)
Q
;
CLEANUP ;Final cleanup
I DDGFDY'=DY!(DDGFDX'=DX) D
. D PAGE^DDGFUPDP(P1,P2,P3,P4,T,DDGFAREA)
E D CORNER(1) S DDGFLIM=P1_U_P2_U_P3_U_P4
;
D RC(DY,DX)
K DDGFDY,DDGFDX,DDGFAREA
Q
;
READ() N S,Y
F R *Y:DTIME D C Q:Y'=-1
Q Y
;
C I Y<0 S Y="TO" Q
S S=""
C1 S S=S_$C(Y)
I DDGF("SIN")'[(U_S) D I Y=-1 W $C(7) Q
. I $C(Y)'?1L S Y=-1 Q
. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
;
I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
R *Y:5 G:Y'=-1 C1 W $C(7)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFAPC 3292 printed Dec 13, 2024@02:42:16 Page 2
DDGFAPC ;SFISC/MKO-ADJUST PAGE COORDINATES ;01:16 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 ;
+7 ;Input:
+8 ; T = PTOP: top of page
+9 ; PBRC: bottom right corner of page
+10 ;Returns:
+11 ; DDGFLIM
+12 ;
+13 NEW DDGFE,P1,P2,P3,P4
+14 ;
+15 DO SETUP
+16 SET DDGFE=0
FOR
SET Y=$$READ
if $TEXT(@Y)=""
WRITE $CHAR(7)
if $TEXT(@Y)]""
DO @Y
if DDGFE
QUIT
+17 DO CLEANUP
+18 QUIT
+19 ;
DESELECT ;
+1 SET DDGFE=1
+2 QUIT
+3 ;
LNU if DY'>$PIECE(DDGFLIM,U)
QUIT
+1 DO MV(DY-1,DX)
+2 QUIT
LND if DY'<$PIECE(DDGFLIM,U,3)
QUIT
+1 DO MV(DY+1,DX)
+2 QUIT
CHR if DX'<$PIECE(DDGFLIM,U,4)
QUIT
+1 DO MV(DY,DX+1)
+2 QUIT
CHL if DX'>$PIECE(DDGFLIM,U,2)
QUIT
+1 DO MV(DY,DX-1)
+2 QUIT
TBR if DX'<$PIECE(DDGFLIM,U,4)
QUIT
+1 DO MV(DY,DX+$$MIN(5,$PIECE(DDGFLIM,U,4)-DX))
+2 QUIT
TBL if DX'>$PIECE(DDGFLIM,U,2)
QUIT
+1 DO MV(DY,DX-$$MIN(5,DX-$PIECE(DDGFLIM,U,2)))
+2 QUIT
SCT if DY'>$PIECE(DDGFLIM,U)
QUIT
+1 DO MV($PIECE(DDGFLIM,U),DX)
+2 QUIT
SCB if DY'<$PIECE(DDGFLIM,U,3)
QUIT
+1 DO MV($PIECE(DDGFLIM,U,3),DX)
+2 QUIT
SCR if DX'<$PIECE(DDGFLIM,U,4)
QUIT
+1 DO MV(DY,$PIECE(DDGFLIM,U,4))
+2 QUIT
SCL if DX'>$PIECE(DDGFLIM,U,2)
QUIT
+1 DO MV(DY,$PIECE(DDGFLIM,U,2))
+2 QUIT
+3 ;
MV(DDGFY,DDGFX) ;
+1 IF T="PTOP"
Begin DoDot:1
+2 FOR DDGFC=P1_U_P2,P1_U_P4,P3_U_P2,P3_U_P4
DO REPALL^DDGLIBW(DDGFC_"^1^1")
+3 SET P1=P1+DDGFY-DY
SET P2=P2+DDGFX-DX
SET P3=P3+DDGFY-DY
SET P4=P4+DDGFX-DX
End DoDot:1
+4 ;
+5 IF T="PBRC"
Begin DoDot:1
+6 if DDGFX'=DX
DO REPALL^DDGLIBW(P1_U_P4_"^1^1")
+7 if DDGFY'=DY
DO REPALL^DDGLIBW(P3_U_P2_"^1^1")
+8 DO REPALL^DDGLIBW(P3_U_P4_"^1^1")
+9 SET P3=P3+DDGFY-DY
SET P4=P4+DDGFX-DX
End DoDot:1
+10 ;
+11 DO CORNER()
+12 SET DY=DDGFY
SET DX=DDGFX
+13 KILL DDGFC
+14 QUIT
+15 ;
CORNER(N) ;Draw corners of box
+1 ;In: P1,P2,P3,P4,T; if N:normal video
+2 NEW DY,DX
+3 SET DY=P1
SET DX=P2
XECUTE IOXY
+4 WRITE $PIECE(DDGLGRA,DDGLDEL)_$SELECT($GET(N):"",1:$PIECE(DDGLVID,DDGLDEL,6))_$PIECE(DDGLGRA,DDGLDEL,5)
+5 SET DY=P1
SET DX=P4
XECUTE IOXY
WRITE $PIECE(DDGLGRA,DDGLDEL,6)
+6 SET DY=P3
SET DX=P2
XECUTE IOXY
WRITE $PIECE(DDGLGRA,DDGLDEL,7)
+7 SET DX=P4
XECUTE IOXY
+8 WRITE $PIECE(DDGLGRA,DDGLDEL,8)_$SELECT($GET(N):"",1:$PIECE(DDGLVID,DDGLDEL,10))_$PIECE(DDGLGRA,DDGLDEL,2)
+9 QUIT
+10 ;
MIN(X,Y,Z) ;Return the minimum of two or three numbers
+1 NEW A
+2 SET A=$SELECT(X<Y:X,1:Y)
+3 if $GET(Z)=""
QUIT A
+4 QUIT $SELECT(A<Z:A,1:Z)
+5 ;
RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
+1 NEW S
+2 IF DDGFR
Begin DoDot:1
+3 SET DY=IOSL-6
SET DX=IOM-9
SET S="R"_(DDGFY+1)_",C"_(DDGFX+1)
+4 XECUTE IOXY
WRITE S_$JUSTIFY("",7-$LENGTH(S))
End DoDot:1
+5 SET DY=DDGFY
SET DX=DDGFX
XECUTE IOXY
+6 QUIT
+7 ;
SETUP ;Initial setup
+1 SET DDGFDY=DY
SET DDGFDX=DX
+2 ;
+3 ;Get page coordinates
+4 SET P4=@DDGFREF@("F",DDGFPG)
+5 SET P1=$PIECE(P4,U)
SET P2=$PIECE(P4,U,2)
SET P3=$PIECE(P4,U,3)
SET P4=$PIECE(P4,U,4)
+6 SET DDGFAREA=P1_U_P2_U_(P3-P1+1)_U_(P4-P2+1)
+7 ;
+8 ;Draw corners in reverse video, reset DDGFLIM
+9 DO CORNER()
+10 IF T="PTOP"
SET DDGFLIM=0_U_(DX-P2)_U_(DY+IOSL-8-P3)_U_(DX+IOM-2-P4)
+11 IF T="PBRC"
SET DDGFLIM=P1+2_U_(P2+2)_U_(IOSL-8)_U_(IOM-2)
+12 QUIT
+13 ;
CLEANUP ;Final cleanup
+1 IF DDGFDY'=DY!(DDGFDX'=DX)
Begin DoDot:1
+2 DO PAGE^DDGFUPDP(P1,P2,P3,P4,T,DDGFAREA)
End DoDot:1
+3 IF '$TEST
DO CORNER(1)
SET DDGFLIM=P1_U_P2_U_P3_U_P4
+4 ;
+5 DO RC(DY,DX)
+6 KILL DDGFDY,DDGFDX,DDGFAREA
+7 QUIT
+8 ;
READ() NEW S,Y
+1 FOR
READ *Y:DTIME
DO C
if Y'=-1
QUIT
+2 QUIT Y
+3 ;
C IF Y<0
SET Y="TO"
QUIT
+1 SET S=""
C1 SET S=S_$CHAR(Y)
+1 IF DDGF("SIN")'[(U_S)
Begin DoDot:1
+2 IF $CHAR(Y)'?1L
SET Y=-1
QUIT
+3 SET S=$EXTRACT(S,1,$LENGTH(S)-1)_$CHAR(Y-32)
if DDGF("SIN")'[(U_S_U)
SET Y=-1
End DoDot:1
IF Y=-1
WRITE $CHAR(7)
QUIT
+4 ;
+5 IF DDGF("SIN")[(U_S_U)
IF S'=$CHAR(27)
SET Y=$PIECE(DDGF("SOUT"),U,$LENGTH($PIECE(DDGF("SIN"),U_S_U),U))
QUIT
+6 READ *Y:5
if Y'=-1
GOTO C1
WRITE $CHAR(7)
+7 QUIT
