1: DDBRGE ;SFISC/DCL-BROWSE GET/EXECUTE EVENT ;03:27 PM 29 Nov 1994;
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4: EN 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
21: CLS 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
35: END Q
36: KTMP D KTMP^DDBRU
37: Q
38: READ() N S,Y
39: F R *Y:DTIME D C Q:Y'=-1
40: Q Y
41: C I Y<0 S Y="TO" Q
42: S S=""
43: C1 S S=S_$C(Y)
44: I DDBGF("DDBIN")'[(U_S) D I Y=-1 W $C(7) Q
45: . I $C(Y)'?1L S Y=-1 Q
46: . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDBGF("DDBIN")'[(U_S_U) Y=-1
47: I DDBGF("DDBIN")[(U_S_U),S'=$C(27) S Y=$P(DDBGF("DDBOUT"),U,$L($P(DDBGF("DDBIN"),U_S_U),U)) Q
48: R *Y:5 G:Y'=-1 C1 W $C(7)
49: Q
50: GETKEY N AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
51: N FIND,SELECT,PREVSC,NEXTSC,HELP,KP7,KP8
52: S AU=$P(DDGLKEY,U,2)
53: S AD=$P(DDGLKEY,U,3)
54: S AR=$P(DDGLKEY,U,4)
55: S AL=$P(DDGLKEY,U,5)
56: S F1=$P(DDGLKEY,U,6)
57: S F2=$P(DDGLKEY,U,7)
58: S F3=$P(DDGLKEY,U,8)
59: S F4=$P(DDGLKEY,U,9)
60: S FIND=$P(DDGLKEY,U,10)
61: S SELECT=$P(DDGLKEY,U,11)
62: S PREVSC=$P(DDGLKEY,U,14)
63: S NEXTSC=$P(DDGLKEY,U,15)
64: S HELP=$P(DDGLKEY,U,16)
65: S KP7=$P(DDGLKEY,U,25)
66: S KP8=$P(DDGLKEY,U,26)
67: F N="DDB" D
68: . S DDBGF(N_"IN")="",DDBGF(N_"OUT")=""
69: . F I=1:1 S T=$P($T(@(N_"MAP")+I),";;",2,999) Q:T="" D
70: .. S @("K="_$P(T,";",2))
71: .. I DDBGF(N_"IN")'[(U_K) D
72: ... S DDBGF(N_"IN")=DDBGF(N_"IN")_U_K
73: ... S DDBGF(N_"OUT")=DDBGF(N_"OUT")_$P(T,";")_U
74: . S DDBGF(N_"IN")=DDBGF(N_"IN")_U
75: . S DDBGF(N_"OUT")=$E(DDBGF(N_"OUT"),1,$L(DDBGF(N_"OUT"))-1)
76: Q
77: TO S DDBRE="^" Q
78: HELP D HELP^DDBR0 Q
79: HELPS D HELPS^DDBR0 Q
80: RETURN D SWITCH^DDBR2("","R") Q
81: SWITCH D SWITCH^DDBR2() Q
82: RPS I 'DDBRSA D PSR^DDBR0(1) Q
83: N DDBRNI F DDBRNI=1,2 D
84: .I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
85: .I DDBRSA=1 S DDBL=DDBRSA(DDBRSA,"DDBL") D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
86: .Q
87: Q
88: NEXT D NOOF^DDBR1 Q
89: FIND D FIND^DDBR1 Q
90: GOTO D GOTO^DDBR1 Q
91: BOT D BOT^DDBR0 Q
92: TOP D TOP^DDBR0 Q
93: PD D PD^DDBR0 Q
94: PU D PU^DDBR0 Q
95: QUIT ;
96: EXIT D EXIT^DDBR0 Q
97: COLR D RR^DDBR0 Q
98: COLL D RL^DDBR0 Q
99: COLRE D RRE^DDBR0 Q
100: COLLE D RLE^DDBR0 Q
101: COLJ D COLJ^DDBR0 Q
102: LND D LD^DDBR0 Q
103: LNU D LU^DDBR0 Q
104: PF1Z I $G(^TMP("DDBPF1Z",$J))]"" X ^($J) G RPS
105: G BQT
106: PF2Z I $G(^TMP("DDBPF2Z",$J))]"" X ^($J) G RPS
107: G BQT
108: PF3Z I $G(^TMP("DDBPF3Z",$J))]"" X ^($J) G RPS
109: G BQT
110: PF4Z I $G(^TMP("DDBPF4Z",$J))]"" X ^($J) G RPS
111: G BQT
112: SCRN1 I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM G RPS
113: G BQT
114: SCRN2 I DDBRSA=1 D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM G RPS
115: G BQT
116: SPLIT I 'DDBRSA,$D(DDBRSA(1)) D SPLIT^DDBRS Q
117: G BQT
118: FULL I DDBRSA D FULL^DDBRS(.DDBRSA) Q
119: G BQT
120: RESIZU 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
121: G BQT
122: RESIZD 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
123: G BQT
124: BQT W $C(7)
125: Q
126: 1 S DX=0,DY=$P(DDBRSA(1,"DDBSY"),";",4) X IOXY W $P(DDGLCLR,DDGLDEL) Q
127: 2 S DX=0,DY=$P(DDBRSA(2,"DDBSY"),";") X IOXY W $P(DDGLCLR,DDGLDEL) Q
128: DDBMAP ;
129: ;;LNU;AU;
130: ;;LND;AD;
131: ;;COLR;AR;
132: ;;COLL;AL;
133: ;;EXIT;F1_"E";
134: ;;QUIT;F1_"Q";
135: ;;PU;F1_AU;
136: ;;PU;PREVSC;
137: ;;PD;F1_AD;
138: ;;PD;NEXTSC;
139: ;;COLRE;F1_AR;
140: ;;COLLE;F1_AL;
141: ;;COLJ;F1_"C";
142: ;;TOP;F1_"T";
143: ;;BOT;F1_"B";
144: ;;GOTO;F1_"G";
145: ;;FIND;F1_"F";
146: ;;FIND;FIND;
147: ;;NEXT;"N";
148: ;;NEXT;F1_"N";
149: ;;RPS;F1_"P";
150: ;;SWITCH;F1_"S";
151: ;;SWITCH;SELECT;
152: ;;RETURN;"R";
153: ;;HELP;F1_"H";
154: ;;HELP;"HELP";
155: ;;HELPS;F1_F1_"H";
156: ;;PF1Z;F1_"Z"; ^TMP(""DDBPF1Z",$J)=executable code (user defined)
157: ;;PF2Z;F2_"Z"; ^TMP(""DDBPF2Z",$J)=executable code (user defined)
158: ;;PF3Z;F3_"Z"; ^TMP(""DDBPF3Z",$J)=executable code (user defined)
159: ;;PF4Z;F4_"Z"; ^TMP(""DDBPF4Z",$J)=executable code (user defined)
160: ;;EXIT;"EXIT";
161: ;;SCRN1;F2_AU;
162: ;;SCRN2;F2_AD;
163: ;;SPLIT;F2_"S";
164: ;;FULL;F2_"F";
165: ;;RESIZU;F2_F2_AU;
166: ;;RESIZD;F2_F2_AD;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDBRGE.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman / USER