DIWE4 ;SFISC/GFT-WP - PRINT, BREAK, JOIN, PROGRAMMER-EDIT ;02:07 PM 8 Dec 1999
;;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.
;
PRINT W " "_$$EZBLD^DIALOG(8117)_DWLC_"// " R DW2:DTIME S:'$T DW2=U,DTOUT=1 S:DW2="" DW2=DWLC Q:DW2>DWLC!(DW2<X) S DW2=+DW2 ;**CCO/NI 'TO LINE:'
LINNUMS S:$D(DV)[0 DV=0 S %=2 W !,$$EZBLD^DIALOG(8162) D YN^DICN Q:%<1 S I=%,J=0 ;**CCO/NI 'WANT LINE NUMBERS?'
RD I I=1 S %=2 W !,$$EZBLD^DIALOG(8163) D YN^DICN Q:%<0 S:%=1 J=124 I %=0 W !,$$EZBLD^DIALOG(8164),! G RD ;**CCO/NI 'ROUGH DRAFT? AND HELP
D0 ;Entry point for screen editor.
S DIWF="W"_$S(J:"N",DWPK="FM"&$D(DQ(1)):$E("N",$P(DQ(1),U,2)["L"),1:"")_$E("L",I)_$C(J)
K DW1,IOP,I,J D:'$D(DISYS) OS^DII I $D(^%ZTSCH("RUN")),$D(^%ZOSF("UCI")),$D(^DD("OS",DISYS,8)) S %ZIS="QM"
D ^%ZIS G K:POP
S DIWR=IOM-(DIWF["L"*4),DIWL=1,DWI="F D=DWL:0 S X="_DIC_"D,0) D ^DIWP S D=$O("_DIC_"D)) Q:(D'>0)!(D>"_DW2_") I '(D#60),$D(ZTQUEUED),$$S^%ZTLOAD S X=$$EZBLD^DIALOG(1528) D ^DIWP S ZTSTOP=1 Q",DWJ=0 ;**CCO/NI 'TASK STOPPED'
HD I DWPK'="FM" S DWH=$$EZBLD^DIALOG(8165) G QUE ;**CCO/NI HEADING FOR OUTPUT
S:$G(DIEL)="" DIEL=DL-1 S DW1=DIE,DW2=DA,%=DIEL,I(%)=DIE,J(%)=DP,I(%,0)=DA,DWH=$S($D(DQ)<11:"",1:$P(DQ(DQ),U))
DWH S DWH=$O(^DD(J(%),0,"NM",0))_$P(" FILE",1,'%)_":"_DWH I @("$D("_I(%)_I(%,0)_",0))") S DWH=""""_$P(^(0),U,1)_""" IN "_DWH
S %=%-1 I %+1,$D(DP(%+1)),$D(DIE(%+1)),$D(DA(DIEL-%)) S J(%)=DP(%+1),I(%)=DIE(%+1),I(%,0)=DA(DIEL-%) G DWH
QUE I '$D(IO("Q")) D PRNT G X
S DIR(0)="D^::AEFR",DIR("A")=$$EZBLD^DIALOG(8160),DIR("B")="NOW" D ^DIR G:$D(DIRUT) X S ZTDTH=Y ;**CCO/NI 'ENTER A DATE/TIME'
S ZTRTN="PRNT^DIWE4",ZTDESC=DWH
F %="DIC","DIWF","DIWL","DIWR","DV","DWH","DWI","DWJ","DWL","DW2","D0","I","J","I(","J(" S ZTSAVE(%)=""
D ^%ZTLOAD S IOP="HOME" D ^%ZIS W $$EZBLD^DIALOG(8161,$G(ZTSK)),! K ZTSK G X ;**CCO/NI 'REQUEST QUEUED'
;
PRNT S ^UTILITY($J,1)="S DWJ=DWJ+1 W:$D(DIFF)&($Y) @IOF S DIFF=1 W ?3,DWH,?IOM-22,"" "" S Y=DT X ^DD(""DD"") W Y,"" "",$$EZBLD^DIALOG(7095,DWJ),!!" ;**CCO/NI 'PAGE'
I $E(IOST)="C" S DIFF=1
U IO X ^(1),DWI D ^DIWW W:$E(IOST)'="C"&($Y) @IOF D CLOSE^DIO4
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
X S:$D(DW1) DIE=DW1,DA=DW2
K K %,I,J,X1,DIWF,DIWL,DIWR,DIWT,DIWLL,DISYS,DW1,DW2,DWJ,DWH,DIFF,DIR,POP,^UTILITY($J,1) Q
Q
;
Y ;
Q:DUZ(0)'["@"
R !!,"The text is in X and returned in Y",!,"Enter MUMPS xecute string to do transformation: ",X:DTIME S:'$T DTOUT=1 G 1:X'?1U.E D ^DIM G 1:'$D(X) S DW=X
R !,"Edit from line: 1// ",DW1:DTIME S:'$T DTOUT=1 G 1:DW1=U!'$T S:DW1="" DW1=1 G 1:+DW1'=DW1 W " thru: ",DWLC,"// " R DW2:DTIME S:'$T DTOUT=1 G 1:DW2=U!'$T S:DW2="" DW2=DWLC
IF (DW1>DW2)!(DW2>DWLC)!(DW1<1) G 1
F I=DW1:1:DW2 S X=@(DIC_"I,0)") K Y X DW I $D(Y)=1 S @(DIC_"I,0)")=Y W !,$J(I,3)_">"_Y S DWL=I
G 1
;
B ;BREAK
G 1:X=U,OPT:'X
BA W !,$$EZBLD^DIALOG(8120) R X:DTIME S:'$T DTOUT=1 G 1:U[X S DW=^(0) I DW'[X W $C(7),"??" G BA ;**CCO/NI 'AFTER CHARACTERS:'
S DWLC=DWLC+1 X "F I=DWLC:-1:DWL+1 S "_DIC_"I,0)="_DIC_"I-1,0) W ""."""
S @(DIC_"0)")=DWLC,Y=$F(DW,X)-1,@(DIC_"DWL,0)")=$E(DW,1,Y),@(DIC_"DWL+1,0)")=$E(DW,Y+1,999)
W !,$J(DWL,3)_">",@(DIC_"DWL,0)"),!,$J(DWL+1,3)_">",@(DIC_"DWL+1,0)")
1 G ^DIWE1
;
OPT W ! G OPT^DIWE1
;
J ;JOIN
G 1:X=U,OPT:'X I X=DWLC W $C(7),"??" G OPT
S @("Y="_DIC_"X+1,0)"),@("J="_DIC_"X,0)"),I=$L(Y)+$L(J)-250 I I>0 W !,$$EZBLD^DIALOG(349,I) G 1 ;**CCO/NI TOO LONG
S ^(0)=J_" "_Y W !,$J(X,3)_">"_^(0),! F I=X+1:1:DWLC-1 S @(DIC_"I,0)="_DIC_"I+1,0)") W "."
K @(DIC_"DWLC)") S DWLC=DWLC-1 G 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIWE4 3770 printed Apr 09, 2024@21:47:21 Page 2
DIWE4 ;SFISC/GFT-WP - PRINT, BREAK, JOIN, PROGRAMMER-EDIT ;02:07 PM 8 Dec 1999
+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 ;
PRINT ;**CCO/NI 'TO LINE:'
WRITE " "_$$EZBLD^DIALOG(8117)_DWLC_"// "
READ DW2:DTIME
if '$TEST
SET DW2=U
SET DTOUT=1
if DW2=""
SET DW2=DWLC
if DW2>DWLC!(DW2<X)
QUIT
SET DW2=+DW2
LINNUMS ;**CCO/NI 'WANT LINE NUMBERS?'
if $DATA(DV)[0
SET DV=0
SET %=2
WRITE !,$$EZBLD^DIALOG(8162)
DO YN^DICN
if %<1
QUIT
SET I=%
SET J=0
RD ;**CCO/NI 'ROUGH DRAFT? AND HELP
IF I=1
SET %=2
WRITE !,$$EZBLD^DIALOG(8163)
DO YN^DICN
if %<0
QUIT
if %=1
SET J=124
IF %=0
WRITE !,$$EZBLD^DIALOG(8164),!
GOTO RD
D0 ;Entry point for screen editor.
+1 SET DIWF="W"_$SELECT(J:"N",DWPK="FM"&$DATA(DQ(1)):$EXTRACT("N",$PIECE(DQ(1),U,2)["L"),1:"")_$EXTRACT("L",I)_$CHAR(J)
+2 KILL DW1,IOP,I,J
if '$DATA(DISYS)
DO OS^DII
IF $DATA(^%ZTSCH("RUN"))
IF $DATA(^%ZOSF("UCI"))
IF $DATA(^DD("OS",DISYS,8))
SET %ZIS="QM"
+3 DO ^%ZIS
if POP
GOTO K
+4 ;**CCO/NI 'TASK STOPPED'
SET DIWR=IOM-(DIWF["L"*4)
SET DIWL=1
SET DWI="F D=DWL:0 S X="_DIC_"D,0) D ^DIWP S D=$O("_DIC_"D)) Q:(D'>0)!(D>"_DW2_") I '(D#60),$D(ZTQUEUED),$$S^%ZTLOAD S X=$$EZBLD^DIALOG(1528) D ^DIWP S ZTSTOP=1 Q"
SET DWJ=0
HD ;**CCO/NI HEADING FOR OUTPUT
IF DWPK'="FM"
SET DWH=$$EZBLD^DIALOG(8165)
GOTO QUE
+1 if $GET(DIEL)=""
SET DIEL=DL-1
SET DW1=DIE
SET DW2=DA
SET %=DIEL
SET I(%)=DIE
SET J(%)=DP
SET I(%,0)=DA
SET DWH=$SELECT($DATA(DQ)<11:"",1:$PIECE(DQ(DQ),U))
DWH SET DWH=$ORDER(^DD(J(%),0,"NM",0))_$PIECE(" FILE",1,'%)_":"_DWH
IF @("$D("_I(%)_I(%,0)_",0))")
SET DWH=""""_$PIECE(^(0),U,1)_""" IN "_DWH
+1 SET %=%-1
IF %+1
IF $DATA(DP(%+1))
IF $DATA(DIE(%+1))
IF $DATA(DA(DIEL-%))
SET J(%)=DP(%+1)
SET I(%)=DIE(%+1)
SET I(%,0)=DA(DIEL-%)
GOTO DWH
QUE IF '$DATA(IO("Q"))
DO PRNT
GOTO X
+1 ;**CCO/NI 'ENTER A DATE/TIME'
SET DIR(0)="D^::AEFR"
SET DIR("A")=$$EZBLD^DIALOG(8160)
SET DIR("B")="NOW"
DO ^DIR
if $DATA(DIRUT)
GOTO X
SET ZTDTH=Y
+2 SET ZTRTN="PRNT^DIWE4"
SET ZTDESC=DWH
+3 FOR %="DIC","DIWF","DIWL","DIWR","DV","DWH","DWI","DWJ","DWL","DW2","D0","I","J","I(","J("
SET ZTSAVE(%)=""
+4 ;**CCO/NI 'REQUEST QUEUED'
DO ^%ZTLOAD
SET IOP="HOME"
DO ^%ZIS
WRITE $$EZBLD^DIALOG(8161,$GET(ZTSK)),!
KILL ZTSK
GOTO X
+5 ;
PRNT ;**CCO/NI 'PAGE'
SET ^UTILITY($JOB,1)="S DWJ=DWJ+1 W:$D(DIFF)&($Y) @IOF S DIFF=1 W ?3,DWH,?IOM-22,"" "" S Y=DT X ^DD(""DD"") W Y,"" "",$$EZBLD^DIALOG(7095,DWJ),!!"
+1 IF $EXTRACT(IOST)="C"
SET DIFF=1
+2 USE IO
XECUTE ^(1)
XECUTE DWI
DO ^DIWW
if $EXTRACT(IOST)'="C"&($Y)
WRITE @IOF
DO CLOSE^DIO4
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
+5 ;
X if $DATA(DW1)
SET DIE=DW1
SET DA=DW2
K KILL %,I,J,X1,DIWF,DIWL,DIWR,DIWT,DIWLL,DISYS,DW1,DW2,DWJ,DWH,DIFF,DIR,POP,^UTILITY($JOB,1)
QUIT
+1 QUIT
+2 ;
Y ;
+1 if DUZ(0)'["@"
QUIT
+2 READ !!,"The text is in X and returned in Y",!,"Enter MUMPS xecute string to do transformation: ",X:DTIME
if '$TEST
SET DTOUT=1
if X'?1U.E
GOTO 1
DO ^DIM
if '$DATA(X)
GOTO 1
SET DW=X
+3 READ !,"Edit from line: 1// ",DW1:DTIME
if '$TEST
SET DTOUT=1
if DW1=U!'$TEST
GOTO 1
if DW1=""
SET DW1=1
if +DW1'=DW1
GOTO 1
WRITE " thru: ",DWLC,"// "
READ DW2:DTIME
if '$TEST
SET DTOUT=1
if DW2=U!'$TEST
GOTO 1
if DW2=""
SET DW2=DWLC
+4 IF (DW1>DW2)!(DW2>DWLC)!(DW1<1)
GOTO 1
+5 FOR I=DW1:1:DW2
SET X=@(DIC_"I,0)")
KILL Y
XECUTE DW
IF $DATA(Y)=1
SET @(DIC_"I,0)")=Y
WRITE !,$JUSTIFY(I,3)_">"_Y
SET DWL=I
+6 GOTO 1
+7 ;
B ;BREAK
+1 if X=U
GOTO 1
if 'X
GOTO OPT
BA ;**CCO/NI 'AFTER CHARACTERS:'
WRITE !,$$EZBLD^DIALOG(8120)
READ X:DTIME
if '$TEST
SET DTOUT=1
if U[X
GOTO 1
SET DW=^(0)
IF DW'[X
WRITE $CHAR(7),"??"
GOTO BA
+1 SET DWLC=DWLC+1
XECUTE "F I=DWLC:-1:DWL+1 S "_DIC_"I,0)="_DIC_"I-1,0) W ""."""
+2 SET @(DIC_"0)")=DWLC
SET Y=$FIND(DW,X)-1
SET @(DIC_"DWL,0)")=$EXTRACT(DW,1,Y)
SET @(DIC_"DWL+1,0)")=$EXTRACT(DW,Y+1,999)
+3 WRITE !,$JUSTIFY(DWL,3)_">",@(DIC_"DWL,0)"),!,$JUSTIFY(DWL+1,3)_">",@(DIC_"DWL+1,0)")
1 GOTO ^DIWE1
+1 ;
OPT WRITE !
GOTO OPT^DIWE1
+1 ;
J ;JOIN
+1 if X=U
GOTO 1
if 'X
GOTO OPT
IF X=DWLC
WRITE $CHAR(7),"??"
GOTO OPT
+2 ;**CCO/NI TOO LONG
SET @("Y="_DIC_"X+1,0)")
SET @("J="_DIC_"X,0)")
SET I=$LENGTH(Y)+$LENGTH(J)-250
IF I>0
WRITE !,$$EZBLD^DIALOG(349,I)
GOTO 1
+3 SET ^(0)=J_" "_Y
WRITE !,$JUSTIFY(X,3)_">"_^(0),!
FOR I=X+1:1:DWLC-1
SET @(DIC_"I,0)="_DIC_"I+1,0)")
WRITE "."
+4 KILL @(DIC_"DWLC)")
SET DWLC=DWLC-1
GOTO 1
