DIWE1 ;SFISC/GFT-WORD PROCESSING FUNCTION ;4JUN2008
;;22.0;VA FileMan;**159**;Mar 30, 1999;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
G X:$D(DTOUT) I '$D(DWL) S I=DWLC,J=$S(I<11:1,1:I-8) W:J>1 ?7,". . .",!?7,". . ." D LL
1 G X:$D(DTOUT) R !,"EDIT Option: ",X:DTIME S:'$T DTOUT=1 G X:U[X!(X=".")
LC I X?1L S X=$C($A(X)-32)
S J="^DOPT(""DIWE1""," I X?1U S I=$F(DWO,X)-1 I I>0 S ^DISV(DUZ,J)=I S I=I*2-1 G OPT
I X=" ",$D(^DISV(DUZ,J)) S I=^(J),X=$E(DWO,I) I X]"" W X S I=I*2-1 G OPT
I X?1N.N S I=9 D LN G E2:X W "OR"
W !?5,"Choose, by first letter, a Word Processing Command"
I X?2"?".E W " from the following:" F I=1:2 S Y=$T(OPT+I),J=$E(Y,1) Q:J=" " I DWO[J W !?10,$P(Y,";",4)
W !?5,"or type a Line Number to edit that line." G 1
;
OPT Q:$D(DTOUT) S X1=$T(OPT+I),X=$P(X1,";",3) W $E(X,'$X)_$E(X,2,99) G @$E(X1,1)
A ;;Add lines;Add Lines to End of Text
D ^DIWE2 S (DWL,DWLC)=DWI,@(DIC_"0)=DWLC") G 1:DWLC,X
B ;;Break line: ;Break a Line into Two;
D RD G B^DIWE4
C ;;Change every: ;Change Every String to Another in a Range of Lines;
G C^DIWE2
D ;;Delete from line: ;Delete Line(s);
D RD G D^DIWE3
E ;;Edit line: ;Edit a Line (Replace __ With __);
D RD G OPT:X="",1:X=U,LC:X?1A,E2
G ;;Get Data from Another Source ;Get Data from Another Source
G X^DIWE5
I ;;Insert after line: ;Insert Line(s) after an Existing Line;
D RD G I^DIWE2
J ;;Join line: ;Join Line to the One Following;
D RD G J^DIWE4
L ;;List line: ;List a Range of Lines;
S DIWELAST=$S($G(DIWELAST):DIWELAST,1:1) W DIWELAST_"//" R X:DTIME S:'$T X=U,DTOUT=1 S:X="" X=DIWELAST D LN G LIST:X,1:X=U W !,$P(X1,";",3) G L
M ;;Move line: ;Move Lines to New Location within Text;
D RD G M^DIWE3
P ;;Print from Line: 1//;Print Lines as Formatted Output;
R X:DTIME S:'$T X=U,DTOUT=1 S:X="" X=1 D LN,^DIWE4:X G 1
R ;;Repeat line: ;Repeat Lines at a New Location
D RD G R^DIWE3
S ;;Search for: ;Search for a String
G S^DIWE2
T ;;Transfer incoming text after line: ;Transfer Lines From Another Document
D RD,Z^DIWE3 G DIWE1
U ;;Utilities in Word-Processing;Utility Sub-Menu
D ^DIWE11 G 1
Y ;;Y;Y-Programmer Edit;
G Y^DIWE4
;;
E2 S Y=^(0) S:Y="" Y=" " W !,$J(DWL,3)_">"_Y,! S DIRWP=1 D RW^DIR2 K DIRWP G E2:X?1."?",X:X?1."^"
TAB I X[$C(9) S X=$P(X,$C(9),1)_$C(124)_"TAB"_$C(124)_$P(X,$C(9),2,999) G TAB
S:X]"" ^(0)=X
;check if line is greater than max, DWLW, break line up and treat as an insert
I $L(X)>DWLW D
. N I,J,DIC1
. K ^UTILITY($J,"W") S DIC1=DIC,DIC="^UTILITY($J,""W"",",@(DIC_"0)")=""
. F DWI=1:1 Q:$L(X)'>DWLW S J=$F(X,"",DWLW-7),J=$S(J<1!(J>DWLW):DWLW,1:J),@(DIC_"DWI,0)")=$E(X,1,J-1),X=$E(X,J,256)
. S @(DIC_"DWI,0)")=X
. W !,(DWI-1)_" line"_$E("s",DWI>2)_" inserted.."
. X "F J=DWL+1:1:DWLC S DWI=DWI+1,"_DIC_"DWI,0)="_DIC1_"J,0) W ""."""
. S I=DWL X "F J=1:1 Q:'$D("_DIC_"J,0)) S "_DIC1_"I,0)=^(0),I=I+1 W ""."""
. S DWLC=I-1,DIC=DIC1 K ^UTILITY($J,"W")
E I X="@" S (DW1,DW2)=DWL W "DELETED..." D DEL^DIWE3
W ! S I=9 G OPT
;
RD R X:DTIME S:'$T DTOUT=1 I X?1."?" W !?5,"Enter a line number from 1 through "_DWLC,!!,$P(X1,";",3) G RD
LN I U[X!(X=".") S X=U Q
Q:I=9&(X?1A) I 'DWLC,I<27,I-13 S X=U W " THERE ARE NO LINES!",$C(7),! Q
I "+- "[$E(X,1),X?1P.N,$D(DWL) S:X?1P X=X_1 S X=X+DWL W " "_X
E S X=+X
I (I=13!(I=27)&(X=0))!$D(@(DIC_"X,0)")) S DWL=X Q
S X="" G LNQ^DIWE5
;
X K DIWELAST
G X^DIWE
;
LIST W " to: "_DWLC_"// " R I:DTIME S:'$T DTOUT=1 S I=$S(I="":DWLC,1:I) I I,I>DWLC!(I<1) S I=DWLC
S J=X,DIWELAST=$S(DWLC=I:1,1:I) D LL G 1
LL X "F J=J:1:I W !,$J(J,3)_"">""_"_DIC_"J,0)"
DIWE1 ;SFISC/GFT-WORD PROCESSING FUNCTION ;4JUN2008
+1 ;;22.0;VA FileMan;**159**;Mar 30, 1999;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 IF $DATA(DTOUT)
GOTO X
IF '$DATA(DWL)
SET I=DWLC
SET J=$SELECT(I<11:1,1:I-8)
IF J>1
WRITE ?7,". . .",!?7,". . ."
DO LL
1 IF $DATA(DTOUT)
GOTO X
READ !,"EDIT Option: ",X:DTIME
IF '$TEST
SET DTOUT=1
IF U[X!(X=".")
GOTO X
LC IF X?1L
SET X=$CHAR($ASCII(X)-32)
+1 SET J="^DOPT(""DIWE1"","
IF X?1U
SET I=$FIND(DWO,X)-1
IF I>0
SET ^DISV(DUZ,J)=I
SET I=I*2-1
GOTO OPT
+2 IF X=" "
IF $DATA(^DISV(DUZ,J))
SET I=^(J)
SET X=$EXTRACT(DWO,I)
IF X]""
WRITE X
SET I=I*2-1
GOTO OPT
+3 IF X?1N.N
SET I=9
DO LN
IF X
GOTO E2
WRITE "OR"
+4 WRITE !?5,"Choose, by first letter, a Word Processing Command"
+5 IF X?2"?".E
WRITE " from the following:"
FOR I=1:2
SET Y=$TEXT(OPT+I)
SET J=$EXTRACT(Y,1)
IF J=" "
QUIT
IF DWO[J
WRITE !?10,$PIECE(Y,";",4)
+6 WRITE !?5,"or type a Line Number to edit that line."
GOTO 1
+7 ;
OPT IF $DATA(DTOUT)
QUIT
SET X1=$TEXT(OPT+I)
SET X=$PIECE(X1,";",3)
WRITE $EXTRACT(X,'$X)_$EXTRACT(X,2,99)
GOTO @$EXTRACT(X1,1)
A ;;Add lines;Add Lines to End of Text
+1 DO ^DIWE2
SET (DWL,DWLC)=DWI
SET @(DIC_"0)=DWLC")
IF DWLC
GOTO 1
GOTO X
B ;;Break line: ;Break a Line into Two;
+1 DO RD
GOTO B^DIWE4
C ;;Change every: ;Change Every String to Another in a Range of Lines;
+1 GOTO C^DIWE2
D ;;Delete from line: ;Delete Line(s);
+1 DO RD
GOTO D^DIWE3
E ;;Edit line: ;Edit a Line (Replace __ With __);
+1 DO RD
IF X=""
GOTO OPT
IF X=U
GOTO 1
IF X?1A
GOTO LC
GOTO E2
G ;;Get Data from Another Source ;Get Data from Another Source
+1 GOTO X^DIWE5
I ;;Insert after line: ;Insert Line(s) after an Existing Line;
+1 DO RD
GOTO I^DIWE2
J ;;Join line: ;Join Line to the One Following;
+1 DO RD
GOTO J^DIWE4
L ;;List line: ;List a Range of Lines;
+1 SET DIWELAST=$SELECT($GET(DIWELAST):DIWELAST,1:1)
WRITE DIWELAST_"//"
READ X:DTIME
IF '$TEST
SET X=U
SET DTOUT=1
IF X=""
SET X=DIWELAST
DO LN
IF X
GOTO LIST
IF X=U
GOTO 1
WRITE !,$PIECE(X1,";",3)
GOTO L
M ;;Move line: ;Move Lines to New Location within Text;
+1 DO RD
GOTO M^DIWE3
P ;;Print from Line: 1//;Print Lines as Formatted Output;
+1 READ X:DTIME
IF '$TEST
SET X=U
SET DTOUT=1
IF X=""
SET X=1
DO LN
IF X
DO ^DIWE4
GOTO 1
R ;;Repeat line: ;Repeat Lines at a New Location
+1 DO RD
GOTO R^DIWE3
S ;;Search for: ;Search for a String
+1 GOTO S^DIWE2
T ;;Transfer incoming text after line: ;Transfer Lines From Another Document
+1 DO RD
DO Z^DIWE3
GOTO DIWE1
U ;;Utilities in Word-Processing;Utility Sub-Menu
+1 DO ^DIWE11
GOTO 1
Y ;;Y;Y-Programmer Edit;
+1 GOTO Y^DIWE4
+2 ;;
E2 SET Y=^(0)
IF Y=""
SET Y=" "
WRITE !,$JUSTIFY(DWL,3)_">"_Y,!
SET DIRWP=1
DO RW^DIR2
KILL DIRWP
IF X?1."?"
GOTO E2
IF X?1."^"
GOTO X
TAB IF X[$CHAR(9)
SET X=$PIECE(X,$CHAR(9),1)_$CHAR(124)_"TAB"_$CHAR(124)_$PIECE(X,$CHAR(9),2,999)
GOTO TAB
+1 IF X]""
SET ^(0)=X
+2 ;check if line is greater than max, DWLW, break line up and treat as an insert
+3 IF $LENGTH(X)>DWLW
Begin DoDot:1
+4 NEW I,J,DIC1
+5 KILL ^UTILITY($JOB,"W")
SET DIC1=DIC
SET DIC="^UTILITY($J,""W"","
SET @(DIC_"0)")=""
+6 FOR DWI=1:1
IF $LENGTH(X)'>DWLW
QUIT
SET J=$FIND(X,"",DWLW-7)
SET J=$SELECT(J<1!(J>DWLW):DWLW,1:J)
SET @(DIC_"DWI,0)")=$EXTRACT(X,1,J-1)
SET X=$EXTRACT(X,J,256)
+7 SET @(DIC_"DWI,0)")=X
+8 WRITE !,(DWI-1)_" line"_$EXTRACT("s",DWI>2)_" inserted.."
+9 XECUTE "F J=DWL+1:1:DWLC S DWI=DWI+1,"_DIC_"DWI,0)="_DIC1_"J,0) W ""."""
+10 SET I=DWL
XECUTE "F J=1:1 Q:'$D("_DIC_"J,0)) S "_DIC1_"I,0)=^(0),I=I+1 W ""."""
+11 SET DWLC=I-1
SET DIC=DIC1
KILL ^UTILITY($JOB,"W")
End DoDot:1
+12 IF '$TEST
IF X="@"
SET (DW1,DW2)=DWL
WRITE "DELETED..."
DO DEL^DIWE3
+13 WRITE !
SET I=9
GOTO OPT
+14 ;
RD READ X:DTIME
IF '$TEST
SET DTOUT=1
IF X?1."?"
WRITE !?5,"Enter a line number from 1 through "_DWLC,!!,$PIECE(X1,";",3)
GOTO RD
LN IF U[X!(X=".")
SET X=U
QUIT
+1 IF I=9&(X?1A)
QUIT
IF 'DWLC
IF I<27
IF I-13
SET X=U
WRITE " THERE ARE NO LINES!",$CHAR(7),!
QUIT
+2 IF "+- "[$EXTRACT(X,1)
IF X?1P.N
IF $DATA(DWL)
IF X?1P
SET X=X_1
SET X=X+DWL
WRITE " "_X
+3 IF '$TEST
SET X=+X
+4 IF (I=13!(I=27)&(X=0))!$DATA(@(DIC_"X,0)"))
SET DWL=X
QUIT
+5 SET X=""
GOTO LNQ^DIWE5
+6 ;
X KILL DIWELAST
+1 GOTO X^DIWE
+2 ;
LIST WRITE " to: "_DWLC_"// "
READ I:DTIME
IF '$TEST
SET DTOUT=1
SET I=$SELECT(I="":DWLC,1:I)
IF I
IF I>DWLC!(I<1)
SET I=DWLC
+1 SET J=X
SET DIWELAST=$SELECT(DWLC=I:1,1:I)
DO LL
GOTO 1
LL XECUTE "F J=J:1:I W !,$J(J,3)_"">""_"_DIC_"J,0)"