Return to DDW9.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDW9	;SFISC/MKO-MARK TEXT ;10:10 AM  17 May 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: CHKDEL(DDWY)	;Check that cursor is on block and delete
    6: 	N DDWI
    7: 	N DDWC1,DDWC2,DDWR1,DDWR2,DDWI
    8: 	D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
    9: 	S DDWY=0,DDWI=DDWRW+DDWA
   10: 	Q:DDWI<DDWR1
   11: 	Q:DDWI>DDWR2
   12: 	I DDWI=DDWR1,DDWC<DDWC1 D UNMARK^DDW7 Q
   13: 	I DDWI=DDWR2,DDWC-1>DDWC2 D UNMARK^DDW7 Q
   14: 	;
   15: 	D DELBLK()
   16: 	S DDWY=1
   17: 	Q
   18: 	;
   19: DELBLK(DDWNDEL)	;Delete block
   20: 	;Returns: DDWNDEL=# lines deleted from the screen
   21: 	N DDWNP,DDWI,DDWX
   22: 	I '$D(DDWR1) N DDWR1,DDWR2,DDWC1,DDWC2 D
   23: 	. D PMARK(DDWMARK,.DDWR1,.DDWC1,.DDWR2,.DDWC2)
   24: 	;
   25: 	S DDWNDEL=0,$E(DDWBF,1,3)=111
   26: 	K DDWMARK
   27: 	;
   28: 	I DDWR2-DDWA<1 D
   29: 	. D DELABV
   30: 	E  I DDWR1-DDWA>DDWMR D
   31: 	. D DELBEL
   32: 	E  D DELMID
   33: 	;
   34: 	D IND^DDW7()
   35: 	Q
   36: 	;
   37: DELABV	;All of the block is above the screen
   38: 	I DDWR1=DDWR2 D  Q
   39: 	. N DDWX
   40: 	. S DDWX=^TMP("DDW",$J,DDWR1),$E(DDWX,DDWC1,DDWC2)=""
   41: 	. I DDWX]"" S ^TMP("DDW",$J,DDWR1)=DDWX
   42: 	. E  D SHIFTA(DDWR1,DDWR1)
   43: 	;
   44: 	D:DDWR2-DDWR1>50 MSG^DDW("Deleting selected text.")
   45: 	N DDWFST,DDWLST
   46: 	S DDWFST=$E(^TMP("DDW",$J,DDWR1),1,DDWC1-1)
   47: 	S DDWLST=$E(^TMP("DDW",$J,DDWR2),DDWC2+1,999)
   48: 	I DDWFST]"" S ^TMP("DDW",$J,DDWR1)=DDWFST,DDWFST=DDWR1+1
   49: 	E  S DDWFST=DDWR1
   50: 	I DDWLST]"" S ^TMP("DDW",$J,DDWR2)=DDWLST,DDWLST=DDWR2-1
   51: 	E  S DDWLST=DDWR2
   52: 	D SHIFTA(DDWFST,DDWLST)
   53: 	D:DDWR2-DDWR1>50 MSG^DDW()
   54: 	Q
   55: 	;
   56: SHIFTA(DDWA1,DDWA2)	;
   57: 	N DDWNL
   58: 	S DDWNL=DDWA2-DDWA1+1
   59: 	I DDWA2=DDWA S DDWA=DDWA-DDWNL,DDWCNT=DDWCNT-DDWNL Q
   60: 	;
   61: 	N DDWI
   62: 	F DDWI=DDWA1:1:DDWA-DDWNL S ^TMP("DDW",$J,DDWI)=^TMP("DDW",$J,DDWI+DDWNL)
   63: 	S DDWA=DDWA-DDWNL,DDWCNT=DDWCNT-DDWNL
   64: 	Q
   65: 	;
   66: DELBEL	;All of the block is below the screen
   67: 	N DDWS1,DDWS2
   68: 	S DDWS1=DDWA+DDWMR+DDWSTB-DDWR1+1,DDWS2=DDWA+DDWMR+DDWSTB-DDWR2+1
   69: 	I DDWS1=DDWS2 D  Q
   70: 	. N DDWX
   71: 	. S DDWX=^TMP("DDW1",$J,DDWS1),$E(DDWX,DDWC1,DDWC2)=""
   72: 	. I DDWX]"" S ^TMP("DDW1",$J,DDWS1)=DDWX
   73: 	. E  D SHIFTB(DDWS1,DDWS1)
   74: 	;
   75: 	D:DDWR2-DDWR1>50 MSG^DDW("Deleting selected text.")
   76: 	N DDWFST,DDWLST
   77: 	S DDWFST=$E(^TMP("DDW1",$J,DDWS1),1,DDWC1-1)
   78: 	S DDWLST=$E(^TMP("DDW1",$J,DDWS2),DDWC2+1,999)
   79: 	I DDWFST]"" S ^TMP("DDW1",$J,DDWS1)=DDWFST,DDWFST=DDWS1-1
   80: 	E  S DDWFST=DDWS1
   81: 	I DDWLST]"" S ^TMP("DDW1",$J,DDWS2)=DDWLST,DDWLST=DDWS2+1
   82: 	E  S DDWLST=DDWS2
   83: 	D SHIFTB(DDWFST,DDWLST)
   84: 	D:DDWR2-DDWR1>50 MSG^DDW()
   85: 	Q
   86: 	;
   87: SHIFTB(DDWS1,DDWS2)	;
   88: 	N DDWNL
   89: 	S DDWNL=DDWS1-DDWS2+1
   90: 	I DDWS1=DDWSTB S DDWSTB=DDWSTB-DDWNL,DDWCNT=DDWCNT-DDWNL Q
   91: 	;
   92: 	N DDWI
   93: 	F DDWI=DDWS2:1:DDWSTB-DDWNL S ^TMP("DDW1",$J,DDWI)=^TMP("DDW1",$J,DDWI+DDWNL)
   94: 	S DDWSTB=DDWSTB-DDWNL,DDWCNT=DDWCNT-DDWNL
   95: 	Q
   96: 	;
   97: DELMID	;A portion of the block appears on the screen
   98: 	I DDWR2-1-DDWA>DDWMR D
   99: 	. S DDWX=DDWR2-(DDWA+DDWMR+1)
  100: 	. S DDWSTB=DDWSTB-DDWX,DDWCNT=DDWCNT-DDWX
  101: 	;
  102: 	I DDWR2-DDWA>DDWMR D
  103: 	. S DDWX=$E(^TMP("DDW1",$J,DDWSTB),DDWC2+1,999)
  104: 	. I DDWX="" S DDWSTB=DDWSTB-1,DDWCNT=DDWCNT-1
  105: 	. E  S ^TMP("DDW1",$J,DDWSTB)=DDWX
  106: 	;
  107: 	D POS($$MAX(DDWR1-DDWA,1),$S(DDWR1=DDWR2:DDWC1,1:1),"RN")
  108: 	;
  109: 	S DDWNP=DDWR2-DDWA'<DDWMR
  110: 	F DDWI=DDWRW:1:$$MIN(DDWR2-DDWA,DDWMR) D
  111: 	. 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)
  112: 	. I DDWX]"" D
  113: 	.. S DDWL(DDWRW)=DDWX
  114: 	.. I 'DDWNP D
  115: 	... D CUP(DDWRW,1)
  116: 	... W $P(DDGLCLR,DDGLDEL)_$E(DDWX,1+DDWOFS,IOM+DDWOFS)
  117: 	.. D POS(DDWRW+(DDWI<$$MIN(DDWR2-DDWA,DDWMR)),DDWC,"RN")
  118: 	. E  D XLINE^DDW5(1,DDWNP) S DDWNDEL=DDWNDEL+1
  119: 	;
  120: 	I DDWNP F DDWI=$$MAX(DDWR1-DDWA,1):1:DDWMR D
  121: 	. D CUP(DDWI,1)
  122: 	. W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  123: 	;
  124: 	I DDWR1+1'>DDWA D
  125: 	. S DDWX=DDWA-DDWR1
  126: 	. S DDWA=DDWA-DDWX,DDWCNT=DDWCNT-DDWX
  127: 	;
  128: 	I DDWR1'>DDWA D
  129: 	. S DDWX=$E(^TMP("DDW",$J,DDWA),1,DDWC1-1)
  130: 	. I DDWX="" S DDWA=DDWA-1,DDWCNT=DDWCNT-1
  131: 	. E  S ^TMP("DDW",$J,DDWA)=DDWX
  132: 	;
  133: 	S:DDWCNT<1 DDWCNT=1
  134: 	D:DDWRW+DDWA>DDWCNT UP^DDWT1
  135: 	Q
  136: 	;
  137: PMARK(M,R1,C1,R2,C2)	;Parse M (DDWMARK)
  138: 	S R1=$P(M,U),C1=$P(M,U,2)
  139: 	S R2=$P(M,U,3),C2=$P(M,U,4)
  140: 	Q
  141: 	;
  142: CUP(Y,X)	;
  143: 	S DY=IOTM+Y-2,DX=X-1 X IOXY
  144: 	Q
  145: 	;
  146: POS(R,C,F)	;Pos cursor based on char pos C
  147: 	N DDWX
  148: 	S:$G(C)="E" C=$L($G(DDWL(R)))+1
  149: 	S:$G(F)["N" DDWN=$G(DDWL(R))
  150: 	S:$G(F)["R" DDWRW=R,DDWC=C
  151: 	;
  152: 	S DDWX=C-DDWOFS
  153: 	I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
  154: 	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  155: 	Q
  156: 	;
  157: MIN(X,Y)	;
  158: 	Q $S(X<Y:X,1:Y)
  159: 	;
  160: MAX(X,Y)	;
  161: 	Q $S(X>Y:X,1:Y)