source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDBR0.m@ 623

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