DIR02 ;SFISC/MKO-MULTILINE FIELD EDITOR ;3:24 PM 29 Aug 1995
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;
N DIR0FL,DIR0LN,DIR0NC,DIR0QU
X DDGLZOSF("EOFF"),DDGLZOSF("TRMON")
W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")
S DIR0QU=0
;
S:$D(DIR0C)#2 DIR0C=DIR0C+1
D INIT,^DIR03
W $P(DDGLVID,DDGLDEL,7)
Q
;
SM ;ScreenMan's entry point, called from ^DIR01
N DIR0DN,DIR0FL,DIR0LN,DIR0NC,DIR0NL
S DIR0R=IOSL-6,DIR0S=0,DIR0L=IOM-1,DIR0NL=4
;
D INIT,^DIR03
;
S:$D(DTOUT) DIR0A=DIR0D
;
;Restore command area
S DY=DIR0R,DX=DIR0S X IOXY
W $P(DDGLVID,DDGLDEL,10)_$P(DDGLCLR,DDGLDEL,3)
;
S DY=IOSL-1
I DDO D
. S DX=0 X IOXY W "COMMAND:"
. S DX=IOM-35 X IOXY W "Press <PF1>H for help"
S DX=IOM-8 X IOXY
W $S('$D(DDGLVAN):$P(DDGLVID,DDGLDEL,6),1:"")_$S($G(DIR0("REP")):"Replace",1:"Insert ")_$P(DDGLVID,DDGLDEL,10)
;
;Restore variables
S (DY,DIR0R)=$P(DIR0,U),(DX,DIR0S)=$P(DIR0,U,2),DIR0L=$P(DIR0,U,3)
S DIR0F=DIR0S+DIR0L
S DIR0SP=$J("",DIR0L) S:$G(DDGLVAN) DIR0SP=$TR(DIR0SP," ","_")
I DIR0A]"","^?"[$E(DIR0A) S DIR0QT=1
;
;Repaint answer
X IOXY
W:'$D(DDGLVAN) $P(DDGLVID,DDGLDEL,6)
I DIR0C>DIR0L D
. W $E(DIR0A,DIR0C-DIR0L+1,DIR0C)_$E(DIR0SP,DIR0C>$L(DIR0A))
. S DX=DIR0F-1
E D
. W $E(DIR0A,1,DIR0L)_$E(DIR0SP,$L(DIR0A)+1,999)
. S DX=DIR0S+DIR0C-1
X IOXY
K DTOUT
Q
;
INIT ;Setup
K DTOUT
S:DIR0M<$L(DIR0A) DIR0M=$L(DIR0A)
S DIR0SP=$J("",DIR0L) S:$G(DDSVAN) DIR0SP=$TR(DIR0SP," ","_")
;
F DIR0LN=1:1:DIR0NL D
. S DY=DIR0R+DIR0LN-1,DX=DIR0S X IOXY
. S X=$E(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
. W X_$E(DIR0SP,$L(X)+1,999)
;
S:DIR0NL*DIR0L-1<DIR0M DIR0M=DIR0NL*DIR0L-1
S DIR0NL=DIR0M\DIR0L+1,DIR0NC=DIR0M#DIR0L
S DIR0F=DIR0S+DIR0L-1,DIR0FL=DIR0S+DIR0NC-1
S DIR0SV=$G(DIR0("L")),DIR0DN=0
;
S DIR0C=$S($G(DIR0C)<1:1,1:DIR0C)
S:DIR0C-1>DIR0M DIR0C=DIR0M+1
S DIR0LN=DIR0C\DIR0L+1
S DY=DIR0R+DIR0LN-1,DX=DIR0S+(DIR0C#DIR0L)-1
X IOXY
Q
;
KILL ;Cleanup all variables
D KILL^DDGLIB0()
Q
DIR02 ;SFISC/MKO-MULTILINE FIELD EDITOR ;3:24 PM 29 Aug 1995
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
EN ;
+1 NEW DIR0FL,DIR0LN,DIR0NC,DIR0QU
+2 XECUTE DDGLZOSF("EOFF")
XECUTE DDGLZOSF("TRMON")
+3 WRITE $SELECT('$DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,6),1:"")
+4 SET DIR0QU=0
+5 ;
+6 IF $DATA(DIR0C)#2
SET DIR0C=DIR0C+1
+7 DO INIT
DO ^DIR03
+8 WRITE $PIECE(DDGLVID,DDGLDEL,7)
+9 QUIT
+10 ;
SM ;ScreenMan's entry point, called from ^DIR01
+1 NEW DIR0DN,DIR0FL,DIR0LN,DIR0NC,DIR0NL
+2 SET DIR0R=IOSL-6
SET DIR0S=0
SET DIR0L=IOM-1
SET DIR0NL=4
+3 ;
+4 DO INIT
DO ^DIR03
+5 ;
+6 IF $DATA(DTOUT)
SET DIR0A=DIR0D
+7 ;
+8 ;Restore command area
+9 SET DY=DIR0R
SET DX=DIR0S
XECUTE IOXY
+10 WRITE $PIECE(DDGLVID,DDGLDEL,10)_$PIECE(DDGLCLR,DDGLDEL,3)
+11 ;
+12 SET DY=IOSL-1
+13 IF DDO
Begin DoDot:1
+14 SET DX=0
XECUTE IOXY
WRITE "COMMAND:"
+15 SET DX=IOM-35
XECUTE IOXY
WRITE "Press <PF1>H for help"
End DoDot:1
+16 SET DX=IOM-8
XECUTE IOXY
+17 WRITE $SELECT('$DATA(DDGLVAN):$PIECE(DDGLVID,DDGLDEL,6),1:"")_$SELECT($GET(DIR0("REP")):"Replace",1:"Insert ")_$PIECE(DDGLVID,DDGLDEL,10)
+18 ;
+19 ;Restore variables
+20 SET (DY,DIR0R)=$PIECE(DIR0,U)
SET (DX,DIR0S)=$PIECE(DIR0,U,2)
SET DIR0L=$PIECE(DIR0,U,3)
+21 SET DIR0F=DIR0S+DIR0L
+22 SET DIR0SP=$JUSTIFY("",DIR0L)
IF $GET(DDGLVAN)
SET DIR0SP=$TRANSLATE(DIR0SP," ","_")
+23 IF DIR0A]""
IF "^?"[$EXTRACT(DIR0A)
SET DIR0QT=1
+24 ;
+25 ;Repaint answer
+26 XECUTE IOXY
+27 IF '$DATA(DDGLVAN)
WRITE $PIECE(DDGLVID,DDGLDEL,6)
+28 IF DIR0C>DIR0L
Begin DoDot:1
+29 WRITE $EXTRACT(DIR0A,DIR0C-DIR0L+1,DIR0C)_$EXTRACT(DIR0SP,DIR0C>$LENGTH(DIR0A))
+30 SET DX=DIR0F-1
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 WRITE $EXTRACT(DIR0A,1,DIR0L)_$EXTRACT(DIR0SP,$LENGTH(DIR0A)+1,999)
+33 SET DX=DIR0S+DIR0C-1
End DoDot:1
+34 XECUTE IOXY
+35 KILL DTOUT
+36 QUIT
+37 ;
INIT ;Setup
+1 KILL DTOUT
+2 IF DIR0M<$LENGTH(DIR0A)
SET DIR0M=$LENGTH(DIR0A)
+3 SET DIR0SP=$JUSTIFY("",DIR0L)
IF $GET(DDSVAN)
SET DIR0SP=$TRANSLATE(DIR0SP," ","_")
+4 ;
+5 FOR DIR0LN=1:1:DIR0NL
Begin DoDot:1
+6 SET DY=DIR0R+DIR0LN-1
SET DX=DIR0S
XECUTE IOXY
+7 SET X=$EXTRACT(DIR0A,DIR0LN-1*DIR0L+1,DIR0LN*DIR0L)
+8 WRITE X_$EXTRACT(DIR0SP,$LENGTH(X)+1,999)
End DoDot:1
+9 ;
+10 IF DIR0NL*DIR0L-1<DIR0M
SET DIR0M=DIR0NL*DIR0L-1
+11 SET DIR0NL=DIR0M\DIR0L+1
SET DIR0NC=DIR0M#DIR0L
+12 SET DIR0F=DIR0S+DIR0L-1
SET DIR0FL=DIR0S+DIR0NC-1
+13 SET DIR0SV=$GET(DIR0("L"))
SET DIR0DN=0
+14 ;
+15 SET DIR0C=$SELECT($GET(DIR0C)<1:1,1:DIR0C)
+16 IF DIR0C-1>DIR0M
SET DIR0C=DIR0M+1
+17 SET DIR0LN=DIR0C\DIR0L+1
+18 SET DY=DIR0R+DIR0LN-1
SET DX=DIR0S+(DIR0C#DIR0L)-1
+19 XECUTE IOXY
+20 QUIT
+21 ;
KILL ;Cleanup all variables
+1 DO KILL^DDGLIB0()
+2 QUIT
