- DDBRAHTR ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT PROCESSOR REVERSE TAB ;NOV 04, 1996@13:52
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- Q
- REVTAB ; Reverse Tab
- S DDBRHT=$G(DDBRHT)
- I $P(DDBRHT,DDGLDEL,4)'=DDBSA S DDBRHT=""
- N LIM,ULCLR,ULNEW
- S LIM=DDBL,ULCLR=DDBRHT'>0,ULNEW=0
- PSR ;S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
- D SDLR($S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1)
- Q
- SDLR(L) N I,J,SFR,STO
- I +DDBRHT<L!(+DDBRHT>LIM) S DDBRHT="",ULCLR=1
- S DX=0,SFR=$P(DDBSY,";",3),STO=$P(DDBSY,";",2),L=L+DDBSRL
- F I=SFR:-1:STO S L=L-1 Q:$S(DDBZN:$D(@DDBSA@(L,0)),1:$D(@DDBSA@(L)))
- S (SFR,DY)=I X IOXY
- F I=SFR:-1:STO D
- .I $D(@DDBSA@(L)) S X=$S(DDBZN:@DDBSA@(L,0),1:@DDBSA@(L)),L=L-1
- .E Q
- .I ULCLR,ULNEW Q
- .Q:$L(X,"$.%")'>2
- .S WRF=0,J=$P(X,"$.%",$P(DDBRHT,DDGLDEL,3)),X=$$HTD(X,L+1)
- .I +DDBRHT,J=$P(DDBRHT,DDGLDEL,2) S ULCLR=1,WRF=1
- .Q:'WRF
- .S DY=I
- .X IOXY
- .W $P(DDGLCLR,DDGLDEL),X
- .Q
- ;
- I 'ULNEW S DDBRHT=""
- Q
- ;
- HTD(X,WPIEN) ;text
- Q:'DDBRHTF $E(X,DDBSF,DDBST)
- Q:$L(X,"$.")'>2 X
- S:$L(X,"$.$")>2 X=$$HT(X,"$.$","","","","","","")
- S:$L(X,"$.%")>2 X=$$HT(X,"$.%",$P(DDGLVID,DDGLDEL),$P(DDGLVID,DDGLDEL,3),(WPIEN'>+DDBRHT!(DDBRHT="")),$S(WPIEN=+DDBRHT:$P(DDBRHT,DDGLDEL,3)-2,1:$L(X,"$.%")-1),$P(DDGLVID,DDGLDEL,4),$P(DDGLVID,DDGLDEL,5))
- Q X
- ;
- HT(Y,D,C1,C2,UF,UP,U1,U2) ;
- Q:$L(Y,D)'>2 Y
- N YL,I,Y1
- S YL=$L(Y,D),Y1=""
- F I=1:1:YL D
- .S:I#2 Y1=Y1_$P(Y,D,I)
- .I UF,I=UP,'ULNEW D Q
- ..S Y1=Y1_C1_U1_$P($P(Y,D,I),"^",$S($P(Y,D,I)["$CREF$":$L($P(Y,D,I),"^"),1:2),255)_U2_C2,ULNEW=1,WRF=1
- ..S DDBRHT=WPIEN_DDGLDEL_$P(Y,D,I)_DDGLDEL_I_DDGLDEL_DDBSA
- .S:'(I#2) Y1=Y1_C1_$P($P(Y,D,I),"^",$S($P(Y,D,I)["$CREF$":$L($P(Y,D,I),"^"),1:2),255)_C2
- .Q
- Q Y1
- DDBRAHTR ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT PROCESSOR REVERSE TAB ;NOV 04, 1996@13:52
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 QUIT
- REVTAB ; Reverse Tab
- +1 SET DDBRHT=$GET(DDBRHT)
- +2 IF $PIECE(DDBRHT,DDGLDEL,4)'=DDBSA
- SET DDBRHT=""
- +3 NEW LIM,ULCLR,ULNEW
- +4 SET LIM=DDBL
- SET ULCLR=DDBRHT'>0
- SET ULNEW=0
- PSR ;S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
- +1 DO SDLR($SELECT(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)+1)
- +2 QUIT
- SDLR(L) NEW I,J,SFR,STO
- +1 IF +DDBRHT<L!(+DDBRHT>LIM)
- SET DDBRHT=""
- SET ULCLR=1
- +2 SET DX=0
- SET SFR=$PIECE(DDBSY,";",3)
- SET STO=$PIECE(DDBSY,";",2)
- SET L=L+DDBSRL
- +3 FOR I=SFR:-1:STO
- SET L=L-1
- IF $SELECT(DDBZN
- QUIT
- +4 SET (SFR,DY)=I
- XECUTE IOXY
- +5 FOR I=SFR:-1:STO
- Begin DoDot:1
- +6 IF $DATA(@DDBSA@(L))
- SET X=$SELECT(DDBZN:@DDBSA@(L,0),1:@DDBSA@(L))
- SET L=L-1
- +7 IF '$TEST
- QUIT
- +8 IF ULCLR
- IF ULNEW
- QUIT
- +9 IF $LENGTH(X,"$.%")'>2
- QUIT
- +10 SET WRF=0
- SET J=$PIECE(X,"$.%",$PIECE(DDBRHT,DDGLDEL,3))
- SET X=$$HTD(X,L+1)
- +11 IF +DDBRHT
- IF J=$PIECE(DDBRHT,DDGLDEL,2)
- SET ULCLR=1
- SET WRF=1
- +12 IF 'WRF
- QUIT
- +13 SET DY=I
- +14 XECUTE IOXY
- +15 WRITE $PIECE(DDGLCLR,DDGLDEL),X
- +16 QUIT
- End DoDot:1
- +17 ;
- +18 IF 'ULNEW
- SET DDBRHT=""
- +19 QUIT
- +20 ;
- HTD(X,WPIEN) ;text
- +1 IF 'DDBRHTF
- QUIT $EXTRACT(X,DDBSF,DDBST)
- +2 IF $LENGTH(X,"$.")'>2
- QUIT X
- +3 IF $LENGTH(X,"$.$")>2
- SET X=$$HT(X,"$.$","","","","","","")
- +4 IF $LENGTH(X,"$.%")>2
- SET X=$$HT(X,"$.%",$PIECE(DDGLVID,DDGLDEL),$PIECE(DDGLVID,DDGLDEL,3),(WPIEN'>+DDBRHT!(DDBRHT="")),$SELECT(WPIEN=+DDBRHT:$PIECE(DDBRHT,DDGLDEL,3)-2,1:$LENGTH(X,"$.%")-1),$PIECE(DDGLVID,DDGLDEL,4),$PIECE(DDGLVID,DDGLDEL,5))
- +5 QUIT X
- +6 ;
- HT(Y,D,C1,C2,UF,UP,U1,U2) ;
- +1 IF $LENGTH(Y,D)'>2
- QUIT Y
- +2 NEW YL,I,Y1
- +3 SET YL=$LENGTH(Y,D)
- SET Y1=""
- +4 FOR I=1:1:YL
- Begin DoDot:1
- +5 IF I#2
- SET Y1=Y1_$PIECE(Y,D,I)
- +6 IF UF
- IF I=UP
- IF 'ULNEW
- Begin DoDot:2
- +7 SET Y1=Y1_C1_U1_$PIECE($PIECE(Y,D,I),"^",$SELECT($PIECE(Y,D,I)["$CREF$":$LENGTH($PIECE(Y,D,I),"^"),1:2),255)_U2_C2
- SET ULNEW=1
- SET WRF=1
- +8 SET DDBRHT=WPIEN_DDGLDEL_$PIECE(Y,D,I)_DDGLDEL_I_DDGLDEL_DDBSA
- End DoDot:2
- QUIT
- +9 IF '(I#2)
- SET Y1=Y1_C1_$PIECE($PIECE(Y,D,I),"^",$SELECT($PIECE(Y,D,I)["$CREF$":$LENGTH($PIECE(Y,D,I),"^"),1:2),255)_C2
- +10 QUIT
- End DoDot:1
- +11 QUIT Y1
