Return to DIR01.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIR01	;SFISC/MKO-FIELD EDITOR ;02:39 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: 	I DIR0A]"" D F X IOXY Q:DIR0QT
    5: 	F  D E X IOXY Q:DIR0QT
    6: 	Q
    7: 	;
    8: F	D READ(.DIR0CH)
    9: 	I "?^"'[DIR0CH=$L(DIR0CH) S DIR0A="" D REP,DEOF Q
   10: 	D:DIR0CH]"" E1
   11: 	Q
   12: 	;
   13: E	I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),DIR0F>DX,DIR0M>$L(DIR0A),'$D(DIR0KD) D
   14: 	. D PREAD($$MIN(DIR0F-DX,DIR0M-DIR0C+1),.DIR0ST,.DIR0CH)
   15: 	. Q:DIR0ST=""
   16: 	. S DIR0CHG=1
   17: 	. I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
   18: 	. E  S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
   19: 	. S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
   20: 	E  D READ(.DIR0CH)
   21: 	Q:DIR0CH=""
   22: 	;
   23: E1	I "?^"[DIR0CH,DIR0C=1,'DIR0QU S DIR0A="",DIR0QU=1 D REP,DEOF Q
   24: 	D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
   25: 	I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
   26: 	Q
   27: 	;
   28: REP	I DIR0C>DIR0M W $C(7) Q
   29: 	S DIR0CHG=1
   30: 	S $E(DIR0A,DIR0C)=DIR0CH,DIR0C=DIR0C+1
   31: 	I DIR0F>DX S DX=DX+1 W DIR0CH Q
   32: 	N DIX
   33: 	S DIX=DIR0C-(DIR0L\2)
   34: 	S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
   35: 	S DX=DIR0S X IOXY
   36: 	W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
   37: 	Q
   38: 	;
   39: INS	I $L(DIR0A)'<DIR0M W $C(7) Q
   40: 	S DIR0CHG=1
   41: 	S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999),DIR0C=DIR0C+1
   42: 	I DIR0F>DX S DX=DX+1 W $E(DIR0A,DIR0C-1,DIR0C+DIR0F-DX-1) Q
   43: 	S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1) S DX=DIR0F
   44: 	Q
   45: 	;
   46: RIGHT	Q:DIR0C>$L(DIR0A)
   47: 	I DX<DIR0F S DX=DX+1,DIR0C=DIR0C+1 Q
   48: 	S DIR0C=DIR0C+1,DX=DIR0S X IOXY
   49: 	W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
   50: 	S DX=DIR0F
   51: 	Q
   52: 	;
   53: LEFT	Q:DIR0C'>1
   54: 	I DX>DIR0S S DX=DX-1,DIR0C=DIR0C-1 Q
   55: 	S DIR0C=DIR0C-1 W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
   56: 	Q
   57: 	;
   58: JRT	Q:DIR0C>$L(DIR0A)
   59: 	I DIR0F=DX D  Q
   60: 	. S DIR0C=DIR0C+DIR0L S:DIR0C+1>$L(DIR0A) DIR0C=$L(DIR0A)+1
   61: 	. S DX=DIR0S X IOXY W $E(DIR0A,DIR0C-DIR0L,DIR0C-1)
   62: 	. S DX=DIR0F
   63: 	N DIX
   64: 	S DIX=$L(DIR0A)-DIR0C+1
   65: 	I DIR0F-DX>DIX S DX=DX+DIX,DIR0C=DIR0C+DIX Q
   66: 	S DIR0C=DIR0C+DIR0F-DX,DX=DIR0F
   67: 	Q
   68: 	;
   69: JLT	Q:DIR0C'>1
   70: 	I DX=DIR0S D  Q
   71: 	. S DIR0C=DIR0C-DIR0L S:DIR0C<1 DIR0C=1
   72: 	. W $E(DIR0A,DIR0C,DIR0C+DIR0L-1)
   73: 	S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
   74: 	Q
   75: 	;
   76: FDE	Q:DIR0C>$L(DIR0A)
   77: 	I DX+$L(DIR0A)-DIR0C-DIR0L<DIR0S D  Q
   78: 	. S DX=DX+$L(DIR0A)-DIR0C+1,DIR0C=$L(DIR0A)+1
   79: 	S DIR0C=$L(DIR0A)+1,DX=DIR0S X IOXY
   80: 	W $E(DIR0A,DIR0C-DIR0L,DIR0C)
   81: 	S DX=DIR0F
   82: 	Q
   83: 	;
   84: FDB	Q:DIR0C'>1
   85: 	I DX-DIR0C+1<DIR0S S DX=DIR0S X IOXY W $E(DIR0A,1,DIR0L)
   86: 	S DX=DIR0S,DIR0C=1
   87: 	Q
   88: 	;
   89: BS	Q:DIR0C'>1
   90: 	S DIR0CHG=1
   91: 	S DIR0C=DIR0C-1,DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
   92: 	I DX>DIR0S D  Q
   93: 	. S DX=DX-1 X IOXY
   94: 	. W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
   95: 	N DIX
   96: 	S DIX=DIR0C-(DIR0L\2)
   97: 	S:$L(DIR0A)-DIX+1<DIR0L DIX=$L(DIR0A)-DIR0L+1
   98: 	S:DIX<1 DIX=1
   99: 	W $E(DIR0A,DIX,DIX+DIR0L-1) S DX=DIR0S+DIR0C-DIX
  100: 	Q
  101: 	;
  102: DEL	Q:DIR0C>$L(DIR0A)!(DIR0F'>DX)
  103: 	S DIR0CHG=1
  104: 	S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)
  105: 	W $E(DIR0A_$E(DIR0SP),DIR0C,DIR0C+DIR0F-DX-1)
  106: 	Q
  107: 	;
  108: CLR	S DIR0CHG=1
  109: 	S DIR0C=1,DX=DIR0S X IOXY
  110: 	I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
  111: 	S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
  112: 	W $E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
  113: 	Q
  114: 	;
  115: DEOF	S DIR0CHG=1
  116: 	W $E(DIR0SP,DX-DIR0S+1,999)
  117: 	S DIR0A=$E(DIR0A,1,DIR0C-1)
  118: 	Q
  119: 	;
  120: RPM	N DX,DY
  121: 	I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
  122: 	I $G(DIR0("REP")) W:$D(DDS) "Insert " K DIR0("REP")
  123: 	E  W:$D(DDS) "Replace" S DIR0("REP")=1
  124: 	Q
  125: 	;
  126: KPM	I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
  127: 	E  S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
  128: 	Q
  129: 	;
  130: WRT	G WRT^DIR0W
  131: WLT	G WLT^DIR0W
  132: DLW	G DLW^DIR0W
  133: HLP	G ^DIR0H
  134: ZM	G SM^DIR02
  135: 	;
  136: TO	S DTOUT=1,DIR0A=DIR0D
  137: UP	;
  138: DOWN	;
  139: TAB	;
  140: FDL	;
  141: CR	;
  142: NB	;
  143: NP	;
  144: PP	;
  145: SEL	;
  146: EX	;
  147: QT	;
  148: CL	;
  149: SV	;
  150: RF	;
  151: 	S DIR0QT=1
  152: 	Q
  153: NOP	W $C(7)
  154: 	Q
  155: 	;
  156: READ(Y)	;Out: Y=char or mnemonic
  157: 	F  D  Q:Y'=-1
  158: 	. R *Y:DTIME
  159: 	. I Y>31,Y<127 S Y=$C(Y) Q
  160: 	. I Y<0 S Y="TO" Q
  161: 	. D MNE(.Y)
  162: 	I Y'="TO",$D(DIR0KD) D @DIR0KD
  163: 	Q
  164: 	;
  165: PREAD(DIR0LEN,DIR0ST,Y)	;
  166: 	; Y = Mnem, Null if DIR0LEN chars read or invalid
  167: 	X DDGLZOSF("EON")
  168: 	R DIR0ST#DIR0LEN:DTIME E  S Y="TO" Q
  169: 	X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
  170: 	I $C(Y)?1C,Y D
  171: 	. D MNE(.Y) S:Y=-1 Y=""
  172: 	E  S Y=""
  173: 	Q
  174: 	;
  175: MNE(Y)	;Out: Y=mnemonic, or -1 if invalid
  176: 	N S,F
  177: 	S S="",F=0
  178: 	F  D MNELOOP Q:F
  179: 	Q
  180: 	;
  181: MNELOOP	;
  182: 	S S=S_$C(Y)
  183: 	I DIR0(DIR0P_"IN")'[(U_S) D  I Y=-1 D FLUSH Q
  184: 	. I $C(Y)'?1L S Y=-1 Q
  185: 	. S S=$E(S,1,$L(S)-1)_$C(Y-32)
  186: 	. S:DIR0(DIR0P_"IN")'[(U_S_U) Y=-1
  187: 	;
  188: 	I DIR0(DIR0P_"IN")[(U_S_U),S'=$C(27) D
  189: 	. S Y=$P(DIR0(DIR0P_"OUT"),";",$L($P(DIR0(DIR0P_"IN"),U_S_U),U)),F=1
  190: 	E  R *Y:5 D:Y=-1 FLUSH
  191: 	Q
  192: 	;
  193: FLUSH	N X
  194: 	S F=1 W $C(7) F  R *X:0 E  Q
  195: 	Q
  196: 	;
  197: MIN(X,Y)	;
  198: 	Q $S(X<Y:X,1:Y)