Annotation of freem_fileman/DIR03.m, revision 1.1
1.1 ! snw 1: DIR03 ;SFISC/MKO-MULTILINE FIELD EDITOR ;03:37 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: F D E X IOXY Q:DIR0DN
! 5: Q
! 6: ;
! 7: E I $G(DIR0("REP"))&DIR0C>1!DIR0C>$L(DIR0A),$S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)>DX D
! 8: . D PREAD^DIR01($S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)-DX,.DIR0ST,.DIR0CH)
! 9: . Q:'$L(DIR0ST)
! 10: . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
! 11: . E S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
! 12: . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
! 13: E D READ^DIR01(.DIR0CH)
! 14: Q:DIR0CH=""
! 15: ;
! 16: I "?^"[DIR0CH,DIR0C=1,'DIR0QU D Q
! 17: . D DEOF X IOXY
! 18: . S DIR0A="",DIR0QU=1 D REP
! 19: D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
! 20: I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
! 21: Q
! 22: ;
! 23: REP I DIR0C>DIR0M W $C(7) Q
! 24: S DIR0CHG=1
! 25: S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C+1,999)
! 26: S DIR0C=DIR0C+1
! 27: W DIR0CH
! 28: I DX<DIR0F S DX=DX+1 Q
! 29: S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S Q
! 30: Q
! 31: ;
! 32: INS I $L(DIR0A)'<DIR0M W $C(7) Q
! 33: S DIR0CHG=1
! 34: S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999)
! 35: W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
! 36: D
! 37: . N DIR0LN,DY,DX
! 38: . S DX=DIR0S
! 39: . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
! 40: .. S DY=DIR0R+DIR0LN-1 X IOXY
! 41: .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
! 42: S DIR0C=DIR0C+1
! 43: I DX<DIR0F S DX=DX+1 Q
! 44: S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
! 45: Q
! 46: ;
! 47: RIGHT Q:DIR0C>$L(DIR0A)
! 48: S DIR0C=DIR0C+1
! 49: I DX<DIR0F!(DIR0LN=DIR0NL) S DX=DX+1 Q
! 50: S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
! 51: Q
! 52: ;
! 53: LEFT Q:DIR0C'>1
! 54: S DIR0C=DIR0C-1
! 55: I DX>DIR0S S DX=DX-1 Q
! 56: S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
! 57: Q
! 58: ;
! 59: JRT Q:DIR0C>$L(DIR0A)
! 60: Q:DX=DIR0F
! 61: S DIR0C=DIR0LN*DIR0L S:DIR0C>$L(DIR0A) DIR0C=$L(DIR0A)+1
! 62: S DX=DIR0C#DIR0L-1+DIR0S S:DX<DIR0S DX=DIR0F
! 63: Q
! 64: ;
! 65: JLT Q:DIR0C'>1
! 66: Q:DX=DIR0S
! 67: S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
! 68: Q
! 69: ;
! 70: UP Q:DIR0LN=1
! 71: S DIR0C=DIR0C-DIR0L,DIR0LN=DIR0LN-1,DY=DY-1
! 72: Q
! 73: ;
! 74: DOWN Q:DIR0LN=DIR0NL
! 75: Q:$L(DIR0A)\DIR0L<DIR0LN
! 76: S DIR0C=DIR0C+DIR0L,DIR0LN=DIR0LN+1,DY=DY+1
! 77: S:DIR0C>($L(DIR0A)+1) DIR0C=$L(DIR0A)+1,DX=DIR0C#DIR0L+DIR0S-1
! 78: Q
! 79: ;
! 80: FDE ;
! 81: NP Q:DIR0C>$L(DIR0A)
! 82: S DIR0C=$L(DIR0A)+1,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
! 83: S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
! 84: S DY=DIR0R+DIR0LN-1
! 85: Q
! 86: ;
! 87: FDB ;
! 88: PP Q:DIR0C'>1
! 89: S DIR0LN=1,DY=DIR0R,DX=DIR0S,DIR0C=1
! 90: Q
! 91: ;
! 92: BS Q:DIR0C'>1
! 93: S DIR0CHG=1
! 94: S DX=DX-1,DIR0C=DIR0C-1
! 95: S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
! 96: I DX<DIR0S S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
! 97: X IOXY W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
! 98: D
! 99: . N DIR0LN,DY,DX
! 100: . S DX=DIR0S
! 101: . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
! 102: .. S DY=DIR0R+DIR0LN-1 X IOXY
! 103: .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
! 104: S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
! 105: Q
! 106: ;
! 107: DEL Q:DIR0C>$L(DIR0A)
! 108: S DIR0CHG=1
! 109: S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
! 110: W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
! 111: D
! 112: . N DIR0LN,DY,DX
! 113: . S DX=DIR0S
! 114: . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
! 115: .. S DY=DIR0R+DIR0LN-1 X IOXY
! 116: .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
! 117: S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
! 118: Q
! 119: ;
! 120: CLR N %X
! 121: S DIR0CHG=1
! 122: S %X=DIR0A
! 123: I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
! 124: S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
! 125: S %X=DIR0A_$J("",$L(%X)-$L(DIR0A))
! 126: S DX=DIR0S
! 127: F DIR0LN=1:1:$L(%X)\DIR0L+1 D
! 128: . S DY=DIR0R+DIR0LN-1 X IOXY
! 129: . W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
! 130: S (DIR0C,DIR0LN)=1,DY=DIR0R
! 131: Q
! 132: ;
! 133: DEOF N %X
! 134: Q:DIR0C>$L(DIR0A)
! 135: S DIR0CHG=1
! 136: S %X=DIR0A,DIR0A=$E(DIR0A,1,DIR0C-1),%X=DIR0A_$J("",$L(%X)-$L(DIR0A))
! 137: W $E(%X,DIR0C,DIR0C+DIR0F-DX)
! 138: D
! 139: . N DIR0LN,DY,DX
! 140: . S DX=DIR0S
! 141: . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(%X)\DIR0L+1 D
! 142: .. S DY=DIR0R+DIR0LN-1 X IOXY
! 143: .. W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
! 144: Q
! 145: ;
! 146: RPM N DX,DY
! 147: I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
! 148: I $G(DIR0("REP")) W "Insert " K DIR0("REP")
! 149: E W "Replace" S DIR0("REP")=1
! 150: Q
! 151: ;
! 152: KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
! 153: E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
! 154: Q
! 155: ;
! 156: WRT G WRT2^DIR0W
! 157: WLT ;
! 158: FDL G WLT2^DIR0W
! 159: DLW G DLW2^DIR0W
! 160: ;
! 161: HLP ;
! 162: NB ;
! 163: SEL ;
! 164: SV ;
! 165: RF ;
! 166: NOP W $C(7)
! 167: Q
! 168: TO S DTOUT=1,DIR0A=DIR0D
! 169: ZM ;
! 170: QT ;
! 171: EX ;
! 172: CL ;
! 173: TAB ;
! 174: CR S DIR0DN=1
! 175: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIR03.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman