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

DDW6.m

Go to the documentation of this file. 
  1. DDW6 ;SFISC/MKO-JOIN ;10:41 AM  16 Jun 2000 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**18**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. REFMT ;Reformat
  1.  N DDWRFMT
  1.  I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
  1.  D POS(DDWRW,DDWLMAR,"R")
  1.  S DDWRFMT=0 F  D JOIN Q:DDWRFMT
  1.  Q
  1.  ;
  1. JOIN ;Join
  1.  N DDWI,DDWSCR,DDWNSV,DDWLL,DDWTXT,DDWTXT0
  1.  I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
  1.  ;
  1.  ;Get current line
  1.  S (DDWTXT(1),DDWNSV)=DDWN
  1.  ;
  1.  ;Get next line
  1.  I DDWRW=DDWMR S:DDWSTB DDWTXT(2)=^TMP("DDW1",$J,DDWSTB)
  1.  E  S:DDWA+DDWRW<DDWCNT DDWTXT(2)=DDWL(DDWRW+1)
  1.  ;
  1.  I $G(DDWTXT(2))?." " D  Q:$G(DDWRFMT)
  1.  . I $L(DDWN)>DDWRMAR S:$D(DDWTXT(2))#2 DDWLL=DDWTXT(2)
  1.  . E  I $D(DDWRFMT) S DDWRFMT=1
  1.  ;
  1.  ;Adjust
  1.  S DDWTXT0=$O(DDWTXT(""),-1)
  1.  D ADJMAR(.DDWTXT,"","I")
  1.  S:$D(DDWLL) DDWTXT=DDWTXT+1,DDWTXT(DDWTXT)=DDWLL
  1.  S (DDWN,DDWL(DDWRW))=DDWTXT(1)
  1.  ;
  1.  ;Delete next line
  1.  I DDWTXT0>1,DDWTXT=1 D
  1.  . I DDWRW=DDWMR S DDWSTB=DDWSTB-1,DDWCNT=DDWCNT-1,$E(DDWBF,1,3)=111
  1.  . E  D POS(DDWRW+1,DDWC,"RN"),XLINE^DDW5(1),POS(DDWRW-1,DDWC,"RN")
  1.  ;
  1.  ;DDWSCR: curr scr = final scr
  1.  I DDWTXT=1,'$D(DDWRFMT) S DDWSCR=$L(DDWTXT(1))+1-DDWOFS
  1.  E  S DDWSCR=DDWLMAR-DDWOFS
  1.  S DDWSCR=DDWSCR'<1&(DDWSCR'>IOM)
  1.  ;
  1.  I DDWSCR,DDWNSV'=DDWN D
  1.  . I DDWNSV]"",$P(DDWNSV,DDWN)="" D
  1.  .. D CUP(DDWRW,$$MAX($L(DDWN)+1-DDWOFS,1))
  1.  .. W $P(DDGLCLR,DDGLDEL)
  1.  . E  I DDWN]"",$P(DDWN,DDWNSV)="" D
  1.  .. D CUP(DDWRW,$$MAX($L(DDWNSV)+1-DDWOFS,1))
  1.  .. W $E(DDWN,$$MAX($L(DDWNSV),DDWOFS)+1,IOM+DDWOFS)
  1.  . E  D
  1.  .. D CUP(DDWRW,DDWOFS+1)
  1.  .. W $P(DDGLCLR,DDGLDEL)_$E(DDWN,DDWOFS+1,IOM+DDWOFS)
  1.  ;
  1.  I DDWTXT=1 D
  1.  . I '$D(DDWRFMT) D
  1.  .. D POS(DDWRW,"E","RN")
  1.  . E  D POS(DDWRW,DDWLMAR,"RN")
  1.  E  D JOIN2
  1.  Q
  1.  ;
  1. JOIN2 ;Join produced >1 lines
  1.  D POS(DDWRW,DDWLMAR,"R")
  1.  ;
  1.  I DDWTXT0=2 D
  1.  . I DDWRW<DDWMR D
  1.  .. S DDWL(DDWRW+1)=DDWTXT(2)
  1.  .. S DDWRW=DDWRW+1
  1.  .. I DDWSCR D
  1.  ... D CUP(DDWRW,1)
  1.  ... W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWRW),1+DDWOFS,IOM+DDWOFS)
  1.  . E  D
  1.  .. S ^TMP("DDW1",$J,DDWSTB)=DDWTXT(2)
  1.  .. D MVFWD^DDW3(1)
  1.  ;
  1.  F DDWI=DDWTXT0+1:1:DDWTXT D
  1.  . D ILINE^DDW5
  1.  . S (DDWN,DDWL(DDWRW))=DDWTXT(DDWI)
  1.  . D CUP(DDWRW,1)
  1.  . W $P(DDGLCLR,DDGLDEL)_$E(DDWN,1+DDWOFS,IOM+DDWOFS)
  1.  ;
  1.  D POS(DDWRW-($D(DDWLL)#2),DDWLMAR,"RN")
  1.  Q
  1.  ;
  1. ADJMAR(DDWT,DDWW,DDWFLG) ;Adjust length of text in DDWT array
  1.  ;  DDWT = Text array
  1.  ;  DDWW = Width
  1.  ;DDWFLG = I:First line $L=DDWRMAR, subsequent $L=DDWRMAR-DDWLMAR+1
  1.  ;
  1.  N DDWJ
  1.  S DDWJ=1
  1.  I $G(DDWFLG)["I" S DDWW=DDWRMAR
  1.  E  I '$D(DDWW) S DDWW=DDWRMAR-DDWLMAR+1
  1.  ;
  1.  F  Q:'$D(DDWT(DDWJ))  D AMLOOP
  1.  S DDWT=$O(DDWT(""),-1)
  1.  I DDWLMAR>1 F DDWJ=$G(DDWFLG)["I"+1:1:DDWT D
  1.  . S DDWT(DDWJ)=$J("",DDWLMAR-1)_DDWT(DDWJ)
  1.  Q
  1.  ;
  1. AMLOOP ;Process DDWT(DDWJ)
  1.  I $E(DDWT(DDWJ),1,DDWW)=$J("",DDWW) S DDWT(DDWJ)=$$LD(DDWT(DDWJ))
  1.  ;
  1.  E  I $L(DDWT(DDWJ))>DDWW F  D  Q:$L(DDWT(DDWJ))'>DDWW
  1.  . N DDWK,DDWFST,DDWLST
  1.  . F DDWK=$O(DDWT(""),-1)+1:-1:DDWJ+2 S DDWT(DDWK)=DDWT(DDWK-1)
  1.  . D SLICE(DDWT(DDWJ),DDWW,.DDWFST,.DDWLST)
  1.  . S DDWT(DDWJ)=DDWFST,DDWT(DDWJ+1)=DDWLST
  1.  . D AMINCJ
  1.  ;
  1.  E  I $L(DDWT(DDWJ))=DDWW!'$D(DDWT(DDWJ+1)) D
  1.  . I DDWRAP,$D(DDWT(DDWJ+1)) S DDWT(DDWJ+1)=$$LD(DDWT(DDWJ+1))
  1.  . D AMINCJ
  1.  ;
  1.  E  I 'DDWRAP D
  1.  . N DDWK S DDWK=DDWW-$L(DDWT(DDWJ))
  1.  . S DDWT(DDWJ)=DDWT(DDWJ)_$E(DDWT(DDWJ+1),1,DDWK)
  1.  . S DDWT(DDWJ+1)=$E(DDWT(DDWJ+1),DDWK+1,999)
  1.  . D:DDWT(DDWJ+1)="" AMSHIFT(.DDWT,DDWJ+1)
  1.  ;
  1.  E  D
  1.  . N DDWD,DDWI,DDWNXT,DDWSP,DDWX1,DDWX2
  1.  . S DDWD=0 F  D  Q:DDWD
  1.  .. S DDWX1=DDWT(DDWJ),(DDWX2,DDWT(DDWJ+1))=$$LD(DDWT(DDWJ+1))
  1.  .. I DDWX2="" S DDWD=1 Q
  1.  .. S DDWNXT=$P(DDWX2," "),DDWI=$L(DDWNXT)
  1.  .. I $E(DDWX2,DDWI+2)=" ",$E(DDWX2,DDWI+3,999)'?." " D
  1.  ... F DDWI=DDWI+2:1 Q:$E(DDWX2,DDWI+1)'=" "
  1.  .. S DDWSP=DDWX1'?.E1" "
  1.  .. I $L(DDWX1)+DDWSP+$L($E(DDWX2,1,DDWI))>DDWW S DDWD=1 Q
  1.  .. S DDWT(DDWJ)=DDWX1_$E(" ",DDWSP)_$E(DDWX2,1,DDWI)
  1.  .. S DDWT(DDWJ+1)=$$LD($E(DDWX2,DDWI+1,999))
  1.  . ;
  1.  . I DDWT(DDWJ+1)="" D
  1.  .. D AMSHIFT(.DDWT,DDWJ+1)
  1.  . E  D AMINCJ
  1.  Q
  1.  ;
  1. AMSHIFT(DDWT,DDWJ) ;Delete DDWT(DDWJ) and shift up
  1.  N DDWI
  1.  F DDWI=DDWJ:1:$O(DDWT(""),-1)-1 S DDWT(DDWI)=DDWT(DDWI+1)
  1.  K DDWT($O(DDWT(""),-1))
  1.  Q
  1.  ;
  1. AMINCJ ;Incr DDWJ
  1.  I DDWJ=1,$G(DDWFLG)["I" S DDWW=DDWRMAR-DDWLMAR+1
  1.  S DDWJ=DDWJ+1
  1.  Q
  1.  ;
  1. SLICE(DDWN,DDWW,DDWFST,DDWRST) ;
  1.  ;Out: DDWFST=first part of text, $L<=DDWRMAR
  1.  ;     DDWRST=remaining part (lead blanks removed)
  1.  N DDWI,DDWP,DDWX
  1.  S:'$G(DDWW) DDWW=DDWRMAR
  1.  I 'DDWRAP S DDWFST=$E(DDWN,1,DDWW),DDWLST=$E(DDWN,DDWW+1,999) Q
  1.  ;
  1.  ;Set DDWI to column # at which to break
  1.  S DDWX=$E(DDWN,1,DDWW),DDWI=DDWW
  1.  I DDWX'[" "
  1.  E  I DDWX?." "
  1.  E  I $E(DDWX,DDWW)=" ",$E(DDWN,DDWW+1)'=" "
  1.  E  D
  1.  . F DDWP=$L(DDWX," "):-1:0 Q:$P(DDWX," ",DDWP)]""
  1.  . Q:DDWP=1
  1.  . S DDWI=$L($P(DDWX," ",1,DDWP-1))+1
  1.  . S:DDWI'>$S(DDWW=DDWRMAR:DDWLMAR,1:1) DDWI=DDWW
  1.  ;
  1.  S DDWFST=$E(DDWN,1,DDWI),DDWRST=$$LD($E(DDWN,DDWI+1,999))
  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) ;Pos cursor
  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) ;Screen number
  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)
  1. MAX(X,Y) ;
  1.  Q $S(X>Y:X,1:Y)