- DDBRAHTE ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT JUMP EDIT ;NOV 04, 1996@13:51
- ;;22.0;VA FileMan;**145**;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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
- DDBRAHTE ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT JUMP EDIT ;NOV 04, 1996@13:51
- +1 ;;22.0;VA FileMan;**145**;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 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
