DIWE12 ;SFISC/XAK,RWF-WORD PROCESSING CHANGE EDITORS ;29MAR2013
;;22.2;VA FileMan;**7**;Jan 05, 2016;Build 3
;;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.
;
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
EGP . ;W:'DWLC !,$J("",$G(DL)*2)_$$EZBLD^DIALOG(8148) ;**CCO/NI "THERE ARE NO LINES" ;p7
. 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 !
E . S DIR(0)="Y",DIR("A")=$J("",$G(DL)*2)_$$EZBLD^DIALOG(8175),DIR("B")="NO",DIR("?")="^D BLD^DIALOG(8176),MSG^DIALOG(""WH"")" ;**CCO/NI 'YES' AND 'NO' HELP
D ^DIR K DIR I '$D(DIRUT),Y=1 D
.X DIWE(0)
E N DIDNEDIT S DIDNEDIT=1 ;DID NOT EDIT, SO DO NOT AUDIT
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 W !,$$EZBLD^DIALOG(8170) R X:DTIME S:'$T DTOUT=1,X=U G AQ:U[X!(X=".") ;**CCO/NI 'SELECT ALTERNATE EDITOR:'
I X'?.UNP S X=$$UP^DILIBF(X) ;**CCO/NI UPPERCASE TRANSLATION
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 !,$$EZBLD^DIALOG(8171) ;**CCO/NI (plus next line) HELP MESSAGE ABOUT CHOOSING AND ALTERNATE EDITOR
I X?2"?".E W $$EZBLD^DIALOG(8172) 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.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIWE12 2818 printed Apr 09, 2024@21:51:27 Page 2
DIWE12 ;SFISC/XAK,RWF-WORD PROCESSING CHANGE EDITORS ;29MAR2013
+1 ;;22.2;VA FileMan;**7**;Jan 05, 2016;Build 3
+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 ;
+7 if $DATA(DIWE(1))
QUIT
SET DIWE(1)=DIWE
DO 1
KILL DIWE(1)
QUIT
+8 ;
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
EGP ;W:'DWLC !,$J("",$G(DL)*2)_$$EZBLD^DIALOG(8148) ;**CCO/NI "THERE ARE NO LINES" ;p7
+1 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 !
E ;**CCO/NI 'YES' AND 'NO' HELP
SET DIR(0)="Y"
SET DIR("A")=$JUSTIFY("",$GET(DL)*2)_$$EZBLD^DIALOG(8175)
SET DIR("B")="NO"
SET DIR("?")="^D BLD^DIALOG(8176),MSG^DIALOG(""WH"")"
End DoDot:1
+1 DO ^DIR
KILL DIR
IF '$DATA(DIRUT)
IF Y=1
Begin DoDot:1
+2 XECUTE DIWE(0)
End DoDot:1
+3 ;DID NOT EDIT, SO DO NOT AUDIT
IF '$TEST
NEW DIDNEDIT
SET DIDNEDIT=1
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 ;**CCO/NI 'SELECT ALTERNATE EDITOR:'
WRITE !,$$EZBLD^DIALOG(8170)
READ X:DTIME
if '$TEST
SET DTOUT=1
SET X=U
if U[X!(X=".")
GOTO AQ
+1 ;**CCO/NI UPPERCASE TRANSLATION
IF X'?.UNP
SET X=$$UP^DILIBF(X)
+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 ;**CCO/NI (plus next line) HELP MESSAGE ABOUT CHOOSING AND ALTERNATE EDITOR
WRITE !,$$EZBLD^DIALOG(8171)
+6 IF X?2"?".E
WRITE $$EZBLD^DIALOG(8172)
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.
