DIR02 ;SFISC/MKO-MULTILINE FIELD EDITOR ;25MAY2004
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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) F DY=DY:1:IOSL-1 K DDSMOUSE(DY)
;
BOT D BOT^DDSCOM
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIR02 2085 printed Apr 09, 2024@21:54:12 Page 2
DIR02 ;SFISC/MKO-MULTILINE FIELD EDITOR ;25MAY2004
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
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)
FOR DY=DY:1:IOSL-1
KILL DDSMOUSE(DY)
+11 ;
BOT DO BOT^DDSCOM
+1 ;Restore variables
+2 SET (DY,DIR0R)=$PIECE(DIR0,U)
SET (DX,DIR0S)=$PIECE(DIR0,U,2)
SET DIR0L=$PIECE(DIR0,U,3)
+3 SET DIR0F=DIR0S+DIR0L
+4 SET DIR0SP=$JUSTIFY("",DIR0L)
if $GET(DDGLVAN)
SET DIR0SP=$TRANSLATE(DIR0SP," ","_")
+5 IF DIR0A]""
IF "^?"[$EXTRACT(DIR0A)
SET DIR0QT=1
+6 ;
+7 ;Repaint answer
+8 XECUTE IOXY
+9 if '$DATA(DDGLVAN)
WRITE $PIECE(DDGLVID,DDGLDEL,6)
+10 IF DIR0C>DIR0L
Begin DoDot:1
+11 WRITE $EXTRACT(DIR0A,DIR0C-DIR0L+1,DIR0C)_$EXTRACT(DIR0SP,DIR0C>$LENGTH(DIR0A))
+12 SET DX=DIR0F-1
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 WRITE $EXTRACT(DIR0A,1,DIR0L)_$EXTRACT(DIR0SP,$LENGTH(DIR0A)+1,999)
+15 SET DX=DIR0S+DIR0C-1
End DoDot:1
+16 XECUTE IOXY
+17 KILL DTOUT
+18 QUIT
+19 ;
+20 ;
+21 ;
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
