Return to DDWT1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DDWT1	;SFISC/PD KELTZ,MKO-READ AND PROCESS ;08:14 AM  30 Aug 1994
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	D LOAD^DDW1
	F  D GETIN Q:$D(DDWFIN)
	Q
	;
GETIN	;Get input
	I DDWC'>DDWRMAR,DDWC-DDWOFS<IOM,DDWC>$L(DDWN)!DDWREP,'$D(DDWMARK) D
	. N DDWANS
	. D PREAD($$MIN(DDWRMAR,IOM-1+DDWOFS)-DDWC+1,DDWTO,.DDWANS,.DDWQ)
	. I DDWANS]"" D
	.. S:DDWQ="TO" DDWQ=""
	.. S $E(DDWN,DDWC,DDWC+$L(DDWANS)-1)=DDWANS,DDWL(DDWRW)=DDWN
	.. S DDWC=DDWC+$L(DDWANS)
	E  D
	. D READ(DDWTO,.DDWQ)
	. D:$L(DDWQ)=1 DISPL
	;
	I DDWQ'="TO" K DDWTC
	E  D
	. S DDWTC=$G(DDWTC)+1
	. S:DDWTC<(DTIME\DDWTO) DDWQ=""
	. I DDWSTAT,DDWTC=1,$L(DDWQ)'>1 D STATUS
	;
	I $L(DDWQ)>1 D @DDWQ I DDWSTAT D STATUS S DDWTC=1
	Q
	;
DISPL	;Display char
	I DDWC>245 W $C(7) Q
	;
	I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
	S:DDWC-1>$L(DDWN) DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
	S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)_DDWQ_$E(DDWN,DDWC+DDWREP,999)
	S DDWC=DDWC+1
	;
	I DDWREP W DDWQ
	E  D
	. I $P(DDGLED,DDGLDEL,5)]"" W $P(DDGLED,DDGLDEL,5)_DDWQ
	. E  W DDWQ_$E(DDWN,DDWC,IOM+DDWOFS)
	D POS(DDWRW,DDWC,"R")
	D:$L(DDWN)>DDWRMAR WRAP^DDW5
	Q
	;
RUB	N DDWX
	I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
	;
	I DDWC=1 D
	. I DDWRW=1 D
	.. I 'DDWA W $C(7)
	.. E  D MVBCK^DDW3(1),POS(1,"E","R")
	. E  D POS(DDWRW-1,"E","RN")
	E  D
	. S DDWC=DDWC-1,$E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN
	. I DDWC-DDWOFS>0 D
	.. D CUP(DDWRW,DDWC-DDWOFS)
	.. I $P(DDGLED,DDGLDEL,6)]"" W $P(DDGLED,DDGLDEL,6)
	.. E  W $E(DDWN_" ",DDWC,IOM+DDWOFS) D CUP(DDWRW,DDWC-DDWOFS)
	. E  D POS(DDWRW,DDWC)
	Q
	;
DEL	N DDWX
	I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
	;
	I DDWC>$L(DDWN) D  Q
	. I DDWN?." " D
	.. D XLINE^DDW5()
	. E  D
	.. N DDWY,DDWX
	.. S DDWY=DDWRW+DDWA,DDWX=DDWC
	.. D JOIN^DDW6
	.. D POS(DDWY-DDWA,DDWX,"RN")
	;
	S $E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN,DDWX=$E(DDWN,IOM+DDWOFS)
	I $P(DDGLED,DDGLDEL,6)]"" D
	. W $P(DDGLED,DDGLDEL,6)
	. I DDWX]" " D CUP(DDWRW,IOM) W DDWX D CUP(DDWRW,DDWC-DDWOFS)
	E  D
	. W $E(DDWN_" ",DDWC,IOM+DDWOFS)
	. D CUP(DDWRW,DDWC-DDWOFS)
	Q
	;
STATUS	N DDWX,DDWS
	S DDWS="Scr "_(DDWA+DDWRW-1\DDWMR+1)_" of "_(DDWCNT-1\DDWMR+1)
	S DDWX="Ln "_(DDWA+DDWRW)_" of "_DDWCNT
	S $E(DDWS,IOM\2+1-($L(DDWX)\2),999)=DDWX
	S DDWX="Col "_DDWC
	S $E(DDWS,IOM-$L(DDWX),999)=DDWX
	D CUP(DDWMR+2,1) W $P(DDGLCLR,DDGLDEL)_DDWS
	D POS(DDWRW,DDWC)
	Q
	;
UP	I DDWRW>1 D
	. D POS(DDWRW-1,DDWC,"RN")
	E  I DDWA D
	. D MVBCK^DDW3(1)
	E  W $C(7)
	I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
	Q
