- 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 Jan 18, 2025@03:42:56 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 ""