Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDW5

DDW5.m

Go to the documentation of this file.
DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM  21 Dec 1994
 ;;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.
 ;
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 <RET>)
 ; 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 DDWRW<DDWMR D
 . I DDWA+DDWMR'>DDWCNT 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 DDWRW<DDWMR D
 . S DDWX=IOTM
 . S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
 . D CUP(DDWMR,1) W $C(10)
 . W @$P(DDGLED,DDGLDEL,2)
 E  D
 . D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
 ;
 I DDWL(DDWMR)'?." " D
 . D CUP(DDWMR,1)
 . W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
 Q
 ;
TR(X) Q:$G(X)="" X
 N I
 F I=$L(X):-1:0 Q:$E(X,I)'=" "
 Q $E(X,1,I)
 ;
LD(X) Q:$G(X)="" X
 N I
 F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
 Q $E(X,I,999)
 ;
CUP(Y,X) ;
 S DY=IOTM+Y-2,DX=X-1 X IOXY
 Q
 ;
POS(R,C,F) ;
 N DDWX
 S:$G(C)="E" C=$L($G(DDWL(R)))+1
 S:$G(F)["N" DDWN=$G(DDWL(R))
 S:$G(F)["R" DDWRW=R,DDWC=C
 ;
 S DDWX=C-DDWOFS
 I DDWX>IOM!(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<Y:X,1:Y)