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

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1DDBR0 ;SFISC/DCL-VA FILEMAN BROWSER FUNCTIONS ;NOV 04, 1996@13:47
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5PU 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),$$HTD(@DDBSA@(I,0),I)
11 ..S DDBL=DDBL-1
12 F I=I:-1:J Q:I'>0!('$D(@DDBSA@(I))) D
13 .X IOXY
14 .W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I)
15 .S DDBL=DDBL-1
16 D:K'=DDBL RLPI
17 Q
18PD 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),$$HTD(@DDBSA@(I,0),I) S DDBL=DDBL+1
23 .Q
24 F I=I:1:J Q:'$D(@DDBSA@(I)) W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) S DDBL=DDBL+1
25 D:K'=DDBL RLPI
26 Q
27LU 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),$$HTD(@DDBSA@(I,0),I) D RLPIR Q
31 I I>0,$D(@DDBSA@(I)) S DDBL=DDBL-1 W IORI,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(I),I) D RLPIR Q
32 Q
33LD 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),$$HTD(@DDBSA@(DDBL,0),DDBL)
38 .D RLPIR
39 .Q
40 I 'DDBZN,$D(@DDBSA@(DDBL+1)) D Q
41 .S DDBL=DDBL+1
42 .W !,$P(DDGLCLR,DDGLDEL),$$HTD(@DDBSA@(DDBL),DDBL)
43 .D RLPIR
44 .Q
45 Q
46COL(N) N X
47 S X=$O(@DDBC@(DDBSF),N) Q:X'>0
48 S DDBSF=X
49COLENT S DDBST=DDBSF+(IOM-1),DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
50 D SDLR(DDBL+1),COLR
51 I DDBHDRC D ENCHDR^DDBR4
52 Q
53COLJ N X
54COLA S X(2)="Col> " W $$WS^DDBR1(.X) D G:X=""!(X=U) OUT
55 .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,1,"","KPW",.X)
56 .K DIR0
57 .Q
58 I $E(X)="?" G COLERR
59 I X<1!(X>255) W $C(7) G COLERR
60 S DDBSF=X G COLENT
61 Q
62COLERR S X(1)=" * [ Enter a number between 1 and 255 ] *"
63 G COLA
64OUT D PSR^DDBR0()
65 Q
66RLE Q:$G(DDBRHTF) S DDBSF=1 G COLENT
67RRE Q:$G(DDBRHTF) S DDBSF=$O(@DDBC@(""),-1) G COLENT
68 ;
69ONLINE Q
70RR I DDBRHTF D JUMP^DDBRAHTJ(1) Q
71 D COL(1)
72 Q
73RL I DDBRHTF D JUMP^DDBRAHTJ(-1) Q
74 D COL(-1)
75 Q
76TOP S DDBL=0 D SDLR(1),RLPIR
77 Q
78BOT I DDBTL>DDBSRL S DDBL=DDBTL-DDBSRL D SDLR(DDBL+1),RLPIR
79 Q
80EXIT S DDBRE="^"
81 Q
82TO S DDBTO=DDBTO+1,DDBE=-1 S:DDBTO'<($G(DTIME,300)\5) DDBE="^"
83 Q
84RCLSI D RLPIR,COLR
85 Q
86PSR(PSR) S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
87 D:$G(PSR) HFR D SDLR(DDBL+1),RLPIR,COLR
88 Q
89SDL ;
90SDLR(L) N I,J,SFR,STO
91 S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
92 S DY=SFR X IOXY
93 I DDBZN F I=SFR:1:STO D
94 .W:I'=SFR !
95 .W $P(DDGLCLR,DDGLDEL)
96 .I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L,0),L) S DDBL=DDBL+1,L=L+1
97 .S J=J+1
98 .Q
99 I 'DDBZN F I=SFR:1:STO D
100 .W:I'=SFR !
101 .W $P(DDGLCLR,DDGLDEL)
102 .I J=L,$D(@DDBSA@(L)) W $$HTD(@DDBSA@(L),L) S DDBL=DDBL+1,L=L+1
103 .S J=J+1
104 .Q
105 Q
106HFR N FTR S FTR=1
107HDR S DX=0
108 S DY=$P(DDBSY,";")
109 X IOXY
110 W $P(DDGLVID,DDGLDEL,6)
111 W DDBHDR
112 W $P(DDGLVID,DDGLDEL,10)
113 G:$G(FTR) FTR
114 Q
115FTR I DDBFLGS Q
116 W $P(DDGLVID,DDGLDEL,6)
117 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
118 S DY=$P(DDBSY,";",4)
119 X IOXY
120 W DDBFTR
121 S DX=$P(DDBSX,";",3)
122 X IOXY
123 W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)," of ",DDBTL
124 S DX=$P(DDBSX,";",4)
125 X IOXY
126 W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)," of ",DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
127 S DX=$P(DDBSX,";",2)
128 X IOXY
129 W:'DDBRHTF $J(DDBSF,4)
130 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
131 W $P(DDGLVID,DDGLDEL,10)
132 Q
133RLPI ;
134RLPIR I DDBFLGS Q
135 S DX=$P(DDBSX,";",3),DY=$P(DDBSY,";",4)
136 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
137 W $P(DDGLVID,DDGLDEL,6)
138 X IOXY
139 W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL),6)
140 S DX=$P(DDBSX,";",4)
141 X IOXY
142 W $J($S(DDBL>DDBTL:" ",DDBL<1:" ",1:DDBL-1\DDBSRL+1),5)
143 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
144 W $P(DDGLVID,DDGLDEL,10)
145 Q
146COLR I DDBFLGS!(DDBRHTF) Q
147 S DX=$P(DDBSX,";",2),DY=$P(DDBSY,";",4)
148 X IOXY
149 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,4)
150 W $P(DDGLVID,DDGLDEL,6)
151 W $J(DDBSF,4)
152 I DDBRSA=1 W $P(DDGLVID,DDGLDEL,10)
153 W $P(DDGLVID,DDGLDEL,10)
154 Q
155 ;
156HTD(X,WPIEN) ;
157 Q:'DDBRHTF $E(X,DDBSF,DDBST)
158 Q:$L(X,"$.")'>2 X
159 S:$L(X,"$.$")>2 X=$$HT(X,"$.$","","")
160 S:$L(X,"$.%")>2 X=$$HT(X,"$.%",$P(DDGLVID,DDGLDEL),$P(DDGLVID,DDGLDEL,3))
161 Q X
162 ;
163HT(Y,D,C1,C2) ;
164 Q:$L(Y,D)'>2 Y
165 N YL,I,Y1
166 S YL=$L(Y,D),Y1=""
167 F I=1:1:YL D
168 .S:I#2 Y1=Y1_$P(Y,D,I)
169 .I '(I#2),+$G(DDBRHT)=WPIEN,$P(DDBRHT,DDGLDEL,4)=DDBSA,$P(DDBRHT,DDGLDEL,2)=$P(Y,D,I) D Q
170 ..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
171 ..Q
172 .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
173 .Q
174 Q Y1
Note: See TracBrowser for help on using the repository browser.