Return to DDBR0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDBR0	;SFISC/DCL-VA FILEMAN BROWSER FUNCTIONS ;10:01 AM  24 Oct 1004;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	Q
    5: PU	N I,J,K S I=DDBL-DDBSRL,J=I-(DDBSRL-1),K=DDBL
    6: 	S DX=$P(DDBSX,";"),DY=$P(DDBSY,";",2)
    7: 	I DDBZN D  D:K'=DDBL RLPI Q
    8: 	.F I=I:-1:J Q:'$D(@DDBSA@(I,0))  D
    9: 	..X IOXY
   10: 	..W IORI,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I,0),DDBSF,DDBST)
   11: 	..S DDBL=DDBL-1
   12: 	F I=I:-1:J Q:'I!('$D(@DDBSA@(I)))  D
   13: 	.X IOXY
   14: 	.W IORI,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST)
   15: 	.S DDBL=DDBL-1
   16: 	D:K'=DDBL RLPI
   17: 	Q
   18: PD	N I,J,K S I=DDBL+1,J=DDBL+DDBSRL,K=DDBL
   19: 	S DX=0,DY=$P(DDBSY,";",3)
   20: 	X IOXY
   21: 	I DDBZN D  D:K'=DDBL RLPI Q
   22: 	.F I=I:1:J Q:'$D(@DDBSA@(I,0))  W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I,0),DDBSF,DDBST) S DDBL=DDBL+1
   23: 	.Q
   24: 	F I=I:1:J Q:'$D(@DDBSA@(I))  W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST) S DDBL=DDBL+1
   25: 	D:K'=DDBL RLPI
   26: 	Q
   27: LU	N I S I=DDBL-DDBSRL
   28: 	S DX=0,DY=$P(DDBSY,";",2)
   29: 	X IOXY
   30: 	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
   31: 	I I,$D(@DDBSA@(I)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(I),DDBSF,DDBST) D RLPIR Q
   32: 	Q
   33: LD	S DX=0,DY=$P(DDBSY,";",3)
   34: 	X IOXY
   35: 	I DDBZN,$D(@DDBSA@(DDBL+1,0)) D  Q
   36: 	.S DDBL=DDBL+1
   37: 	.W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(DDBL,0),DDBSF,DDBST)
   38: 	.D RLPIR
   39: 	.Q
   40: 	I 'DDBZN,$D(@DDBSA@(DDBL+1)) D  Q
   41: 	.S DDBL=DDBL+1
   42: 	.W !,$P(DDGLCLR,DDGLDEL),$E(@DDBSA@(DDBL),DDBSF,DDBST)
   43: 	.D RLPIR
   44: 	.Q
   45: 	Q
   46: COL(N)	N X
   47: 	S X=$O(@DDBC@(DDBSF),N) Q:X'>0
   48: 	S DDBSF=X
   49: COLENT	S DDBST=DDBSF+(IOM-1),DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
   50: 	D SDLR(DDBL+1),COLR
   51: 	Q
   52: COLJ	N X
   53: COLA	S X(2)="Col> " W $$WS^DDBR1(.X) D  G:X=""!(X=U) OUT
   54: 	.D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
   55: 	.K DIR0
   56: 	.Q
   57: 	I $E(X)="?" G COLERR
   58: 	I X<1!(X>255) W $C(7) G COLERR
   59: 	S DDBSF=X G COLENT
   60: 	Q
   61: COLERR	S X(1)="    * [ Enter a number between 1 and 255 ] *"
   62: 	G COLA
   63: OUT	D PSR^DDBR0()
   64: 	Q
   65: RLE	S DDBSF=1 G COLENT
   66: RRE	S DDBSF=$O(@DDBC@(""),-1) G COLENT
   67: HELPS	N DDBHELPS
   68: 	S DDBHELPS=58+DDBSRL
   69: HELP	I DDBSA="^DI(.84,9201,2)" S DDBL=0 D SDLR^DDBR0(1),RLPIR Q
   70: 	N DDBHA S DDBHA="^DI(.84,9201,2)"
   71: 	D BROWSE^DDBR(DDBHA,"PNH","VA FileMan Help Document",$G(DDBHELPS),"",IOTM-1,IOBM+1)
   72: 	W @IOSTBM
   73: 	D PSR^DDBR0(1)
   74: 	Q
   75: ONLINE	Q
   76: RR	D COL(1)
   77: 	Q
   78: RL	D COL(-1)
   79: 	Q
   80: TOP	S DDBL=0 D SDLR(1),RLPIR
   81: 	Q
   82: BOT	I DDBTL>DDBSRL S DDBL=DDBTL-DDBSRL D SDLR(DDBL+1),RLPIR
   83: 	Q
   84: EXIT	S DDBRE="^"
   85: 	Q
   86: TO	S DDBTO=DDBTO+1,DDBE=-1 S:DDBTO'<($G(DTIME,300)\5) DDBE="^"
   87: 	Q
   88: RCLSI	D RLPIR,COLR
   89: 	Q
   90: PSR(PSR)	S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
   91: 	D:$G(PSR) HFR D SDLR(DDBL+1),RLPIR,COLR
   92: 	Q
   93: SDL	;
   94: SDLR(L)	N I,J,SFR,STO
   95: 	S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
   96: 	S DY=SFR X IOXY
   97: 	I DDBZN F I=SFR:1:STO D
   98: 	.W:I'=SFR !
   99: 	.W $P(DDGLCLR,DDGLDEL)
  100: 	.I J=L,$D(@DDBSA@(L)) W $E(@DDBSA@(L,0),DDBSF,DDBST) S DDBL=DDBL+1,L=L+1
  101: 	.S J=J+1
  102: 	.Q
  103: 	I 'DDBZN F I=SFR:1:STO D
  104: 	.W:I'=SFR !
  105: 	.W $P(DDGLCLR,DDGLDEL)
  106: 	.I J=L,$D(@DDBSA@(L)) W $E(@DDBSA@(L),DDBSF,DDBST) S DDBL=DDBL+1,L=L+1
  107: 	.S J=J+1
  108: 	.Q
  109: 	Q
  110: HFR	N FTR S FTR=1
  111: HDR	S DX=0
  112: 	S DY=$P(DDBSY,";")
  113: 	X IOXY
  114: 	W $P(DDGLVID,DDGLDEL,6)
  115: 	W DDBHDR
  116: 	W $P(DDGLVID,DDGLDEL,10)
  117: 	G:$G(FTR) FTR
  118: 	Q
  119: FTR	I DDBFLGS Q
  120: 	W $P(DDGLVID,DDGLDEL,6)
  121: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  122: 	S DY=$P(DDBSY,";",4)
  123: 	X IOXY
  124: 	W DDBFTR
  125: 	S DX=$P(DDBSX,";",3)
  126: 	X IOXY
  127: 	W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)," of ",DDBTL
  128: 	S DX=$P(DDBSX,";",4)
  129: 	X IOXY
  130: 	W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)," of ",DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
  131: 	S DX=$P(DDBSX,";",2)
  132: 	X IOXY
  133: 	W $J(DDBSF,4)
  134: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  135: 	W $P(DDGLVID,DDGLDEL,10)
  136: 	Q
  137: 	W $P(DDGLVID,DDGLDEL,10)
  138: 	Q
  139: RLPI	;
  140: RLPIR	I DDBFLGS Q
  141: 	S DX=$P(DDBSX,";",3),DY=$P(DDBSY,";",4)
  142: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  143: 	W $P(DDGLVID,DDGLDEL,6)
  144: 	X IOXY
  145: 	W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)
  146: 	S DX=$P(DDBSX,";",4)
  147: 	X IOXY
  148: 	W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)
  149: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  150: 	W $P(DDGLVID,DDGLDEL,10)
  151: 	Q
  152: COLR	I DDBFLGS Q
  153: 	S DX=$P(DDBSX,";",2),DY=$P(DDBSY,";",4)
  154: 	X IOXY
  155: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  156: 	W $P(DDGLVID,DDGLDEL,6)
  157: 	W $J(DDBSF,4)
  158: 	I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  159: 	W $P(DDGLVID,DDGLDEL,10)
  160: 	Q