Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIR03

DIR03.m

Go to the documentation of this file.
  1. DIR03 ;SFISC/MKO-MULTILINE FIELD EDITOR ;11OCT2004
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. F D E X IOXY Q:DIR0DN!$G(DIR0QT)
  1. Q
  1. ;
  1. E I $G(DIR0("REP"))&DIR0C>1!(DIR0C>$L(DIR0A)),$S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)>DX,'$D(DIR0KD) D
  1. . D PREAD^DIR01($S(DIR0LN<DIR0NL:DIR0F,1:DIR0FL)-DX,.DIR0ST,.DIR0CH)
  1. . Q:'$L(DIR0ST)
  1. . I '$G(DIR0("REP")) S DIR0A=DIR0A_DIR0ST
  1. . E S $E(DIR0A,DIR0C,DIR0C+$L(DIR0ST)-1)=DIR0ST
  1. . S DX=DX+$L(DIR0ST),DIR0C=DIR0C+$L(DIR0ST)
  1. E D READ^DIR01(.DIR0CH)
  1. Q:DIR0CH=""
  1. ;
  1. I "?^"[DIR0CH,DIR0C=1,'DIR0QU D Q
  1. . D DEOF X IOXY
  1. . S DIR0A="",DIR0QU=1 D REP
  1. D @$S($L(DIR0CH)>1:DIR0CH,$G(DIR0("REP")):"REP",1:"INS")
  1. I DIR0QU,"?^"'[$E(DIR0A)!'$L(DIR0A) S DIR0QU=0,DIR0A="" D CLR
  1. Q
  1. ;
  1. REP I DIR0C>DIR0M W $C(7) Q
  1. S DIR0CHG=1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C+1,999)
  1. S DIR0C=DIR0C+1
  1. W DIR0CH
  1. I DX<DIR0F S DX=DX+1 Q
  1. S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S Q
  1. Q
  1. ;
  1. INS I $L(DIR0A)'<DIR0M W $C(7) Q
  1. S DIR0CHG=1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_DIR0CH_$E(DIR0A,DIR0C,999)
  1. W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
  1. D
  1. . N DIR0LN,DY,DX
  1. . S DX=DIR0S
  1. . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
  1. .. S DY=DIR0R+DIR0LN-1 X IOXY
  1. .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
  1. S DIR0C=DIR0C+1
  1. I DX<DIR0F S DX=DX+1 Q
  1. S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
  1. Q
  1. ;
  1. S DIR0C=DIR0C+1
  1. I DX<DIR0F!(DIR0LN=DIR0NL) S DX=DX+1 Q
  1. S DIR0LN=DIR0LN+1,DY=DY+1,DX=DIR0S
  1. Q
  1. ;
  1. LEFT Q:DIR0C'>1
  1. S DIR0C=DIR0C-1
  1. I DX>DIR0S S DX=DX-1 Q
  1. S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
  1. Q
  1. ;
  1. JRT Q:DIR0C>$L(DIR0A)
  1. Q:DX=DIR0F
  1. S DIR0C=DIR0LN*DIR0L S:DIR0C>$L(DIR0A) DIR0C=$L(DIR0A)+1
  1. S DX=DIR0C#DIR0L-1+DIR0S S:DX<DIR0S DX=DIR0F
  1. Q
  1. ;
  1. JLT Q:DIR0C'>1
  1. Q:DX=DIR0S
  1. S DIR0C=DIR0C-DX+DIR0S,DX=DIR0S
  1. Q
  1. ;
  1. UP Q:DIR0LN=1
  1. S DIR0C=DIR0C-DIR0L,DIR0LN=DIR0LN-1,DY=DY-1
  1. Q
  1. ;
  1. DOWN Q:DIR0LN=DIR0NL
  1. Q:$L(DIR0A)\DIR0L<DIR0LN
  1. S DIR0C=DIR0C+DIR0L,DIR0LN=DIR0LN+1,DY=DY+1
  1. S:DIR0C>($L(DIR0A)+1) DIR0C=$L(DIR0A)+1,DX=DIR0C#DIR0L+DIR0S-1
  1. Q
  1. ;
  1. FDE ;
  1. NP Q:DIR0C>$L(DIR0A)
  1. S DIR0C=$L(DIR0A)+1,DIR0LN=DIR0C-1\DIR0L+1,DX=DIR0C-1#DIR0L+DIR0S
  1. S:DIR0LN>DIR0NL DIR0LN=DIR0NL,DX=DIR0S+DIR0NC
  1. S DY=DIR0R+DIR0LN-1
  1. Q
  1. ;
  1. FDB ;
  1. PP Q:DIR0C'>1
  1. S DIR0LN=1,DY=DIR0R,DX=DIR0S,DIR0C=1
  1. Q
  1. ;
  1. BS Q:DIR0C'>1
  1. S DIR0CHG=1
  1. S DX=DX-1,DIR0C=DIR0C-1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
  1. I DX<DIR0S S DIR0LN=DIR0LN-1,DY=DY-1,DX=DIR0F
  1. X IOXY W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
  1. D
  1. . N DIR0LN,DY,DX
  1. . S DX=DIR0S
  1. . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
  1. .. S DY=DIR0R+DIR0LN-1 X IOXY
  1. .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
  1. S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
  1. Q
  1. ;
  1. DEL Q:DIR0C>$L(DIR0A)
  1. S DIR0CHG=1
  1. S DIR0A=$E(DIR0A,1,DIR0C-1)_$E(DIR0A,DIR0C+1,999)_" "
  1. W $E(DIR0A,DIR0C,DIR0C+DIR0F-DX)
  1. D
  1. . N DIR0LN,DY,DX
  1. . S DX=DIR0S
  1. . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(DIR0A)\DIR0L+1 D
  1. .. S DY=DIR0R+DIR0LN-1 X IOXY
  1. .. W $E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
  1. S DIR0A=$E(DIR0A,1,$L(DIR0A)-1)
  1. Q
  1. ;
  1. CLR N %X
  1. S DIR0CHG=1
  1. S %X=DIR0A
  1. I DIR0A]"",DIR0A'=DIR0D S DIR0SV=DIR0A
  1. S DIR0A=$S(DIR0A=DIR0D:DIR0SV,DIR0A="":DIR0D,1:"")
  1. S %X=DIR0A_$J("",$L(%X)-$L(DIR0A))
  1. S DX=DIR0S
  1. F DIR0LN=1:1:$L(%X)\DIR0L+1 D
  1. . S DY=DIR0R+DIR0LN-1 X IOXY
  1. . W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
  1. S (DIR0C,DIR0LN)=1,DY=DIR0R
  1. Q
  1. ;
  1. DEOF N %X
  1. Q:DIR0C>$L(DIR0A)
  1. S DIR0CHG=1
  1. S %X=DIR0A,DIR0A=$E(DIR0A,1,DIR0C-1),%X=DIR0A_$J("",$L(%X)-$L(DIR0A))
  1. W $E(%X,DIR0C,DIR0C+DIR0F-DX)
  1. D
  1. . N DIR0LN,DY,DX
  1. . S DX=DIR0S
  1. . F DIR0LN=DIR0C-1\DIR0L+2:1:$L(%X)\DIR0L+1 D
  1. .. S DY=DIR0R+DIR0LN-1 X IOXY
  1. .. W $E(%X,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
  1. Q
  1. ;
  1. RPM N DX,DY
  1. I $D(DDS) S DX=IOM-8,DY=IOSL-1 X IOXY
  1. I $G(DIR0("REP")) W "Insert " K DIR0("REP")
  1. E W "Replace" S DIR0("REP")=1
  1. Q
  1. ;
  1. KPM I $G(DDGLKPNM) K DDGLKPNM W $P(DDGLED,DDGLDEL,9)
  1. E S DDGLKPNM=1 W $P(DDGLED,DDGLDEL,10)
  1. Q
  1. ;
  1. WRT G WRT2^DIR0W
  1. WLT ;
  1. FDL G WLT2^DIR0W
  1. DLW G DLW2^DIR0W
  1. ;
  1. HLP ;
  1. NB ;
  1. SEL ;
  1. SV ;
  1. RF ;
  1. NOP W $C(7)
  1. Q
  1. TO I $D(DIR0TO)#2 D @DIR0TO Q
  1. S DTOUT=1
  1. ZM ;
  1. QT ;
  1. EX ;
  1. CL ;
  1. TAB ;
  1. CR S DIR0DN=1
  1. Q
  1. ;
  1. MOUSEDN N % R *%,*%
  1. Q
  1. MOUSE G MOUSE^DIR01