DDSBOX ;SFISC/MKO-DRAW A BOX ;2015-01-02 6:19 PM
;;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.
;
EN(DDSUL,DDSLR) ;move entry point from topoof routine.
;
D BOUNDS Q:'Y
;
S DDS3L=""
S $P(DDS3L,$P(DDGLGRA,DDGLDEL,3),$P(DDSLR,",",2)-$P(DDSUL,",",2))=""
S DDS3M=$P(DDGLGRA,DDGLDEL,4)_$J("",$P(DDSLR,",",2)-$P(DDSUL,",",2)-1)_$P(DDGLGRA,DDGLDEL,4)
;
S DY=$P(DDSUL,",")-1,DX=$P(DDSUL,",",2)-1 X IOXY
W $P(DDGLGRA,DDGLDEL)_$P(DDGLGRA,DDGLDEL,5)_DDS3L_$P(DDGLGRA,DDGLDEL,6)
;
F DY=$P(DDSUL,","):1:$P(DDSLR,",")-2 D
. S DX=$P(DDSUL,",",2)-1 X IOXY
. W DDS3M
;
S DY=$P(DDSLR,",")-1,DX=$P(DDSUL,",",2)-1 X IOXY
W $P(DDGLGRA,DDGLDEL,7)_DDS3L_$P(DDGLGRA,DDGLDEL,8)_$P(DDGLGRA,DDGLDEL,2)
;
K DDS3L,DDS3M
Q
;
CLEAR(DDSUL,DDSLR) ;Clear area within upper left and lower right coords
N S
D BOUNDS Q:'Y
;
S S=$J("",$P(DDSLR,",",2)-$P(DDSUL,",",2)+1)
S DX=$P(DDSUL,",",2)-1
F DY=$P(DDSUL,",")-1:1:$P(DDSLR,",")-1 X IOXY W S
Q
;
BOUNDS ;Make sure area is within acceptable boundaries
N DDSV,DDSP
S Y=1
I $G(DDSUL)=""!($G(DDSLR))="" S Y=0 Q
;
F DDSV="DDSUL","DDSLR" D
. S:$P(@DDSV,",")>DDSHBX $P(@DDSV,",")=DDSHBX
. S:$P(@DDSV,",",2)>(IOM-1) $P(@DDSV,",",2)=IOM-1
. F DDSP=1,2 S:$P(@DDSV,",",DDSP)<1 $P(@DDSV,",",DDSP)=1
;
I $P(DDSLR,",")-$P(DDSUL,",")<2 S Y=0 Q
I $P(DDSLR,",",2)-$P(DDSUL,",",2)<2 S Y=0 Q
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSBOX 1638 printed Nov 22, 2024@17:53:06 Page 2
DDSBOX ;SFISC/MKO-DRAW A BOX ;2015-01-02 6:19 PM
+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 ;
EN(DDSUL,DDSLR) ;move entry point from topoof routine.
+1 ;
+2 DO BOUNDS
if 'Y
QUIT
+3 ;
+4 SET DDS3L=""
+5 SET $PIECE(DDS3L,$PIECE(DDGLGRA,DDGLDEL,3),$PIECE(DDSLR,",",2)-$PIECE(DDSUL,",",2))=""
+6 SET DDS3M=$PIECE(DDGLGRA,DDGLDEL,4)_$JUSTIFY("",$PIECE(DDSLR,",",2)-$PIECE(DDSUL,",",2)-1)_$PIECE(DDGLGRA,DDGLDEL,4)
+7 ;
+8 SET DY=$PIECE(DDSUL,",")-1
SET DX=$PIECE(DDSUL,",",2)-1
XECUTE IOXY
+9 WRITE $PIECE(DDGLGRA,DDGLDEL)_$PIECE(DDGLGRA,DDGLDEL,5)_DDS3L_$PIECE(DDGLGRA,DDGLDEL,6)
+10 ;
+11 FOR DY=$PIECE(DDSUL,","):1:$PIECE(DDSLR,",")-2
Begin DoDot:1
+12 SET DX=$PIECE(DDSUL,",",2)-1
XECUTE IOXY
+13 WRITE DDS3M
End DoDot:1
+14 ;
+15 SET DY=$PIECE(DDSLR,",")-1
SET DX=$PIECE(DDSUL,",",2)-1
XECUTE IOXY
+16 WRITE $PIECE(DDGLGRA,DDGLDEL,7)_DDS3L_$PIECE(DDGLGRA,DDGLDEL,8)_$PIECE(DDGLGRA,DDGLDEL,2)
+17 ;
+18 KILL DDS3L,DDS3M
+19 QUIT
+20 ;
CLEAR(DDSUL,DDSLR) ;Clear area within upper left and lower right coords
+1 NEW S
+2 DO BOUNDS
if 'Y
QUIT
+3 ;
+4 SET S=$JUSTIFY("",$PIECE(DDSLR,",",2)-$PIECE(DDSUL,",",2)+1)
+5 SET DX=$PIECE(DDSUL,",",2)-1
+6 FOR DY=$PIECE(DDSUL,",")-1:1:$PIECE(DDSLR,",")-1
XECUTE IOXY
WRITE S
+7 QUIT
+8 ;
BOUNDS ;Make sure area is within acceptable boundaries
+1 NEW DDSV,DDSP
+2 SET Y=1
+3 IF $GET(DDSUL)=""!($GET(DDSLR))=""
SET Y=0
QUIT
+4 ;
+5 FOR DDSV="DDSUL","DDSLR"
Begin DoDot:1
+6 if $PIECE(@DDSV,",")>DDSHBX
SET $PIECE(@DDSV,",")=DDSHBX
+7 if $PIECE(@DDSV,",",2)>(IOM-1)
SET $PIECE(@DDSV,",",2)=IOM-1
+8 FOR DDSP=1,2
if $PIECE(@DDSV,",",DDSP)<1
SET $PIECE(@DDSV,",",DDSP)=1
End DoDot:1
+9 ;
+10 IF $PIECE(DDSLR,",")-$PIECE(DDSUL,",")<2
SET Y=0
QUIT
+11 IF $PIECE(DDSLR,",",2)-$PIECE(DDSUL,",",2)<2
SET Y=0
QUIT
+12 ;
+13 QUIT
