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

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1DDBRGE ;SFISC/DCL-BROWSE GET/EXECUTE EVENT ;NOV 04, 1996@13:52
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN N DDBGF
5 D GETKEY
6 S DDBRPE=0
7 W @IOSTBM
8 S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL D PSR^DDBR0(1)
9 S DX=0,DY=$P(DDBSY,";",3) X IOXY
10 X DDGLZOSF("EOFF")
11 F S DDBRE=$$READ D Q:DDBRE="^"
12 .I $T(@DDBRE)="" W $C(7) Q
13 .X DDGLZOSF("EON")
14 .D @DDBRE
15 .I DDBRSA S DDBRSA(DDBRSA,"DDBL")=DDBL
16 .S DX=0,DY=$P(DDBSY,";",3) X IOXY
17 .S DDBRPE=DDBRE
18 .X DDGLZOSF("EOFF")
19 X DDGLZOSF("EON")
20 I $G(DDBFLG)["H" Q
21CLS S DX=0 F DY=$P(DDBSY,";"):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
22 I DDBRSA S X=DDBL D
23 .N DDBL S DDBL=X
24 .D SR^DDBRS(DDBRSA,$S(DDBRSA=2:1,1:2),.DDBRSA)
25 .W @IOSTBM
26 .S DX=0 F DY=$P(DDBSY,";"):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
27 .Q
28 I $G(DDBC1),$G(DDBC0)]"" K @DDBC0@(1)
29 K ^TMP("DDBC","DDBC",$J)
30 S IOTM=1,IOBM=IOSL W @IOSTBM,$P(DDGLVID,DDGLDEL,9)
31 D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
32 S DX=0,DY=IOSL-1 X IOXY
33 I DDBSRL+2=IOSL W @IOF
34 D:$G(DDBFLG)'["P" KTMP
35END Q
36KTMP D KTMP^DDBRU
37 Q
38READ() N S,Y
39 F R *Y:DTIME D C Q:Y'=-1
40 Q Y
41C I Y<0 S Y="TO" Q
42 ;I Y=13 S Y="COLR" Q
43 S S=""
44C1 S S=S_$C(Y)
45 I DDBGF("DDBIN")'[(U_S) D I Y=-1 W $C(7) Q
46 . I $C(Y)'?1L S Y=-1 Q
47 . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDBGF("DDBIN")'[(U_S_U) Y=-1
48 I DDBGF("DDBIN")[(U_S_U),S'=$C(27) S Y=$P(DDBGF("DDBOUT"),U,$L($P(DDBGF("DDBIN"),U_S_U),U)) Q
49 R *Y:5 G:Y'=-1 C1 W $C(7)
50 Q
51GETKEY N AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
52 N FIND,SELECT,PREVSC,NEXTSC,HELP,KP7,KP8
53 S AU=$P(DDGLKEY,U,2)
54 S AD=$P(DDGLKEY,U,3)
55 S AR=$P(DDGLKEY,U,4)
56 S AL=$P(DDGLKEY,U,5)
57 S F1=$P(DDGLKEY,U,6)
58 S F2=$P(DDGLKEY,U,7)
59 S F3=$P(DDGLKEY,U,8)
60 S F4=$P(DDGLKEY,U,9)
61 S FIND=$P(DDGLKEY,U,10)
62 S SELECT=$P(DDGLKEY,U,11)
63 S PREVSC=$P(DDGLKEY,U,14)
64 S NEXTSC=$P(DDGLKEY,U,15)
65 S HELP=$P(DDGLKEY,U,16)
66 S KP7=$P(DDGLKEY,U,25)
67 S KP8=$P(DDGLKEY,U,26)
68 F N="DDB" D
69 . S DDBGF(N_"IN")="",DDBGF(N_"OUT")=""
70 . F I=1:1 S T=$P($T(@(N_"MAP")+I),";;",2,999) Q:T="" D
71 .. S @("K="_$P(T,";",2))
72 .. I DDBGF(N_"IN")'[(U_K) D
73 ... S DDBGF(N_"IN")=DDBGF(N_"IN")_U_K
74 ... S DDBGF(N_"OUT")=DDBGF(N_"OUT")_$P(T,";")_U
75 . S DDBGF(N_"IN")=DDBGF(N_"IN")_U
76 . S DDBGF(N_"OUT")=$E(DDBGF(N_"OUT"),1,$L(DDBGF(N_"OUT"))-1)
77 Q
78TO S DDBRE="^" Q
79HELP D HELP^DDBR1 Q
80HELPS D HELPS^DDBR1 Q
81RETURN D SWITCH^DDBR2("","R") Q
82SWITCH D SWITCH^DDBR2() Q
83RPS I 'DDBRSA D PSR^DDBR0(1) Q
84 N DDBRNI F DDBRNI=1,2 D
85 .I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
86 .I DDBRSA=1 S DDBL=DDBRSA(DDBRSA,"DDBL") D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
87 .Q
88 Q
89NEXT D NOOF^DDBR1 Q
90FIND D FIND^DDBR1 Q
91GOTO D GOTO^DDBR1 Q
92BOT D BOT^DDBR0 Q
93TOP D TOP^DDBR0 Q
94PD D PD^DDBR0 Q
95PU D PU^DDBR0 Q
96QUIT ;
97EXIT D EXIT^DDBR0 Q
98COLR D RR^DDBR0 Q
99COLL D RL^DDBR0 Q
100COLRE D RRE^DDBR0 Q
101COLLE D RLE^DDBR0 Q
102COLJ D COLJ^DDBR0 Q
103LND D LD^DDBR0 Q
104LNU D LU^DDBR0 Q
105HU D CHDR^DDBR4(-1) Q
106HD D CHDR^DDBR4(1) Q
107PH D PRTHELP^DDBRP Q
108STPB D STPB^DDBRWB Q
109VIEW D VIEW^DDBRWB Q
110AHT I DDBRHTF D TAB^DDBRAHT Q
111 G BQT
112AHTR I DDBRHTF D REVTAB^DDBRAHTR Q
113 G BQT
114TEHT I DDBRHTF D TEDIT^DDBRAHTE Q
115 G BQT
116RA I DDBRHTF D RA^DDBRAHTE Q
117 G BQT
118SCRN1 I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM G RPS
119 G BQT
120SCRN2 I DDBRSA=1 D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM G RPS
121 G BQT
122SPLIT I 'DDBRSA,$D(DDBRSA(1)) D SPLIT^DDBRS Q
123 G BQT
124FULL I DDBRSA D FULL^DDBRS(.DDBRSA) Q
125 G BQT
126RESIZU I DDBRSA,(DDBRSA(1,"IOBM")-1)>(DDBRSA(0,"IOTM")+2) S DDBRSA(1,"IOBM")=DDBRSA(1,"IOBM")-1,DDBRSA(2,"IOTM")=DDBRSA(2,"IOTM")-1 D 2,1,ENTB^DDBRS(.DDBRSA,-1) G RPS
127 G BQT
128RESIZD I DDBRSA,(DDBRSA(2,"IOTM")+1)<(DDBRSA(0,"IOBM")-2) S DDBRSA(1,"IOBM")=DDBRSA(1,"IOBM")+1,DDBRSA(2,"IOTM")=DDBRSA(2,"IOTM")+1 D 1,2,ENTB^DDBRS(.DDBRSA,+1) G RPS
129 G BQT
130BQT W $C(7)
131 Q
1321 S DX=0,DY=$P(DDBRSA(1,"DDBSY"),";",4) X IOXY W $P(DDGLCLR,DDGLDEL) Q
1332 S DX=0,DY=$P(DDBRSA(2,"DDBSY"),";") X IOXY W $P(DDGLCLR,DDGLDEL) Q
134DDBMAP ;
135 ;;LNU;AU;
136 ;;LND;AD;
137 ;;COLR;AR;
138 ;;COLL;AL;
139 ;;EXIT;F1_"E";
140 ;;QUIT;F1_"Q";
141 ;;PU;F1_AU;
142 ;;PU;PREVSC;
143 ;;PD;F1_AD;
144 ;;PD;NEXTSC;
145 ;;COLRE;F1_AR;
146 ;;COLLE;F1_AL;
147 ;;STPB;F1_"C";
148 ;;VIEW;F1_"V";
149 ;;TOP;F1_"T";
150 ;;BOT;F1_"B";
151 ;;GOTO;F1_"G";
152 ;;FIND;F1_"F";
153 ;;FIND;FIND;
154 ;;NEXT;"N";
155 ;;NEXT;F1_"N";
156 ;;RPS;F1_"P";
157 ;;SWITCH;F1_"S";
158 ;;SWITCH;SELECT;
159 ;;RETURN;"R";
160 ;;HELP;F1_"H";
161 ;;HELP;"HELP";
162 ;;HELPS;F1_F1_"H";
163 ;;EXIT;"EXIT";
164 ;;SCRN1;F2_AU;
165 ;;SCRN2;F2_AD;
166 ;;SPLIT;F2_"S";
167 ;;FULL;F2_"F";
168 ;;RESIZU;F2_F2_AU;
169 ;;RESIZD;F2_F2_AD;
170 ;;HU;F1_F1_AU;
171 ;;HD;F1_F1_AD;
172 ;;PH;F1_F1_F1_"H";
173 ;;STPB;F1_F1_"C";
174 ;;AHT;$C(9);
175 ;;AHTR;"Q";
176 ;;TEHT;F4_"T";
177 ;;RA;F4_"A";
178 ;;COLR;$C(13);
Note: See TracBrowser for help on using the repository browser.