- DDBRAHTJ ;SFISC/DCL-BROWSER HYPERTEXT JUMP ;NOV 04, 1996@13:51
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- JUMP(DDBRDIR) ; pass direction 1/forward -1/backward
- ;
- ;
- N DDBSAN,DDBRAFLG,DDBLST
- S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA)),DDBLST=$NA(^TMP("DDBLST",$J))
- I $G(DDBRDIR)=1 D FRWD Q
- D BCK
- Q
- FRWD ; forward
- Q:'$$CHKI
- N DDBRAHP,DDBRAHA,DDBSANX,DDBRAAH,DDBRAHL,DDBRSET,DIERM
- S DDBSANX=$P(DDBRHT,DDGLDEL,2),DDBRAAH=$P(DDBSANX,"^"),DDBRSET=1
- ;jump to another root
- I DDBSANX["$CREF$" D G STKPT:DDBSANX]"" G PS^DDBR2
- .N DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT,DDBRXC2,DDBRXC3
- .S DDBRATR=$P(DDBSANX,"$CREF$",2)
- .S DDBRAAH=$P($P(DDBSANX,"$CREF$",3),"^")
- .I DDBRATR="" S DDBRAAH="" Q
- .I $D(@DDBRATR)'>9,$E($G(@DDBRATR),1,5)="$XC$^" D Q:$D(@DDBRATR)'>9
- ..N X,DDBRNR
- ..S DDBRXC3=$P(@DDBRATR,"$XC$^",3)
- ..S X(1)="",X(2)=$$CTXT^DDBR("Loading "_DDBRXC3,"",IOM),X(3)=""
- ..W $$WS^DDBR1(.X)
- ..S DDBRXC2=$P(@DDBRATR,"$XC$^",2) X DDBRXC2
- ..I $D(@DDBRATR)'>9 Q
- ..I DDBRXC3]"" D WP^DDBRAP(DDBRATR,"",DDBRXC3)
- ..Q
- .I $D(@DDBRATR)'>9,$E($G(@DDBRATR),1,6)="$XCR$^" D W @IOSTBM Q
- ..N X,IOTM,IOBM,IOSTBM
- ..S DDBRXC2=$P(@DDBRATR,"$XCR$^",2),DDBSANX="" X DDBRXC2
- ..W:$D(IOF) @IOF
- ..S X=0 X ^%ZOSF("RM")
- ..W $P(DDGLVID,DDGLDEL,8)
- ..Q
- .I '$D(@DDBRATR) S DDBRAAH="" Q
- .S DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
- .I '$D(@DDBRANRT) D WP^DDBRAP(DDBRATR)
- .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
- .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
- .S DDBRSET=0
- .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
- .S DDBSA=DDBRATR,DDBSAN=DDBRANRT
- .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG=$TR($P(DDBSANX,"^",$L(DDBSANX,"^")),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- .D SAVSET
- .Q
- ;jump to another file, w-pDD#,entry:entry#anchor
- I DDBRAAH,DDBRAAH["@" D G STKPT
- .N DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT
- .S DDBRAB=$P(DDBRAAH,"#")
- .I DDBRAB="" S DDBRAAH="" Q
- .S DDBRATR=$$GETR^DDBRAP($P(DDBRAB,"@"),$P($P(DDBRAB,"@",2),"#"))
- .I DDBRATR="" D Q
- ..S DDBRAAH=""
- ..I $G(DIERR) S DIERM=$$CTXT^DDBR($G(^TMP("DIERR",$J,+DIERR,"TEXT",1)))
- ..K DIERR,^TMP("DIERR",$J)
- ..Q
- .S DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
- .I '$D(@DDBRANRT) D WP^DDBRAP(DDBRATR)
- .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
- .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
- .S DDBRSET=0
- .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
- .S DDBSA=DDBRATR,DDBSAN=DDBRANRT
- .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG="HYPERTEXT JUMP ID#"_$O(@DDBLST@("J",""),-1)+1
- .D SAVSET
- .Q
- ;jump to another entry in the same file, same level
- I DDBRAAH["#",$P(DDBRAAH,"#")]"" D
- .N DDBRAB,DDBRABR,DDBRAIEN,DDBLSTN,DDBRALEV,DDBRANRT
- .S DDBRAB=$P(DDBRAAH,"#")
- .I DDBRAB="" S DDBRAAH="" Q
- .S DDBRALEV="",DDBRABR=$$IENROOT^DDBRAP($NA(@DDBSA),.DDBRALEV)
- .S DDBRAIEN=$O(@DDBRABR@("B",DDBRAB,""))
- .I 'DDBRAIEN S DDBRAAH="" Q
- .S DDBRANRT=$$NROOT^DDBRAP($NA(@DDBRABR@(DDBRAIEN,DDBRALEV)))
- .I '$D(@DDBRANRT) D WP^DDBRAP($NA(@DDBRABR@(DDBRAIEN,DDBRALEV)))
- .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
- .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
- .S DDBRSET=0
- .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
- .S DDBSA=$NA(@DDBRABR@(DDBRAIEN,DDBRALEV))
- .S DDBSAN=DDBRANRT
- .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG="HYPERTEXT JUMP ID#"_$O(@DDBLST@("J",""),-1)+1
- .D SAVSET
- .Q
- STKPT S:DDBRAAH["#" DDBRAAH=$P(DDBRAAH,"#",2)
- I DDBRAAH]"" S DDBRAHA=$G(@DDBSAN@("A",DDBRAAH))
- I DDBRSET,$G(DDBRAHA)'>0 D NOHTJ($G(DIERM)) G PS^DDBR2
- S DDBRAHL=$S($G(DDBRAHA):DDBRAHA+DDBSRL-1,1:0)
- D SET:DDBRSET,GOTO Q
- Q
- ;
- SET ; set and save jump info
- S DDBRAHP=$O(@DDBLST@("J",""),-1)+1
- S @DDBLST@("J",DDBRAHP)=DDBSA_DDGLDEL_DDBL_"^"_+$G(DDBLSTN)_DDGLDEL_DDBRHT
- Q
- ;
- GOTO ; jump to line in current document
- S DDBL=$S(DDBRAHL'>DDBSRL:0,DDBRAHL>DDBTL:DDBTL,1:DDBRAHL) D PSR^DDBR0(+$G(DDBRAFLG))
- Q
- BCK ; backward
- Q:'$D(@DDBLST@("J"))
- N DDBX,DDBY,DDBRAFLG
- S DDBX=$O(@DDBLST@("J",""),-1),DDBY=@DDBLST@("J",DDBX)
- K @DDBLST@("J",DDBX)
- I $P(DDBY,DDGLDEL)'=DDBSA D S DDBRAFLG=1
- .D USAVEDDB^DDBR2(DDBLST,$P($P(DDBY,DDGLDEL,2),"^",2))
- S DDBL=+$P(DDBY,DDGLDEL,2),DDBRHT=$P(DDBY,DDGLDEL,3,255)
- D PSR^DDBR0(+$G(DDBRAFLG))
- Q
- CHKI() ;return 1 if ok 0 not ok to continue also init DDBRHT if undefined
- S DDBRHT=$G(DDBRHT)
- Q:DDBRHT="" 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
- ;
- NOHTJ(EM) ; no hypertext jump available
- N X,Y
- S Y=$P(DDBSANX,"^",$S(DDBSANX["$CREF$":$L(DDBSANX,"^"),1:2)),X(1)=$$CTXT^DDBR(Y,"",IOM),EM=$G(EM) S:$P(EM,"Error:",2)]"" EM="<< "_$P(EM,"Error:",2)_" >>"
- S X(2)=""
- S X(3)=$$CTXT^DDBR($S(EM]"":EM,1:"<< Hypertext jump is not avaialble >>"),"",IOM)
- W $$WS^DDBR1(.X),$C(7)
- R X:5
- Q
- ;
- SAVSET ;
- S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
- S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
- S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- S DDBZN=$D(@DDBSA@(DDBTL,0))#2
- S DDBDM=0
- S DDBSF=1
- S DDBST=IOM
- S DDBC=$NA(^TMP("DDBC","DDBC",$J))
- I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
- Q
- DDBRAHTJ ;SFISC/DCL-BROWSER HYPERTEXT JUMP ;NOV 04, 1996@13:51
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- JUMP(DDBRDIR) ; pass direction 1/forward -1/backward
- +1 ;
- +2 ;
- +3 NEW DDBSAN,DDBRAFLG,DDBLST
- +4 SET DDBSAN=$$NROOT^DDBRAP($NAME(@DDBSA))
- SET DDBLST=$NAME(^TMP("DDBLST",$JOB))
- +5 IF $GET(DDBRDIR)=1
- DO FRWD
- QUIT
- +6 DO BCK
- +7 QUIT
- FRWD ; forward
- +1 IF '$$CHKI
- QUIT
- +2 NEW DDBRAHP,DDBRAHA,DDBSANX,DDBRAAH,DDBRAHL,DDBRSET,DIERM
- +3 SET DDBSANX=$PIECE(DDBRHT,DDGLDEL,2)
- SET DDBRAAH=$PIECE(DDBSANX,"^")
- SET DDBRSET=1
- +4 ;jump to another root
- +5 IF DDBSANX["$CREF$"
- Begin DoDot:1
- +6 NEW DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT,DDBRXC2,DDBRXC3
- +7 SET DDBRATR=$PIECE(DDBSANX,"$CREF$",2)
- +8 SET DDBRAAH=$PIECE($PIECE(DDBSANX,"$CREF$",3),"^")
- +9 IF DDBRATR=""
- SET DDBRAAH=""
- QUIT
- +10 IF $DATA(@DDBRATR)'>9
- IF $EXTRACT($GET(@DDBRATR),1,5)="$XC$^"
- Begin DoDot:2
- +11 NEW X,DDBRNR
- +12 SET DDBRXC3=$PIECE(@DDBRATR,"$XC$^",3)
- +13 SET X(1)=""
- SET X(2)=$$CTXT^DDBR("Loading "_DDBRXC3,"",IOM)
- SET X(3)=""
- +14 WRITE $$WS^DDBR1(.X)
- +15 SET DDBRXC2=$PIECE(@DDBRATR,"$XC$^",2)
- XECUTE DDBRXC2
- +16 IF $DATA(@DDBRATR)'>9
- QUIT
- +17 IF DDBRXC3]""
- DO WP^DDBRAP(DDBRATR,"",DDBRXC3)
- +18 QUIT
- End DoDot:2
- IF $DATA(@DDBRATR)'>9
- QUIT
- +19 IF $DATA(@DDBRATR)'>9
- IF $EXTRACT($GET(@DDBRATR),1,6)="$XCR$^"
- Begin DoDot:2
- +20 NEW X,IOTM,IOBM,IOSTBM
- +21 SET DDBRXC2=$PIECE(@DDBRATR,"$XCR$^",2)
- SET DDBSANX=""
- XECUTE DDBRXC2
- +22 IF $DATA(IOF)
- WRITE @IOF
- +23 SET X=0
- XECUTE ^%ZOSF("RM")
- +24 WRITE $PIECE(DDGLVID,DDGLDEL,8)
- +25 QUIT
- End DoDot:2
- WRITE @IOSTBM
- QUIT
- +26 IF '$DATA(@DDBRATR)
- SET DDBRAAH=""
- QUIT
- +27 SET DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
- +28 IF '$DATA(@DDBRANRT)
- DO WP^DDBRAP(DDBRATR)
- +29 SET DDBLSTN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)
- +30 DO SAVEDDB^DDBR2(DDBLST,DDBLSTN,1)
- DO SET
- +31 SET DDBRSET=0
- +32 SET DDBRAAH=$PIECE(DDBRAAH,"#",2)
- SET DDBRAFLG=1
- +33 SET DDBSA=DDBRATR
- SET DDBSAN=DDBRANRT
- +34 SET DDBPMSG=$GET(@DDBSAN@("TITLE"))
- IF DDBPMSG=""
- SET DDBPMSG=$TRANSLATE($PIECE(DDBSANX,"^",$LENGTH(DDBSANX,"^")),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +35 DO SAVSET
- +36 QUIT
- End DoDot:1
- IF DDBSANX]""
- GOTO STKPT
- GOTO PS^DDBR2
- +37 ;jump to another file, w-pDD#,entry:entry#anchor
- +38 IF DDBRAAH
- IF DDBRAAH["@"
- Begin DoDot:1
- +39 NEW DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT
- +40 SET DDBRAB=$PIECE(DDBRAAH,"#")
- +41 IF DDBRAB=""
- SET DDBRAAH=""
- QUIT
- +42 SET DDBRATR=$$GETR^DDBRAP($PIECE(DDBRAB,"@"),$PIECE($PIECE(DDBRAB,"@",2),"#"))
- +43 IF DDBRATR=""
- Begin DoDot:2
- +44 SET DDBRAAH=""
- +45 IF $GET(DIERR)
- SET DIERM=$$CTXT^DDBR($GET(^TMP("DIERR",$JOB,+DIERR,"TEXT",1)))
- +46 KILL DIERR,^TMP("DIERR",$JOB)
- +47 QUIT
- End DoDot:2
- QUIT
- +48 SET DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
- +49 IF '$DATA(@DDBRANRT)
- DO WP^DDBRAP(DDBRATR)
- +50 SET DDBLSTN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)
- +51 DO SAVEDDB^DDBR2(DDBLST,DDBLSTN,1)
- DO SET
- +52 SET DDBRSET=0
- +53 SET DDBRAAH=$PIECE(DDBRAAH,"#",2)
- SET DDBRAFLG=1
- +54 SET DDBSA=DDBRATR
- SET DDBSAN=DDBRANRT
- +55 SET DDBPMSG=$GET(@DDBSAN@("TITLE"))
- IF DDBPMSG=""
- SET DDBPMSG="HYPERTEXT JUMP ID#"_$ORDER(@DDBLST@("J",""),-1)+1
- +56 DO SAVSET
- +57 QUIT
- End DoDot:1
- GOTO STKPT
- +58 ;jump to another entry in the same file, same level
- +59 IF DDBRAAH["#"
- IF $PIECE(DDBRAAH,"#")]""
- Begin DoDot:1
- +60 NEW DDBRAB,DDBRABR,DDBRAIEN,DDBLSTN,DDBRALEV,DDBRANRT
- +61 SET DDBRAB=$PIECE(DDBRAAH,"#")
- +62 IF DDBRAB=""
- SET DDBRAAH=""
- QUIT
- +63 SET DDBRALEV=""
- SET DDBRABR=$$IENROOT^DDBRAP($NAME(@DDBSA),.DDBRALEV)
- +64 SET DDBRAIEN=$ORDER(@DDBRABR@("B",DDBRAB,""))
- +65 IF 'DDBRAIEN
- SET DDBRAAH=""
- QUIT
- +66 SET DDBRANRT=$$NROOT^DDBRAP($NAME(@DDBRABR@(DDBRAIEN,DDBRALEV)))
- +67 IF '$DATA(@DDBRANRT)
- DO WP^DDBRAP($NAME(@DDBRABR@(DDBRAIEN,DDBRALEV)))
- +68 SET DDBLSTN=$SELECT($DATA(@DDBLST@("A",DDBSA)):^(DDBSA),1:$ORDER(@DDBLST@(" "),-1)+1)
- +69 DO SAVEDDB^DDBR2(DDBLST,DDBLSTN,1)
- DO SET
- +70 SET DDBRSET=0
- +71 SET DDBRAAH=$PIECE(DDBRAAH,"#",2)
- SET DDBRAFLG=1
- +72 SET DDBSA=$NAME(@DDBRABR@(DDBRAIEN,DDBRALEV))
- +73 SET DDBSAN=DDBRANRT
- +74 SET DDBPMSG=$GET(@DDBSAN@("TITLE"))
- IF DDBPMSG=""
- SET DDBPMSG="HYPERTEXT JUMP ID#"_$ORDER(@DDBLST@("J",""),-1)+1
- +75 DO SAVSET
- +76 QUIT
- End DoDot:1
- STKPT IF DDBRAAH["#"
- SET DDBRAAH=$PIECE(DDBRAAH,"#",2)
- +1 IF DDBRAAH]""
- SET DDBRAHA=$GET(@DDBSAN@("A",DDBRAAH))
- +2 IF DDBRSET
- IF $GET(DDBRAHA)'>0
- DO NOHTJ($GET(DIERM))
- GOTO PS^DDBR2
- +3 SET DDBRAHL=$SELECT($GET(DDBRAHA):DDBRAHA+DDBSRL-1,1:0)
- +4 IF DDBRSET
- DO SET
- DO GOTO
- QUIT
- +5 QUIT
- +6 ;
- SET ; set and save jump info
- +1 SET DDBRAHP=$ORDER(@DDBLST@("J",""),-1)+1
- +2 SET @DDBLST@("J",DDBRAHP)=DDBSA_DDGLDEL_DDBL_"^"_+$GET(DDBLSTN)_DDGLDEL_DDBRHT
- +3 QUIT
- +4 ;
- GOTO ; jump to line in current document
- +1 SET DDBL=$SELECT(DDBRAHL'>DDBSRL:0,DDBRAHL>DDBTL:DDBTL,1:DDBRAHL)
- DO PSR^DDBR0(+$GET(DDBRAFLG))
- +2 QUIT
- BCK ; backward
- +1 IF '$DATA(@DDBLST@("J"))
- QUIT
- +2 NEW DDBX,DDBY,DDBRAFLG
- +3 SET DDBX=$ORDER(@DDBLST@("J",""),-1)
- SET DDBY=@DDBLST@("J",DDBX)
- +4 KILL @DDBLST@("J",DDBX)
- +5 IF $PIECE(DDBY,DDGLDEL)'=DDBSA
- Begin DoDot:1
- +6 DO USAVEDDB^DDBR2(DDBLST,$PIECE($PIECE(DDBY,DDGLDEL,2),"^",2))
- End DoDot:1
- SET DDBRAFLG=1
- +7 SET DDBL=+$PIECE(DDBY,DDGLDEL,2)
- SET DDBRHT=$PIECE(DDBY,DDGLDEL,3,255)
- +8 DO PSR^DDBR0(+$GET(DDBRAFLG))
- +9 QUIT
- 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 $PIECE(DDBRHT,DDGLDEL,4)'=DDBSA
- QUIT 0
- +4 IF +DDBRHT>DDBL
- QUIT 0
- +5 IF +DDBRHT<($SELECT(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1)
- QUIT 0
- +6 QUIT 1
- +7 ;
- NOHTJ(EM) ; no hypertext jump available
- +1 NEW X,Y
- +2 SET Y=$PIECE(DDBSANX,"^",$SELECT(DDBSANX["$CREF$":$LENGTH(DDBSANX,"^"),1:2))
- SET X(1)=$$CTXT^DDBR(Y,"",IOM)
- SET EM=$GET(EM)
- IF $PIECE(EM,"Error
- SET EM="<< "_$PIECE(EM,"Error:",2)_" >>"
- +3 SET X(2)=""
- +4 SET X(3)=$$CTXT^DDBR($SELECT(EM]"":EM,1:"<< Hypertext jump is not avaialble >>"),"",IOM)
- +5 WRITE $$WS^DDBR1(.X),$CHAR(7)
- +6 READ X:5
- +7 QUIT
- +8 ;
- SAVSET ;
- +1 SET DDBHDR=$$CTXT^DDBR(DDBPMSG,$JUSTIFY("",IOM+1),IOM)
- +2 SET DDBTL=$PIECE($GET(@DDBSA@(0)),"^",3)
- IF DDBTL'>0
- SET DDBTL=$ORDER(@DDBSA@(" "),-1)
- +3 SET DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
- +4 SET DDBZN=$DATA(@DDBSA@(DDBTL,0))#2
- +5 SET DDBDM=0
- +6 SET DDBSF=1
- +7 SET DDBST=IOM
- +8 SET DDBC=$NAME(^TMP("DDBC","DDBC",$JOB))
- +9 IF '$DATA(@DDBC)
- FOR I=1,22:22:176
- SET @DDBC@(I)=""
- +10 QUIT
