Return to DIR0.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIR0	;SFISC/MKO-FIELD EDITOR ;02:41 PM  12 Oct 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: SM	;
    6: 	N DIR0A,DIR0C,DIR0CH,DIR0CHG,DIR0D,DIR0F,DIR0L,DIR0M
    7: 	N DIR0P,DIR0QT,DIR0QU,DIR0R,DIR0RJ,DIR0S,DIR0SP,DIR0ST,DIR0SV,DX,DY
    8: 	S DIR0P="" D:$D(DIR0("IN"))[0 GETKEY^DIR0K
    9: 	S:$P(DIR0,U,6) DIR0RJ=1
   10: 	;
   11: 	I $G(DDSH) D
   12: 	. K DDSH
   13: 	. S DY=IOSL-1,DX=0 X IOXY W $P(DDGLCLR,DDGLDEL)
   14: 	. I DDO,'DDM W "COMMAND:"
   15: 	. S DX=IOM-33 X IOXY W $P(DDGLVID,DDGLDEL,10)_$$EZBLD^DIALOG(8074)
   16: 	. S DX=IOM-8 X IOXY
   17: 	. W $P(DDGLVID,DDGLDEL,6)_$P($$EZBLD^DIALOG(7002),U,$G(DIR0("REP"))>0+1)_$P(DDGLVID,DDGLDEL,10)
   18: 	;
   19: 	S (DIR0A,DIR0D)=$G(DIR("B"))
   20: 	S DIR0R=$P(DIR0,U),DIR0S=$P(DIR0,U,2),DIR0L=$P(DIR0,U,3),DIR0M=245
   21: 	;
   22: 	W $P(DDGLVID,DDGLDEL,10)
   23: 	S DY=$P(DIR0,U,4),DX=$P(DIR0,U,5)
   24: 	I $D(DIR("A"))=11 D
   25: 	. N DIX
   26: 	. S DIX="" F  S DIX=$O(DIR("A",DIX)) Q:DIX=""  D
   27: 	.. X IOXY W DIR("A",DIX)
   28: 	.. S DY=DY+1
   29: 	;
   30: 	I $D(DIR("A"))#2 D
   31: 	. X IOXY W DIR("A")
   32: 	. I DDO,DY=IOSL-1 W $P(DDGLCLR,DDGLDEL)
   33: 	;
   34: 	D INIT,^DIR01
   35: 	;
   36: 	W:$D(DTOUT) $C(7)
   37: 	I DIR0A="@",DIR0D'="@" S DIR0A=""
   38: 	S:DIR0CH="QT" DIR0A=DIR0D
   39: 	S X=DIR0A
   40: 	S:X?1"^".E!(X?1"?".E) DIR0A=DIR0D
   41: 	S DIR0N=X=DIR0D S:DIR0A'=DIR0D DIR0("L")=DIR0A
   42: 	;
   43: 	D END,PAINT
   44: 	X DDGLZOSF("EON"),DDGLZOSF("TRMOFF")
   45: 	Q
   46: 	;
   47: EN(DIR0R,DIR0S,DIR0L,DIR0NL,DIR0A,DIR0M,DIR0C,DIR0MAP,DIR0FLG,X,Y)	;
   48: 	;Field editor
   49: 	N DIR0CH,DIR0CHG,DIR0D,DIR0F,DIR0KD,DIR0P,DIR0QT,DIR0QU
   50: 	N DIR0RJ,DIR0SP,DIR0ST,DIR0SV,DX,DY
   51: 	;
   52: 	D INIT^DDGLIB0()
   53: 	;
   54: 	I $D(DIR0MAP)<2 D
   55: 	. S DIR0P="D"
   56: 	. D:$D(DIR0("DIN"))[0 GETKEY^DIR0K
   57: 	E  D
   58: 	. S DIR0P="C"
   59: 	. I $O(DIR0MAP(""))!($D(DIR0MAP("IN"))[0) D
   60: 	.. D GETKEY^DIR0K
   61: 	.. K DIR0MAP S DIR0MAP("IN")=DIR0("CIN"),DIR0MAP("OUT")=DIR0("COUT")
   62: 	. E  D
   63: 	.. S DIR0("CIN")=$G(DIR0MAP("IN")),DIR0("COUT")=$G(DIR0MAP("OUT"))
   64: 	.. S:DIR0("CIN")[(U_"KD"_U) DIR0KD=$P(DIR0("COUT"),";",$L($P(DIR0("CIN"),U_"KD"_U),U))
   65: 	;
   66: 	S (DIR0A,DIR0D)=$G(DIR0A)
   67: 	S:'$G(DIR0R) DIR0R=0
   68: 	S:'$G(DIR0S) DIR0S=0
   69: 	S:'$G(DIR0L) DIR0L=IOM-1-DIR0S
   70: 	S:'$G(DIR0M) DIR0M=245
   71: 	S:'$G(DIR0FLG)["r" DIR0RJ=1
   72: 	;
   73: 	I $G(DIR0NL)>1 D
   74: 	. D EN^DIR02,END
   75: 	E  D INIT,^DIR01,END,PAINT
   76: 	;
   77: 	S X=DIR0A
   78: 	I $D(DTOUT) K DTOUT S:Y="" Y="TO"
   79: 	S $P(Y,U,2)=+$G(DIR0CHG)
   80: 	D KILL^DDGLIB0($G(DIR0FLG))
   81: 	K DIR0("CIN"),DIR0("COUT")
   82: 	Q
   83: 	;
   84: INIT	;
   85: 	K DTOUT
   86: 	X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
   87: 	S DIR0SV=$G(DIR0("L"))
   88: 	S:'$G(DIR0C) DIR0C=1
   89: 	S (DIR0QT,DIR0QU)=0,DY=DIR0R,DX=DIR0S,DIR0F=DIR0S+DIR0L
   90: 	;
   91: 	X IOXY
   92: 	S DIR0SP=$J("",DIR0L) S:$G(DDGLVAN) DIR0SP=$TR(DIR0SP," ","_")
   93: 	I DIR0C-1>DIR0L D
   94: 	. W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,DIR0C-DIR0L,DIR0C-1)
   95: 	. S DX=DIR0F
   96: 	E  D
   97: 	. W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
   98: 	. S DX=DIR0S+DIR0C-1
   99: 	. X IOXY
  100: 	Q
  101: 	;
  102: END	;
  103: 	S Y=$P("U^D^R^L^N^NB^NP^PP^SEL^EX^QT^CL^SV^RF",U,$L($P("^UP^DOWN^TAB^FDL^CR^NB^NP^PP^SEL^EX^QT^CL^SV^RF^",U_DIR0CH_U),U))
  104: 	S:Y="" Y=$P($G(DIR0QT),U,2)
  105: 	N X,Y S DIR0SP=$TR(DIR0SP,"_"," ")
  106: 	Q
  107: 	;
  108: PAINT	;
  109: 	N DIR0X
  110: 	I $G(DIR0FLG)["P" W $P(DDGLVID,DDGLDEL,10) Q
  111: 	I '$G(DIR0RJ) S DIR0X=$E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
  112: 	E  S DIR0X=$E(DIR0SP,$L(DIR0A)+1,999)_$E(DIR0A,1,DIR0L)
  113: 	S DX=DIR0S X IOXY
  114: 	W $P(DDGLVID,DDGLDEL,10)_$P(DDGLVID,DDGLDEL)_DIR0X_$P(DDGLVID,DDGLDEL,10)
  115: 	Q
  116: 	;
  117: UPDATE(DIR0NA,DIR0NC)	;Update ans/curs pos
  118: 	N DIR0STR,DIR0X
  119: 	S:$D(DIR0NA)[0 DIR0NA=DIR0A
  120: 	S:$D(DIR0NC)[0 DIR0NC=DIR0C
  121: 	S:DIR0NC<1 DIR0NC=1
  122: 	S:DIR0NC-1>$L(DIR0NA) DIR0NC=$L(DIR0NA)+1
  123: 	S DIR0X=DX+DIR0NC-DIR0C
  124: 	;
  125: 	I DIR0A=DIR0NA,DIR0X'<DIR0S,DIR0X'>DIR0F D
  126: 	. S DX=DIR0X X IOXY
  127: 	E  D
  128: 	. S DIR0X=DIR0NC-DIR0L S:DIR0X<1 DIR0X=1
  129: 	. S DX=DIR0S X IOXY
  130: 	. S DIR0STR=$E(DIR0NA,DIR0X,DIR0X+DIR0L-1)
  131: 	. W DIR0STR_$E(DIR0SP,$L(DIR0STR)+1,999)
  132: 	. S DX=DIR0S+DIR0NC-DIR0X X IOXY
  133: 	;
  134: 	S DIR0A=DIR0NA,DIR0C=DIR0NC
  135: 	Q
  136: 	;
  137: KILL	;
  138: 	D KILL^DDGLIB0()
  139: 	Q
  140: 	;
  141: 	;#8074  Press <PF1>H for help
  142: 	;#7002  Insert^Replace