- DIWE4 ;SFISC/GFT-WP - ROUGH DRAFT, BREAK, JOIN ;10/28/96 15:00
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- W " to Line: "_DWLC_"// " R DW2:DTIME S:'$T DW2=U,DTOUT=1 S:DW2="" DW2=DWLC Q:DW2>DWLC!(DW2<X) S DW2=+DW2
- S:$D(DV)[0 DV=0 S %=2 W !,"WANT LINE NUMBERS" D YN^DICN Q:%<1 S I=%,J=0
- RD I I=1 S %=2 W !,"ROUGH DRAFT" D YN^DICN Q:%<0 S:%=1 J=124 I %=0 W !,"A Rough Draft is printed line-for-line, showing windows.",! G RD
- 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=""***TASK STOPPED***"" D ^DIWP S ZTSTOP=1 Q",DWJ=0
- I DWPK'="FM" S DWH="Line Editor Print" G QUE
- 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")="REQUESTED TIME TO PRINT",DIR("B")="NOW",DIR("?")="Enter a date with a time" D ^DIR G:$D(DIRUT) X S ZTDTH=Y
- 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 " REQUEST QUEUED!",! K ZTSK G X
- ;
- 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 D DT^DIO2 W "" PAGE "",DWJ,!!"
- 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 R !," after character(s): ",X:DTIME S:'$T DTOUT=1 G 1:U[X S DW=^(0) I DW'[X W $C(7),"??" G BA
- 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 W $C(7)," TOO LONG" G 1
- 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
- DIWE4 ;SFISC/GFT-WP - ROUGH DRAFT, BREAK, JOIN ;10/28/96 15:00
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 WRITE " to Line: "_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
- +4 IF $DATA(DV)[0
- SET DV=0
- SET %=2
- WRITE !,"WANT LINE NUMBERS"
- DO YN^DICN
- IF %<1
- QUIT
- SET I=%
- SET J=0
- RD IF I=1
- SET %=2
- WRITE !,"ROUGH DRAFT"
- DO YN^DICN
- IF %<0
- QUIT
- IF %=1
- SET J=124
- IF %=0
- WRITE !,"A Rough Draft is printed line-for-line, showing windows.",!
- 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 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=""***TASK STOPPED***"" D ^DIWP S ZTSTOP=1 Q"
- SET DWJ=0
- +5 IF DWPK'="FM"
- SET DWH="Line Editor Print"
- GOTO QUE
- +6 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 SET DIR(0)="D^::AEFR"
- SET DIR("A")="REQUESTED TIME TO PRINT"
- SET DIR("B")="NOW"
- SET DIR("?")="Enter a date with a time"
- 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 DO ^%ZTLOAD
- SET IOP="HOME"
- DO ^%ZIS
- WRITE " REQUEST QUEUED!",!
- KILL ZTSK
- GOTO X
- +5 ;
- PRNT SET ^UTILITY($JOB,1)="S DWJ=DWJ+1 W:$D(DIFF)&($Y) @IOF S DIFF=1 W ?3,DWH,?IOM-22,"" "" S Y=DT D DT^DIO2 W "" PAGE "",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 READ !," after character(s): ",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 SET @("Y="_DIC_"X+1,0)")
- SET @("J="_DIC_"X,0)")
- IF $LENGTH(Y)+$LENGTH(J)>250
- WRITE $CHAR(7)," TOO LONG"
- 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
