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

DDW9.m

Go to the documentation of this file. 
  1. DDW9 ;SFISC/MKO-MARK TEXT ;10:10 AM  17 May 1994
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. CHKDEL(DDWY) ;Check that cursor is on block and delete
  1.  N DDWI
  1.  N DDWC1,DDWC2,DDWR1,DDWR2,DDWI
  1.  D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
  1.  S DDWY=0,DDWI=DDWRW+DDWA
  1.  Q:DDWI<DDWR1
  1.  Q:DDWI>DDWR2
  1.  I DDWI=DDWR1,DDWC<DDWC1 D UNMARK^DDW7 Q
  1.  I DDWI=DDWR2,DDWC-1>DDWC2 D UNMARK^DDW7 Q
  1.  ;
  1.  D DELBLK()
  1.  S DDWY=1
  1.  Q
  1.  ;
  1. DELBLK(DDWNDEL) ;Delete block
  1.  ;Returns: DDWNDEL=# lines deleted from the screen
  1.  N DDWNP,DDWI,DDWX
  1.  I '$D(DDWR1) N DDWR1,DDWR2,DDWC1,DDWC2 D
  1.  . D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
  1.  ;
  1.  S DDWNDEL=0,$E(DDWBF,1,3)=111
  1.  K DDWMARK
  1.  ;
  1.  I DDWR2-DDWA<1 D
  1.  . D DELABV
  1.  E  I DDWR1-DDWA>DDWMR D
  1.  . D DELBEL
  1.  E  D DELMID
  1.  ;
  1.  D IND^DDW7()
  1.  Q
  1.  ;
  1. DELABV ;All of the block is above the screen
  1.  I DDWR1=DDWR2 D  Q
  1.  . N DDWX
  1.  . S DDWX=^TMP("DDW",$J,DDWR1),$E(DDWX,DDWC1,DDWC2)=""
  1.  . I DDWX]"" S ^TMP("DDW",$J,DDWR1)=DDWX
  1.  . E  D SHIFTA(DDWR1,DDWR1)
  1.  ;
  1.  D:DDWR2-DDWR1>50 MSG^DDW("Deleting selected text.")
  1.  N DDWFST,DDWLST
  1.  S DDWFST=$E(^TMP("DDW",$J,DDWR1),1,DDWC1-1)
  1.  S DDWLST=$E(^TMP("DDW",$J,DDWR2),DDWC2+1,999)
  1.  I DDWFST]"" S ^TMP("DDW",$J,DDWR1)=DDWFST,DDWFST=DDWR1+1
  1.  E  S DDWFST=DDWR1
  1.  I DDWLST]"" S ^TMP("DDW",$J,DDWR2)=DDWLST,DDWLST=DDWR2-1
  1.  E  S DDWLST=DDWR2
  1.  D SHIFTA(DDWFST,DDWLST)
  1.  D:DDWR2-DDWR1>50 MSG^DDW()
  1.  Q
  1.  ;
  1. SHIFTA(DDWA1,DDWA2) ;
  1.  N DDWNL
  1.  S DDWNL=DDWA2-DDWA1+1
  1.  I DDWA2=DDWA S DDWA=DDWA-DDWNL,DDWCNT=DDWCNT-DDWNL Q
  1.  ;
  1.  N DDWI
  1.  F DDWI=DDWA1:1:DDWA-DDWNL S ^TMP("DDW",$J,DDWI)=^TMP("DDW",$J,DDWI+DDWNL)
  1.  S DDWA=DDWA-DDWNL,DDWCNT=DDWCNT-DDWNL
  1.  Q
  1.  ;
  1. DELBEL ;All of the block is below the screen
  1.  N DDWS1,DDWS2
  1.  S DDWS1=DDWA+DDWMR+DDWSTB-DDWR1+1,DDWS2=DDWA+DDWMR+DDWSTB-DDWR2+1
  1.  I DDWS1=DDWS2 D  Q
  1.  . N DDWX
  1.  . S DDWX=^TMP("DDW1",$J,DDWS1),$E(DDWX,DDWC1,DDWC2)=""
  1.  . I DDWX]"" S ^TMP("DDW1",$J,DDWS1)=DDWX
  1.  . E  D SHIFTB(DDWS1,DDWS1)
  1.  ;
  1.  D:DDWR2-DDWR1>50 MSG^DDW("Deleting selected text.")
  1.  N DDWFST,DDWLST
  1.  S DDWFST=$E(^TMP("DDW1",$J,DDWS1),1,DDWC1-1)
  1.  S DDWLST=$E(^TMP("DDW1",$J,DDWS2),DDWC2+1,999)
  1.  I DDWFST]"" S ^TMP("DDW1",$J,DDWS1)=DDWFST,DDWFST=DDWS1-1
  1.  E  S DDWFST=DDWS1
  1.  I DDWLST]"" S ^TMP("DDW1",$J,DDWS2)=DDWLST,DDWLST=DDWS2+1
  1.  E  S DDWLST=DDWS2
  1.  D SHIFTB(DDWFST,DDWLST)
  1.  D:DDWR2-DDWR1>50 MSG^DDW()
  1.  Q
  1.  ;
  1. SHIFTB(DDWS1,DDWS2) ;
  1.  N DDWNL
  1.  S DDWNL=DDWS1-DDWS2+1
  1.  I DDWS1=DDWSTB S DDWSTB=DDWSTB-DDWNL,DDWCNT=DDWCNT-DDWNL Q
  1.  ;
  1.  N DDWI
  1.  F DDWI=DDWS2:1:DDWSTB-DDWNL S ^TMP("DDW1",$J,DDWI)=^TMP("DDW1",$J,DDWI+DDWNL)
  1.  S DDWSTB=DDWSTB-DDWNL,DDWCNT=DDWCNT-DDWNL
  1.  Q
  1.  ;
  1. DELMID ;A portion of the block appears on the screen
  1.  I DDWR2-1-DDWA>DDWMR D
  1.  . S DDWX=DDWR2-(DDWA+DDWMR+1)
  1.  . S DDWSTB=DDWSTB-DDWX,DDWCNT=DDWCNT-DDWX
  1.  ;
  1.  I DDWR2-DDWA>DDWMR D
  1.  . S DDWX=$E(^TMP("DDW1",$J,DDWSTB),DDWC2+1,999)
  1.  . I DDWX="" S DDWSTB=DDWSTB-1,DDWCNT=DDWCNT-1
  1.  . E  S ^TMP("DDW1",$J,DDWSTB)=DDWX
  1.  ;
  1.  D POS($$MAX(DDWR1-DDWA,1),$S(DDWR1=DDWR2:DDWC1,1:1),"RN")
  1.  ;
  1.  S DDWNP=DDWR2-DDWA'<DDWMR
  1.  F DDWI=DDWRW:1:$$MIN(DDWR2-DDWA,DDWMR) D
  1.  . S DDWX=$E(DDWL(DDWRW),1,$S(DDWI+DDWA=DDWR1:DDWC1,1:1)-1)_$E(DDWL(DDWRW),$S(DDWI+DDWA=DDWR2:DDWC2,1:999)+1,999)
  1.  . I DDWX]"" D
  1.  .. S DDWL(DDWRW)=DDWX
  1.  .. I 'DDWNP D
  1.  ... D CUP(DDWRW,1)
  1.  ... W $P(DDGLCLR,DDGLDEL)_$E(DDWX,1+DDWOFS,IOM+DDWOFS)
  1.  .. D POS(DDWRW+(DDWI<$$MIN(DDWR2-DDWA,DDWMR)),DDWC,"RN")
  1.  . E  D XLINE^DDW5(1,DDWNP) S DDWNDEL=DDWNDEL+1
  1.  ;
  1.  I DDWNP F DDWI=$$MAX(DDWR1-DDWA,1):1:DDWMR D
  1.  . D CUP(DDWI,1)
  1.  . W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  1.  ;
  1.  I DDWR1+1'>DDWA D
  1.  . S DDWX=DDWA-DDWR1
  1.  . S DDWA=DDWA-DDWX,DDWCNT=DDWCNT-DDWX
  1.  ;
  1.  I DDWR1'>DDWA D
  1.  . S DDWX=$E(^TMP("DDW",$J,DDWA),1,DDWC1-1)
  1.  . I DDWX="" S DDWA=DDWA-1,DDWCNT=DDWCNT-1
  1.  . E  S ^TMP("DDW",$J,DDWA)=DDWX
  1.  ;
  1.  S:DDWCNT<1 DDWCNT=1
  1.  D:DDWRW+DDWA>DDWCNT UP^DDWT1
  1.  Q
  1.  ;
  1. PMARK(M,R1,C1,R2,C2) ;Parse M (DDWMARK)
  1.  S R1=$P(M,U),C1=$P(M,U,2)
  1.  S R2=$P(M,U,3),C2=$P(M,U,4)
  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^DDW3(C,.DDWOFS)
  1.  S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  1.  Q
  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)