DDBRWB ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;01:54 PM 3 Sep 2002
;;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.
;
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($$EZBLD^DIALOG(7078.3),"",IOM) ;**RESTRICTED
.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($$EZBLD^DIALOG(7078.4),"",IOM) ;**RESTRICTED
.W $$WS^DDBR1(.X),$C(7)
.R X:5
.Q
N X,XF,XT
GTR S X(1)=$G(X(1)),X(2)=$$EZBLD^DIALOG(7078) ;**COPY TEXT
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)=$$EZBLD^DIALOG(7078.1) G GTR ;**ENTER LINES
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)=$$EZBLD^DIALOG(7078.2,DDBTL) G GTR ;**ERROR
I XT,XT<1!(XT>DDBTL) S X(1)=$$EZBLD^DIALOG(7078.2,DDBTL) G GTR ;**
I XT>0,XT<XF S X(1)=$$EZBLD^DIALOG(1511) G GTR ;**FROM LESS THAN TO
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($$EZBLD^DIALOG(7078.5),"",IOM) ;**RESTRICTED
.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($$EZBLD^DIALOG(7078.6),"",IOM) ;**RESTRICTED
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 ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDBRWB 2749 printed Oct 16, 2024@18:42:31 Page 2
DDBRWB ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;01:54 PM 3 Sep 2002
+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 ;
+7 QUIT
STPB ; Save To Paste Buffer
+1 IF DDBSA=$NAME(^TMP("DDWB",$JOB))
Begin DoDot:1
+2 NEW X
+3 ;**RESTRICTED
SET X(1)=""
SET X(2)=$$CTXT^DDBR($$EZBLD^DIALOG(7078.3),"",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 ;**RESTRICTED
SET X(1)=""
SET X(2)=$$CTXT^DDBR($$EZBLD^DIALOG(7078.4),"",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 ;**COPY TEXT
SET X(1)=$GET(X(1))
SET X(2)=$$EZBLD^DIALOG(7078)
+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 ;**ENTER LINES
IF $EXTRACT(X)="?"
SET X(1)=$$EZBLD^DIALOG(7078.1)
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 ;**ERROR
IF XF<1!(XF>DDBTL)
SET X(1)=$$EZBLD^DIALOG(7078.2,DDBTL)
GOTO GTR
+11 ;**
IF XT
IF XT<1!(XT>DDBTL)
SET X(1)=$$EZBLD^DIALOG(7078.2,DDBTL)
GOTO GTR
+12 ;**FROM LESS THAN TO
IF XT>0
IF XT<XF
SET X(1)=$$EZBLD^DIALOG(1511)
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 ;**RESTRICTED
SET X(1)=""
SET X(2)=$$CTXT^DDBR($$EZBLD^DIALOG(7078.5),"",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 ;**RESTRICTED
SET X(1)=""
SET X(2)=$$CTXT^DDBR($$EZBLD^DIALOG(7078.6),"",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 ""
