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. 
  1. DDW5 ;SFISC/PD KELTZ-WRAP, BREAK, ILINE, XLINE ;01:23 PM  21 Dec 1994
  1.  ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1.  ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1.  ;;Licensed under the terms of the Apache License, Version 2.0.
  1.  ;
  1. WRAP ;Wrap at word boundary
  1.  S:$E(DDWN,DDWC,999)?1." " (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
  1.  I DDWC'>$L(DDWN) D WRAPI Q
  1.  I 'DDWRAP D POS(DDWRW,DDWRMAR+1,"R"),BREAK(1) Q
  1.  D WRAPW
  1.  Q
  1.  ;
  1. WRAPI ;Cursor in middle
  1.  I $E(DDWN,DDWLMAR,999)'[" "!'DDWRAP D BREAK(-1),POS(DDWRW-1,"E","RN") Q
  1.  N DDWCSV,DDWI,DDWLST,DDWRMSV
  1.  S DDWI=$F(DDWN," ",DDWC)
  1.  I DDWI,DDWI-2'>DDWRMAR D
  1.  . S DDWCSV=DDWC
  1.  . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
  1.  . D POS(DDWRW,DDWI,"R"),BREAK(-1),POS(DDWRW-1,DDWCSV,"RN")
  1.  . S (DDWN,DDWL(DDWRW))=$$TR(DDWN)
  1.  E  I DDWC=2 D
  1.  . D POS(DDWRW,DDWRMAR+1,"R"),BREAK(-1),POS(DDWRW-1,2,"RN")
  1.  E  D
  1.  . S DDWLST=$$TR($E(DDWN,DDWC,999))
  1.  . S (DDWL(DDWRW),DDWN)=$E(DDWN,1,DDWC-1)
  1.  . S DDWRMSV=DDWRMAR,DDWRMAR=$$MIN(DDWRMAR,DDWC-2)
  1.  . D WRAPW
  1.  . W $E(DDWLST,1,IOM+DDWOFS-DDWC)
  1.  . S DDWL(DDWRW)=DDWN_DDWLST,DDWRMAR=DDWRMSV
  1.  . D POS(DDWRW,DDWC,"RN")
  1.  Q
  1.  ;
  1. WRAPW ;Cursor at end
  1.  N DDWI,DDWS1,DDWS2,DDWTXT
  1.  S DDWTXT(1)=DDWN
  1.  D ADJMAR^DDW6(.DDWTXT,"","I")
  1.  ;
  1.  S DDWS1=$$SCR($L(DDWTXT(1))+1),DDWS2=$$SCR($L(DDWTXT(DDWTXT))+1)
  1.  I DDWS1=$P(DDWOFS,U,4),DDWS2=$P(DDWOFS,U,4),DDWTXT=2 D
  1.  . S (DDWN,DDWL(DDWRW))=DDWTXT(1)_DDWTXT(2)
  1.  . S DDWC=$L(DDWTXT(1))+1
  1.  . D POS(DDWRW,DDWC),BREAK(1)
  1.  ;
  1.  E  D
  1.  . F DDWI=1:1:DDWTXT-1 D
  1.  .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
  1.  .. D ILINE
  1.  .. S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI+1)
  1.  .. I DDWS2=$P(DDWOFS,U,4) D
  1.  ... D CUP(DDWRW-1,1)
  1.  ... W $P(DDGLCLR,DDGLDEL)_$E(DDWTXT(DDWI),1+DDWOFS,IOM+DDWOFS)
  1.  ... D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  . D POS(DDWRW,"E","R")
  1.  Q
  1.  ;
  1. BREAK(DDWFLAG) ;Break line, make new line current
  1.  ;Final cursor position:
  1.  ; 0:lmar of new line (used by <RET>)
  1.  ; 1:end of new line (used by Wrap)
  1.  ;-1:doesn't matter (used by Wrap)
  1.  N DDWRST
  1.  I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
  1.  S DDWRST=$E(DDWN,DDWC,999)
  1.  I DDWLMAR>1,DDWRST'?@(DDWLMAR-1_""" "".E") D
  1.  . S DDWRST=$J("",DDWLMAR-1)_$$LD(DDWRST)
  1.  S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
  1.  W $P(DDGLCLR,DDGLDEL)
  1.  D ILINE
  1.  S (DDWN,DDWL(DDWRW))=DDWRST
  1.  ;
  1.  I $G(DDWFLAG)=1 D
  1.  . I $$SCR($L(DDWN)+1)=$P(DDWOFS,U,4) D
  1.  .. D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  . D POS(DDWRW,"E","R")
  1.  ;
  1.  E  I '$G(DDWFLAG) D
  1.  . I $P(DDWOFS,U,4)=1 D CUP(DDWRW,1) W $E(DDWN,1,IOM)
  1.  . D POS(DDWRW,DDWLMAR,"R")
  1.  ;
  1.  E  D CUP(DDWRW,1) W $E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  Q
  1.  ;
  1. ILINE ;Insert line below current line, make that current
  1.  ;Column is unchanged
  1.  N DDWI,DDWX
  1.  I DDWRW<DDWMR D
  1.  . I DDWA+DDWMR'>DDWCNT D
  1.  .. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWMR)
  1.  . F DDWI=DDWMR:-1:DDWRW+2 S DDWL(DDWI)=DDWL(DDWI-1)
  1.  . S DDWL(DDWRW+1)=""
  1.  . D CUP(DDWRW+1,1)
  1.  . ;
  1.  . I $P(DDGLED,DDGLDEL,3)]"" D
  1.  .. I $P(DDGLED,DDGLDEL,2)="" D
  1.  ... D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4) D CUP(DDWRW+1,1)
  1.  .. W $P(DDGLED,DDGLDEL,3)
  1.  . E  D
  1.  .. S DDWX=IOTM
  1.  .. S IOTM=IOTM+DDWRW W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
  1.  .. D CUP(DDWRW+1,1) W $P(DDGLED,DDGLDEL)
  1.  .. W @$P(DDGLED,DDGLDEL,2)
  1.  . D POS(DDWRW+1,DDWC,"RN")
  1.  ;
  1.  E  D
  1.  . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(1)
  1.  . F DDWI=1:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
  1.  . S DDWL(DDWMR)=""
  1.  . D SCRUP^DDW3(1)
  1.  S DDWCNT=DDWCNT+1
  1.  S $E(DDWBF,1,3)=111
  1.  Q
  1.  ;
  1. XLINE(DDWFLAG,DDWNP) ;Delete current line
  1.  ;DDWFLAG:
  1.  ; 1:leave cursor on deleted line (used by Join)
  1.  ; 0:move cursor up one line if deleted line is last line
  1.  ;   (used by PF1-D and DELBLK)
  1.  ; DDWNP = 1:don't bother printing, used by DELBLK
  1.  N DDWI,DDWX
  1.  I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
  1.  F DDWI=DDWRW:1:DDWMR-1 S DDWL(DDWI)=DDWL(DDWI+1)
  1.  S DDWX="" S:DDWSTB DDWX=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
  1.  S DDWL(DDWMR)=DDWX
  1.  ;
  1.  D:'$G(DDWNP) XLINEP
  1.  ;
  1.  S DDWCNT=DDWCNT-1
  1.  I 'DDWCNT D
  1.  . S DDWCNT=1 D POS(1,DDWLMAR,"RN")
  1.  E  I DDWA+DDWRW>DDWCNT,'$G(DDWFLAG) D
  1.  . D UP^DDWT1
  1.  E  D POS(DDWRW,DDWC,"N")
  1.  S $E(DDWBF,1,3)=111
  1.  Q
  1.  ;
  1. XLINEP ;Redisplay screen
  1.  I $P(DDGLED,DDGLDEL,4)]"" D
  1.  . W $P(DDGLED,DDGLDEL,4)
  1.  . I $P(DDGLED,DDGLDEL,2)="" D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
  1.  E  I DDWRW<DDWMR D
  1.  . S DDWX=IOTM
  1.  . S IOTM=IOTM+DDWRW-1 W @$P(DDGLED,DDGLDEL,2) S IOTM=DDWX
  1.  . D CUP(DDWMR,1) W $C(10)
  1.  . W @$P(DDGLED,DDGLDEL,2)
  1.  E  D
  1.  . D CUP(DDWMR,1) W $P(DDGLCLR,DDGLDEL)
  1.  ;
  1.  I DDWL(DDWMR)'?." " D
  1.  . D CUP(DDWMR,1)
  1.  . W $E(DDWL(DDWMR),1+DDWOFS,IOM+DDWOFS)
  1.  Q
  1.  ;
  1. TR(X) Q:$G(X)="" X
  1.  N I
  1.  F I=$L(X):-1:0 Q:$E(X,I)'=" "
  1.  Q $E(X,1,I)
  1.  ;
  1. LD(X) Q:$G(X)="" X
  1.  N I
  1.  F I=1:1:$L(X)+1 Q:$E(X,I)'=" "
  1.  Q $E(X,I,999)
  1.  ;
  1. CUP(Y,X) ;
  1.  S DY=IOTM+Y-2,DX=X-1 X IOXY
  1.  Q
  1.  ;
  1. POS(R,C,F) ;
  1.  N DDWX
  1.  S:$G(C)="E" C=$L($G(DDWL(R)))+1
  1.  S:$G(F)["N" DDWN=$G(DDWL(R))
  1.  S:$G(F)["R" DDWRW=R,DDWC=C
  1.  ;
  1.  S DDWX=C-DDWOFS
  1.  I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q
  1.  ;
  1. SCR(C) ;
  1.  Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
  1.  ;
  1. MIN(X,Y) ;
  1.  Q $S(X<Y:X,1:Y)