- DDW7 ;SFISC/MKO-MARK TEXT ;2:30 PM 27 Jul 2000 [ 04/02/2003 8:25 AM ]
- ;;22.0;VA FileMan;**1001**;APR 1, 2003
- ;;22.0;VA FileMan;**18**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- 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)
- DDW7 ;SFISC/MKO-MARK TEXT ;2:30 PM 27 Jul 2000 [ 04/02/2003 8:25 AM ]
- +1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
- +2 ;;22.0;VA FileMan;**18**;Mar 30, 1999
- +3 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +4 ;
- 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)
