DDSU ;SFISC/MLH-PROCESS HELP ;14NOV2012
;;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.
;
LIST ;
I '$D(DDS) D Q
FM .;FileMan help - Non screen
.N A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
.S A0=""
.F S A0=$O(DDH(A0)) Q:'A0 S DDSDIW=$X,DDSDIY=$Y D W I $G(DDD)>2,DDSDIW-$X!(DDSDIY-$Y) D STP Q:$D(DTOUT)
.I $G(DIPGM)="DICQ1",$G(DP),$G(DIC("?N",DP)) D
..N DIZ S DIZ=0 D T Q
Q .I '$D(DTOUT) D SV S DDH=0 Q
.K DDH D:'DTOUT Q
..K DTOUT N % S %=$G(DIPGM) I %'="DICQ1",%'="DIEQ" Q
..S DUOUT=1
;
;SCREENMAN HELP
N DIR0A K DICQRETA,DICQRETV D SC I $D(DIR0A) S DICQRETV=DIR0A ;RETURN VALUE from MOUSE
Q
;
SC ;Screen Help, also from DDS2,DDSCOM,DDSMSG
N A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
K DTOUT,DUOUT
;
W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X DDGLZOSF("RM")
I $D(DDQ)#2,DDQ<(IOSL-1),DDQ>DDSHBX!$P(DDQ,U,2)!$D(DDIOL) S DY=$P(DDQ,U),DX=$P(DDQ,U,2)
E D CLRMSG^DDS S DY=DDSHBX
X DDXY
;
S:$G(DDD,5)=5 DDD=1
S:$D(DDO) DDSB1=DDO
S DDM=1,DDO=.5
S (A0,DIY,X)="",A1=0,A5=$S(DDD=2:$O(DS(0)),1:$O(DDH(A0)))
K A2,DDSQ
;Now loop thru the DDHs
F D Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)!$D(DIR0A)
SC1 .S A6=A0,A0=$O(DDH(A0)) S:A6="" A6=A0-1
.I 'A0,DDD Q:DDD=1 Q:DD<DS
.S A4=$O(DDH(+A0,""))
.I A4'="X"!(DY'>DDSHBX) S DY=DY+1 X DDXY
.I A4="E" D SC2 Q
MORE .I $Y'<(IOSL-2)!'A0 D SC2 Q:DDO'<1!(X=U)!'A0!DIY!$D(DTOUT)!$D(DUOUT)!$D(DIR0A) S DY=DDSHBX+1,DX=0 X DDXY
.Q:A4=""
.D WR ;Write something!
.I $Y'<(IOSL-1),'$D(DTOUT),'$D(DUOUT) D Q ;SEE IF WE ARE 2 LINES FROM BOTTOM
..W ! S A6=A0 D SC2 ;Now that we have written choice #A0, allow them to choose it
..W $P(DDGLVID,DDGLDEL,8) S X=0 X DDGLZOSF("RM") D REFRESH^DDSUTL
..W $P(DDGLVID,DDGLDEL,9) S X=$G(IOM,80)-1 X DDGLZOSF("RM")
..S DX=0,DY=DDSHBX X DDXY
.S DY=$Y,DX=0
I $D(DDSB1) S:DDO<1 DDO=DDSB1
E K DDO
;
S %=0
S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
S:DDQ>DDSHBX DDM=1
I $D(A2) K DDD,DDH,DDQ S %=A2 S:%'=1 DDSQ=1 D CLRMSG^DDS G QQ
I $D(DDC),DDC'<0 D SV
E K DDD,DDH S DDSQ=1 ;DDSQ means we're done with the Lister
;
QQ S A0=$X S X=0 X DDGLZOSF("RM") W $P(DDGLVID,DDGLDEL,8) S $X=A0
Q
;
;
SC2 S DX=0,DY=IOSL-1 X DDXY
I DDD=1 W $$EZBLD^DIALOG(8053) D READ Q ;DDD=1 means 'HIT RETURN to CONTINUE'
W $$EZBLD^DIALOG(8081,A5_"-"_A6)_$P(DDGLCLR,DDGLDEL) ;CHOOSE 1-3 ...
D READ I $G(DUOUT) K DDC G Q2
I X]"",X<A5!(X>A6) W $C(7) G SC2
E I X S:DDD["J" DDO=$O(DDH(X,"")) K DDC
D CLRMSG^DDS
S DDM=1
Q2 S DIY=X,DY=DDSHBX
Q
;
;
SV ;Kill DDH array, but save the "ID" nodes and DDH itself
K A1,A2
S:$D(DDH("ID")) A1=DDH("ID")
S:$D(DDH("ID",1)) A2=DDH("ID",1)
K DDH S DDH=0
S:$D(A1) DDH("ID")=A1
S:$D(A2) DDH("ID",1)=A2
Q
;
;
;
Z ;From DICQ1,DIEQ
D Y,T Q
;
Y D:'$D(DISYS) OS^DII
S $X=0,$Y=0
S DIZ=$S($D(DILN)&'$D(DIR0):DILN,$G(IOSL):IOSL-3,1:21) ;**
Q
;
;
;
STP Q:$D(DD)[0!($D(DIY)[0) I DD+DIY'>79 W ?DD S DD=DD+DIY Q
;
T W !?3 S DD=DIY+3
I $Y>DIZ!'$Y D
.N DDSUP S DDSUP=$$EZBLD^DIALOG(8053) W DDSUP R %Y:$G(DTIME,300) ;**
. E S DTOUT=1 K DDD
. W $C(13),$J("",$L(DDSUP)+3),$C(13) Q:$D(DTOUT)
. I %Y[U S DTOUT=0 K DDD
. D Y W ?3
Q
;
W S A4=$O(DDH(A0,"")) Q:A4="" Q:DDH(A0,A4)=""
W:'$D(DDD) !
I $G(DDD)=3,A4["T" K DDD
;
WR I A4["X" D Q
. N DDD,DIY,DDSXEC
. S DDSXEC=DDH(A0,A4)
. N DDH
. I $D(DDS) N DDSID S DDSID=1 S DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
. X DDSXEC
;
I A4["Q" D Q
. S A4=DDH(A0,A4),%=$P(A4,U,1)
. I $D(DDS) D ASK Q
. W $P(A4,U,2)
. D YN^DICN
;
I A4["T" D Q
. I DDH(A0,A4)[$C(0) D
.. S DX=$L(DDH(A0,A4),$C(0))-1
.. X DDXY
.. S DDH(A0,A4)=$TR(DDH(A0,A4),$C(0),"")
. W DDH(A0,A4)
;
I '$D(DDS),$G(DDD)'["J",A4'=+A4 Q
I $D(DDS),$G(DDD)=2!($G(DDD)["J") W A0,?7
;
CHOICE I $D(DDS),$G(DDSMOUSY) D
.W " " D WRITMOUS(DDH(A0,A4))
E W DDH(A0,A4)
I $D(DDH("ID")) D S:$D(DUOUT) DIY=U
. N DDD,DIY,DDSID
. S DDSID=DDH("ID")
. S:$D(DDH("ID",1))#2 DDSID(1)=DDH("ID",1)
. N DDH
. S:$D(DDSID(1))#2 DDH("ID",1)=DDSID(1) K DDSID(1)
. S Y=A4
. S:$D(DDS) DDQ=$S(DY>(IOSL-1):IOSL-1,1:DY)_U_$X
. X DDSID
Q
;
;
WRITMOUS(C) ;MAKE THE CHOICES IN THE COMMAND AREA CLICKABLE!!
W $P(DDGLCLR,DDGLDEL)
N F
F Q:$A(C)-32 S C=$E(C,2,999) W " " ;LEADING BLANKS
F F=0:1 Q:$A(C,$L(C))-32 S C=$E(C,1,$L(C)-1)
I $G(DDSMOUSY) S DDSMOUSE($Y,$X,$X+$L(C)-1,1)=C W $$HIGH(C)
E W C
W $J("",F)
Q
;
;
;
HIGH(X) ;also from DDSCOM, DDSR
I '$D(DDGLVID) Q X
Q $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL,6)_X_$P(DDGLVID,DDGLDEL,10)
;
;
;
ASK W $P(A4,U,2)_$S(%'>2:"? ",1:"")_$S(%>0&(%<3):$P($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$P(DDGLCLR,DDGLDEL)
S A2=0
D READ I $G(DUOUT) S A2=-1 Q
I %>2 S A2=X Q
N %1 S %1=$$PRS^DIALOGU(7001,X) S:%1>0 X=$E($P(%1,U,2))
K %1
I "YyNn^"'[X W $C(7) X DDXY G ASK
I X]"","^Nn"[X S A2=2 K DDC Q
S:"Yy"[X A2=1
S:X=""&(%]"") A2=+%
S DDD=1
Q
;
;
READ ;RETURNS 'X' & 'DICQRETA'
N DIR0P,DIR0KD,S
X DDGLZOSF("EOFF")
S (DIR0P,X)="" F D Q:'$D(S)
.D READ^DIR01(.S) I S="TO" S DTOUT=1 K DCC G Q2
.I $L(S)=1 S X=X_S W S Q
.I S="CR" K S Q
.I S="EX"!(S="SV")!(S="QT") S DICQRETA=S,DUOUT=1,X=U K S Q
.I S="MOUSEDN" Q ;ignore down-click
.I S="MOUSE" K S D MOUSE^DIR01 K:$G(DIR0A)?."??" DIR0A S DUOUT=1,DDSQ=1 Q
.W *7
X DDGLZOSF("EON")
I X?1."^" S DUOUT=1,X=U Q
D CLRMSG^DDS S DDM=1 Q
;
;
;
;
H ;From DICN
S:'$D(A1) A1="T"
S DDH=$G(DDH)+1,DDH(DDH,A1)=DST
K A1,DST
D SC
Q
;#8053 Press 'RETURN' to continue...
;#8081 Choose |from-to| or '^'...
;#7001 Yes^No
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDSU 5815 printed Jun 11, 2024@22:40:50 Page 2
DDSU ;SFISC/MLH-PROCESS HELP ;14NOV2012
+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 ;
LIST ;
+1 IF '$DATA(DDS)
Begin DoDot:1
FM ;FileMan help - Non screen
+1 NEW A0,A1,A2,A3,A4,DDSDIW,DDSDIY,Y
+2 SET A0=""
+3 FOR
SET A0=$ORDER(DDH(A0))
if 'A0
QUIT
SET DDSDIW=$X
SET DDSDIY=$Y
DO W
IF $GET(DDD)>2
IF DDSDIW-$X!(DDSDIY-$Y)
DO STP
if $DATA(DTOUT)
QUIT
+4 IF $GET(DIPGM)="DICQ1"
IF $GET(DP)
IF $GET(DIC("?N",DP))
Begin DoDot:2
+5 NEW DIZ
SET DIZ=0
DO T
QUIT
End DoDot:2
Q IF '$DATA(DTOUT)
DO SV
SET DDH=0
QUIT
+1 KILL DDH
if 'DTOUT
Begin DoDot:2
+2 KILL DTOUT
NEW %
SET %=$GET(DIPGM)
IF %'="DICQ1"
IF %'="DIEQ"
QUIT
+3 SET DUOUT=1
End DoDot:2
QUIT
End DoDot:1
QUIT
+4 ;
+5 ;SCREENMAN HELP
+6 ;RETURN VALUE from MOUSE
NEW DIR0A
KILL DICQRETA,DICQRETV
DO SC
IF $DATA(DIR0A)
SET DICQRETV=DIR0A
+7 QUIT
+8 ;
SC ;Screen Help, also from DDS2,DDSCOM,DDSMSG
+1 NEW A0,A1,A2,A3,A4,A5,A6,DDSB1,X,Y
+2 KILL DTOUT,DUOUT
+3 ;
+4 WRITE $PIECE(DDGLVID,DDGLDEL,9)
SET X=$GET(IOM,80)-1
XECUTE DDGLZOSF("RM")
+5 IF $DATA(DDQ)#2
IF DDQ<(IOSL-1)
IF DDQ>DDSHBX!$PIECE(DDQ,U,2)!$DATA(DDIOL)
SET DY=$PIECE(DDQ,U)
SET DX=$PIECE(DDQ,U,2)
+6 IF '$TEST
DO CLRMSG^DDS
SET DY=DDSHBX
+7 XECUTE DDXY
+8 ;
+9 if $GET(DDD,5)=5
SET DDD=1
+10 if $DATA(DDO)
SET DDSB1=DDO
+11 SET DDM=1
SET DDO=.5
+12 SET (A0,DIY,X)=""
SET A1=0
SET A5=$SELECT(DDD=2:$ORDER(DS(0)),1:$ORDER(DDH(A0)))
+13 KILL A2,DDSQ
+14 ;Now loop thru the DDHs
+15 FOR
Begin DoDot:1
SC1 SET A6=A0
SET A0=$ORDER(DDH(A0))
if A6=""
SET A6=A0-1
+1 IF 'A0
IF DDD
if DDD=1
QUIT
if DD<DS
QUIT
+2 SET A4=$ORDER(DDH(+A0,""))
+3 IF A4'="X"!(DY'>DDSHBX)
SET DY=DY+1
XECUTE DDXY
+4 IF A4="E"
DO SC2
QUIT
MORE IF $Y'<(IOSL-2)!'A0
DO SC2
if DDO'<1!(X=U)!'A0!DIY!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIR0A)
QUIT
SET DY=DDSHBX+1
SET DX=0
XECUTE DDXY
+1 if A4=""
QUIT
+2 ;Write something!
DO WR
+3 ;SEE IF WE ARE 2 LINES FROM BOTTOM
IF $Y'<(IOSL-1)
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
Begin DoDot:2
+4 ;Now that we have written choice #A0, allow them to choose it
WRITE !
SET A6=A0
DO SC2
+5 WRITE $PIECE(DDGLVID,DDGLDEL,8)
SET X=0
XECUTE DDGLZOSF("RM")
DO REFRESH^DDSUTL
+6 WRITE $PIECE(DDGLVID,DDGLDEL,9)
SET X=$GET(IOM,80)-1
XECUTE DDGLZOSF("RM")
+7 SET DX=0
SET DY=DDSHBX
XECUTE DDXY
End DoDot:2
QUIT
+8 SET DY=$Y
SET DX=0
End DoDot:1
if DDO'<1!(X=U)!'A0!DIY!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIR0A)
QUIT
+9 IF $DATA(DDSB1)
if DDO<1
SET DDO=DDSB1
+10 IF '$TEST
KILL DDO
+11 ;
+12 SET %=0
+13 SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
+14 if DDQ>DDSHBX
SET DDM=1
+15 IF $DATA(A2)
KILL DDD,DDH,DDQ
SET %=A2
if %'=1
SET DDSQ=1
DO CLRMSG^DDS
GOTO QQ
+16 IF $DATA(DDC)
IF DDC'<0
DO SV
+17 ;DDSQ means we're done with the Lister
IF '$TEST
KILL DDD,DDH
SET DDSQ=1
+18 ;
QQ SET A0=$X
SET X=0
XECUTE DDGLZOSF("RM")
WRITE $PIECE(DDGLVID,DDGLDEL,8)
SET $X=A0
+1 QUIT
+2 ;
+3 ;
SC2 SET DX=0
SET DY=IOSL-1
XECUTE DDXY
+1 ;DDD=1 means 'HIT RETURN to CONTINUE'
IF DDD=1
WRITE $$EZBLD^DIALOG(8053)
DO READ
QUIT
+2 ;CHOOSE 1-3 ...
WRITE $$EZBLD^DIALOG(8081,A5_"-"_A6)_$PIECE(DDGLCLR,DDGLDEL)
+3 DO READ
IF $GET(DUOUT)
KILL DDC
GOTO Q2
+4 IF X]""
IF X<A5!(X>A6)
WRITE $CHAR(7)
GOTO SC2
+5 IF '$TEST
IF X
if DDD["J"
SET DDO=$ORDER(DDH(X,""))
KILL DDC
+6 DO CLRMSG^DDS
+7 SET DDM=1
Q2 SET DIY=X
SET DY=DDSHBX
+1 QUIT
+2 ;
+3 ;
SV ;Kill DDH array, but save the "ID" nodes and DDH itself
+1 KILL A1,A2
+2 if $DATA(DDH("ID"))
SET A1=DDH("ID")
+3 if $DATA(DDH("ID",1))
SET A2=DDH("ID",1)
+4 KILL DDH
SET DDH=0
+5 if $DATA(A1)
SET DDH("ID")=A1
+6 if $DATA(A2)
SET DDH("ID",1)=A2
+7 QUIT
+8 ;
+9 ;
+10 ;
Z ;From DICQ1,DIEQ
+1 DO Y
DO T
QUIT
+2 ;
Y if '$DATA(DISYS)
DO OS^DII
+1 SET $X=0
SET $Y=0
+2 ;**
SET DIZ=$SELECT($DATA(DILN)&'$DATA(DIR0):DILN,$GET(IOSL):IOSL-3,1:21)
+3 QUIT
+4 ;
+5 ;
+6 ;
STP if $DATA(DD)[0!($DATA(DIY)[0)
QUIT
IF DD+DIY'>79
WRITE ?DD
SET DD=DD+DIY
QUIT
+1 ;
T WRITE !?3
SET DD=DIY+3
+1 IF $Y>DIZ!'$Y
Begin DoDot:1
+2 ;**
NEW DDSUP
SET DDSUP=$$EZBLD^DIALOG(8053)
WRITE DDSUP
READ %Y:$GET(DTIME,300)
+3 IF '$TEST
SET DTOUT=1
KILL DDD
+4 WRITE $CHAR(13),$JUSTIFY("",$LENGTH(DDSUP)+3),$CHAR(13)
if $DATA(DTOUT)
QUIT
+5 IF %Y[U
SET DTOUT=0
KILL DDD
+6 DO Y
WRITE ?3
End DoDot:1
+7 QUIT
+8 ;
W SET A4=$ORDER(DDH(A0,""))
if A4=""
QUIT
if DDH(A0,A4)=""
QUIT
+1 if '$DATA(DDD)
WRITE !
+2 IF $GET(DDD)=3
IF A4["T"
KILL DDD
+3 ;
WR IF A4["X"
Begin DoDot:1
+1 NEW DDD,DIY,DDSXEC
+2 SET DDSXEC=DDH(A0,A4)
+3 NEW DDH
+4 IF $DATA(DDS)
NEW DDSID
SET DDSID=1
SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_DX
+5 XECUTE DDSXEC
End DoDot:1
QUIT
+6 ;
+7 IF A4["Q"
Begin DoDot:1
+8 SET A4=DDH(A0,A4)
SET %=$PIECE(A4,U,1)
+9 IF $DATA(DDS)
DO ASK
QUIT
+10 WRITE $PIECE(A4,U,2)
+11 DO YN^DICN
End DoDot:1
QUIT
+12 ;
+13 IF A4["T"
Begin DoDot:1
+14 IF DDH(A0,A4)[$CHAR(0)
Begin DoDot:2
+15 SET DX=$LENGTH(DDH(A0,A4),$CHAR(0))-1
+16 XECUTE DDXY
+17 SET DDH(A0,A4)=$TRANSLATE(DDH(A0,A4),$CHAR(0),"")
End DoDot:2
+18 WRITE DDH(A0,A4)
End DoDot:1
QUIT
+19 ;
+20 IF '$DATA(DDS)
IF $GET(DDD)'["J"
IF A4'=+A4
QUIT
+21 IF $DATA(DDS)
IF $GET(DDD)=2!($GET(DDD)["J")
WRITE A0,?7
+22 ;
CHOICE IF $DATA(DDS)
IF $GET(DDSMOUSY)
Begin DoDot:1
+1 WRITE " "
DO WRITMOUS(DDH(A0,A4))
End DoDot:1
+2 IF '$TEST
WRITE DDH(A0,A4)
+3 IF $DATA(DDH("ID"))
Begin DoDot:1
+4 NEW DDD,DIY,DDSID
+5 SET DDSID=DDH("ID")
+6 if $DATA(DDH("ID",1))#2
SET DDSID(1)=DDH("ID",1)
+7 NEW DDH
+8 if $DATA(DDSID(1))#2
SET DDH("ID",1)=DDSID(1)
KILL DDSID(1)
+9 SET Y=A4
+10 if $DATA(DDS)
SET DDQ=$SELECT(DY>(IOSL-1):IOSL-1,1:DY)_U_$X
+11 XECUTE DDSID
End DoDot:1
if $DATA(DUOUT)
SET DIY=U
+12 QUIT
+13 ;
+14 ;
WRITMOUS(C) ;MAKE THE CHOICES IN THE COMMAND AREA CLICKABLE!!
+1 WRITE $PIECE(DDGLCLR,DDGLDEL)
+2 NEW F
+3 ;LEADING BLANKS
FOR
if $ASCII(C)-32
QUIT
SET C=$EXTRACT(C,2,999)
WRITE " "
+4 FOR F=0:1
if $ASCII(C,$LENGTH(C))-32
QUIT
SET C=$EXTRACT(C,1,$LENGTH(C)-1)
+5 IF $GET(DDSMOUSY)
SET DDSMOUSE($Y,$X,$X+$LENGTH(C)-1,1)=C
WRITE $$HIGH(C)
+6 IF '$TEST
WRITE C
+7 WRITE $JUSTIFY("",F)
+8 QUIT
+9 ;
+10 ;
+11 ;
HIGH(X) ;also from DDSCOM, DDSR
+1 IF '$DATA(DDGLVID)
QUIT X
+2 QUIT $PIECE(DDGLVID,DDGLDEL,10)_$PIECE(DDGLVID,DDGLDEL,6)_X_$PIECE(DDGLVID,DDGLDEL,10)
+3 ;
+4 ;
+5 ;
ASK WRITE $PIECE(A4,U,2)_$SELECT(%'>2:"? ",1:"")_$SELECT(%>0&(%<3):$PIECE($$EZBLD^DIALOG(7001),U,%)_"// ",1:"")_$PIECE(DDGLCLR,DDGLDEL)
+1 SET A2=0
+2 DO READ
IF $GET(DUOUT)
SET A2=-1
QUIT
+3 IF %>2
SET A2=X
QUIT
+4 NEW %1
SET %1=$$PRS^DIALOGU(7001,X)
if %1>0
SET X=$EXTRACT($PIECE(%1,U,2))
+5 KILL %1
+6 IF "YyNn^"'[X
WRITE $CHAR(7)
XECUTE DDXY
GOTO ASK
+7 IF X]""
IF "^Nn"[X
SET A2=2
KILL DDC
QUIT
+8 if "Yy"[X
SET A2=1
+9 if X=""&(%]"")
SET A2=+%
+10 SET DDD=1
+11 QUIT
+12 ;
+13 ;
READ ;RETURNS 'X' & 'DICQRETA'
+1 NEW DIR0P,DIR0KD,S
+2 XECUTE DDGLZOSF("EOFF")
+3 SET (DIR0P,X)=""
FOR
Begin DoDot:1
+4 DO READ^DIR01(.S)
IF S="TO"
SET DTOUT=1
KILL DCC
GOTO Q2
+5 IF $LENGTH(S)=1
SET X=X_S
WRITE S
QUIT
+6 IF S="CR"
KILL S
QUIT
+7 IF S="EX"!(S="SV")!(S="QT")
SET DICQRETA=S
SET DUOUT=1
SET X=U
KILL S
QUIT
+8 ;ignore down-click
IF S="MOUSEDN"
QUIT
+9 IF S="MOUSE"
KILL S
DO MOUSE^DIR01
if $GET(DIR0A)?."??"
KILL DIR0A
SET DUOUT=1
SET DDSQ=1
QUIT
+10 WRITE *7
End DoDot:1
if '$DATA(S)
QUIT
+11 XECUTE DDGLZOSF("EON")
+12 IF X?1."^"
SET DUOUT=1
SET X=U
QUIT
+13 DO CLRMSG^DDS
SET DDM=1
QUIT
+14 ;
+15 ;
+16 ;
+17 ;
H ;From DICN
+1 if '$DATA(A1)
SET A1="T"
+2 SET DDH=$GET(DDH)+1
SET DDH(DDH,A1)=DST
+3 KILL A1,DST
+4 DO SC
+5 QUIT
+6 ;#8053 Press 'RETURN' to continue...
+7 ;#8081 Choose |from-to| or '^'...
+8 ;#7001 Yes^No
