DDBRGE ;SFISC/DCL-BROWSE GET/EXECUTE EVENT ;03:27 PM 29 Nov 1994;
;;21.0;VA FileMan;;Dec 28, 1994
;Per VHA Directive 10-93-142, this routine should not be modified.
EN N DDBGF
D GETKEY
S DDBRPE=0
W @IOSTBM
S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL D PSR^DDBR0(1)
S DX=0,DY=$P(DDBSY,";",3) X IOXY
X DDGLZOSF("EOFF")
F S DDBRE=$$READ D Q:DDBRE="^"
.I $T(@DDBRE)="" W $C(7) Q
.X DDGLZOSF("EON")
.D @DDBRE
.I DDBRSA S DDBRSA(DDBRSA,"DDBL")=DDBL
.S DX=0,DY=$P(DDBSY,";",3) X IOXY
.S DDBRPE=DDBRE
.X DDGLZOSF("EOFF")
X DDGLZOSF("EON")
I $G(DDBFLG)["H" Q
CLS S DX=0 F DY=$P(DDBSY,";"):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
I DDBRSA S X=DDBL D
.N DDBL S DDBL=X
.D SR^DDBRS(DDBRSA,$S(DDBRSA=2:1,1:2),.DDBRSA)
.W @IOSTBM
.S DX=0 F DY=$P(DDBSY,";"):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
.Q
I $G(DDBC1),$G(DDBC0)]"" K @DDBC0@(1)
K ^TMP("DDBC","DDBC",$J)
S IOTM=1,IOBM=IOSL W @IOSTBM,$P(DDGLVID,DDGLDEL,9)
D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
S DX=0,DY=IOSL-1 X IOXY
I DDBSRL+2=IOSL W @IOF
D:$G(DDBFLG)'["P" KTMP
END Q
KTMP D KTMP^DDBRU
Q
READ() N S,Y
F R *Y:DTIME D C Q:Y'=-1
Q Y
C I Y<0 S Y="TO" Q
S S=""
C1 S S=S_$C(Y)
I DDBGF("DDBIN")'[(U_S) D I Y=-1 W $C(7) Q
. I $C(Y)'?1L S Y=-1 Q
. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDBGF("DDBIN")'[(U_S_U) Y=-1
I DDBGF("DDBIN")[(U_S_U),S'=$C(27) S Y=$P(DDBGF("DDBOUT"),U,$L($P(DDBGF("DDBIN"),U_S_U),U)) Q
R *Y:5 G:Y'=-1 C1 W $C(7)
Q
GETKEY N AU,AD,AR,AL,F1,F2,F3,F4,I,K,N,T
N FIND,SELECT,PREVSC,NEXTSC,HELP,KP7,KP8
S AU=$P(DDGLKEY,U,2)
S AD=$P(DDGLKEY,U,3)
S AR=$P(DDGLKEY,U,4)
S AL=$P(DDGLKEY,U,5)
S F1=$P(DDGLKEY,U,6)
S F2=$P(DDGLKEY,U,7)
S F3=$P(DDGLKEY,U,8)
S F4=$P(DDGLKEY,U,9)
S FIND=$P(DDGLKEY,U,10)
S SELECT=$P(DDGLKEY,U,11)
S PREVSC=$P(DDGLKEY,U,14)
S NEXTSC=$P(DDGLKEY,U,15)
S HELP=$P(DDGLKEY,U,16)
S KP7=$P(DDGLKEY,U,25)
S KP8=$P(DDGLKEY,U,26)
F N="DDB" D
. S DDBGF(N_"IN")="",DDBGF(N_"OUT")=""
. F I=1:1 S T=$P($T(@(N_"MAP")+I),";;",2,999) Q:T="" D
.. S @("K="_$P(T,";",2))
.. I DDBGF(N_"IN")'[(U_K) D
... S DDBGF(N_"IN")=DDBGF(N_"IN")_U_K
... S DDBGF(N_"OUT")=DDBGF(N_"OUT")_$P(T,";")_U
. S DDBGF(N_"IN")=DDBGF(N_"IN")_U
. S DDBGF(N_"OUT")=$E(DDBGF(N_"OUT"),1,$L(DDBGF(N_"OUT"))-1)
Q
TO S DDBRE="^" Q
HELP D HELP^DDBR0 Q
HELPS D HELPS^DDBR0 Q
RETURN D SWITCH^DDBR2("","R") Q
SWITCH D SWITCH^DDBR2() Q
RPS I 'DDBRSA D PSR^DDBR0(1) Q
N DDBRNI F DDBRNI=1,2 D
.I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
.I DDBRSA=1 S DDBL=DDBRSA(DDBRSA,"DDBL") D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM D PSR^DDBR0(1) Q
.Q
Q
NEXT D NOOF^DDBR1 Q
FIND D FIND^DDBR1 Q
GOTO D GOTO^DDBR1 Q
BOT D BOT^DDBR0 Q
TOP D TOP^DDBR0 Q
PD D PD^DDBR0 Q
PU D PU^DDBR0 Q
QUIT ;
EXIT D EXIT^DDBR0 Q
COLR D RR^DDBR0 Q
COLL D RL^DDBR0 Q
COLRE D RRE^DDBR0 Q
COLLE D RLE^DDBR0 Q
COLJ D COLJ^DDBR0 Q
LND D LD^DDBR0 Q
LNU D LU^DDBR0 Q
PF1Z I $G(^TMP("DDBPF1Z",$J))]"" X ^($J) G RPS
G BQT
PF2Z I $G(^TMP("DDBPF2Z",$J))]"" X ^($J) G RPS
G BQT
PF3Z I $G(^TMP("DDBPF3Z",$J))]"" X ^($J) G RPS
G BQT
PF4Z I $G(^TMP("DDBPF4Z",$J))]"" X ^($J) G RPS
G BQT
SCRN1 I DDBRSA=2 D SR^DDBRS(2,1,.DDBRSA) W @IOSTBM G RPS
G BQT
SCRN2 I DDBRSA=1 D SR^DDBRS(1,2,.DDBRSA) W @IOSTBM G RPS
G BQT
SPLIT I 'DDBRSA,$D(DDBRSA(1)) D SPLIT^DDBRS Q
G BQT
FULL I DDBRSA D FULL^DDBRS(.DDBRSA) Q
G BQT
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
G BQT
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
G BQT
BQT W $C(7)
Q
1 S DX=0,DY=$P(DDBRSA(1,"DDBSY"),";",4) X IOXY W $P(DDGLCLR,DDGLDEL) Q
2 S DX=0,DY=$P(DDBRSA(2,"DDBSY"),";") X IOXY W $P(DDGLCLR,DDGLDEL) Q
DDBMAP ;
;;LNU;AU;
;;LND;AD;
;;COLR;AR;
;;COLL;AL;
;;EXIT;F1_"E";
;;QUIT;F1_"Q";
;;PU;F1_AU;
;;PU;PREVSC;
;;PD;F1_AD;
;;PD;NEXTSC;
;;COLRE;F1_AR;
;;COLLE;F1_AL;
;;COLJ;F1_"C";
;;TOP;F1_"T";
;;BOT;F1_"B";
;;GOTO;F1_"G";
;;FIND;F1_"F";
;;FIND;FIND;
;;NEXT;"N";
;;NEXT;F1_"N";
;;RPS;F1_"P";
;;SWITCH;F1_"S";
;;SWITCH;SELECT;
;;RETURN;"R";
;;HELP;F1_"H";
;;HELP;"HELP";
;;HELPS;F1_F1_"H";
;;PF1Z;F1_"Z"; ^TMP(""DDBPF1Z",$J)=executable code (user defined)
;;PF2Z;F2_"Z"; ^TMP(""DDBPF2Z",$J)=executable code (user defined)
;;PF3Z;F3_"Z"; ^TMP(""DDBPF3Z",$J)=executable code (user defined)
;;PF4Z;F4_"Z"; ^TMP(""DDBPF4Z",$J)=executable code (user defined)
;;EXIT;"EXIT";
;;SCRN1;F2_AU;
;;SCRN2;F2_AD;
;;SPLIT;F2_"S";
;;FULL;F2_"F";
;;RESIZU;F2_F2_AU;
;;RESIZD;F2_F2_AD;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>