Annotation of freem_fileman/DIR01.m, revision 1.1
1.1 ! snw 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)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIR01.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman