DDBR0 ;SFISC/DCL-VA FILEMAN BROWSER FUNCTIONS ;10:01 AM 24 Oct 1004;
;;21.0;VA FileMan;;Dec 28, 1994
;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),$E(@DDBSA@(I,0),DDBSF,DDBST)
..S DDBL=DDBL-1
F I=I:-1:J Q:'I!('$D(@DDBSA@(I))) D
.X IOXY
.W IORI,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST)
.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),$E(@DDBSA@(I,0),DDBSF,DDBST) S DDBL=DDBL+1
.Q
F I=I:1:J Q:'$D(@DDBSA@(I)) W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST) 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),$E(@DDBSA@(I,0),DDBSF,DDBST) D RLPIR Q
I I,$D(@DDBSA@(I)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST) 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),$E(@DDBSA@(DDBL,0),DDBSF,DDBST)
.D RLPIR
.Q
I 'DDBZN,$D(@DDBSA@(DDBL+1)) D Q
.S DDBL=DDBL+1
.W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(DDBL),DDBSF,DDBST)
.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
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 S DDBSF=1 G COLENT
RRE S DDBSF=$O(@DDBC@(""),-1) G COLENT
HELPS N DDBHELPS
S DDBHELPS=58+DDBSRL
HELP I DDBSA="^DI(.84,9201,2)" S DDBL=0 D SDLR^DDBR0(1),RLPIR Q
N DDBHA S DDBHA="^DI(.84,9201,2)"
D BROWSE^DDBR(DDBHA,"PNH","VA FileMan Help Document",$G(DDBHELPS),"",IOTM-1,IOBM+1)
W @IOSTBM
D PSR^DDBR0(1)
Q
ONLINE Q
RR D COL(1)
Q
RL 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 $E(@DDBSA@(L,0),DDBSF,DDBST) 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 $E(@DDBSA@(L),DDBSF,DDBST) 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 $J(DDBSF,4)
I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
W $P(DDGLVID,DDGLDEL,10)
Q
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 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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>