freem_fileman/USER/DDW4.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDW4.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD

Restructure repository

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)," ","!"))