| [613] | 1 | DDWT1 ;SFISC/PD KELTZ,MKO-READ AND PROCESS ;11:35 AM 25 Aug 2000
|
|---|
| 2 | ;;22.0;VA FileMan;**18**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D LOAD^DDW1 K DUOUT ;GFT
|
|---|
| 5 | F D GETIN Q:$D(DDWFIN)
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | GETIN ;Get input
|
|---|
| 9 | I DDWC'>DDWRMAR,DDWC-DDWOFS<IOM,DDWC>$L(DDWN)!DDWREP,'$D(DDWMARK) D
|
|---|
| 10 | . N DDWANS
|
|---|
| 11 | . D PREAD($$MIN(DDWRMAR,IOM-1+DDWOFS)-DDWC+1,DDWTO,.DDWANS,.DDWQ)
|
|---|
| 12 | . I DDWANS]"" D
|
|---|
| 13 | .. S DDWED=1
|
|---|
| 14 | .. I DDWSTAT,DDWQ="TO",DDWTO<DTIME S DDWQ=""
|
|---|
| 15 | .. S $E(DDWN,DDWC,DDWC+$L(DDWANS)-1)=DDWANS,DDWL(DDWRW)=DDWN
|
|---|
| 16 | .. S DDWC=DDWC+$L(DDWANS)
|
|---|
| 17 | E D
|
|---|
| 18 | . D READ(DDWTO,.DDWQ)
|
|---|
| 19 | . D:$L(DDWQ)=1 DISPL
|
|---|
| 20 | ;
|
|---|
| 21 | I DDWSTAT D
|
|---|
| 22 | . I DDWQ="TO" D
|
|---|
| 23 | .. I $G(DDWTC) S:$$HDIFF(DDWTC,$H)+1<DTIME DDWQ=""
|
|---|
| 24 | .. E S DDWTC=$H,DDWQ="" D:DDWSTAT STATUS
|
|---|
| 25 | . E K DDWTC
|
|---|
| 26 | ;
|
|---|
| 27 | I $G(DDWAUTO),DDWQ'="TO",$$HDIFF(DDWAUTO("H"),$H)'<DDWAUTO("S") D AUTOSV^DDW1
|
|---|
| 28 | ;
|
|---|
| 29 | I $L(DDWQ)>1 D @DDWQ D:DDWSTAT STATUS
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | DISPL ;Display char
|
|---|
| 33 | I DDWC>245 W $C(7) Q
|
|---|
| 34 | ;
|
|---|
| 35 | S DDWED=1
|
|---|
| 36 | I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
|
|---|
| 37 | S:DDWC-1>$L(DDWN) DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
|
|---|
| 38 | S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)_DDWQ_$E(DDWN,DDWC+DDWREP,999)
|
|---|
| 39 | S DDWC=DDWC+1
|
|---|
| 40 | ;
|
|---|
| 41 | I DDWREP W DDWQ
|
|---|
| 42 | E D
|
|---|
| 43 | . I $P(DDGLED,DDGLDEL,5)]"" W $P(DDGLED,DDGLDEL,5)_DDWQ
|
|---|
| 44 | . E W DDWQ_$E(DDWN,DDWC,IOM+DDWOFS)
|
|---|
| 45 | D POS(DDWRW,DDWC,"R")
|
|---|
| 46 | D:$L(DDWN)>DDWRMAR WRAP^DDW5
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | RUB N DDWX
|
|---|
| 50 | S DDWED=1
|
|---|
| 51 | I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
|
|---|
| 52 | ;
|
|---|
| 53 | I DDWC=1 D
|
|---|
| 54 | . I DDWRW=1 D
|
|---|
| 55 | .. I 'DDWA W $C(7)
|
|---|
| 56 | .. E D MVBCK^DDW3(1),POS(1,"E","R")
|
|---|
| 57 | . E D POS(DDWRW-1,"E","RN")
|
|---|
| 58 | E D
|
|---|
| 59 | . S DDWC=DDWC-1,$E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN
|
|---|
| 60 | . S DDWX=$E(DDWN,IOM+DDWOFS)
|
|---|
| 61 | . I DDWC-DDWOFS>0 D
|
|---|
| 62 | .. D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 63 | .. I $P(DDGLED,DDGLDEL,6)]"" D
|
|---|
| 64 | ... W $P(DDGLED,DDGLDEL,6)
|
|---|
| 65 | ... I DDWX]" " D CUP(DDWRW,IOM) W DDWX D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 66 | .. E W $E(DDWN_" ",DDWC,IOM+DDWOFS) D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 67 | . E D POS(DDWRW,DDWC)
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | DEL N DDWX
|
|---|
| 71 | S DDWED=1
|
|---|
| 72 | I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
|
|---|
| 73 | ;
|
|---|
| 74 | I DDWC>$L(DDWN) D Q
|
|---|
| 75 | . I DDWN?." " D
|
|---|
| 76 | .. N DDWLAST
|
|---|
| 77 | .. S DDWLAST=DDWRW+DDWA=DDWCNT
|
|---|
| 78 | .. D XLINE^DDW5()
|
|---|
| 79 | .. D:DDWLAST POS(DDWRW,"E","R")
|
|---|
| 80 | . E D
|
|---|
| 81 | .. N DDWY,DDWX
|
|---|
| 82 | .. S DDWY=DDWRW+DDWA,DDWX=DDWC
|
|---|
| 83 | .. D JOIN^DDW6
|
|---|
| 84 | .. D POS(DDWY-DDWA,DDWX,"RN")
|
|---|
| 85 | ;
|
|---|
| 86 | S $E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN,DDWX=$E(DDWN,IOM+DDWOFS)
|
|---|
| 87 | I $P(DDGLED,DDGLDEL,6)]"" D
|
|---|
| 88 | . W $P(DDGLED,DDGLDEL,6)
|
|---|
| 89 | . I DDWX]" " D CUP(DDWRW,IOM) W DDWX D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 90 | E D
|
|---|
| 91 | . W $E(DDWN_" ",DDWC,IOM+DDWOFS)
|
|---|
| 92 | . D CUP(DDWRW,DDWC-DDWOFS)
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | STATUS N DDWX,DDWS
|
|---|
| 96 | S DDWS="Scr "_(DDWA+DDWRW-1\DDWMR+1)_" of "_(DDWCNT-1\DDWMR+1)
|
|---|
| 97 | S DDWX="Ln "_(DDWA+DDWRW)_" of "_DDWCNT
|
|---|
| 98 | S $E(DDWS,IOM\2+1-($L(DDWX)\2),999)=DDWX
|
|---|
| 99 | S DDWX="Col "_DDWC
|
|---|
| 100 | S $E(DDWS,IOM-$L(DDWX),999)=DDWX
|
|---|
| 101 | D CUP(DDWMR+2,1) W $P(DDGLCLR,DDGLDEL)_DDWS
|
|---|
| 102 | D POS(DDWRW,DDWC)
|
|---|
| 103 | Q
|
|---|
| 104 | ;
|
|---|
| 105 | UP I DDWRW>1 D
|
|---|
| 106 | . D POS(DDWRW-1,DDWC,"RN")
|
|---|
| 107 | E I DDWA D
|
|---|
| 108 | . D MVBCK^DDW3(1)
|
|---|
| 109 | E W $C(7)
|
|---|
| 110 | I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
|
|---|
| 111 | Q
|
|---|
| 112 | DN I DDWA+DDWRW'<DDWCNT W $C(7) Q
|
|---|
| 113 | I DDWRW<DDWMR D
|
|---|
| 114 | . D POS(DDWRW+1,DDWC,"RN")
|
|---|
| 115 | E I DDWSTB D
|
|---|
| 116 | . D MVFWD^DDW3(1)
|
|---|
| 117 | E W $C(7) Q
|
|---|
| 118 | I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
|
|---|
| 119 | Q
|
|---|
| 120 | RT I DDWC>245,DDWC>$L(DDWN) W $C(7)
|
|---|
| 121 | E D POS(DDWRW,DDWC+1,"R")
|
|---|
| 122 | Q
|
|---|
| 123 | LT I DDWC=1 D
|
|---|
| 124 | . I DDWRW=1,'DDWA W $C(7)
|
|---|
| 125 | . E D UP,POS(DDWRW,"E","R")
|
|---|
| 126 | E D POS(DDWRW,DDWC-1,"R")
|
|---|
| 127 | Q
|
|---|
| 128 | ;
|
|---|
| 129 | SV K DDWED G SV^DDW1
|
|---|
| 130 | SW D SAVE^DDW1 S DDWFIN="",DIWESW=1 Q
|
|---|
| 131 | EX D SAVE^DDW1 S DDWFIN="" Q
|
|---|
| 132 | QT S DUOUT=1 G QUIT^DDW1 ;GFT
|
|---|
| 133 | TO D SAVE^DDW1 S DTOUT=1,DDWFIN="" W $C(7) Q
|
|---|
| 134 | HLP D HLP^DDWH,POS(DDWRW,DDWC) Q
|
|---|
| 135 | AUT G AUTOTM^DDW1
|
|---|
| 136 | ;
|
|---|
| 137 | TST G TSET^DDW2
|
|---|
| 138 | TSALL G TSALL^DDW2
|
|---|
| 139 | LST G LSET^DDW2
|
|---|
| 140 | RST G RSET^DDW2
|
|---|
| 141 | WRM G WRAPM^DDW2
|
|---|
| 142 | RPM G REPLM^DDW2
|
|---|
| 143 | ST G STAT^DDW2
|
|---|
| 144 | ;
|
|---|
| 145 | TOP G TOP^DDW3
|
|---|
| 146 | BOT G BOT^DDW3
|
|---|
| 147 | ;
|
|---|
| 148 | PDN G PGDN^DDW4
|
|---|
| 149 | PUP G PGUP^DDW4
|
|---|
| 150 | TAB G TAB^DDW4
|
|---|
| 151 | JLT G JLEFT^DDW4
|
|---|
| 152 | JRT G JRIGHT^DDW4
|
|---|
| 153 | LB G LBEG^DDW4
|
|---|
| 154 | LE G LEND^DDW4
|
|---|
| 155 | WRT G WORDR^DDW4
|
|---|
| 156 | WLT G WORDL^DDW4
|
|---|
| 157 | DLW S DDWED=1 G DELW^DDW4
|
|---|
| 158 | DEOL S DDWED=1 G DEOL^DDW4
|
|---|
| 159 | ;
|
|---|
| 160 | BRK S DDWED=1 D BREAK^DDW5() Q
|
|---|
| 161 | XLN S DDWED=1 D XLINE^DDW5() D:DDWC'=1 POS(DDWRW,1,"R") Q
|
|---|
| 162 | ;
|
|---|
| 163 | JN S DDWED=1 G JOIN^DDW6
|
|---|
| 164 | RFT S DDWED=1 G REFMT^DDW6
|
|---|
| 165 | ;
|
|---|
| 166 | MRK G MARK^DDW7
|
|---|
| 167 | UMK G UNMARK^DDW7
|
|---|
| 168 | ;
|
|---|
| 169 | CPY D COPY^DDW8() Q
|
|---|
| 170 | CUT D CUT^DDW8() Q
|
|---|
| 171 | PST D PASTE^DDW8() Q
|
|---|
| 172 | ;
|
|---|
| 173 | FND G FIND^DDWF
|
|---|
| 174 | ;
|
|---|
| 175 | NXT G NEXT^DDWF
|
|---|
| 176 | GTO G GOTO^DDWG
|
|---|
| 177 | CHG G CHG^DDWC
|
|---|
| 178 | Q
|
|---|
| 179 | ;
|
|---|
| 180 | READ(DDWTO,Y) ;Out: Y = Char or mnemonic
|
|---|
| 181 | F D Q:Y'=-1
|
|---|
| 182 | . R *Y:DDWTO
|
|---|
| 183 | . I Y>127 D HS(.Y)
|
|---|
| 184 | . I Y>31,Y<127 S Y=$C(Y) Q
|
|---|
| 185 | . I Y<0 S Y="TO" Q
|
|---|
| 186 | . D MNE(.Y)
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | PREAD(DDWLEN,DDWTO,DDWST,Y) ;
|
|---|
| 190 | ;In: DDWLEN = # chars to read
|
|---|
| 191 | ;Out: DDWST = String
|
|---|
| 192 | ; Y = Mnemonic, Null if DDWLEN chars read or invalid
|
|---|
| 193 | X DDGLZOSF("EON")
|
|---|
| 194 | R DDWST#DDWLEN:DDWTO E S Y="TO" Q
|
|---|
| 195 | X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
|
|---|
| 196 | ;
|
|---|
| 197 | D:DDWST?.E1.C.E H(.DDWST)
|
|---|
| 198 | ;
|
|---|
| 199 | I $C(Y)?1C,Y D
|
|---|
| 200 | . D MNE(.Y)
|
|---|
| 201 | . I Y=-1 S Y=""
|
|---|
| 202 | . E I $L(Y)=1 W Y S DDWST=DDWST_Y,Y=""
|
|---|
| 203 | E S Y=""
|
|---|
| 204 | Q
|
|---|
| 205 | ;
|
|---|
| 206 | MNE(Y) ;In: Y = Ascii value of first character
|
|---|
| 207 | ;Out: Y = Mnemonic, or -1 if invalid
|
|---|
| 208 | N S,F,T
|
|---|
| 209 | I Y=13 S DDWHLOG=$P($H,",",2)
|
|---|
| 210 | E I Y=10,$D(DDWHLOG)#2,$P($H,",",2)-DDWHLOG<1 K DDWHLOG S Y=-1 Q
|
|---|
| 211 | E K DDWHLOG
|
|---|
| 212 | S S="",F=0,T="DDW(""IN"")"
|
|---|
| 213 | F D MNELOOP(.S,.Y,.T,.F) Q:F
|
|---|
| 214 | Q
|
|---|
| 215 | ;
|
|---|
| 216 | MNELOOP(S,Y,T,F) ;Read more
|
|---|
| 217 | ;In/Out:
|
|---|
| 218 | ; S = string of input chars
|
|---|
| 219 | ; Y = ascii of current char
|
|---|
| 220 | ; T = table under consideration
|
|---|
| 221 | ;Out:
|
|---|
| 222 | ; Y = mnemonic, or -1
|
|---|
| 223 | ; F = 1 : done
|
|---|
| 224 | ;
|
|---|
| 225 | N E
|
|---|
| 226 | S S=S_$C(Y)
|
|---|
| 227 | I @T'[(U_S) D
|
|---|
| 228 | . I $C(Y)?1L D
|
|---|
| 229 | .. S $E(S,$L(S))=$C(Y-32)
|
|---|
| 230 | .. S:@T'[(U_S_U) E=1
|
|---|
| 231 | . E S E=1
|
|---|
| 232 | I $T,$G(E) D Q
|
|---|
| 233 | . S T=$Q(@T)
|
|---|
| 234 | . I T]"" S $E(S,$L(S))=""
|
|---|
| 235 | . E D FLUSH S F=1,Y=-1
|
|---|
| 236 | ;
|
|---|
| 237 | I @T[(U_S_U),S'=$C(27) D Q
|
|---|
| 238 | . S Y=$P(@$TR(T,"IN","OT"),U,$L($P(@T,U_S_U),U)),F=1
|
|---|
| 239 | ;
|
|---|
| 240 | R *Y:5 I Y=-1 D FLUSH S F=1
|
|---|
| 241 | Q
|
|---|
| 242 | ;
|
|---|
| 243 | H(DDWST) ;
|
|---|
| 244 | S DDWST=$TR(DDWST,$C(145,146,147,148),"''""""")
|
|---|
| 245 | I DDWST?.E1.C.E D
|
|---|
| 246 | . N DDWCON,DDWI
|
|---|
| 247 | . S DDWCON=""
|
|---|
| 248 | . F DDWI=128:1:255 S DDWCON=DDWCON_$C(DDWI)
|
|---|
| 249 | . S DDWST=$TR(DDWST,DDWCON,$J(" ",128))
|
|---|
| 250 | D POS(DDWRW,DDWC)
|
|---|
| 251 | W DDWST
|
|---|
| 252 | Q
|
|---|
| 253 | ;
|
|---|
| 254 | HS(Y) ;
|
|---|
| 255 | I Y>144,Y<149 S Y=$A($E("''""""",Y-144))
|
|---|
| 256 | E S Y=32
|
|---|
| 257 | Q
|
|---|
| 258 | ;
|
|---|
| 259 | FLUSH ;
|
|---|
| 260 | N DDWX
|
|---|
| 261 | W $C(7) F R *DDWX:0 E Q
|
|---|
| 262 | Q
|
|---|
| 263 | ;
|
|---|
| 264 | CUP(Y,X) ;
|
|---|
| 265 | S DY=IOTM+Y-2,DX=X-1 X IOXY
|
|---|
| 266 | Q
|
|---|
| 267 | ;
|
|---|
| 268 | POS(R,C,F) ;Pos cursor based on char pos C
|
|---|
| 269 | N DDWX
|
|---|
| 270 | S:$G(C)="E" C=$L($G(DDWL(R)))+1
|
|---|
| 271 | S:$G(F)["N" DDWN=$G(DDWL(R))
|
|---|
| 272 | S:$G(F)["R" DDWRW=R,DDWC=C
|
|---|
| 273 | ;
|
|---|
| 274 | S DDWX=C-DDWOFS
|
|---|
| 275 | I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
|
|---|
| 276 | S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
|
|---|
| 277 | Q
|
|---|
| 278 | ;
|
|---|
| 279 | MIN(X,Y) ;
|
|---|
| 280 | Q $S(X<Y:X,1:Y)
|
|---|
| 281 | ;
|
|---|
| 282 | HDIFF(H1,H2) ;# seconds between two $H's
|
|---|
| 283 | Q (H2-H1)*86400+$P(H2,",",2)-$P(H1,",",2)
|
|---|
