- 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 Feb 19, 2025@00:20:03 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