source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDBRAHTJ.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.0 KB
RevLine 
[613]1DDBRAHTJ ;SFISC/DCL-BROWSER HYPERTEXT JUMP ;NOV 04, 1996@13:51
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5JUMP(DDBRDIR) ; pass direction 1/forward -1/backward
6 ;
7 ;
8 N DDBSAN,DDBRAFLG,DDBLST
9 S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA)),DDBLST=$NA(^TMP("DDBLST",$J))
10 I $G(DDBRDIR)=1 D FRWD Q
11 D BCK
12 Q
13FRWD ; forward
14 Q:'$$CHKI
15 N DDBRAHP,DDBRAHA,DDBSANX,DDBRAAH,DDBRAHL,DDBRSET,DIERM
16 S DDBSANX=$P(DDBRHT,DDGLDEL,2),DDBRAAH=$P(DDBSANX,"^"),DDBRSET=1
17 ;jump to another root
18 I DDBSANX["$CREF$" D G STKPT:DDBSANX]"" G PS^DDBR2
19 .N DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT,DDBRXC2,DDBRXC3
20 .S DDBRATR=$P(DDBSANX,"$CREF$",2)
21 .S DDBRAAH=$P($P(DDBSANX,"$CREF$",3),"^")
22 .I DDBRATR="" S DDBRAAH="" Q
23 .I $D(@DDBRATR)'>9,$E($G(@DDBRATR),1,5)="$XC$^" D Q:$D(@DDBRATR)'>9
24 ..N X,DDBRNR
25 ..S DDBRXC3=$P(@DDBRATR,"$XC$^",3)
26 ..S X(1)="",X(2)=$$CTXT^DDBR("Loading "_DDBRXC3,"",IOM),X(3)=""
27 ..W $$WS^DDBR1(.X)
28 ..S DDBRXC2=$P(@DDBRATR,"$XC$^",2) X DDBRXC2
29 ..I $D(@DDBRATR)'>9 Q
30 ..I DDBRXC3]"" D WP^DDBRAP(DDBRATR,"",DDBRXC3)
31 ..Q
32 .I $D(@DDBRATR)'>9,$E($G(@DDBRATR),1,6)="$XCR$^" D W @IOSTBM Q
33 ..N X,IOTM,IOBM,IOSTBM
34 ..S DDBRXC2=$P(@DDBRATR,"$XCR$^",2),DDBSANX="" X DDBRXC2
35 ..W:$D(IOF) @IOF
36 ..S X=0 X ^%ZOSF("RM")
37 ..W $P(DDGLVID,DDGLDEL,8)
38 ..Q
39 .I '$D(@DDBRATR) S DDBRAAH="" Q
40 .S DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
41 .I '$D(@DDBRANRT) D WP^DDBRAP(DDBRATR)
42 .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
43 .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
44 .S DDBRSET=0
45 .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
46 .S DDBSA=DDBRATR,DDBSAN=DDBRANRT
47 .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG=$TR($P(DDBSANX,"^",$L(DDBSANX,"^")),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
48 .D SAVSET
49 .Q
50 ;jump to another file, w-pDD#,entry:entry#anchor
51 I DDBRAAH,DDBRAAH["@" D G STKPT
52 .N DDBRAB,DDBRABR,DDBLSTN,DDBRATR,DDBRANRT
53 .S DDBRAB=$P(DDBRAAH,"#")
54 .I DDBRAB="" S DDBRAAH="" Q
55 .S DDBRATR=$$GETR^DDBRAP($P(DDBRAB,"@"),$P($P(DDBRAB,"@",2),"#"))
56 .I DDBRATR="" D Q
57 ..S DDBRAAH=""
58 ..I $G(DIERR) S DIERM=$$CTXT^DDBR($G(^TMP("DIERR",$J,+DIERR,"TEXT",1)))
59 ..K DIERR,^TMP("DIERR",$J)
60 ..Q
61 .S DDBRANRT=$$NROOT^DDBRAP(DDBRATR)
62 .I '$D(@DDBRANRT) D WP^DDBRAP(DDBRATR)
63 .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
64 .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
65 .S DDBRSET=0
66 .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
67 .S DDBSA=DDBRATR,DDBSAN=DDBRANRT
68 .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG="HYPERTEXT JUMP ID#"_$O(@DDBLST@("J",""),-1)+1
69 .D SAVSET
70 .Q
71 ;jump to another entry in the same file, same level
72 I DDBRAAH["#",$P(DDBRAAH,"#")]"" D
73 .N DDBRAB,DDBRABR,DDBRAIEN,DDBLSTN,DDBRALEV,DDBRANRT
74 .S DDBRAB=$P(DDBRAAH,"#")
75 .I DDBRAB="" S DDBRAAH="" Q
76 .S DDBRALEV="",DDBRABR=$$IENROOT^DDBRAP($NA(@DDBSA),.DDBRALEV)
77 .S DDBRAIEN=$O(@DDBRABR@("B",DDBRAB,""))
78 .I 'DDBRAIEN S DDBRAAH="" Q
79 .S DDBRANRT=$$NROOT^DDBRAP($NA(@DDBRABR@(DDBRAIEN,DDBRALEV)))
80 .I '$D(@DDBRANRT) D WP^DDBRAP($NA(@DDBRABR@(DDBRAIEN,DDBRALEV)))
81 .S DDBLSTN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
82 .D SAVEDDB^DDBR2(DDBLST,DDBLSTN,1),SET
83 .S DDBRSET=0
84 .S DDBRAAH=$P(DDBRAAH,"#",2),DDBRAFLG=1
85 .S DDBSA=$NA(@DDBRABR@(DDBRAIEN,DDBRALEV))
86 .S DDBSAN=DDBRANRT
87 .S DDBPMSG=$G(@DDBSAN@("TITLE")) S:DDBPMSG="" DDBPMSG="HYPERTEXT JUMP ID#"_$O(@DDBLST@("J",""),-1)+1
88 .D SAVSET
89 .Q
90STKPT S:DDBRAAH["#" DDBRAAH=$P(DDBRAAH,"#",2)
91 I DDBRAAH]"" S DDBRAHA=$G(@DDBSAN@("A",DDBRAAH))
92 I DDBRSET,$G(DDBRAHA)'>0 D NOHTJ($G(DIERM)) G PS^DDBR2
93 S DDBRAHL=$S($G(DDBRAHA):DDBRAHA+DDBSRL-1,1:0)
94 D SET:DDBRSET,GOTO Q
95 Q
96 ;
97SET ; set and save jump info
98 S DDBRAHP=$O(@DDBLST@("J",""),-1)+1
99 S @DDBLST@("J",DDBRAHP)=DDBSA_DDGLDEL_DDBL_"^"_+$G(DDBLSTN)_DDGLDEL_DDBRHT
100 Q
101 ;
102GOTO ; jump to line in current document
103 S DDBL=$S(DDBRAHL'>DDBSRL:0,DDBRAHL>DDBTL:DDBTL,1:DDBRAHL) D PSR^DDBR0(+$G(DDBRAFLG))
104 Q
105BCK ; backward
106 Q:'$D(@DDBLST@("J"))
107 N DDBX,DDBY,DDBRAFLG
108 S DDBX=$O(@DDBLST@("J",""),-1),DDBY=@DDBLST@("J",DDBX)
109 K @DDBLST@("J",DDBX)
110 I $P(DDBY,DDGLDEL)'=DDBSA D S DDBRAFLG=1
111 .D USAVEDDB^DDBR2(DDBLST,$P($P(DDBY,DDGLDEL,2),"^",2))
112 S DDBL=+$P(DDBY,DDGLDEL,2),DDBRHT=$P(DDBY,DDGLDEL,3,255)
113 D PSR^DDBR0(+$G(DDBRAFLG))
114 Q
115CHKI() ;return 1 if ok 0 not ok to continue also init DDBRHT if undefined
116 S DDBRHT=$G(DDBRHT)
117 Q:DDBRHT="" 0
118 I $P(DDBRHT,DDGLDEL,4)'=DDBSA Q 0
119 I +DDBRHT>DDBL Q 0
120 I +DDBRHT<($S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1) Q 0
121 Q 1
122 ;
123NOHTJ(EM) ; no hypertext jump available
124 N X,Y
125 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)_" >>"
126 S X(2)=""
127 S X(3)=$$CTXT^DDBR($S(EM]"":EM,1:"<< Hypertext jump is not avaialble >>"),"",IOM)
128 W $$WS^DDBR1(.X),$C(7)
129 R X:5
130 Q
131 ;
132SAVSET ;
133 S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
134 S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
135 S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
136 S DDBZN=$D(@DDBSA@(DDBTL,0))#2
137 S DDBDM=0
138 S DDBSF=1
139 S DDBST=IOM
140 S DDBC=$NA(^TMP("DDBC","DDBC",$J))
141 I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
142 Q
Note: See TracBrowser for help on using the repository browser.