DDW7 ;SFISC/MKO-MARK TEXT ;2:30 PM 27 Jul 2000
;;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.
;
MARK ;Mark the text
I $D(DDWMARK) D
. D BOUND
E D
. S DDWMARK=DDWA+DDWRW_U_DDWC_U_(DDWA+DDWRW)_U_$$MAX(DDWC,$L(DDWN))
. D PAINT(DDWMARK,1),IND(1)
Q
;
BOUND ;Mark ending boundary, highlight selected text
N DDWI,DDWX,DDWY
;
S DDWI=DDWA+DDWRW_U_DDWC
S DDWX=$P(DDWMARK,U,1,2)
S DDWY=$P(DDWMARK,U,3,4)
;
I $$ISLESS(DDWI,DDWX) D
. D PAINT(DDWX_U_DDWY)
. D PAINT(DDWI_U_DDWX,1)
. S DDWMARK=DDWI_U_DDWX
E D
. I $$ISLESS(DDWI,DDWY) D
.. D PAINT(DDWI_U_DDWY),PAINT(DDWI_U_DDWI,1)
. E D PAINT(DDWY_U_DDWI,1)
. S DDWMARK=DDWX_U_DDWI
D CUP(DDWRW,DDWC-DDWOFS)
Q
;
UNMARK ;Unmark the text
D:$D(DDWMARK) PAINT(DDWMARK),IND()
K DDWMARK
Q
;
PAINT(DDWMARK,DDWREV) ;Paint selected text
N DDWI,DDWE1,DDWE2,DDWL1,DDWL2,DDWR1,DDWC1,DDWR2,DDWC2
S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
S DDWL1=$$MAX(DDWR1-DDWA,1),DDWL2=$$MIN(DDWR2-DDWA,DDWMR)
Q:DDWL1>DDWL2
;
W:$G(DDWREV) $P(DDGLVID,DDGLDEL,6)
F DDWI=DDWL1:1:DDWL2 D
. S DDWE1=$$MAX($S(DDWI+DDWA=DDWR1:DDWC1,1:1),DDWOFS+1)
. S DDWE2=$$MIN($S(DDWI+DDWA=DDWR2:DDWC2,1:999),IOM+DDWOFS)
. Q:DDWE1>DDWE2
. D CUP(DDWI,DDWE1-DDWOFS)
. W $E(DDWL(DDWI),DDWE1,DDWE2)
W:$G(DDWREV) $P(DDGLVID,DDGLDEL,10)
Q
;
IND(DDWX) ;Paint indicator
S DY=$G(DDWBM,IOSL)-1,DX=IOM-7 X IOXY
W $S($G(DDWX):$P(DDGLVID,DDGLDEL,6)_"Select"_$P(DDGLVID,DDGLDEL,10),1:$P(DDGLCLR,DDGLDEL))
D CUP(DDWRW,DDWC-DDWOFS)
Q
;
CUP(Y,X) ;
S DY=IOTM+Y-2,DX=X-1 X IOXY
Q
;
POS(R,C,F) ;Pos cursor based on char pos C
N DDWX
S:$G(C)="E" C=$L($G(DDWL(R)))+1
S:$G(F)["N" DDWN=$G(DDWL(R))
S:$G(F)["R" DDWRW=R,DDWC=C
;
S DDWX=C-DDWOFS
I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
Q
;
ISLESS(X,Y) ;Is coordinate X less than coordinate Y
N R1,C1,R2,C2
S R1=$P(X,U),C1=$P(X,U,2)
S R2=$P(Y,U),C2=$P(Y,U,2)
;
Q:R1>R2 0
Q:R1<R2 1
Q:C1>C2 0
Q 1
;
MIN(X,Y) ;
Q $S(X<Y:X,1:Y)
;
MAX(X,Y) ;
Q $S(X>Y:X,1:Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDW7 2376 printed Nov 22, 2024@17:53:53 Page 2
DDW7 ;SFISC/MKO-MARK TEXT ;2:30 PM 27 Jul 2000
+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 ;
MARK ;Mark the text
+1 IF $DATA(DDWMARK)
Begin DoDot:1
+2 DO BOUND
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 SET DDWMARK=DDWA+DDWRW_U_DDWC_U_(DDWA+DDWRW)_U_$$MAX(DDWC,$LENGTH(DDWN))
+5 DO PAINT(DDWMARK,1)
DO IND(1)
End DoDot:1
+6 QUIT
+7 ;
BOUND ;Mark ending boundary, highlight selected text
+1 NEW DDWI,DDWX,DDWY
+2 ;
+3 SET DDWI=DDWA+DDWRW_U_DDWC
+4 SET DDWX=$PIECE(DDWMARK,U,1,2)
+5 SET DDWY=$PIECE(DDWMARK,U,3,4)
+6 ;
+7 IF $$ISLESS(DDWI,DDWX)
Begin DoDot:1
+8 DO PAINT(DDWX_U_DDWY)
+9 DO PAINT(DDWI_U_DDWX,1)
+10 SET DDWMARK=DDWI_U_DDWX
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 IF $$ISLESS(DDWI,DDWY)
Begin DoDot:2
+13 DO PAINT(DDWI_U_DDWY)
DO PAINT(DDWI_U_DDWI,1)
End DoDot:2
+14 IF '$TEST
DO PAINT(DDWY_U_DDWI,1)
+15 SET DDWMARK=DDWX_U_DDWI
End DoDot:1
+16 DO CUP(DDWRW,DDWC-DDWOFS)
+17 QUIT
+18 ;
UNMARK ;Unmark the text
+1 if $DATA(DDWMARK)
DO PAINT(DDWMARK)
DO IND()
+2 KILL DDWMARK
+3 QUIT
+4 ;
PAINT(DDWMARK,DDWREV) ;Paint selected text
+1 NEW DDWI,DDWE1,DDWE2,DDWL1,DDWL2,DDWR1,DDWC1,DDWR2,DDWC2
+2 SET DDWR1=$PIECE(DDWMARK,U,1)
SET DDWC1=$PIECE(DDWMARK,U,2)
+3 SET DDWR2=$PIECE(DDWMARK,U,3)
SET DDWC2=$PIECE(DDWMARK,U,4)
+4 SET DDWL1=$$MAX(DDWR1-DDWA,1)
SET DDWL2=$$MIN(DDWR2-DDWA,DDWMR)
+5 if DDWL1>DDWL2
QUIT
+6 ;
+7 if $GET(DDWREV)
WRITE $PIECE(DDGLVID,DDGLDEL,6)
+8 FOR DDWI=DDWL1:1:DDWL2
Begin DoDot:1
+9 SET DDWE1=$$MAX($SELECT(DDWI+DDWA=DDWR1:DDWC1,1:1),DDWOFS+1)
+10 SET DDWE2=$$MIN($SELECT(DDWI+DDWA=DDWR2:DDWC2,1:999),IOM+DDWOFS)
+11 if DDWE1>DDWE2
QUIT
+12 DO CUP(DDWI,DDWE1-DDWOFS)
+13 WRITE $EXTRACT(DDWL(DDWI),DDWE1,DDWE2)
End DoDot:1
+14 if $GET(DDWREV)
WRITE $PIECE(DDGLVID,DDGLDEL,10)
+15 QUIT
+16 ;
IND(DDWX) ;Paint indicator
+1 SET DY=$GET(DDWBM,IOSL)-1
SET DX=IOM-7
XECUTE IOXY
+2 WRITE $SELECT($GET(DDWX):$PIECE(DDGLVID,DDGLDEL,6)_"Select"_$PIECE(DDGLVID,DDGLDEL,10),1:$PIECE(DDGLCLR,DDGLDEL))
+3 DO CUP(DDWRW,DDWC-DDWOFS)
+4 QUIT
+5 ;
CUP(Y,X) ;
+1 SET DY=IOTM+Y-2
SET DX=X-1
XECUTE IOXY
+2 QUIT
+3 ;
POS(R,C,F) ;Pos cursor based on char pos C
+1 NEW DDWX
+2 if $GET(C)="E"
SET C=$LENGTH($GET(DDWL(R)))+1
+3 if $GET(F)["N"
SET DDWN=$GET(DDWL(R))
+4 if $GET(F)["R"
SET DDWRW=R
SET DDWC=C
+5 ;
+6 SET DDWX=C-DDWOFS
+7 IF DDWX>IOM!(DDWX<1)
DO SHIFT^DDW3(C,.DDWOFS)
+8 SET DY=IOTM+R-2
SET DX=C-DDWOFS-1
XECUTE IOXY
+9 QUIT
+10 ;
ISLESS(X,Y) ;Is coordinate X less than coordinate Y
+1 NEW R1,C1,R2,C2
+2 SET R1=$PIECE(X,U)
SET C1=$PIECE(X,U,2)
+3 SET R2=$PIECE(Y,U)
SET C2=$PIECE(Y,U,2)
+4 ;
+5 if R1>R2
QUIT 0
+6 if R1<R2
QUIT 1
+7 if C1>C2
QUIT 0
+8 QUIT 1
+9 ;
MIN(X,Y) ;
+1 QUIT $SELECT(X<Y:X,1:Y)
+2 ;
MAX(X,Y) ;
+1 QUIT $SELECT(X>Y:X,1:Y)
