Annotation of freem_fileman/DDBRGE.m, revision 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>
![[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