DIWE12 ;SFISC/XAK,RWF-WORD PROCESSING CHANGE EDITORS ;11:21 AM 5 Mar 1999
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
Q:$D(DIWE(1)) S DIWE(1)=DIWE D 1 K DIWE(1) Q
;
1 I '$D(DIWE(9)) D ASK G QX:U[X
2 S DIWE=DIWE(9) K DIWE(9) I $D(DIWE(1)),DIWE=DIWE(1) K DIWE(1) Q
OPT S DIWE(5)=$G(^DIST(1.2,DIWE,2)) I DIWE(5)]"" X DIWE(5) I '$T S:$D(DIWE(2)) DIWE(9)=1 G 1 ;Not valid
Q:$D(DTOUT) S @(DIC_"0)")=DWLC,DIWE(0)=$S($D(^DIST(1.2,DIWE,1)):^(1),1:"") I $G(DIWE)=1!$D(DDS)!$D(DIWE(1))!($G(DWPK)'="FM"&($D(DIWEPSE)[0)) X DIWE(0) G QQ
K DIR I $G(DWPK)'="FM" S DIR(0)="E"
E D
. N I,J
. W:'DWLC !,$J("",$G(DL)*2)_"No existing text"
. I DWLC S I=DWLC,J=$S(I<11:1,1:I-8) W:J>1 ?7,". . .",!?7,". . ." X "F J=J:1:I W !,"_DIC_"J,0)" W !
. S DIR(0)="Y",DIR("A")=$J("",$G(DL)*2)_"Edit",DIR("B")="NO",DIR("?",1)=" Enter 'YES' if you wish to go into the editor.",DIR("?")=" Enter 'NO' if you do not wish to edit at this time."
. Q
D ^DIR K DIR I '$D(DIRUT),Y=1 X DIWE(0)
QQ K DIWEPSE,DUOUT I $D(DIWE(1)) S DIWE=DIWE(1),DIWE(5)=$G(^DIST(1.2,DIWE,3)) X:DIWE(5)]"" DIWE(5)
QX K DWOU I $D(DIWESW) K DIWESW G:'$D(DIWE(1)) 1
D:$D(DIWE(2)) X^DIWE Q
;
ASK R !,"Select ALTERNATE EDITOR: ",X:DTIME S:'$T DTOUT=1,X=U G AQ:U[X!(X=".")
I X'?.UNP S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S Y=X I X?1U.ANP,'$D(^DIST(1.2,"B",X)) S X=$O(^(X)) S:$E(X,1,$L(Y))'=Y X="?"
S J="^DIST(1.2," I X?1U.UNP S I=$O(^DIST(1.2,"B",X,0)) I I>0 S ^DISV(DUZ,J)=I,DIWE(9)=I W $P(X,Y,2) G AX
I X=" ",$D(^DISV(DUZ,J)) S I=^(J) I $D(^DIST(1.2,I,0))#2 S DIWE(9)=I,X=$P(^(0),U,1) W X G AX
W !?5,"Choose an Alternate Editor"
I X?2"?".E W " from the following:" S Y="" F I=0:0 S Y=$O(^DIST(1.2,"B",Y)) Q:Y']"" S DIWE=+$O(^(Y,0)),DIWE(5)=$G(^DIST(1.2,DIWE,2)) I 1 X:DIWE(5)]"" DIWE(5) I $T W !?10,Y
G ASK
AQ S X=U
AX Q
;
;DIC is the root of the where the text is located.
;DWLC is the line count, must be updated by the editor.
;The @(DIC_"0)") node will be updated by DIWE on exit.
;Variables not to be changed:
;DWHD,DIWPT,DWO,DWLR,DWL,DWPK,DWAFT,DIWE
;DIWE = Pointer to current editor
;DIWE(0) = Calling code
;DIWE(1) = if $D Called from this editor, will return at end.
;DIWE(2) = if $D Flag to say prefered editor not R/W used in exit.
;DIWE(5) = if $D Other execute code for OK TO RUN, RETURN TO CALLING
;DIWE(9) = if $D then entry number of editor to switch to.
DIWE12 ;SFISC/XAK,RWF-WORD PROCESSING CHANGE EDITORS ;11:21 AM 5 Mar 1999
+1 ;;22.0;VA FileMan;;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 IF $DATA(DIWE(1))
QUIT
SET DIWE(1)=DIWE
DO 1
KILL DIWE(1)
QUIT
+4 ;
1 IF '$DATA(DIWE(9))
DO ASK
IF U[X
GOTO QX
2 SET DIWE=DIWE(9)
KILL DIWE(9)
IF $DATA(DIWE(1))
IF DIWE=DIWE(1)
KILL DIWE(1)
QUIT
OPT ;Not valid
SET DIWE(5)=$GET(^DIST(1.2,DIWE,2))
IF DIWE(5)]""
XECUTE DIWE(5)
IF '$TEST
IF $DATA(DIWE(2))
SET DIWE(9)=1
GOTO 1
+1 IF $DATA(DTOUT)
QUIT
SET @(DIC_"0)")=DWLC
SET DIWE(0)=$SELECT($DATA(^DIST(1.2,DIWE,1)):^(1),1:"")
IF $GET(DIWE)=1!$DATA(DDS)!$DATA(DIWE(1))!($GET(DWPK)'="FM"&($DATA(DIWEPSE)[0))
XECUTE DIWE(0)
GOTO QQ
+2 KILL DIR
IF $GET(DWPK)'="FM"
SET DIR(0)="E"
+3 IF '$TEST
Begin DoDot:1
+4 NEW I,J
+5 IF 'DWLC
WRITE !,$JUSTIFY("",$GET(DL)*2)_"No existing text"
+6 IF DWLC
SET I=DWLC
SET J=$SELECT(I<11:1,1:I-8)
IF J>1
WRITE ?7,". . .",!?7,". . ."
XECUTE "F J=J:1:I W !,"_DIC_"J,0)"
WRITE !
+7 SET DIR(0)="Y"
SET DIR("A")=$JUSTIFY("",$GET(DL)*2)_"Edit"
SET DIR("B")="NO"
SET DIR("?",1)=" Enter 'YES' if you wish to go into the editor."
SET DIR("?")=" Enter 'NO' if you do not wish to edit at this time."
+8 QUIT
End DoDot:1
+9 DO ^DIR
KILL DIR
IF '$DATA(DIRUT)
IF Y=1
XECUTE DIWE(0)
QQ KILL DIWEPSE,DUOUT
IF $DATA(DIWE(1))
SET DIWE=DIWE(1)
SET DIWE(5)=$GET(^DIST(1.2,DIWE,3))
IF DIWE(5)]""
XECUTE DIWE(5)
QX KILL DWOU
IF $DATA(DIWESW)
KILL DIWESW
IF '$DATA(DIWE(1))
GOTO 1
+1 IF $DATA(DIWE(2))
DO X^DIWE
QUIT
+2 ;
ASK READ !,"Select ALTERNATE EDITOR: ",X:DTIME
IF '$TEST
SET DTOUT=1
SET X=U
IF U[X!(X=".")
GOTO AQ
+1 IF X'?.UNP
SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 SET Y=X
IF X?1U.ANP
IF '$DATA(^DIST(1.2,"B",X))
SET X=$ORDER(^(X))
IF $EXTRACT(X,1,$LENGTH(Y))'=Y
SET X="?"
+3 SET J="^DIST(1.2,"
IF X?1U.UNP
SET I=$ORDER(^DIST(1.2,"B",X,0))
IF I>0
SET ^DISV(DUZ,J)=I
SET DIWE(9)=I
WRITE $PIECE(X,Y,2)
GOTO AX
+4 IF X=" "
IF $DATA(^DISV(DUZ,J))
SET I=^(J)
IF $DATA(^DIST(1.2,I,0))#2
SET DIWE(9)=I
SET X=$PIECE(^(0),U,1)
WRITE X
GOTO AX
+5 WRITE !?5,"Choose an Alternate Editor"
+6 IF X?2"?".E
WRITE " from the following:"
SET Y=""
FOR I=0:0
SET Y=$ORDER(^DIST(1.2,"B",Y))
IF Y']""
QUIT
SET DIWE=+$ORDER(^(Y,0))
SET DIWE(5)=$GET(^DIST(1.2,DIWE,2))
IF 1
IF DIWE(5)]""
XECUTE DIWE(5)
IF $TEST
WRITE !?10,Y
+7 GOTO ASK
AQ SET X=U
AX QUIT
+1 ;
+2 ;DIC is the root of the where the text is located.
+3 ;DWLC is the line count, must be updated by the editor.
+4 ;The @(DIC_"0)") node will be updated by DIWE on exit.
+5 ;Variables not to be changed:
+6 ;DWHD,DIWPT,DWO,DWLR,DWL,DWPK,DWAFT,DIWE
+7 ;DIWE = Pointer to current editor
+8 ;DIWE(0) = Calling code
+9 ;DIWE(1) = if $D Called from this editor, will return at end.
+10 ;DIWE(2) = if $D Flag to say prefered editor not R/W used in exit.
+11 ;DIWE(5) = if $D Other execute code for OK TO RUN, RETURN TO CALLING
+12 ;DIWE(9) = if $D then entry number of editor to switch to.
