Annotation of freem_fileman/USER/DDW4.m, revision 1.1
1.1 ! snw 1: DDW4 ;SFISC/PD KELTZ-OTHER NAVIGATION, DEL ;09:00 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: TAB N DDWX
! 6: S DDWX=$F(DDWRUL,"T",DDWC+1) G:'DDWX ERR
! 7: D POS(DDWRW,DDWX-1,"R")
! 8: Q
! 9: ;
! 10: DEOL S (DDWN,DDWL(DDWRW))=$E(DDWN,1,DDWC-1)
! 11: W $P(DDGLCLR,DDGLDEL)
! 12: Q
! 13: ;
! 14: DELW N DDWI,DDWW
! 15: I $D(DDWMARK),DDWRW+DDWA'>$P(DDWMARK,U,3) D UNMARK^DDW7
! 16: I DDWC>$L(DDWN) D Q
! 17: . I DDWN?." " D
! 18: .. D XLINE^DDW5()
! 19: . E D
! 20: .. N DDWY,DDWX
! 21: .. S DDWY=DDWRW+DDWA,DDWX=DDWC
! 22: .. D JOIN^DDW6
! 23: .. D POS(DDWY-DDWA,DDWX,"RN")
! 24: ;
! 25: S DDWI=$$WRPOS(DDWN)
! 26: S DDWW=$E(DDWN,DDWC,DDWI-1)
! 27: S $E(DDWN,DDWC,DDWI-1)="",DDWL(DDWRW)=DDWN
! 28: I $P(DDGLED,DDGLDEL,6)]"" D
! 29: . F DDWI=1:1:$L(DDWW) W $P(DDGLED,DDGLDEL,6)
! 30: . S DDWI=$E(DDWN,IOM-$L(DDWW)+1+DDWOFS,IOM+DDWOFS)
! 31: . I DDWI]"" D CUP(DDWRW,IOM-$L(DDWW)+1) W DDWI D CUP(DDWRW,DDWC-DDWOFS)
! 32: E D
! 33: . W $E(DDWN_$J("",$L(DDWW)),DDWC,IOM+DDWOFS)
! 34: . D CUP(DDWRW,DDWC-DDWOFS)
! 35: Q
! 36: ;
! 37: WORDR N DDWI
! 38: S DDWI=$$WRPOS(DDWN)
! 39: D POS(DDWRW,DDWI,"R")
! 40: Q
! 41: ;
! 42: WRPOS(DDWT) ;
! 43: N DDWP,DDWS
! 44: S DDWT=$$PUNC(DDWT)
! 45: S DDWS=$F(DDWT," ",DDWC+1),DDWP=$F(DDWT,"!",DDWC+1)
! 46: S:'DDWS DDWS=999 S:'DDWP DDWP=999
! 47: ;
! 48: I DDWC>$L(DDWT) D
! 49: . I DDWRW+DDWA'<DDWCNT S DDWI=$L(DDWT)+1
! 50: . E D DN^DDWT1 S DDWI=1
! 51: E I DDWS=999,DDWP=999 D
! 52: . S DDWI=$L(DDWT)+1
! 53: E I $E(DDWT,DDWC)="!" D
! 54: . F DDWI=DDWC+1:1 Q:$E(DDWT,DDWI)'="!"
! 55: . F DDWI=DDWI:1 Q:$E(DDWT,DDWI)'=" "
! 56: E I DDWS<DDWP D
! 57: . F DDWI=DDWS:1 Q:$E(DDWT,DDWI)'=" "
! 58: E S DDWI=DDWP-1
! 59: Q DDWI
! 60: ;
! 61: WORDL N DDWD,DDWI,DDWT
! 62: S DDWT=$$PUNC(DDWN)
! 63: ;
! 64: I DDWC=1 D
! 65: . I DDWRW=1,'DDWA S DDWI=1
! 66: . E D UP^DDWT1 S DDWI=$L(DDWN)+1
! 67: E D
! 68: . S DDWI=DDWC-1
! 69: . S:$E(DDWT,DDWI)="" DDWI=$L(DDWT)
! 70: . I $E(DDWT,DDWI)=" " F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'=" "
! 71: . I $E(DDWT,DDWI)="!" D
! 72: .. F DDWI=DDWI-1:-1:0 Q:$E(DDWT,DDWI)'="!"
! 73: . E I DDWI D
! 74: .. F DDWI=DDWI-1:-1:0 Q:" !"[$E(DDWT,DDWI)
! 75: . S DDWI=DDWI+1
! 76: D POS(DDWRW,DDWI,"R")
! 77: Q
! 78: ;
! 79: PGDN N DDWX
! 80: I DDWRW<DDWMR D
! 81: . D POS($$MIN(DDWCNT-DDWA,DDWMR),DDWC,"RN")
! 82: E D
! 83: . S DDWX=$$MIN(DDWSTB,DDWMR)
! 84: . D:DDWX MVFWD^DDW3(DDWX)
! 85: Q
! 86: ;
! 87: PGUP N DDWX
! 88: I DDWRW>1 D
! 89: . D POS(1,DDWC,"RN")
! 90: E D
! 91: . S DDWX=$$MIN(DDWA,DDWMR)
! 92: . D:DDWX MVBCK^DDW3(DDWX)
! 93: Q
! 94: ;
! 95: JLEFT N DDWX
! 96: I DDWN?." " S DDWX=1
! 97: E F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
! 98: I DDWC-DDWOFS=1,DDWC>1 D POS(DDWRW,DDWC-1,"R") Q:DDWC=DDWX
! 99: S DDWC=$$MAX($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:0),1+DDWOFS)
! 100: D POS(DDWRW,DDWC,"R")
! 101: Q
! 102: JRIGHT N DDWX
! 103: S DDWX=$L(DDWN)+1
! 104: I DDWC-DDWOFS=IOM,DDWC<246 D POS(DDWRW,DDWC+1,"R") Q:DDWC=DDWX
! 105: S DDWC=$$MIN($S($$SCR(DDWX)=$$SCR(DDWC)&(DDWC'=DDWX):DDWX,1:999),$$MIN(IOM+DDWOFS,246))
! 106: D POS(DDWRW,DDWC,"R")
! 107: Q
! 108: ;
! 109: LBEG N DDWX
! 110: F DDWX=1:1:$L(DDWN) Q:$E(DDWN,DDWX)'=" "
! 111: D POS(DDWRW,DDWX,"R")
! 112: Q
! 113: LEND D POS(DDWRW,"E","R")
! 114: Q
! 115: ;
! 116: ERR ;Beep
! 117: W $C(7)
! 118: Q
! 119: ;
! 120: CUP(Y,X) ;Cursor positioning
! 121: S DY=IOTM+Y-2,DX=X-1 X IOXY
! 122: Q
! 123: ;
! 124: POS(R,C,F) ;Pos cursor based on char pos C
! 125: N DDWX
! 126: S:$G(C)="E" C=$L($G(DDWL(R)))+1
! 127: S:$G(F)["N" DDWN=$G(DDWL(R))
! 128: S:$G(F)["R" DDWRW=R,DDWC=C
! 129: ;
! 130: S DDWX=C-DDWOFS
! 131: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS)
! 132: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY
! 133: Q
! 134: ;
! 135: SCR(C) ;Screen #
! 136: Q C-$P(DDWOFS,U,2)-1\$P(DDWOFS,U,3)+1
! 137: ;
! 138: MIN(X,Y) ;
! 139: Q $S(X<Y:X,1:Y)
! 140: MAX(X,Y) ;
! 141: Q $S(X>Y:X,1:Y)
! 142: PUNC(X) ;
! 143: Q $TR(X,"`~!@#$%^&*()-_=+\|[{]};:'"",<.>/?",$TR($J("",32)," ","!"))
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>