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