DDBRWB ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;NOV 04, 1996@13:56
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
STPB ; Save To Paste Buffer
I DDBSA=$NA(^TMP("DDWB",$J)) D G PS^DDBR2
.N X
.S X(1)="",X(2)=$$CTXT^DDBR("<< Copy to Paste Buffer RESTRICTED When Viewing Buffer >>","",IOM)
.W $$WS^DDBR1(.X),$C(7)
.R X:5
.Q
I $E(DDBSA,1,11)="^DI(.84,920" D G PS^DDBR2
.N X
.S X(1)="",X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit HELP to Copy to Paste Buffer >>","",IOM)
.W $$WS^DDBR1(.X),$C(7)
.R X:5
.Q
N X,XF,XT
GTR S X(1)=$G(X(1)),X(2)="Copy Text Line(s) to Paste Buffer >"
W $$WS(.X)
D G:X=""!(X=U) OUT
.D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
.K DIR0
.Q
I $E(X)="?" S X(1)="* Enter line or range, separated by "":"", of lines *" G GTR
I 'X&($E(X)'="*") G OUT
I $E(X)="*" S X=$TR(X,"a","A"),XF=1,XT=DDBTL
E S X=$TR(X,"a-/;|* ","A:::::"),XF=+X,XT=+$P(X,":",2)
I XF<1!(XF>DDBTL) S X(1)="Must be a valid line or range of lines, from 1 to "_DDBTL G GTR
I XT,XT<1!(XT>DDBTL) S X(1)="Must be a valid line or range of lines, from 1 to "_DDBTL G GTR
I XT>0,XT<XF S X(1)="To value must be greater than from value" G GTR
D SAVE(XF,$S(XT'>0:XF,1:XT),X["A")
K X
S X(2)="Text Copied to Buffer"
W $$WS(.X)
R X:3
G OUT
;
SAVE(FR,TO,APN) ; Save From To (lines) APN=append to end of current list
K:'APN ^TMP("DDWB",$J)
N I,II
S II=$O(^TMP("DDWB",$J,""),-1)+1
I DDBZN D Q
.F I=FR:1:TO S ^TMP("DDWB",$J,II)=@DDBSA@(I,0),II=II+1
.Q
F I=FR:1:TO S ^TMP("DDWB",$J,II)=@DDBSA@(I),II=II+1
Q
VIEW I DDBSA=$NA(^TMP("DDWB",$J)) S DDBL=0 D SDLR^DDBR0(1),RLPIR^DDBR0 Q
I $E(DDBSA,1,11)="^DI(.84,920" D G PS^DDBR2
.N X
.S X(1)="",X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit HELP To View Buffer >>","",IOM)
.W $$WS^DDBR1(.X),$C(7)
.R X:5
.Q
N DDBHA,DDBHAT S DDBHA=$NA(^TMP("DDWB",$J)),DDBHAT=0
I $D(^TMP("DDWB",$J))'>9 S ^TMP("DDWB",$J,1)="< No Text >",DDBHAT=1
D BROWSE^DDBR(DDBHA,"PNH","View Paste Buffer",$G(DDBHELPS),"",IOTM-1,IOBM+1)
K:DDBHAT ^TMP("DDWB",$J)
W @IOSTBM
D PSR^DDBR0(1)
Q
;
SWITCH ; Switching Restricted while in View
N X
S X(1)="",X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit View Buffer to SWITCH >>","",IOM)
W $$WS^DDBR1(.X),$C(7)
R X:5
G PS^DDBR2
;
OUT D PSR^DDBR0()
Q
;
WS(X) S DX=0,DY=$P(DDBSY,";",3)-3 X IOXY
W $P(DDGLGRA,DDGLDEL)
W $TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))
W $P(DDGLGRA,DDGLDEL,2)
W !,$P(DDGLCLR,DDGLDEL),$G(X(1))
W !,$P(DDGLCLR,DDGLDEL),$G(X(2))
W !,$P(DDGLCLR,DDGLDEL),$G(X(3))
S DY=$P(DDBSY,";",3),DX=$L($G(X(2)))+2 X IOXY
Q ""
DDBRWB ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;NOV 04, 1996@13:56
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
STPB ; Save To Paste Buffer
+1 IF DDBSA=$NAME(^TMP("DDWB",$JOB))
Begin DoDot:1
+2 NEW X
+3 SET X(1)=""
SET X(2)=$$CTXT^DDBR("<< Copy to Paste Buffer RESTRICTED When Viewing Buffer >>","",IOM)
+4 WRITE $$WS^DDBR1(.X),$CHAR(7)
+5 READ X:5
+6 QUIT
End DoDot:1
GOTO PS^DDBR2
+7 IF $EXTRACT(DDBSA,1,11)="^DI(.84,920"
Begin DoDot:1
+8 NEW X
+9 SET X(1)=""
SET X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit HELP to Copy to Paste Buffer >>","",IOM)
+10 WRITE $$WS^DDBR1(.X),$CHAR(7)
+11 READ X:5
+12 QUIT
End DoDot:1
GOTO PS^DDBR2
+13 NEW X,XF,XT
GTR SET X(1)=$GET(X(1))
SET X(2)="Copy Text Line(s) to Paste Buffer >"
+1 WRITE $$WS(.X)
+2 Begin DoDot:1
+3 DO EN^DIR0($PIECE(DDBSY,";",3)-1,$LENGTH($GET(X(2)))+2,30,1,"",100,1,"","KPW",.X)
+4 KILL DIR0
+5 QUIT
End DoDot:1
IF X=""!(X=U)
GOTO OUT
+6 IF $EXTRACT(X)="?"
SET X(1)="* Enter line or range, separated by "":"", of lines *"
GOTO GTR
+7 IF 'X&($EXTRACT(X)'="*")
GOTO OUT
+8 IF $EXTRACT(X)="*"
SET X=$TRANSLATE(X,"a","A")
SET XF=1
SET XT=DDBTL
+9 IF '$TEST
SET X=$TRANSLATE(X,"a-/;|* ","A:::::")
SET XF=+X
SET XT=+$PIECE(X,":",2)
+10 IF XF<1!(XF>DDBTL)
SET X(1)="Must be a valid line or range of lines, from 1 to "_DDBTL
GOTO GTR
+11 IF XT
IF XT<1!(XT>DDBTL)
SET X(1)="Must be a valid line or range of lines, from 1 to "_DDBTL
GOTO GTR
+12 IF XT>0
IF XT<XF
SET X(1)="To value must be greater than from value"
GOTO GTR
+13 DO SAVE(XF,$SELECT(XT'>0:XF,1:XT),X["A")
+14 KILL X
+15 SET X(2)="Text Copied to Buffer"
+16 WRITE $$WS(.X)
+17 READ X:3
+18 GOTO OUT
+19 ;
SAVE(FR,TO,APN) ; Save From To (lines) APN=append to end of current list
+1 IF 'APN
KILL ^TMP("DDWB",$JOB)
+2 NEW I,II
+3 SET II=$ORDER(^TMP("DDWB",$JOB,""),-1)+1
+4 IF DDBZN
Begin DoDot:1
+5 FOR I=FR:1:TO
SET ^TMP("DDWB",$JOB,II)=@DDBSA@(I,0)
SET II=II+1
+6 QUIT
End DoDot:1
QUIT
+7 FOR I=FR:1:TO
SET ^TMP("DDWB",$JOB,II)=@DDBSA@(I)
SET II=II+1
+8 QUIT
VIEW IF DDBSA=$NAME(^TMP("DDWB",$JOB))
SET DDBL=0
DO SDLR^DDBR0(1)
DO RLPIR^DDBR0
QUIT
+1 IF $EXTRACT(DDBSA,1,11)="^DI(.84,920"
Begin DoDot:1
+2 NEW X
+3 SET X(1)=""
SET X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit HELP To View Buffer >>","",IOM)
+4 WRITE $$WS^DDBR1(.X),$CHAR(7)
+5 READ X:5
+6 QUIT
End DoDot:1
GOTO PS^DDBR2
+7 NEW DDBHA,DDBHAT
SET DDBHA=$NAME(^TMP("DDWB",$JOB))
SET DDBHAT=0
+8 IF $DATA(^TMP("DDWB",$JOB))'>9
SET ^TMP("DDWB",$JOB,1)="< No Text >"
SET DDBHAT=1
+9 DO BROWSE^DDBR(DDBHA,"PNH","View Paste Buffer",$GET(DDBHELPS),"",IOTM-1,IOBM+1)
+10 IF DDBHAT
KILL ^TMP("DDWB",$JOB)
+11 WRITE @IOSTBM
+12 DO PSR^DDBR0(1)
+13 QUIT
+14 ;
SWITCH ; Switching Restricted while in View
+1 NEW X
+2 SET X(1)=""
SET X(2)=$$CTXT^DDBR("<< RESTRICTED Must Exit View Buffer to SWITCH >>","",IOM)
+3 WRITE $$WS^DDBR1(.X),$CHAR(7)
+4 READ X:5
+5 GOTO PS^DDBR2
+6 ;
OUT DO PSR^DDBR0()
+1 QUIT
+2 ;
WS(X) SET DX=0
SET DY=$PIECE(DDBSY,";",3)-3
XECUTE IOXY
+1 WRITE $PIECE(DDGLGRA,DDGLDEL)
+2 WRITE $TRANSLATE($JUSTIFY("",IOM)," ",$PIECE(DDGLGRA,DDGLDEL,3))
+3 WRITE $PIECE(DDGLGRA,DDGLDEL,2)
+4 WRITE !,$PIECE(DDGLCLR,DDGLDEL),$GET(X(1))
+5 WRITE !,$PIECE(DDGLCLR,DDGLDEL),$GET(X(2))
+6 WRITE !,$PIECE(DDGLCLR,DDGLDEL),$GET(X(3))
+7 SET DY=$PIECE(DDBSY,";",3)
SET DX=$LENGTH($GET(X(2)))+2
XECUTE IOXY
+8 QUIT ""