File:  [Coherent Logic Development] / freem_fileman / USER / DDBR0.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

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>