- 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 Mar 13, 2025@21:59:45 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.
