Annotation of freem_fileman/DDBRGE.m, revision 1.1.1.1

1.1       snw         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>