175 lines
4.4 KiB
Mathematica
175 lines
4.4 KiB
Mathematica
DDBR0 ;SFISC/DCL-VA FILEMAN BROWSER FUNCTIONS ;NOV 04, 1996@13:47
|
|
;;22.0;VA FileMan;;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
PU N I,J,K S I=DDBL-DDBSRL,J=I-(DDBSRL-1),K=DDBL
|
|
S DX=$P(DDBSX,";"),DY=$P(DDBSY,";",2)
|
|
I DDBZN D D:K'=DDBL RLPI Q
|
|
.F I=I:-1:J Q:'$D(@DDBSA@(I,0)) D
|
|
..X IOXY
|
|
..W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I)
|
|
..S DDBL=DDBL-1
|
|
F I=I:-1:J Q:I'>0!('$D(@DDBSA@(I))) D
|
|
.X IOXY
|
|
.W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I)
|
|
.S DDBL=DDBL-1
|
|
D:K'=DDBL RLPI
|
|
Q
|
|
PD N I,J,K S I=DDBL+1,J=DDBL+DDBSRL,K=DDBL
|
|
S DX=0,DY=$P(DDBSY,";",3)
|
|
X IOXY
|
|
I DDBZN D D:K'=DDBL RLPI Q
|
|
.F I=I:1:J Q:'$D(@DDBSA@(I,0)) W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I) S DDBL=DDBL+1
|
|
.Q
|
|
F I=I:1:J Q:'$D(@DDBSA@(I)) W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) S DDBL=DDBL+1
|
|
D:K'=DDBL RLPI
|
|
Q
|
|
LU N I S I=DDBL-DDBSRL
|
|
S DX=0,DY=$P(DDBSY,";",2)
|
|
X IOXY
|
|
I DDBZN Q:'$D(@DDBSA@(I,0)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I) D RLPIR Q
|
|
I I>0,$D(@DDBSA@(I)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) D RLPIR Q
|
|
Q
|
|
LD S DX=0,DY=$P(DDBSY,";",3)
|
|
X IOXY
|
|
I DDBZN,$D(@DDBSA@(DDBL+1,0)) D Q
|
|
.S DDBL=DDBL+1
|
|
.W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(DDBL,0),DDBL)
|
|
.D RLPIR
|
|
.Q
|
|
I 'DDBZN,$D(@DDBSA@(DDBL+1)) D Q
|
|
.S DDBL=DDBL+1
|
|
.W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(DDBL),DDBL)
|
|
.D RLPIR
|
|
.Q
|
|
Q
|
|
COL(N) N X
|
|
S X=$O(@DDBC@(DDBSF),N) Q:X'>0
|
|
S DDBSF=X
|
|
COLENT S DDBST=DDBSF+(IOM-1),DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
|
|
D SDLR(DDBL+1),COLR
|
|
I DDBHDRC D ENCHDR^DDBR4
|
|
Q
|
|
COLJ N X
|
|
COLA S X(2)="Col> " W $$WS^DDBR1(.X) D G:X=""!(X=U) OUT
|
|
.D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
|
|
.K DIR0
|
|
.Q
|
|
I $E(X)="?" G COLERR
|
|
I X<1!(X>255) W $C(7) G COLERR
|
|
S DDBSF=X G COLENT
|
|
Q
|
|
COLERR S X(1)=" * [ Enter a number between 1 and 255 ] *"
|
|
G COLA
|
|
OUT D PSR^DDBR0()
|
|
Q
|
|
RLE Q:$G(DDBRHTF) S DDBSF=1 G COLENT
|
|
RRE Q:$G(DDBRHTF) S DDBSF=$O(@DDBC@(""),-1) G COLENT
|
|
;
|
|
ONLINE Q
|
|
RR I DDBRHTF D JUMP^DDBRAHTJ(1) Q
|
|
D COL(1)
|
|
Q
|
|
RL I DDBRHTF D JUMP^DDBRAHTJ(-1) Q
|
|
D COL(-1)
|
|
Q
|
|
TOP S DDBL=0 D SDLR(1),RLPIR
|
|
Q
|
|
BOT I DDBTL>DDBSRL S DDBL=DDBTL-DDBSRL D SDLR(DDBL+1),RLPIR
|
|
Q
|
|
EXIT S DDBRE="^"
|
|
Q
|
|
TO S DDBTO=DDBTO+1,DDBE=-1 S:DDBTO'<($G(DTIME,300)\5) DDBE="^"
|
|
Q
|
|
RCLSI D RLPIR,COLR
|
|
Q
|
|
PSR(PSR) S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
|
|
D:$G(PSR) HFR D SDLR(DDBL+1),RLPIR,COLR
|
|
Q
|
|
SDL ;
|
|
SDLR(L) N I,J,SFR,STO
|
|
S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
|
|
S DY=SFR X IOXY
|
|
I DDBZN F I=SFR:1:STO D
|
|
.W:I'=SFR !
|
|
.W $P(DDGLCLR,DDGLDEL)
|
|
.I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L,0),L) S DDBL=DDBL+1,L=L+1
|
|
.S J=J+1
|
|
.Q
|
|
I 'DDBZN F I=SFR:1:STO D
|
|
.W:I'=SFR !
|
|
.W $P(DDGLCLR,DDGLDEL)
|
|
.I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L),L) S DDBL=DDBL+1,L=L+1
|
|
.S J=J+1
|
|
.Q
|
|
Q
|
|
HFR N FTR S FTR=1
|
|
HDR S DX=0
|
|
S DY=$P(DDBSY,";")
|
|
X IOXY
|
|
W $P(DDGLVID,DDGLDEL,6)
|
|
W DDBHDR
|
|
W $P(DDGLVID,DDGLDEL,10)
|
|
G:$G(FTR) FTR
|
|
Q
|
|
FTR I DDBFLGS Q
|
|
W $P(DDGLVID,DDGLDEL,6)
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
|
|
S DY=$P(DDBSY,";",4)
|
|
X IOXY
|
|
W DDBFTR
|
|
S DX=$P(DDBSX,";",3)
|
|
X IOXY
|
|
W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)," of ",DDBTL
|
|
S DX=$P(DDBSX,";",4)
|
|
X IOXY
|
|
W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)," of ",DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
|
|
S DX=$P(DDBSX,";",2)
|
|
X IOXY
|
|
W:'DDBRHTF $J(DDBSF,4)
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
|
|
W $P(DDGLVID,DDGLDEL,10)
|
|
Q
|
|
RLPI ;
|
|
RLPIR I DDBFLGS Q
|
|
S DX=$P(DDBSX,";",3),DY=$P(DDBSY,";",4)
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
|
|
W $P(DDGLVID,DDGLDEL,6)
|
|
X IOXY
|
|
W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)
|
|
S DX=$P(DDBSX,";",4)
|
|
X IOXY
|
|
W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
|
|
W $P(DDGLVID,DDGLDEL,10)
|
|
Q
|
|
COLR I DDBFLGS!(DDBRHTF) Q
|
|
S DX=$P(DDBSX,";",2),DY=$P(DDBSY,";",4)
|
|
X IOXY
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
|
|
W $P(DDGLVID,DDGLDEL,6)
|
|
W $J(DDBSF,4)
|
|
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
|
|
W $P(DDGLVID,DDGLDEL,10)
|
|
Q
|
|
;
|
|
HTD(X,WPIEN) ;
|
|
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))
|
|
Q X
|
|
;
|
|
HT(Y,D,C1,C2) ;
|
|
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 '(I#2),+$G(DDBRHT)=WPIEN,$P(DDBRHT,DDGLDEL,4)=DDBSA,$P(DDBRHT,DDGLDEL,2)=$P(Y,D,I) D Q
|
|
..S Y1=Y1_C1_$P(DDGLVID,DDGLDEL,4)_$P($P(Y,D,I),"^",$S($P(Y,D,I)["$CREF$":$L($P(Y,D,I),"^"),1:2),255)_$P(DDGLVID,DDGLDEL,5)_C2
|
|
..Q
|
|
.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
|