DDBRAHTE ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT JUMP EDIT ;NOV 04, 1996@13:51
;;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
REDIT ; root edit for hypertext jump - CLOSED_ROOT
Q
;prototype - phasing out
Q:'$$CHKI
N DDBSAN,DDBSANS,DDBSANX,DDBSANR,X
S DDBSAN=$$NROOT^DDBRAP(DDBSA),DDBSANX=$P(DDBRHT,DDGLDEL,2)
S X(1)=" < Edit Hypertext Jump Closed_Root >"
S DDBSANS=$G(@DDBSAN@("H",DDBSANX)),DDBSANR=$G(@DDBSAN@("H",DDBSANX,0))
Q:DDBSAN=""!(DDBSANS="")
GTR S X(1)=$G(X(1)),X(2)=" "_$E(DDBSANX,1,30)_" >"
W $$WS^DDBR1(.X)
D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,44,1,DDBSANR,100,1,"","KPW",.X)
K DIR0
I $E(X)="?" S X(1)="* Enter closed_root jump for hypertext: "_$E(DDBSANX,1,35)_$S($L(DDBSANX)>35:"...",1:"")_" *" G GTR
I DDBSANR'=X S @DDBSAN@("H",DDBSANX,0)=X
G OUT
;
IEDIT ; interactive edit/switch
Q:'$$CHKI
Q
ANCH ; enter Anchor for jump
Q
;prototype - phasing out
Q:'$$CHKI
N DDBSAN,DDBSANS,DDBSANX,DDBSANR,DDBSANCH,X
S DDBSAN=$$NROOT^DDBRAP(DDBSA),DDBSANX=$P(DDBRHT,DDGLDEL,2)
S X(1)=" < Edit Anchor Jump >"
S DDBSANS=$G(@DDBSAN@("H",DDBSANX)),DDBSANR=$G(@DDBSAN@("H",DDBSANX,0))
S DDBSANCH=$P(DDBSANS,"^",4)
Q:DDBSAN=""!(DDBSANS="")
AGTR S X(1)=$G(X(1)),X(2)=" "_$E(DDBSANX,1,30)_" >"
W $$WS^DDBR1(.X)
D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,44,1,DDBSANCH,100,1,"","KPW",.X)
K DIR0
I $E(X)="?" S X(1)="* Enter FILE#;IEN;FIELD;ANCHOR for: "_$E(DDBSANX,1,35)_$S($L(DDBSANX)>35:"...",1:"")_" *" G AGTR
I DDBSANCH'=X S $P(@DDBSAN@("H",DDBSANX),"^",4)=X
G OUT
Q
;
TEDIT ; edit hypertext document title
I 'DDBRHTF!($G(DUZ(0))'["@") Q
N DDBSAN,DDBSANX,X
S DDBSAN=$$NROOT^DDBRAP(DDBSA),DDBSANX=$G(@DDBSAN@("TITLE"))
S X(1)=" < Edit Hypertext Document Title >"
TGTR S X(1)=$G(X(1)),X(2)=" Title >"
W $$WS^DDBR1(.X)
D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,44,1,DDBSANX,100,1,"","KPW",.X)
K DIR0
I $E(X)="?" S X(1)="* Enter Document Name for Title *" G TGTR
I X'="^" D D RPS^DDBRGE Q
.S @DDBSAN@("TITLE")=X
.S DDBPMSG=X,DDBHDR=$$CTXT^DDBR(X,$J("",IOM+1),IOM)
.Q
G OUT
;
CHKI() ;return 1 if ok 0 not ok to continue also init DDBRHT if undefined
S DDBRHT=$G(DDBRHT)
Q:DDBRHT="" 0
I 'DDBRHTF!($G(DUZ(0))'["@") Q 0
I $P(DDBRHT,DDGLDEL,4)'=DDBSA Q 0
I +DDBRHT>DDBL Q 0
I +DDBRHT<($S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1) Q 0
Q 1
;
OUT D PSR^DDBR0() Q
;
RA ;Rebuild Anchors
I 'DDBRHTF!($G(DUZ(0))'["@") Q
N X,DDBSAN
S DDBSAN=$$NROOT^DDBRAP(DDBSA)
S X(1)="",X(2)=" < Rebuilding Anchor Index for HyperText Jumps >"
W $$WS^DDBR1(.X)
D WP^DDBRAP(DDBSA,"",$G(@DDBSAN@("TITLE"),DDBPMSG))
R X:2
G OUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDBRAHTE 2976 printed Apr 09, 2024@21:52:46 Page 2
DDBRAHTE ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT JUMP EDIT ;NOV 04, 1996@13:51
+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
REDIT ; root edit for hypertext jump - CLOSED_ROOT
+1 QUIT
+2 ;prototype - phasing out
+3 if '$$CHKI
QUIT
+4 NEW DDBSAN,DDBSANS,DDBSANX,DDBSANR,X
+5 SET DDBSAN=$$NROOT^DDBRAP(DDBSA)
SET DDBSANX=$PIECE(DDBRHT,DDGLDEL,2)
+6 SET X(1)=" < Edit Hypertext Jump Closed_Root >"
+7 SET DDBSANS=$GET(@DDBSAN@("H",DDBSANX))
SET DDBSANR=$GET(@DDBSAN@("H",DDBSANX,0))
+8 if DDBSAN=""!(DDBSANS="")
QUIT
GTR SET X(1)=$GET(X(1))
SET X(2)=" "_$EXTRACT(DDBSANX,1,30)_" >"
+1 WRITE $$WS^DDBR1(.X)
+2 DO EN^DIR0($PIECE(DDBSY,";",3)-1,$LENGTH($GET(X(2)))+2,44,1,DDBSANR,100,1,"","KPW",.X)
+3 KILL DIR0
+4 IF $EXTRACT(X)="?"
SET X(1)="* Enter closed_root jump for hypertext: "_$EXTRACT(DDBSANX,1,35)_$SELECT($LENGTH(DDBSANX)>35:"...",1:"")_" *"
GOTO GTR
+5 IF DDBSANR'=X
SET @DDBSAN@("H",DDBSANX,0)=X
+6 GOTO OUT
+7 ;
IEDIT ; interactive edit/switch
+1 if '$$CHKI
QUIT
+2 QUIT
ANCH ; enter Anchor for jump
+1 QUIT
+2 ;prototype - phasing out
+3 if '$$CHKI
QUIT
+4 NEW DDBSAN,DDBSANS,DDBSANX,DDBSANR,DDBSANCH,X
+5 SET DDBSAN=$$NROOT^DDBRAP(DDBSA)
SET DDBSANX=$PIECE(DDBRHT,DDGLDEL,2)
+6 SET X(1)=" < Edit Anchor Jump >"
+7 SET DDBSANS=$GET(@DDBSAN@("H",DDBSANX))
SET DDBSANR=$GET(@DDBSAN@("H",DDBSANX,0))
+8 SET DDBSANCH=$PIECE(DDBSANS,"^",4)
+9 if DDBSAN=""!(DDBSANS="")
QUIT
AGTR SET X(1)=$GET(X(1))
SET X(2)=" "_$EXTRACT(DDBSANX,1,30)_" >"
+1 WRITE $$WS^DDBR1(.X)
+2 DO EN^DIR0($PIECE(DDBSY,";",3)-1,$LENGTH($GET(X(2)))+2,44,1,DDBSANCH,100,1,"","KPW",.X)
+3 KILL DIR0
+4 IF $EXTRACT(X)="?"
SET X(1)="* Enter FILE#;IEN;FIELD;ANCHOR for: "_$EXTRACT(DDBSANX,1,35)_$SELECT($LENGTH(DDBSANX)>35:"...",1:"")_" *"
GOTO AGTR
+5 IF DDBSANCH'=X
SET $PIECE(@DDBSAN@("H",DDBSANX),"^",4)=X
+6 GOTO OUT
+7 QUIT
+8 ;
TEDIT ; edit hypertext document title
+1 IF 'DDBRHTF!($GET(DUZ(0))'["@")
QUIT
+2 NEW DDBSAN,DDBSANX,X
+3 SET DDBSAN=$$NROOT^DDBRAP(DDBSA)
SET DDBSANX=$GET(@DDBSAN@("TITLE"))
+4 SET X(1)=" < Edit Hypertext Document Title >"
TGTR SET X(1)=$GET(X(1))
SET X(2)=" Title >"
+1 WRITE $$WS^DDBR1(.X)
+2 DO EN^DIR0($PIECE(DDBSY,";",3)-1,$LENGTH($GET(X(2)))+2,44,1,DDBSANX,100,1,"","KPW",.X)
+3 KILL DIR0
+4 IF $EXTRACT(X)="?"
SET X(1)="* Enter Document Name for Title *"
GOTO TGTR
+5 IF X'="^"
Begin DoDot:1
+6 SET @DDBSAN@("TITLE")=X
+7 SET DDBPMSG=X
SET DDBHDR=$$CTXT^DDBR(X,$JUSTIFY("",IOM+1),IOM)
+8 QUIT
End DoDot:1
DO RPS^DDBRGE
QUIT
+9 GOTO OUT
+10 ;
CHKI() ;return 1 if ok 0 not ok to continue also init DDBRHT if undefined
+1 SET DDBRHT=$GET(DDBRHT)
+2 if DDBRHT=""
QUIT 0
+3 IF 'DDBRHTF!($GET(DUZ(0))'["@")
QUIT 0
+4 IF $PIECE(DDBRHT,DDGLDEL,4)'=DDBSA
QUIT 0
+5 IF +DDBRHT>DDBL
QUIT 0
+6 IF +DDBRHT<($SELECT(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1)
QUIT 0
+7 QUIT 1
+8 ;
OUT DO PSR^DDBR0()
QUIT
+1 ;
RA ;Rebuild Anchors
+1 IF 'DDBRHTF!($GET(DUZ(0))'["@")
QUIT
+2 NEW X,DDBSAN
+3 SET DDBSAN=$$NROOT^DDBRAP(DDBSA)
+4 SET X(1)=""
SET X(2)=" < Rebuilding Anchor Index for HyperText Jumps >"
+5 WRITE $$WS^DDBR1(.X)
+6 DO WP^DDBRAP(DDBSA,"",$GET(@DDBSAN@("TITLE"),DDBPMSG))
+7 READ X:2
+8 GOTO OUT
