DIWE1 ;SFISC/GFT-WORD PROCESSING FUNCTION ;4JUN2008
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;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.
;
;**CCO/NI THIS ROUTINE THOROUGHLY CHANGED DIALOGS #9150-9175 ARE NOW USED AS THE OPTIONS
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) D G X:'$D(X)
.N DIR,DIRUT,DDS
.S DIR(0)="FO",DIR("A")=$$EZBLD^DIALOG(8149),DIR("?")="^D HELP^DIWE1" ;**CCO/NI READ 'EDIT OPTION:'
.D ^DIR I X="."!$D(DIRUT) K X
LC I X?1L S X=$$UP^DILIBF(X)
S J="^DOPT(""DIWE1""," I X?1U F I=1:1:26 S DIWEX1=$C(64+I) I DWO[DIWEX1,$F($$EZBLD^DIALOG(I+9150),X)=2 S ^DISV(DUZ,J)=I G OPT
I X=" ",$D(^DISV(DUZ,J)) S DIWEX1=$C(64+^(J)) I DWO[DIWEX1 W ! G OPT
I X?1N.N S DIWEX1="E" D LN G E2:X
D HELP G 1
;
HELP ;CALLED FROM DIR READER
W !?5,$$EZBLD^DIALOG(9149)
I X?2"?".E F I=1:1:26 S J=$C(64+I) I DWO[J W !?10,$$EZBLD^DIALOG(I+9150)
W !?5,$$EZBLD^DIALOG(9150) Q
;
OPT Q:$D(DTOUT) S X=$$PROMPT I '$X W $E(X)
E I $F($$EZBLD^DIALOG($A(DIWEX1)-64+9150),X)'=2 W !,$E(X)
W $E(X,2,99) G @DIWEX1
A ;;Add -- DIALOG #9151
D ^DIWE2 S (DWL,DWLC)=DWI,@(DIC_"0)=DWLC") G 1:DWLC,X
B ;;Break #9152
D RD G B^DIWE4
C ;;Change #9153
G C^DIWE2
D ;;Delete #9154
D RD G D^DIWE3
E ;;Edit #9155
D RD G OPT:X="",1:X=U,LC:X?1A,E2
G ;;Get Data from Another Source #9157
G X^DIWE5
I ;;Insert #9159
D RD G I^DIWE2
J ;;Join #9160
D RD G J^DIWE4
L ;;List #9162
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 !,$$EZBLD^DIALOG(9162) G L
M ;;Move #9163
D RD G M^DIWE3
P ;;Print #9166
R X:DTIME S:'$T X=U,DTOUT=1 S:X="" X=1 D LN,^DIWE4:X G 1
R ;;Repeat #9168
D RD G R^DIWE3
S ;;Search #9169
G S^DIWE2
T ;;Transfer #9170
D RD,Z^DIWE3 G DIWE1
U ;;Utilities #9171
D ^DIWE11 G 1
Y ;;Y;Y-Programmer Edit #9175
G Y^DIWE4
;;
PROMPT() Q $$EZBLD^DIALOG($A(DIWEX1)-64+9150.1)
;
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,$L(X))
. S @(DIC_"DWI,0)")=X
. W !,$$EZBLD^DIALOG(8123,DWI-1)
. 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 $$EZBLD^DIALOG(8015) D DEL^DIWE3 ;*CCO/NI "DELETED"
W ! S DIWEX1="E" G OPT
;
RD R X:DTIME S:'$T DTOUT=1 I X?1."?" D G RD
.N I S I(1)=1,I(2)=DWLC W !?5,$$EZBLD^DIALOG(9148,.I),!!,$$PROMPT ;**CCO/NI "ENTER LINE 1-99"
LN I U[X!(X=".") S X=U Q
Q:DIWEX1="E"&(X?1A) I 'DWLC,I<27,I-13 S X=U W " ",$$EZBLD^DIALOG(8148),! Q ;**CCO/NI 'NO LINES!'
I "+- "[$E(X),X?1P.N,$D(DWL) S:X?1P X=X_1 S X=X+DWL W " "_X
E S X=+X
I (DIWEX1="I"!(DIWEX1="R")&(X=0))!$D(@(DIC_"X,0)")) S DWL=X Q
S X="" G LNQ^DIWE5
;
X K DIWELAST
G X^DIWE
;
LIST W " "_$$EZBLD^DIALOG(8117)_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)"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIWE1 3731 printed Dec 13, 2024@02:54:52 Page 2
DIWE1 ;SFISC/GFT-WORD PROCESSING FUNCTION ;4JUN2008
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+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 ;**CCO/NI THIS ROUTINE THOROUGHLY CHANGED DIALOGS #9150-9175 ARE NOW USED AS THE OPTIONS
+8 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
Begin DoDot:1
+1 NEW DIR,DIRUT,DDS
+2 ;**CCO/NI READ 'EDIT OPTION:'
SET DIR(0)="FO"
SET DIR("A")=$$EZBLD^DIALOG(8149)
SET DIR("?")="^D HELP^DIWE1"
+3 DO ^DIR
IF X="."!$DATA(DIRUT)
KILL X
End DoDot:1
if '$DATA(X)
GOTO X
LC IF X?1L
SET X=$$UP^DILIBF(X)
+1 SET J="^DOPT(""DIWE1"","
IF X?1U
FOR I=1:1:26
SET DIWEX1=$CHAR(64+I)
IF DWO[DIWEX1
IF $FIND($$EZBLD^DIALOG(I+9150),X)=2
SET ^DISV(DUZ,J)=I
GOTO OPT
+2 IF X=" "
IF $DATA(^DISV(DUZ,J))
SET DIWEX1=$CHAR(64+^(J))
IF DWO[DIWEX1
WRITE !
GOTO OPT
+3 IF X?1N.N
SET DIWEX1="E"
DO LN
if X
GOTO E2
+4 DO HELP
GOTO 1
+5 ;
HELP ;CALLED FROM DIR READER
+1 WRITE !?5,$$EZBLD^DIALOG(9149)
+2 IF X?2"?".E
FOR I=1:1:26
SET J=$CHAR(64+I)
IF DWO[J
WRITE !?10,$$EZBLD^DIALOG(I+9150)
+3 WRITE !?5,$$EZBLD^DIALOG(9150)
QUIT
+4 ;
OPT if $DATA(DTOUT)
QUIT
SET X=$$PROMPT
IF '$X
WRITE $EXTRACT(X)
+1 IF '$TEST
IF $FIND($$EZBLD^DIALOG($ASCII(DIWEX1)-64+9150),X)'=2
WRITE !,$EXTRACT(X)
+2 WRITE $EXTRACT(X,2,99)
GOTO @DIWEX1
A ;;Add -- DIALOG #9151
+1 DO ^DIWE2
SET (DWL,DWLC)=DWI
SET @(DIC_"0)=DWLC")
if DWLC
GOTO 1
GOTO X
B ;;Break #9152
+1 DO RD
GOTO B^DIWE4
C ;;Change #9153
+1 GOTO C^DIWE2
D ;;Delete #9154
+1 DO RD
GOTO D^DIWE3
E ;;Edit #9155
+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 #9157
+1 GOTO X^DIWE5
I ;;Insert #9159
+1 DO RD
GOTO I^DIWE2
J ;;Join #9160
+1 DO RD
GOTO J^DIWE4
L ;;List #9162
+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 !,$$EZBLD^DIALOG(9162)
GOTO L
M ;;Move #9163
+1 DO RD
GOTO M^DIWE3
P ;;Print #9166
+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 #9168
+1 DO RD
GOTO R^DIWE3
S ;;Search #9169
+1 GOTO S^DIWE2
T ;;Transfer #9170
+1 DO RD
DO Z^DIWE3
GOTO DIWE1
U ;;Utilities #9171
+1 DO ^DIWE11
GOTO 1
Y ;;Y;Y-Programmer Edit #9175
+1 GOTO Y^DIWE4
+2 ;;
PROMPT() QUIT $$EZBLD^DIALOG($ASCII(DIWEX1)-64+9150.1)
+1 ;
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,$LENGTH(X))
+7 SET @(DIC_"DWI,0)")=X
+8 WRITE !,$$EZBLD^DIALOG(8123,DWI-1)
+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 ;*CCO/NI "DELETED"
IF '$TEST
IF X="@"
SET (DW1,DW2)=DWL
WRITE $$EZBLD^DIALOG(8015)
DO DEL^DIWE3
+13 WRITE !
SET DIWEX1="E"
GOTO OPT
+14 ;
RD READ X:DTIME
if '$TEST
SET DTOUT=1
IF X?1."?"
Begin DoDot:1
+1 ;**CCO/NI "ENTER LINE 1-99"
NEW I
SET I(1)=1
SET I(2)=DWLC
WRITE !?5,$$EZBLD^DIALOG(9148,.I),!!,$$PROMPT
End DoDot:1
GOTO RD
LN IF U[X!(X=".")
SET X=U
QUIT
+1 ;**CCO/NI 'NO LINES!'
if DIWEX1="E"&(X?1A)
QUIT
IF 'DWLC
IF I<27
IF I-13
SET X=U
WRITE " ",$$EZBLD^DIALOG(8148),!
QUIT
+2 IF "+- "[$EXTRACT(X)
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 (DIWEX1="I"!(DIWEX1="R")&(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 " "_$$EZBLD^DIALOG(8117)_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)"
