Return to DDW3.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DDW3	;SFISC/MKO-TOP, BOTTOM, SCROLL ;09:19 AM  23 Jun 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: TOP	N DDWI
    6: 	I DDWA=0 D POS(1,1,"RN") Q
    7: 	D SHFTUP(1),POS(1,1,"RN")
    8: 	Q
    9: 	;
   10: SHFTUP(DDWFL)	;
   11: 	N DDWSH
   12: 	S DDWSH=DDWA+1-DDWFL
   13: 	D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
   14: 	;
   15: 	F DDWI=DDWMR:-1:$$MAX(1,DDWMR-DDWSH+1) D:DDWI+DDWA'>DDWCNT
   16: 	. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
   17: 	. ;
   18: 	I $E(DDWBF,2) F DDWI=DDWA:-1:DDWFL+DDWMR D
   19: 	. S DDWSTB=DDWSTB+1
   20: 	. S ^TMP("DDW1",$J,DDWSTB)=^TMP("DDW",$J,DDWI)
   21: 	E  S DDWSTB=$$MAX(DDWCNT-DDWFL+1-DDWMR,0)
   22: 	;
   23: 	S DDWA=DDWFL-1
   24: 	I DDWSH>DDWMR D
   25: 	. F DDWI=1:1:DDWMR S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
   26: 	. I $P(DDWOFS,U,4)=1 D
   27: 	.. D CUP(1,1)
   28: 	.. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
   29: 	. D MSG^DDW()
   30: 	E  D
   31: 	. F DDWI=DDWMR:-1:DDWSH+1 S DDWL(DDWI)=DDWL(DDWI-DDWSH)
   32: 	. F DDWI=DDWSH:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWFL+DDWI-1)
   33: 	. D:$P(DDWOFS,U,4)=1 SCRDN(DDWSH)
   34: 	;
   35: 	S:'DDWA $E(DDWBF,2)=0
   36: 	Q
   37: 	;
   38: BOT	N DDWI
   39: 	I DDWSTB=0 D POS($$MIN(DDWMR,DDWCNT-DDWA),"E","RN") Q
   40: 	D SHFTDN($$MAX(1,DDWCNT-DDWMR+1))
   41: 	D POS(DDWMR,"E","RN")
   42: 	Q
   43: 	;
   44: SHFTDN(DDWFL,DDWCOL)	;
   45: 	N DDWNSTB,DDWSH
   46: 	S DDWSH=DDWFL-DDWA-1,DDWNSTB=DDWCNT-DDWFL+1
   47: 	D:DDWSH>DDWMR MSG^DDW("Repositioning ...")
   48: 	;
   49: 	F DDWI=1:1:$$MIN(DDWSH,DDWMR) D
   50: 	. S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
   51: 	;
   52: 	I $E(DDWBF,3) F DDWI=DDWSTB:-1:DDWNSTB+1 D
   53: 	. S DDWA=DDWA+1
   54: 	. S ^TMP("DDW",$J,DDWA)=^TMP("DDW1",$J,DDWI)
   55: 	E  S DDWA=DDWFL-1
   56: 	;
   57: 	I DDWSH>DDWMR D
   58: 	. F DDWI=1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
   59: 	. I $P(DDWOFS,U,4)=$$SCR($S($D(DDWCOL):DDWCOL,1:$L(DDWL(DDWMR))+1)) D
   60: 	.. D CUP(1,1)
   61: 	.. F DDWI=1:1:DDWMR W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))_$S(DDWI<DDWMR:$C(13,10),1:"")
   62: 	. D MSG^DDW()
   63: 	E  D
   64: 	. F DDWI=1:1:DDWMR-DDWSH S DDWL(DDWI)=DDWL(DDWI+DDWSH)
   65: 	. F DDWI=DDWMR-DDWSH+1:1:DDWMR S DDWL(DDWI)=$S(DDWNSTB-DDWI+1>0:^TMP("DDW1",$J,DDWNSTB-DDWI+1),1:"")
   66: 	. D:$P(DDWOFS,U,4)=$$SCR($L(DDWL(DDWMR))+1) SCRUP(DDWSH)
   67: 	;
   68: 	S DDWSTB=$$MAX(0,DDWNSTB-DDWMR)
   69: 	S:'DDWSTB $E(DDWBF,3)=0
   70: 	Q
   71: 	;
   72: MVFWD(DDWNUM)	;
   73: 	N DDWI
   74: 	F DDWI=1:1:DDWNUM S DDWA=DDWA+1,^TMP("DDW",$J,DDWA)=DDWL(DDWI)
   75: 	F DDWI=1:1:DDWMR-DDWNUM S DDWL(DDWI)=DDWL(DDWI+DDWNUM)
   76: 	F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
   77: 	. S DDWL(DDWI)=^TMP("DDW1",$J,DDWSTB),DDWSTB=DDWSTB-1
   78: 	D SCRUP(DDWNUM)
   79: 	Q
   80: 	;
   81: SCRUP(DDWNUM)	;
   82: 	N DDWI
   83: 	D CUP(DDWMR,1)
   84: 	F DDWI=DDWMR-DDWNUM+1:1:DDWMR D
   85: 	. I $P(DDGLED,DDGLDEL,2)]"" W $C(10)
   86: 	. E  D
   87: 	.. D CUP(1,1) W $P(DDGLED,DDGLDEL,4)
   88: 	.. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,3)
   89: 	. I DDWL(DDWI)'?." " D
   90: 	.. D CUP(DDWMR,1)
   91: 	.. W $$LINE(DDWI,$G(DDWMARK))
   92: 	D POS(DDWMR,DDWC,"RN")
   93: 	Q
   94: 	;
   95: MVBCK(DDWNUM)	;
   96: 	N DDWI
   97: 	F DDWI=DDWMR:-1:DDWMR-DDWNUM+1 D:DDWI+DDWA'>DDWCNT
   98: 	. S DDWSTB=DDWSTB+1,^TMP("DDW1",$J,DDWSTB)=DDWL(DDWI)
   99: 	F DDWI=DDWMR:-1:DDWNUM+1 S DDWL(DDWI)=DDWL(DDWI-DDWNUM)
  100: 	F DDWI=DDWNUM:-1:1 S DDWL(DDWI)=^TMP("DDW",$J,DDWA),DDWA=DDWA-1
  101: 	D SCRDN(DDWNUM)
  102: 	Q
  103: 	;
  104: SCRDN(DDWNUM)	;
  105: 	N DDWI
  106: 	D CUP(1,1)
  107: 	F DDWI=DDWNUM:-1:1 D
  108: 	. I $P(DDGLED,DDGLDEL,2)]"" W $P(DDGLED,DDGLDEL)
  109: 	. E  D
  110: 	.. D CUP(DDWMR,1) W $P(DDGLED,DDGLDEL,4)
  111: 	.. D CUP(1,1) W $P(DDGLED,DDGLDEL,3)
  112: 	. I DDWL(DDWI)'?." " D
  113: 	.. D CUP(1,1)
  114: 	.. W $$LINE(DDWI,$G(DDWMARK))
  115: 	D POS(1,DDWC,"RN")
  116: 	Q
  117: 	;
  118: ERR	;
  119: 	W $C(7)
  120: 	Q
  121: 	;
  122: CUP(Y,X)	;
  123: 	S DY=IOTM+Y-2,DX=X-1 X IOXY
  124: 	Q
  125: 	;
  126: POS(R,C,F)	;Pos cursor based on char pos C
  127: 	N DDWX
  128: 	S:$G(C)="E" C=$L($G(DDWL(R)))+1
  129: 	S:$G(F)["N" DDWN=$G(DDWL(R))
  130: 	S:$G(F)["R" DDWRW=R,DDWC=C
  131: 	;
  132: 	S DDWX=C-DDWOFS
  133: 	I DDWX>IOM!(DDWX<1) D SHIFT(C,.DDWOFS)
  134: 	S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
  135: 	Q
  136: 	;
  137: SHIFT(C,DDWOFS)	;
  138: 	N DDWI,N,M,S
  139: 	S N=$P(DDWOFS,U,2),M=$P(DDWOFS,U,3)
  140: 	S S=$$SCR(C)
  141: 	S DDWOFS=S-1*M_U_N_U_M_U_S
  142: 	D RULER
  143: 	F DDWI=1:1:$$MIN(DDWMR,DDWCNT) D
  144: 	. S DY=IOTM+DDWI-2,DX=0 X IOXY
  145: 	. W $P(DDGLCLR,DDGLDEL)_$$LINE(DDWI,$G(DDWMARK))
  146: 	Q
  147: 	;
  148: RULER	;Write ruler
  149: 	D CUP(DDWMR+1,1)
  150: 	W $P(DDGLCLR,DDGLDEL)_$E(DDWRUL,1+DDWOFS,IOM+DDWOFS)
  151: 	I DDWLMAR-DDWOFS'<1,DDWLMAR-DDWOFS'>IOM D
  152: 	. D CUP(DDWMR+1,DDWLMAR-DDWOFS) W "<"
  153: 	I DDWRMAR-DDWOFS'<1,DDWRMAR-DDWOFS'>IOM D
  154: 	. D CUP(DDWMR+1,DDWRMAR-DDWOFS) W ">"
  155: 	Q
  156: 	;
  157: LINE(DDWI,DDWMARK)	;
  158: 	N DDWX
  159: 	S DDWX=$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS)
  160: 	Q:$G(DDWMARK)="" DDWX
  161: 	;
  162: 	N DDWR1,DDWC1,DDWR2,DDWC2
  163: 	S DDWR1=$P(DDWMARK,U,1),DDWC1=$P(DDWMARK,U,2)
  164: 	S DDWR2=$P(DDWMARK,U,3),DDWC2=$P(DDWMARK,U,4)
  165: 	;
  166: 	I DDWI'<(DDWR1-DDWA),DDWI'>(DDWR2-DDWA) D
  167: 	. N DDWX1,DDWX2
  168: 	. S DDWX1=$S(DDWI=(DDWR1-DDWA):DDWC1,1:1)
  169: 	. S DDWX2=$S(DDWI=(DDWR2-DDWA):DDWC2,1:999)
  170: 	. 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)
  171: 	Q DDWX
  172: 	;
  173: SCR(C)	;
  174: 	Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
  175: 	;
  176: MIN(X,Y)	;
  177: 	Q $S(X<Y:X,1:Y)
  178: 	;
  179: MAX(X,Y)	;
  180: 	Q $S(X>Y:X,1:Y)