- 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 Jan 18, 2025@03:43:15 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