DN	I DDWA+DDWRW'<DDWCNT W $C(7) Q
	I DDWRW<DDWMR D
	. D POS(DDWRW+1,DDWC,"RN")
	E  I DDWSTB D
	. D MVFWD^DDW3(1)
	E  W $C(7) Q
	I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
	Q
RT	I DDWC>245,DDWC>$L(DDWN) W $C(7)
	E  D POS(DDWRW,DDWC+1,"R")
	Q
LT	I DDWC=1 D
	. D UP,POS(DDWRW,"E","R")
	E  D POS(DDWRW,DDWC-1,"R")
	Q
	;
SV	G SV^DDW1
SW	D SAVE^DDW1 S DDWFIN="",DIWESW=1 Q
EX	D SAVE^DDW1 S DDWFIN="" Q
QT	S DDWFIN="" Q
TO	D SAVE^DDW1 S DTOUT=1,DDWFIN="" W $C(7) Q
HLP	D HLP^DDWH,POS(DDWRW,DDWC) Q
	;
TST	G TSET^DDW2
LST	G LSET^DDW2
RST	G RSET^DDW2
WRM	G WRAPM^DDW2
RPM	G REPLM^DDW2
ST	G STAT^DDW2
	;
TOP	G TOP^DDW3
BOT	G BOT^DDW3
	;
PDN	G PGDN^DDW4
PUP	G PGUP^DDW4
TAB	G TAB^DDW4
JLT	G JLEFT^DDW4
JRT	G JRIGHT^DDW4
LB	G LBEG^DDW4
LE	G LEND^DDW4
WRT	G WORDR^DDW4
WLT	G WORDL^DDW4
DLW	G DELW^DDW4
DEOL	G DEOL^DDW4
	;
BRK	D BREAK^DDW5() Q
XLN	D XLINE^DDW5() D:DDWC'=1 POS(DDWRW,1,"R") Q
	;
JN	G JOIN^DDW6
RFT	G REFMT^DDW6
	;
MRK	G MARK^DDW7
UMK	G UNMARK^DDW7
	;
CPY	D COPY^DDW8() Q
CUT	D CUT^DDW8() Q
PST	D PASTE^DDW8() Q
	;
FND	G FIND^DDWF
	;
NXT	G NEXT^DDWF
GTO	G GOTO^DDWG
CHG	G CHG^DDWC
	;
READ(DDWTO,Y)	;Out: Y = Char or mnemonic
	F  D  Q:Y'=-1
	. R *Y:DDWTO
	. I Y>31,Y<127 S Y=$C(Y) Q
	. I Y<0 S Y="TO" Q
	. D MNE(.Y)
	Q
	;
PREAD(DDWLEN,DDWTO,DDWST,Y)	;
	;In:  DDWLEN = # chars to read
	;Out:  DDWST = String
	;          Y = Mnemonic, Null if DDWLEN chars read or invalid
	X DDGLZOSF("EON")
	R DDWST#DDWLEN:DDWTO E  S Y="TO" Q
	X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
	I $C(Y)?1C,Y D
	. D MNE(.Y) S:Y=-1 Y=""
	E  S Y=""
	Q
	;
MNE(Y)	;Out: Y = Mnemonic, or -1 if invalid
	N S,F
	S S="",F=0
	F  D MNELOOP Q:F
	Q
	;
MNELOOP	;Read more
	S S=S_$C(Y)
	I DDW("IN")'[(U_S) D  I Y=-1 D FLUSH Q
	. I $C(Y)'?1L S Y=-1 Q
	. S S=$E(S,1,$L(S)-1)_$C(Y-32)
	. S:DDW("IN")'[(U_S_U) Y=-1
	;
	I DDW("IN")[(U_S_U),S'=$C(27) D  Q
	. S Y=$P(DDW("OUT"),U,$L($P(DDW("IN"),U_S_U),U)),F=1
	;
	R *Y:5 D:Y=-1 FLUSH
	Q
	;
FLUSH	;
	N DDWX
	S F=1 W $C(7) F  R *DDWX:0 E  Q
	Q
	;
CUP(Y,X)	;
	S DY=IOTM+Y-2,DX=X-1 X IOXY
	Q
	;
POS(R,C,F)	;Pos cursor based on char pos C
	N DDWX
	S:$G(C)="E" C=$L($G(DDWL(R)))+1
	S:$G(F)["N" DDWN=$G(DDWL(R))
	S:$G(F)["R" DDWRW=R,DDWC=C
	;
	S DDWX=C-DDWOFS
	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
	Q
	;
MIN(X,Y)	;
	Q $S(X<Y:X,1:Y)