Annotation of freem_fileman/DDWT1.m, revision 1.1
1.1 ! snw 1: DDWT1 ;SFISC/PD KELTZ,MKO-READ AND PROCESS ;08:14 AM 30 Aug 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: D LOAD^DDW1
! 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:DDWQ="TO" DDWQ=""
! 14: .. S $E(DDWN,DDWC,DDWC+$L(DDWANS)-1)=DDWANS,DDWL(DDWRW)=DDWN
! 15: .. S DDWC=DDWC+$L(DDWANS)
! 16: E D
! 17: . D READ(DDWTO,.DDWQ)
! 18: . D:$L(DDWQ)=1 DISPL
! 19: ;
! 20: I DDWQ'="TO" K DDWTC
! 21: E D
! 22: . S DDWTC=$G(DDWTC)+1
! 23: . S:DDWTC<(DTIME\DDWTO) DDWQ=""
! 24: . I DDWSTAT,DDWTC=1,$L(DDWQ)'>1 D STATUS
! 25: ;
! 26: I $L(DDWQ)>1 D @DDWQ I DDWSTAT D STATUS S DDWTC=1
! 27: Q
! 28: ;
! 29: DISPL ;Display char
! 30: I DDWC>245 W $C(7) Q
! 31: ;
! 32: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 33: S:DDWC-1>$L(DDWN) DDWN=DDWN_$J("",DDWC-$L(DDWN)-1)
! 34: S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)_DDWQ_$E(DDWN,DDWC+DDWREP,999)
! 35: S DDWC=DDWC+1
! 36: ;
! 37: I DDWREP W DDWQ
! 38: E D
! 39: . I $P(DDGLED,DDGLDEL,5)]"" W $P(DDGLED,DDGLDEL,5)_DDWQ
! 40: . E W DDWQ_$E(DDWN,DDWC,IOM+DDWOFS)
! 41: D POS(DDWRW,DDWC,"R")
! 42: D:$L(DDWN)>DDWRMAR WRAP^DDW5
! 43: Q
! 44: ;
! 45: RUB N DDWX
! 46: I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
! 47: ;
! 48: I DDWC=1 D
! 49: . I DDWRW=1 D
! 50: .. I 'DDWA W $C(7)
! 51: .. E D MVBCK^DDW3(1),POS(1,"E","R")
! 52: . E D POS(DDWRW-1,"E","RN")
! 53: E D
! 54: . S DDWC=DDWC-1,$E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN
! 55: . I DDWC-DDWOFS>0 D
! 56: .. D CUP(DDWRW,DDWC-DDWOFS)
! 57: .. I $P(DDGLED,DDGLDEL,6)]"" W $P(DDGLED,DDGLDEL,6)
! 58: .. E W $E(DDWN_" ",DDWC,IOM+DDWOFS) D CUP(DDWRW,DDWC-DDWOFS)
! 59: . E D POS(DDWRW,DDWC)
! 60: Q
! 61: ;
! 62: DEL N DDWX
! 63: I $D(DDWMARK) D CHKDEL^DDW9(.DDWX) Q:DDWX
! 64: ;
! 65: I DDWC>$L(DDWN) D Q
! 66: . I DDWN?." " D
! 67: .. D XLINE^DDW5()
! 68: . E D
! 69: .. N DDWY,DDWX
! 70: .. S DDWY=DDWRW+DDWA,DDWX=DDWC
! 71: .. D JOIN^DDW6
! 72: .. D POS(DDWY-DDWA,DDWX,"RN")
! 73: ;
! 74: S $E(DDWN,DDWC)="",DDWL(DDWRW)=DDWN,DDWX=$E(DDWN,IOM+DDWOFS)
! 75: I $P(DDGLED,DDGLDEL,6)]"" D
! 76: . W $P(DDGLED,DDGLDEL,6)
! 77: . I DDWX]" " D CUP(DDWRW,IOM) W DDWX D CUP(DDWRW,DDWC-DDWOFS)
! 78: E D
! 79: . W $E(DDWN_" ",DDWC,IOM+DDWOFS)
! 80: . D CUP(DDWRW,DDWC-DDWOFS)
! 81: Q
! 82: ;
! 83: STATUS N DDWX,DDWS
! 84: S DDWS="Scr "_(DDWA+DDWRW-1\DDWMR+1)_" of "_(DDWCNT-1\DDWMR+1)
! 85: S DDWX="Ln "_(DDWA+DDWRW)_" of "_DDWCNT
! 86: S $E(DDWS,IOM\2+1-($L(DDWX)\2),999)=DDWX
! 87: S DDWX="Col "_DDWC
! 88: S $E(DDWS,IOM-$L(DDWX),999)=DDWX
! 89: D CUP(DDWMR+2,1) W $P(DDGLCLR,DDGLDEL)_DDWS
! 90: D POS(DDWRW,DDWC)
! 91: Q
! 92: ;
! 93: UP I DDWRW>1 D
! 94: . D POS(DDWRW-1,DDWC,"RN")
! 95: E I DDWA D
! 96: . D MVBCK^DDW3(1)
! 97: E W $C(7)
! 98: I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
! 99: Q
! 100: DN I DDWA+DDWRW'<DDWCNT W $C(7) Q
! 101: I DDWRW<DDWMR D
! 102: . D POS(DDWRW+1,DDWC,"RN")
! 103: E I DDWSTB D
! 104: . D MVFWD^DDW3(1)
! 105: E W $C(7) Q
! 106: I DDWC>246,$L(DDWN)<246 D POS(DDWRW,246,"R")
! 107: Q
! 108: RT I DDWC>245,DDWC>$L(DDWN) W $C(7)
! 109: E D POS(DDWRW,DDWC+1,"R")
! 110: Q
! 111: LT I DDWC=1 D
! 112: . D UP,POS(DDWRW,"E","R")
! 113: E D POS(DDWRW,DDWC-1,"R")
! 114: Q
! 115: ;
! 116: SV G SV^DDW1
! 117: SW D SAVE^DDW1 S DDWFIN="",DIWESW=1 Q
! 118: EX D SAVE^DDW1 S DDWFIN="" Q
! 119: QT S DDWFIN="" Q
! 120: TO D SAVE^DDW1 S DTOUT=1,DDWFIN="" W $C(7) Q
! 121: HLP D HLP^DDWH,POS(DDWRW,DDWC) Q
! 122: ;
! 123: TST G TSET^DDW2
! 124: LST G LSET^DDW2
! 125: RST G RSET^DDW2
! 126: WRM G WRAPM^DDW2
! 127: RPM G REPLM^DDW2
! 128: ST G STAT^DDW2
! 129: ;
! 130: TOP G TOP^DDW3
! 131: BOT G BOT^DDW3
! 132: ;
! 133: PDN G PGDN^DDW4
! 134: PUP G PGUP^DDW4
! 135: TAB G TAB^DDW4
! 136: JLT G JLEFT^DDW4
! 137: JRT G JRIGHT^DDW4
! 138: LB G LBEG^DDW4
! 139: LE G LEND^DDW4
! 140: WRT G WORDR^DDW4
! 141: WLT G WORDL^DDW4
! 142: DLW G DELW^DDW4
! 143: DEOL G DEOL^DDW4
! 144: ;
! 145: BRK D BREAK^DDW5() Q
! 146: XLN D XLINE^DDW5() D:DDWC'=1 POS(DDWRW,1,"R") Q
! 147: ;
! 148: JN G JOIN^DDW6
! 149: RFT G REFMT^DDW6
! 150: ;
! 151: MRK G MARK^DDW7
! 152: UMK G UNMARK^DDW7
! 153: ;
! 154: CPY D COPY^DDW8() Q
! 155: CUT D CUT^DDW8() Q
! 156: PST D PASTE^DDW8() Q
! 157: ;
! 158: FND G FIND^DDWF
! 159: ;
! 160: NXT G NEXT^DDWF
! 161: GTO G GOTO^DDWG
! 162: CHG G CHG^DDWC
! 163: ;
! 164: READ(DDWTO,Y) ;Out: Y = Char or mnemonic
! 165: F D Q:Y'=-1
! 166: . R *Y:DDWTO
! 167: . I Y>31,Y<127 S Y=$C(Y) Q
! 168: . I Y<0 S Y="TO" Q
! 169: . D MNE(.Y)
! 170: Q
! 171: ;
! 172: PREAD(DDWLEN,DDWTO,DDWST,Y) ;
! 173: ;In: DDWLEN = # chars to read
! 174: ;Out: DDWST = String
! 175: ; Y = Mnemonic, Null if DDWLEN chars read or invalid
! 176: X DDGLZOSF("EON")
! 177: R DDWST#DDWLEN:DDWTO E S Y="TO" Q
! 178: X DDGLZOSF("EOFF"),DDGLZOSF("TRMRD")
! 179: I $C(Y)?1C,Y D
! 180: . D MNE(.Y) S:Y=-1 Y=""
! 181: E S Y=""
! 182: Q
! 183: ;
! 184: MNE(Y) ;Out: Y = Mnemonic, or -1 if invalid
! 185: N S,F
! 186: S S="",F=0
! 187: F D MNELOOP Q:F
! 188: Q
! 189: ;
! 190: MNELOOP ;Read more
! 191: S S=S_$C(Y)
! 192: I DDW("IN")'[(U_S) D I Y=-1 D FLUSH Q
! 193: . I $C(Y)'?1L S Y=-1 Q
! 194: . S S=$E(S,1,$L(S)-1)_$C(Y-32)
! 195: . S:DDW("IN")'[(U_S_U) Y=-1
! 196: ;
! 197: I DDW("IN")[(U_S_U),S'=$C(27) D Q
! 198: . S Y=$P(DDW("OUT"),U,$L($P(DDW("IN"),U_S_U),U)),F=1
! 199: ;
! 200: R *Y:5 D:Y=-1 FLUSH
! 201: Q
! 202: ;
! 203: FLUSH ;
! 204: N DDWX
! 205: S F=1 W $C(7) F R *DDWX:0 E Q
! 206: Q
! 207: ;
! 208: CUP(Y,X) ;
! 209: S DY=IOTM+Y-2,DX=X-1 X IOXY
! 210: Q
! 211: ;
! 212: POS(R,C,F) ;Pos cursor based on char pos C
! 213: N DDWX
! 214: S:$G(C)="E" C=$L($G(DDWL(R)))+1
! 215: S:$G(F)["N" DDWN=$G(DDWL(R))
! 216: S:$G(F)["R" DDWRW=R,DDWC=C
! 217: ;
! 218: S DDWX=C-DDWOFS
! 219: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
! 220: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
! 221: Q
! 222: ;
! 223: MIN(X,Y) ;
! 224: Q $S(X<Y:X,1:Y)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDWT1.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman