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

DDBRGE ;SFISC/DCL-BROWSE GET/EXECUTE EVENT ;NOV 04, 1996@13:52
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;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
 ;I Y=13 S Y="COLR" 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^DDBR1 Q
HELPS D HELPS^DDBR1 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
HU D CHDR^DDBR4(-1) Q
HD D CHDR^DDBR4(1) Q
PH D PRTHELP^DDBRP Q
STPB D STPB^DDBRWB Q
VIEW D VIEW^DDBRWB Q
AHT I DDBRHTF D TAB^DDBRAHT Q
 G BQT
AHTR I DDBRHTF D REVTAB^DDBRAHTR Q
 G BQT
TEHT I DDBRHTF D TEDIT^DDBRAHTE Q
 G BQT
RA I DDBRHTF D RA^DDBRAHTE Q
 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;
 ;;STPB;F1_"C";
 ;;VIEW;F1_"V";
 ;;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";
 ;;EXIT;"EXIT";
 ;;SCRN1;F2_AU;
 ;;SCRN2;F2_AD;
 ;;SPLIT;F2_"S";
 ;;FULL;F2_"F";
 ;;RESIZU;F2_F2_AU;
 ;;RESIZD;F2_F2_AD;
 ;;HU;F1_F1_AU;
 ;;HD;F1_F1_AD;
 ;;PH;F1_F1_F1_"H";
 ;;STPB;F1_F1_"C";
 ;;AHT;$C(9);
 ;;AHTR;"Q";
 ;;TEHT;F4_"T";
 ;;RA;F4_"A";
 ;;COLR;$C(13);