Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDBR0

DDBR0.m

Go to the documentation of this file.
  1. DDBR0 ;SFISC/DCL-VA FILEMAN BROWSER FUNCTIONS ;04:01 PM 26 Aug 2002
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. Q
  1. PU N I,J,K S I=DDBL-DDBSRL,J=I-(DDBSRL-1),K=DDBL
  1. S DX=$P(DDBSX,";"),DY=$P(DDBSY,";",2)
  1. I DDBZN D D:K'=DDBL RLPI Q
  1. .F I=I:-1:J Q:'$D(@DDBSA@(I,0)) D
  1. ..X IOXY
  1. ..W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I)
  1. ..S DDBL=DDBL-1
  1. F I=I:-1:J Q:I'>0!('$D(@DDBSA@(I))) D
  1. .X IOXY
  1. .W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I)
  1. .S DDBL=DDBL-1
  1. D:K'=DDBL RLPI
  1. Q
  1. PD N I,J,K S I=DDBL+1,J=DDBL+DDBSRL,K=DDBL
  1. S DX=0,DY=$P(DDBSY,";",3)
  1. X IOXY
  1. I DDBZN D D:K'=DDBL RLPI Q
  1. .F I=I:1:J Q:'$D(@DDBSA@(I,0)) W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I) S DDBL=DDBL+1
  1. .Q
  1. F I=I:1:J Q:'$D(@DDBSA@(I)) W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) S DDBL=DDBL+1
  1. D:K'=DDBL RLPI
  1. Q
  1. LU N I S I=DDBL-DDBSRL
  1. S DX=0,DY=$P(DDBSY,";",2)
  1. X IOXY
  1. I DDBZN Q:'$D(@DDBSA@(I,0)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I,0),I) D RLPIR Q
  1. I I>0,$D(@DDBSA@(I)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) D RLPIR Q
  1. Q
  1. LD S DX=0,DY=$P(DDBSY,";",3)
  1. X IOXY
  1. I DDBZN,$D(@DDBSA@(DDBL+1,0)) D Q
  1. .S DDBL=DDBL+1
  1. .W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(DDBL,0),DDBL)
  1. .D RLPIR
  1. .Q
  1. I 'DDBZN,$D(@DDBSA@(DDBL+1)) D Q
  1. .S DDBL=DDBL+1
  1. .W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(DDBL),DDBL)
  1. .D RLPIR
  1. .Q
  1. Q
  1. COL(N) N X
  1. S X=$O(@DDBC@(DDBSF),N) Q:X'>0
  1. S DDBSF=X
  1. COLENT S DDBST=DDBSF+(IOM-1),DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
  1. D SDLR(DDBL+1),COLR
  1. I DDBHDRC D ENCHDR^DDBR4
  1. Q
  1. COLJ N X
  1. COLA S X(2)="Col> " W $$WS^DDBR1(.X) D G:X=""!(X=U) OUT
  1. .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
  1. .K DIR0
  1. .Q
  1. I $E(X)="?" G COLERR
  1. I X<1!(X>255) W $C(7) G COLERR
  1. S DDBSF=X G COLENT
  1. Q
  1. COLERR S X(1)=" * [ "_$$EZBLD^DIALOG(836)_" ] *" ;**'Enter a number between 1 and 255'
  1. G COLA
  1. OUT D PSR^DDBR0()
  1. Q
  1. RLE Q:$G(DDBRHTF) S DDBSF=1 G COLENT
  1. RRE Q:$G(DDBRHTF) S DDBSF=$O(@DDBC@(""),-1) G COLENT
  1. ;
  1. ONLINE Q
  1. RR I DDBRHTF D JUMP^DDBRAHTJ(1) Q
  1. D COL(1)
  1. Q
  1. RL I DDBRHTF D JUMP^DDBRAHTJ(-1) Q
  1. D COL(-1)
  1. Q
  1. TOP S DDBL=0 D SDLR(1),RLPIR
  1. Q
  1. BOT I DDBTL>DDBSRL S DDBL=DDBTL-DDBSRL D SDLR(DDBL+1),RLPIR
  1. Q
  1. EXIT S DDBRE="^"
  1. Q
  1. TO S DDBTO=DDBTO+1,DDBE=-1 S:DDBTO'<($G(DTIME,300)\5) DDBE="^"
  1. Q
  1. RCLSI D RLPIR,COLR
  1. Q
  1. PSR(PSR) S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
  1. D:$G(PSR) HFR D SDLR(DDBL+1),RLPIR,COLR
  1. Q
  1. SDL ;
  1. SDLR(L) N I,J,SFR,STO
  1. S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
  1. S DY=SFR X IOXY
  1. I DDBZN F I=SFR:1:STO D
  1. .W:I'=SFR !
  1. .W $P(DDGLCLR,DDGLDEL)
  1. .I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L,0),L) S DDBL=DDBL+1,L=L+1
  1. .S J=J+1
  1. .Q
  1. I 'DDBZN F I=SFR:1:STO D
  1. .W:I'=SFR !
  1. .W $P(DDGLCLR,DDGLDEL)
  1. .I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L),L) S DDBL=DDBL+1,L=L+1
  1. .S J=J+1
  1. .Q
  1. Q
  1. HFR N FTR S FTR=1
  1. HDR S DX=0
  1. S DY=$P(DDBSY,";")
  1. X IOXY
  1. W $P(DDGLVID,DDGLDEL,6)
  1. W DDBHDR
  1. W $P(DDGLVID,DDGLDEL,10)
  1. G:$G(FTR) FTR
  1. Q
  1. FTR I DDBFLGS Q
  1. W $P(DDGLVID,DDGLDEL,6)
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  1. S DY=$P(DDBSY,";",4)
  1. X IOXY
  1. W DDBFTR
  1. S DX=$P(DDBSX,";",3)
  1. X IOXY
  1. W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)," of ",DDBTL
  1. S DX=$P(DDBSX,";",4)
  1. X IOXY
  1. W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)," of ",DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
  1. S DX=$P(DDBSX,";",2)
  1. X IOXY
  1. W:'DDBRHTF $J(DDBSF,4)
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  1. W $P(DDGLVID,DDGLDEL,10)
  1. Q
  1. RLPI ;
  1. RLPIR I DDBFLGS Q
  1. S DX=$P(DDBSX,";",3),DY=$P(DDBSY,";",4)
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  1. W $P(DDGLVID,DDGLDEL,6)
  1. X IOXY
  1. W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)
  1. S DX=$P(DDBSX,";",4)
  1. X IOXY
  1. W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  1. W $P(DDGLVID,DDGLDEL,10)
  1. Q
  1. COLR I DDBFLGS!(DDBRHTF) Q
  1. S DX=$P(DDBSX,";",2),DY=$P(DDBSY,";",4)
  1. X IOXY
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
  1. W $P(DDGLVID,DDGLDEL,6)
  1. W $J(DDBSF,4)
  1. I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
  1. W $P(DDGLVID,DDGLDEL,10)
  1. Q
  1. ;
  1. HTD(X,WPIEN) ;
  1. Q:'DDBRHTF $E(X,DDBSF,DDBST)
  1. Q:$L(X,"$.")'>2 X
  1. S:$L(X,"$.$")>2 X=$$HT(X,"$.$","","")
  1. S:$L(X,"$.%")>2 X=$$HT(X,"$.%",$P(DDGLVID,DDGLDEL),$P(DDGLVID,DDGLDEL,3))
  1. Q X
  1. ;
  1. HT(Y,D,C1,C2) ;
  1. Q:$L(Y,D)'>2 Y
  1. N YL,I,Y1
  1. S YL=$L(Y,D),Y1=""
  1. F I=1:1:YL D
  1. .S:I#2 Y1=Y1_$P(Y,D,I)
  1. .I '(I#2),+$G(DDBRHT)=WPIEN,$P(DDBRHT,DDGLDEL,4)=DDBSA,$P(DDBRHT,DDGLDEL,2)=$P(Y,D,I) D Q
  1. ..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
  1. ..Q
  1. .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
  1. .Q
  1. Q Y1