File:  [Coherent Logic Development] / freem_fileman / Attic / DDBRGE.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:10:44 2025 UTC (5 weeks, 4 days ago) by snw
Branches: MAIN
CVS tags: HEAD
Initial revision

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>