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

DDW3.m

Go to the documentation of this file. 
  1. DDW3 ;SFISC/MKO-TOP, BOTTOM, SCROLL ;9:08 AM  13 Feb 1996
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. TOP N DDWI
  1.  I DDWA=0 D POS(1,1,"RN") Q
  1.  D SHFTUP(1),POS(1,1,"RN")
  1.  Q
  1.  ;
  1. SHFTUP(DDWFL) ;
  1.  N DDWSH,DDWI
  1.  S DDWSH=DDWA+1-DDWFL
  1.  D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
  1.  ;
  1.  F DDWI=DDWMR:-1:$$MAX(1,DDWMR-DDWSH+1) D:DDWI+DDWA'>DDWCNT
  1.  . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
  1.  . S ^TMP("DDW",$J,DDWA+DDWI)=DDWL(DDWI)
  1.  ;
  1.  I $E(DDWBF,2) F DDWI=DDWA:-1:DDWFL+DDWMR D
  1.  . S DDWSTB=DDWSTB+1
  1.  . S ^TMP("DDW1",$J,DDWSTB)=^TMP("DDW",$J,DDWI)
  1.  E  S DDWSTB=$$MAX(DDWCNT-DDWFL+1-DDWMR,0)
  1.  ;
  1.  S DDWA=DDWFL-1
  1.  I DDWSH>DDWMR D
  1.  . F DDWI=1:1:DDWMR S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
  1.  . I $P(DDWOFS,U,4)=1 D
  1.  .. D CUP(1,1)
  1.  .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
  1.  . D MSG^DDW()
  1.  E  D
  1.  . F DDWI=DDWMR:-1:DDWSH+1 S DDWL(DDWI)=DDWL(DDWI-DDWSH)
  1.  . F DDWI=DDWSH:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
  1.  . D:$P(DDWOFS,U,4)=1 SCRDN(DDWSH)
  1.  ;
  1.  S:'DDWA $E(DDWBF,2)=0
  1.  Q
  1.  ;
  1. BOT N DDWI
  1.  I DDWSTB=0 D POS($$MIN(DDWMR,DDWCNT-DDWA),"E","RN") Q
  1.  D SHFTDN($$MAX(1,DDWCNT-DDWMR+1))
  1.  D POS(DDWMR,"E","RN")
  1.  Q
  1.  ;
  1. SHFTDN(DDWFL,DDWCOL) ;
  1.  N DDWNSTB,DDWSH,DDWI
  1.  S DDWSH=DDWFL-DDWA-1,DDWNSTB=DDWCNT-DDWFL+1
  1.  D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
  1.  ;
  1.  F DDWI=1:1:$$MIN(DDWSH,DDWMR) D
  1.  . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
  1.  . S ^TMP("DDW1",$J,DDWSTB+DDWMR-DDWI+1)=DDWL(DDWI)
  1.  .
  1.  ;
  1.  I $E(DDWBF,3) F DDWI=DDWSTB:-1:DDWNSTB+1 D
  1.  . S DDWA=DDWA+1
  1.  . S ^TMP("DDW",$J,DDWA)=^TMP("DDW1",$J,DDWI)
  1.  E  S DDWA=DDWFL-1
  1.  ;
  1.  I DDWSH>DDWMR D
  1.  . F DDWI=1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
  1.  . I $P(DDWOFS,U,4)=$$SCR($S($D(DDWCOL):DDWCOL,1:$L(DDWL(DDWMR))+1)) D
  1.  .. D CUP(1,1)
  1.  .. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
  1.  . D MSG^DDW()
  1.  E  D
  1.  . F DDWI=1:1:DDWMR-DDWSH S DDWL(DDWI)=DDWL(DDWI+DDWSH)
  1.  . F DDWI=DDWMR-DDWSH+1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
  1.  . D:$P(DDWOFS,U,4)=$$SCR($L(DDWL(DDWMR))+1) SCRUP(DDWSH)
  1.  ;
  1.  S DDWSTB=$$MAX(0,DDWNSTB-DDWMR)
  1.  S:'DDWSTB $E(DDWBF,3)=0
  1.  Q
  1.  ;
  1. MVFWD(DDWNUM) ;
  1.  N DDWI
  1.  F DDWI=1:1:DDWNUM D
  1.  . S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
  1.  . S ^TMP("DDW1",$J,DDWSTB+DDWMR-DDWI+1)=DDWL(DDWI)
  1.  F DDWI=1:1:DDWMR-DDWNUM S DDWL(DDWI)=DDWL(DDWI+DDWNUM)
  1.  F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
  1.  . S DDWL(DDWI)=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
  1.  D SCRUP(DDWNUM)
  1.  Q
  1.  ;
  1. SCRUP(DDWNUM) ;
  1.  N DDWI
  1.  D CUP(DDWMR,1)
  1.  F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
  1.  . I $P(DDGLED,DDGLDEL,2)]"" W $C(10)
  1.  . E  D
  1.  .. D CUP(1,1) W $P(DDGLED,DDGLDEL,4)
  1.  .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
  1.  . I DDWL(DDWI)'?." " D
  1.  .. D CUP(DDWMR,1)
  1.  .. W $$LINE(DDWI,$G(DDWMARK))
  1.  D POS(DDWMR,DDWC,"RN")
  1.  Q
  1.  ;
  1. MVBCK(DDWNUM) ;
  1.  N DDWI
  1.  F DDWI=DDWMR:-1:DDWMR-DDWNUM+1 D:DDWI+DDWA'>DDWCNT
  1.  . S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
  1.  . S ^TMP("DDW",$J,DDWA+DDWI)=DDWL(DDWI)
  1.  F DDWI=DDWMR:-1:DDWNUM+1 S DDWL(DDWI)=DDWL(DDWI-DDWNUM)
  1.  F DDWI=DDWNUM:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWA),DDWA=DDWA-1
  1.  D SCRDN(DDWNUM)
  1.  Q
  1.  ;
  1. SCRDN(DDWNUM) ;
  1.  N DDWI
  1.  D CUP(1,1)
  1.  F DDWI=DDWNUM:-1:1 D
  1.  . I $P(DDGLED,DDGLDEL,2)]"" W $P(DDGLED,DDGLDEL)
  1.  . E  D
  1.  .. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4)
  1.  .. D CUP(1,1) W $P(DDGLED,DDGLDEL,3)
  1.  . I DDWL(DDWI)'?." " D
  1.  .. D CUP(1,1)
  1.  .. W $$LINE(DDWI,$G(DDWMARK))
  1.  D POS(1,DDWC,"RN")
  1.  Q
  1.  ;
  1. ERR ;
  1.  W $C(7)
  1.  Q
  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 based on char pos C
  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(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q
  1.  ;
  1. SHIFT(C,DDWOFS) ;
  1.  N DDWI,N,M,S
  1.  S N=$P(DDWOFS,U,2),M=$P(DDWOFS,U,3)
  1.  S S=$$SCR(C)
  1.  S DDWOFS=S-1*M_U_N_U_M_U_S
  1.  D RULER
  1.  F DDWI=1:1:$$MIN(DDWMR,DDWCNT) D
  1.  . S DY=IOTM+DDWI-2,DX=0 X IOXY
  1.  . W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))
  1.  Q
  1.  ;
  1. RULER ;Write ruler
  1.  D CUP(DDWMR+1,1)
  1.  W $P(DDGLCLR,DDGLDEL)_$E(DDWRUL,1+DDWOFS,IOM+DDWOFS)
  1.  I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
  1.  . D CUP(DDWMR+1,DDWLMAR-DDWOFS) W "<"
  1.  I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
  1.  . D CUP(DDWMR+1,DDWRMAR-DDWOFS) W ">"
  1.  Q
  1.  ;
  1. LINE(DDWI,DDWMARK) ;
  1.  N DDWX
  1.  S DDWX=$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  1.  Q:$G(DDWMARK)="" DDWX
  1.  ;
  1.  N DDWR1,DDWC1,DDWR2,DDWC2
  1.  S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
  1.  S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
  1.  ;
  1.  I DDWI'<(DDWR1-DDWA),DDWI'>(DDWR2-DDWA) D
  1.  . N DDWX1,DDWX2
  1.  . S DDWX1=$S(DDWI=(DDWR1-DDWA):DDWC1,1:1)
  1.  . S DDWX2=$S(DDWI=(DDWR2-DDWA):DDWC2,1:999)
  1.  . S DDWX=$E(DDWL(DDWI),1+DDWOFS,DDWX1-1)_$P(DDGLVID,DDGLDEL,6)_$E(DDWL(DDWI),$$MAX(DDWX1,1+DDWOFS),$$MIN(DDWX2,IOM+DDWOFS))_$P(DDGLVID,DDGLDEL,10)_$E(DDWL(DDWI),$$MAX(DDWX2+1,1+DDWOFS),IOM+DDWOFS)
  1.  Q DDWX
  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)
  1.  ;
  1. MAX(X,Y) ;
  1.  Q $S(X>Y:X,1:Y)