- 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 Feb 19, 2025@00:09:25 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
