Annotation of freem_fileman/USER/DDW3.m, revision 1.1
1.1 ! snw 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)
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>