DDWT1 ;SFISC/PD KELTZ,MKO-READ AND PROCESS ;11:35 AM  25 Aug 2000
 ;;22.0;VA FileMan;**18**;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 D LOAD^DDW1 K DUOUT ;GFT
 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 DDWED=1
 .. I DDWSTAT,DDWQ="TO",DDWTO<DTIME S 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 DDWSTAT D
 . I DDWQ="TO" D
 .. I $G(DDWTC) S:$$HDIFF(DDWTC,$H)+1<DTIME DDWQ=""
 .. E  S DDWTC=$H,DDWQ="" D:DDWSTAT STATUS
 . E  K DDWTC
 ;
 I $G(DDWAUTO),DDWQ'="TO",$$HDIFF(DDWAUTO("H"),$H)'<DDWAUTO("S") D AUTOSV^DDW1
 ;
 I $L(DDWQ)>1 D @DDWQ D:DDWSTAT STATUS
 Q
 ;
DISPL ;Display char
 I DDWC>245 W $C(7) Q
 ;
 S DDWED=1
 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
 S DDWED=1
 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
 . S DDWX=$E(DDWN,IOM+DDWOFS)
 . I DDWC-DDWOFS>0 D
 .. D CUP(DDWRW,DDWC-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  W $E(DDWN_" ",DDWC,IOM+DDWOFS) D CUP(DDWRW,DDWC-DDWOFS)
 . E  D POS(DDWRW,DDWC)
 Q
 ;
DEL N DDWX
 S DDWED=1
 I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
 ;
 I DDWC>$L(DDWN) D  Q
 . I DDWN?." " D
 .. N DDWLAST
 .. S DDWLAST=DDWRW+DDWA=DDWCNT
 .. D XLINE^DDW5()
 .. D:DDWLAST POS(DDWRW,"E","R")
 . 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
 . I DDWRW=1,'DDWA W $C(7)
 . E  D UP,POS(DDWRW,"E","R")
 E  D POS(DDWRW,DDWC-1,"R")
 Q
 ;
SV K DDWED G SV^DDW1
SW D SAVE^DDW1 S DDWFIN="",DIWESW=1 Q
EX D SAVE^DDW1 S DDWFIN="" Q
QT S DUOUT=1 G QUIT^DDW1 ;GFT
TO D SAVE^DDW1 S DTOUT=1,DDWFIN="" W $C(7) Q
HLP D HLP^DDWH,POS(DDWRW,DDWC) Q
AUT G AUTOTM^DDW1
 ;
TST G TSET^DDW2
TSALL G TSALL^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 S DDWED=1 G DELW^DDW4
DEOL S DDWED=1 G DEOL^DDW4
 ;
BRK S DDWED=1 D BREAK^DDW5() Q
XLN S DDWED=1 D XLINE^DDW5() D:DDWC'=1 POS(DDWRW,1,"R") Q
 ;
JN S DDWED=1 G JOIN^DDW6
RFT S DDWED=1 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
 Q
 ;
READ(DDWTO,Y) ;Out: Y = Char or mnemonic
 F  D  Q:Y'=-1
 . R *Y:DDWTO
 . I Y>127 D HS(.Y)
 . 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")
 ;
 D:DDWST?.E1.C.E H(.DDWST)
 ;
 I $C(Y)?1C,Y D
 . D MNE(.Y)
 . I Y=-1 S Y=""
 . E  I $L(Y)=1 W Y S DDWST=DDWST_Y,Y=""
 E  S Y=""
 Q
 ;
MNE(Y) ;In:  Y = Ascii value of first character
 ;Out: Y = Mnemonic, or -1 if invalid
 N S,F,T
 I Y=13 S DDWHLOG=$P($H,",",2)
 E  I Y=10,$D(DDWHLOG)#2,$P($H,",",2)-DDWHLOG<1 K DDWHLOG S Y=-1 Q
 E  K DDWHLOG
 S S="",F=0,T="DDW(""IN"")"
 F  D MNELOOP(.S,.Y,.T,.F) Q:F
 Q
 ;
MNELOOP(S,Y,T,F) ;Read more
 ;In/Out:
 ;  S = string of input chars
 ;  Y = ascii of current char
 ;  T = table under consideration
 ;Out:
 ;  Y = mnemonic, or -1
 ;  F = 1 : done
 ;
 N E
 S S=S_$C(Y)
 I @T'[(U_S) D
 . I $C(Y)?1L D
 .. S $E(S,$L(S))=$C(Y-32)
 .. S:@T'[(U_S_U) E=1
 . E  S E=1
 I $T,$G(E) D  Q
 . S T=$Q(@T)
 . I T]"" S $E(S,$L(S))=""
 . E  D FLUSH S F=1,Y=-1
 ;
 I @T[(U_S_U),S'=$C(27) D  Q
 . S Y=$P(@$TR(T,"IN","OT"),U,$L($P(@T,U_S_U),U)),F=1
 ;
 R *Y:5 I Y=-1 D FLUSH S F=1
 Q
 ;
H(DDWST) ;
 S DDWST=$TR(DDWST,$C(145,146,147,148),"''""""")
 I DDWST?.E1.C.E D
 . N DDWCON,DDWI
 . S DDWCON=""
 . F DDWI=128:1:255 S DDWCON=DDWCON_$C(DDWI)
 . S DDWST=$TR(DDWST,DDWCON,$J(" ",128))
 D POS(DDWRW,DDWC)
 W DDWST
 Q
 ;
HS(Y) ;
 I Y>144,Y<149 S Y=$A($E("''""""",Y-144))
 E  S Y=32
 Q
 ;
FLUSH ;
 N DDWX
 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)
 ;
HDIFF(H1,H2) ;# seconds between two $H's
 Q (H2-H1)*86400+$P(H2,",",2)-$P(H1,",",2)