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

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1DDBR1 ;SFISC/DCL-VA FILEMAN BROWSER PROTOCOLS ;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
5GOTO N X
6GTR S X(1)=$G(X(1)),X(2)="GoTo >" W $$WS(.X) D G:X=""!(X=U) OUT
7 .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,"",100,"","","KPW",.X)
8 .K DIR0
9 .Q
10 I $E(X)="?" S X(1)="* Screen (default), line"_$S('DDBRHTF:" or column",1:"")_" number preceeded by 'S', 'L'"_$S('DDBRHTF:" or 'C'",1:"")_" *" G GTR
11 I X S X=X*DDBSRL G LINE
12 S $E(X)=$TR($E(X),"bclst","BCLST")
13 I X["S",$TR($P(X,"S",2)," ") S X=$TR($P(X,"S",2)," ")*DDBSRL G LINE
14 I X["L",$TR($P(X,"L",2)," ") S X=$TR($P(X,"L",2)," ") G LINE
15 I X["C",'DDBRHTF,$TR($P(X,"C",2)," ") S X=$TR($P(X,"C",2)," ") I X>0&(X<256) S DDBSF=X G COLENT^DDBR0
16 I $E(X)="T" G TOP^DDBR0
17 I $E(X)="B" G BOT^DDBR0
18 G OUT
19LINE S DDBL=$S(X'>DDBSRL:0,X>DDBTL:DDBTL,1:X) D PSR^DDBR0()
20 Q
21NOOF N N
22 S N=1 I $D(DDBFNO) N D,X G FNO
23 S X(1)=" * [ NO PREVIOUS FIND STRING AVAILABLE ] *"
24 N Q S N=0 G BPR
25FIND N D,Q,X
26 N N
27 S N=0
28BPR S X(1)=$G(X(1)),X(2)="Find What: " W $$WS(.X) D G:X="" OUT
29 .N Y
30 .D EN^DIR0($P(DDBSY,";",3)-1,$L($G(X(2)))+2,30,1,$P($G(DDBFNO),U,3,255),100,"","","KPW",.X,.Y)
31 .K DIR0
32 .S:$P($G(Y),U)="U" X=X_"/U"
33 .Q
34 S Q=$TR($E(X,$L(X)-1,$L(X)),"u","U")
35 S D=$S(Q="/U":-1,1:1)
36 S:D=-1 X=$E(X,1,$L(X)-2)
37 Q:X=""
38 I $E(X)="?" S X(1)=" * [ Please enter any characters <cr>, '^' <cr> (exit) ] *" G BPR
39FNO N I,MATCHI,MATCHX
40 I N S D=$P(DDBFNO,"^",2),X=$P(DDBFNO,"^",3,255)
41 S X(1)="",X(2)=" * [ ...Searching "_$S(D=1:"'DOWN'",1:"'UP'")_" for "_X_"... ] *" W $$WS(.X)
42 D S:I<0 I=0
43 .I N&(D=1) S I=DDBL Q
44 .I N S I=DDBL-(DDBSRL-1) Q
45 .I D=1 S I=DDBL-DDBSRL Q
46 .S I=DDBL+1
47 .Q
48 D
49 .N XUC
50 .S XUC=$$U(X)
51 .I DDBDM D Q
52 ..I DDBZN D Q
53 ...F S I=$O(^TMP("DDB",$J,I),D) Q:I'>0 I $$U($G(^(I,0)))[XUC S MATCHI=I,MATCHX=^(0) Q
54 ...Q
55 ..F S I=$O(^TMP("DDB",$J,I),D) Q:I'>0 I $$U(^(I))[XUC S MATCHI=I,MATCHX=^(I) Q
56 ..Q
57 .I DDBZN D Q
58 ..F S I=$O(@DDBSA@(I),D) Q:I'>0 I $$U($G(@DDBSA@(I,0)))[XUC S MATCHI=I,MATCHX=@DDBSA@(I,0) Q
59 ..Q
60 .F S I=$O(@DDBSA@(I),D) Q:I'>0 I $$U(@DDBSA@(I))[XUC S MATCHI=I,MATCHX=@DDBSA@(I) Q
61 .Q
62 I $G(MATCHI) D S DDBFNO=DDBL_"^"_D_"^"_X Q
63 .S DDBSF=1,DDBST=IOM F Q:$F(MATCHX,X)'>DDBST D
64 ..S DDBSF=$O(@DDBC@(DDBSF)) S:DDBSF="" DDBSF=$O(@DDBC@(""))
65 ..S DDBST=DDBSF+(IOM-1)
66 ..Q
67 .I I+(DDBSRL)>DDBTL S I=DDBTL-(DDBSRL-1)
68 .I DDBTL'>DDBSRL S I=1
69 .S DDBL=I-1 D SDLRH(I,X),RCLSI^DDBR0
70 .Q
71 S X(1)="",X(2)=" * [ NO"_$S(N:" OTHER ",1:" ")_"MATCH FOUND ] *" W $C(7),$$WS(.X) H 3
72 D PSRH
73 Q
74OUT D PSR^DDBR0()
75 Q
76PSRH S DDBL=$S(DDBL'>DDBSRL:0,1:DDBL-DDBSRL)
77 D SDLRH(DDBL+1,X)
78 Q
79SDL ;
80SDLRH(L,HLS) N I,J,SFR,STO
81 S DX=0,SFR=$P(DDBSY,";",2),STO=$P(DDBSY,";",3),J=L
82 S DY=SFR X IOXY
83 I DDBZN F I=SFR:1:STO D
84 .W:I'=SFR !
85 .W $P(DDGLCLR,DDGLDEL)
86 .I J=L,$D(@DDBSA@(L)) W $$HL($$HTD^DDBR0(@DDBSA@(L,0),L),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,7)) S DDBL=DDBL+1,L=L+1
87 .S J=J+1
88 .Q
89 I 'DDBZN F I=SFR:1:STO D
90 .W:I'=SFR !
91 .W $P(DDGLCLR,DDGLDEL)
92 .I J=L,$D(@DDBSA@(L)) W $$HL($$HTD^DDBR0(@DDBSA@(L),L),HLS,$P(DDGLVID,DDGLDEL,6),$P(DDGLVID,DDGLDEL,7)) S DDBL=DDBL+1,L=L+1
93 .S J=J+1
94 .Q
95 Q
96HL(X,S,ON,RS,F) S X=$G(X),S=$G(S),F=$G(F)=1
97 G:F CS
98 N C,I,P,T,XU,SU,SL,TL,XL
99 S XU=$$U(X),SU=$$U(S),SL=$L(S),C=$L(XU,SU)-1,T="",XL=0
100 Q:'C X
101 F I=1:1:C S P=$F(XU,SU,XL),T=T_$E(X,XL,P-SL-1)_ON_$E(X,P-SL,P-1)_RS,XL=P
102 S T=T_$E(X,XL,255)
103 Q T
104U(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
105CS Q:$L(X,S)'>1 X
106 N C,I,P,T
107 S T="",C=$L(X,S)
108 F I=1:1:C S P=$P(X,S,I),T=T_P_$S(I'=C:ON_S_RS,1:"")
109 Q T
110HELPS N DDBHELPS
111 S DDBHELPS=$S(DDBFLG["A":83,1:71)+DDBSRL
112HELP I $E(DDBSA,1,11)="^DI(.84,920" S DDBL=0 D SDLR^DDBR0(1),RLPIR^DDBR0 Q
113 N DDBHA S DDBHA=$S(DDBFLG["A":"^DI(.84,9202,2)",1:"^DI(.84,9201,2)")
114 I $D(^TMP("DDBLST",$J,"J")) D
115 .K ^TMP("DDBLST",$J,"JS")
116 .M ^TMP("DDBLST",$J,"JS")=^TMP("DDBLST",$J,"J")
117 .K ^TMP("DDBLST",$J,"J")
118 .Q
119 D BROWSE^DDBR(DDBHA,"PNH"_$S(DDBFLG["A":"A",1:""),"VA FileMan Help Document",$G(DDBHELPS),"",IOTM-1,IOBM+1)
120 K ^TMP("DDBLST",$J,"J")
121 I $D(^TMP("DDBLST",$J,"JS")) M ^TMP("DDBLST",$J,"J")=^TMP("DDBLST",$J,"JS") K ^TMP("DDBLST",$J,"JS")
122 W @IOSTBM
123 D PSR^DDBR0(1)
124 Q
125LC(L,C) Q:$G(L)'>0 ""
126 S C=$G(C,"-")
127 Q $TR($J("",L)," ",C)
128WS(X) S DX=0,DY=$P(DDBSY,";",3)-3 X IOXY
129 W $P(DDGLGRA,DDGLDEL)
130 W $TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))
131 W $P(DDGLGRA,DDGLDEL,2)
132 W !,$P(DDGLCLR,DDGLDEL),$G(X(1))
133 W !,$P(DDGLCLR,DDGLDEL),$G(X(2))
134 W !,$P(DDGLCLR,DDGLDEL),$G(X(3))
135 S DY=$P(DDBSY,";",3),DX=$L($G(X(2)))+2 X IOXY
136 Q ""
Note: See TracBrowser for help on using the repository browser.