- 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
