- 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 Mar 13, 2025@21:59:43 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)"
