DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM 21 Dec 1994 ;;22.0;VA FileMan;;Mar 30, 1999 ;Per VHA Directive 10-93-142, this routine should not be modified. ; WRAP ;Wrap at word boundary S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1) I DDWC'>$L(DDWN) D WRAPI Q I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q D WRAPW Q ; WRAPI ;Cursor in middle I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q N DDWCSV,DDWI,DDWLST,DDWRMSV S DDWI=$F(DDWN," ",DDWC) I DDWI,DDWI-2'>DDWRMAR D . S DDWCSV=DDWC . S (DDWN,DDWL(DDWRW))=$$TR(DDWN) . D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN") . S (DDWN,DDWL(DDWRW))=$$TR(DDWN) E I DDWC=2 D . D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN") E D . S DDWLST=$$TR($E(DDWN,DDWC,999)) . S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1) . S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2) . D WRAPW . W $E(DDWLST,1,IOM+DDWOFS-DDWC) . S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV . D POS(DDWRW,DDWC,"RN") Q ; WRAPW ;Cursor at end N DDWI,DDWS1,DDWS2,DDWTXT S DDWTXT(1)=DDWN D ADJMAR^DDW6(.DDWTXT,"","I") ; S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1) I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D . S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2) . S DDWC=$L(DDWTXT(1))+1 . D POS(DDWRW,DDWC),BREAK(1) ; E D . F DDWI=1:1:DDWTXT-1 D .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI) .. D ILINE .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1) .. I DDWS2=$P(DDWOFS,U,4) D ... D CUP(DDWRW-1,1) ... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS) ... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS) . D POS(DDWRW,"E","R") Q ; BREAK(DDWFLAG) ;Break line, make new line current ;Final cursor position: ; 0:lmar of new line (used by ) ; 1:end of new line (used by Wrap) ;-1:doesn't matter (used by Wrap) N DDWRST I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7 S DDWRST=$E(DDWN,DDWC,999) I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D . S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST) S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1) W $P(DDGLCLR,DDGLDEL) D ILINE S (DDWN,DDWL(DDWRW))=DDWRST ; I $G(DDWFLAG)=1 D . I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D .. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS) . D POS(DDWRW,"E","R") ; E I '$G(DDWFLAG) D . I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM) . D POS(DDWRW,DDWLMAR,"R") ; E D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS) Q ; ILINE ;Insert line below current line, make that current ;Column is unchanged N DDWI,DDWX I DDWRWDDWCNT D .. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR) . F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1) . S DDWL(DDWRW+1)="" . D CUP(DDWRW+1,1) . ; . I $P(DDGLED,DDGLDEL,3)]"" D .. I $P(DDGLED,DDGLDEL,2)="" D ... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1) .. W $P(DDGLED,DDGLDEL,3) . E D .. S DDWX=IOTM .. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX .. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL) .. W @$P(DDGLED,DDGLDEL,2) . D POS(DDWRW+1,DDWC,"RN") ; E D . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1) . F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1) . S DDWL(DDWMR)="" . D SCRUP^DDW3(1) S DDWCNT=DDWCNT+1 S $E(DDWBF,1,3)=111 Q ; XLINE(DDWFLAG,DDWNP) ;Delete current line ;DDWFLAG: ; 1:leave cursor on deleted line (used by Join) ; 0:move cursor up one line if deleted line is last line ; (used by PF1-D and DELBLK) ; DDWNP = 1:don't bother printing, used by DELBLK N DDWI,DDWX I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7 F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1) S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1 S DDWL(DDWMR)=DDWX ; D:'$G(DDWNP) XLINEP ; S DDWCNT=DDWCNT-1 I 'DDWCNT D . S DDWCNT=1 D POS(1,DDWLMAR,"RN") E I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D . D UP^DDWT1 E D POS(DDWRW,DDWC,"N") S $E(DDWBF,1,3)=111 Q ; XLINEP ;Redisplay screen I $P(DDGLED,DDGLDEL,4)]"" D . W $P(DDGLED,DDGLDEL,4) . I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3) E I DDWRWIOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS) S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY Q ; SCR(C) ; Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1 ; MIN(X,Y) ; Q $S(X