DDBRAHT ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT PROCESSOR ;NOV 04, 1996@13:50
;;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
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(DDBL+1)
Q
SDLR(L) N I,J,SFR,STO
I +DDBRHT<L!(+DDBRHT>LIM) S DDBRHT="",ULCLR=1
S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3)
S DY=SFR X IOXY
F I=SFR:1:STO D
.I $D(@DDBSA@(L)) S X=$S(DDBZN:@DDBSA@(L,0),1:@DDBSA@(L)),DDBL=DDBL+1,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,$S(WPIEN=+DDBRHT:$P(DDBRHT,DDGLDEL,3)+2,1:2),$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDBRAHT 1804 printed Nov 22, 2024@17:51:43 Page 2
DDBRAHT ;SFISC/DCL-BROWSER ANCHOR & HYPERTEXT PROCESSOR ;NOV 04, 1996@13:50
+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
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 SET DDBL=$SELECT(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
+1 DO SDLR(DDBL+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,";",2)
SET STO=$PIECE(DDBSY,";",3)
+3 SET DY=SFR
XECUTE IOXY
+4 FOR I=SFR:1:STO
Begin DoDot:1
+5 IF $DATA(@DDBSA@(L))
SET X=$SELECT(DDBZN:@DDBSA@(L,0),1:@DDBSA@(L))
SET DDBL=DDBL+1
SET L=L+1
+6 IF '$TEST
QUIT
+7 IF ULCLR
IF ULNEW
QUIT
+8 if $LENGTH(X,"$.%")'>2
QUIT
+9 SET WRF=0
SET J=$PIECE(X,"$.%",$PIECE(DDBRHT,DDGLDEL,3))
SET X=$$HTD(X,L-1)
+10 IF +DDBRHT
IF J=$PIECE(DDBRHT,DDGLDEL,2)
SET ULCLR=1
SET WRF=1
+11 if 'WRF
QUIT
+12 SET DY=I
+13 XECUTE IOXY
+14 WRITE $PIECE(DDGLCLR,DDGLDEL),X
+15 QUIT
End DoDot:1
+16 ;
+17 IF 'ULNEW
SET DDBRHT=""
+18 QUIT
+19 ;
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,$SELECT(WPIEN=+DDBRHT:$PIECE(DDBRHT,DDGLDEL,3)+2,1:2),$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
