freem_fileman/USER/DDWG.m - view

File: [Coherent Logic Development] / freem_fileman / USER / DDWG.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: DDWG ;SFISC/MKO-GOTO ;09:03 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: GOTO ;Go to a specific location 5: N DDWANS,DDWI,DDWHLP 6: S DDWHLP(1)="Examples, to go to a screen: S21, 21, S+3, +3, -3" 7: S DDWHLP(2)=" to go to a line: L53, L+4, L-5" 8: S DDWHLP(3)=" to go to a column: C40, C+10, C-20" 9: D ASK(4,"Go to: ",17,"","D VALGTO",.DDWHLP,.DDWANS) 10: I U[DDWANS 11: E I "Ss"[$E(DDWANS)!(DDWANS'?1A.E) D 12: . D GOTOS 13: E I "Ll"[$E(DDWANS) D 14: . D GOTOL 15: E I "Cc"[$E(DDWANS) D 16: . D GOTOC 17: Q 18: ; 19: GOTOS ;Go to a page 20: N DDWS 21: S DDWS=DDWANS 22: S:DDWS?1A.E DDWS=$E(DDWS,2,999) 23: S:DDWS?1P.E DDWS=$E(DDWS,2,999) 24: I DDWANS["+" S DDWS=$$SCREEN+DDWS 25: E I DDWANS["-" S DDWS=$$SCREEN-DDWS 26: I DDWS<1 S DDWS=1 27: E I DDWS>$$LTOSC(DDWCNT) S DDWS=$$LTOSC(DDWCNT) 28: D LINE(DDWS-1*DDWMR+1) 29: Q 30: ; 31: GOTOL ;Go to a line 32: N DDWLN 33: S DDWLN=DDWANS 34: S:DDWLN?1A.E DDWLN=$E(DDWLN,2,999) 35: S:DDWLN?1P.E DDWLN=$E(DDWLN,2,999) 36: I DDWANS["+" S DDWLN=DDWA+DDWRW+DDWLN 37: E I DDWANS["-" S DDWLN=DDWA+DDWRW-DDWLN 38: I DDWLN<1 S DDWLN=1 39: E I DDWLN>DDWCNT S DDWLN=DDWCNT 40: D LINE(DDWLN) 41: Q 42: ; 43: GOTOC ;Go to a column 44: N DDWCOL 45: S DDWCOL=DDWANS 46: S:DDWCOL?1A.E DDWCOL=$E(DDWCOL,2,999) 47: S:DDWCOL?1P.E DDWCOL=$E(DDWCOL,2,999) 48: I DDWANS["+" S DDWCOL=DDWC+DDWCOL 49: E I DDWANS["-" S DDWCOL=DDWC-DDWCOL 50: I DDWCOL<1 S DDWCOL=1 51: E I DDWCOL>246 S DDWCOL=246 52: D POS(DDWRW,DDWCOL,"R") 53: Q 54: ; 55: LINE(DDWLN,DDWCOL) ;Adjust arrays and position cursor on line DDWLN 56: I $G(DDWCOL)'="E",'$G(DDWCOL) S DDWCOL=1 57: S:DDWLN>DDWCNT DDWLN=DDWCNT 58: I DDWLN>DDWA,DDWLN'>(DDWA+DDWMR-1) D 59: . D POS(DDWLN-DDWA,DDWCOL,"RN") 60: E I DDWLN>DDWA D 61: . D SHFTDN^DDW3(DDWLN,DDWCOL),POS(DDWLN-DDWA,DDWCOL,"RN") 62: E D 63: . D SHFTUP^DDW3(DDWLN),POS(1,DDWCOL,"RN") 64: Q 65: ; 66: ASK(DDWLC,DDWS,DDWLEN,DDWDEF,DDWVAL,DDWHLP,DDWANS,DDWCOD) ;Prompt user 67: N DDWI 68: D CUP(DDWMR-DDWLC,1) 69: W $P(DDGLGRA,DDGLDEL)_$TR($J("",IOM)," ",$P(DDGLGRA,DDGLDEL,3))_$P(DDGLGRA,DDGLDEL,2) 70: F DDWI=DDWMR-DDWLC+1:1:DDWMR D CUP(DDWI,1) W $P(DDGLCLR,DDGLDEL) 71: K DDWANS F D PROMPT Q:$D(DDWANS) 72: ; 73: F DDWI=DDWMR-DDWLC:1:DDWMR D 74: . D CUP(DDWI,1) 75: . W $P(DDGLCLR,DDGLDEL)_$E(DDWL(DDWI),1+DDWOFS,IOM+DDWOFS) 76: D POS(DDWRW,DDWC,"RN") 77: Q 78: ; 79: PROMPT ;Issue read 80: N DDWERR,DDWX 81: D CUP(DDWMR-DDWLC+1,1) W DDWS_$P(DDGLCLR,DDGLDEL) 82: D EN^DIR0(IOTM+DDWMR-DDWLC-1,$L(DDWS),DDWLEN,1,$G(DDWDEF),245,"","","AKTW",.DDWX,.DDWCOD) 83: ; 84: I DDWCOD="TO" W $C(7) Q 85: I U[DDWX S DDWANS=DDWX Q 86: I $D(DDWHLP)>9!($G(DDWHLP)]""),DDWX?1."?" D HELP(.DDWHLP) Q 87: I $G(DDWVAL)]"" X DDWVAL I $D(DDWERR) W $C(7) D HELP(.DDWERR) Q 88: S DDWANS=DDWX 89: Q 90: ; 91: VALGTO ;Validate DDWX 92: N DDWCH 93: Q:DDWX=U 94: S DDWERR="Invalid format. Enter ? for examples." 95: Q:DDWX'?.1A.1P1.15N 96: I DDWX?1A.E S DDWCH=$E(DDWX) Q:"SsLlCc"'[DDWCH 97: I DDWX?.E1P.E I DDWX'["+",DDWX'["-" Q 98: K DDWERR 99: Q 100: ; 101: HELP(DDWMSG) ;Print message 102: N DDWI,DDWEC 103: S:$D(DDWMSG)<9 DDWMSG(1)=DDWMSG 104: S DDWEC=$O(DDWMSG(""),-1) 105: F DDWI=2:1:DDWLC D 106: . D CUP(DDWMR-DDWLC+DDWI,1) 107: . W $P(DDGLCLR,DDGLDEL)_$G(DDWMSG(DDWI-DDWLC+DDWEC)) 108: Q 109: ; 110: SCREEN() ;Return current screen 111: Q DDWA+DDWRW-1\DDWMR+1 112: ; 113: LTOSC(L) ;Convert line number to page number 114: Q L-1\DDWMR+1 115: ; 116: CUP(Y,X) ;Pos cursor 117: S DY=IOTM+Y-2,DX=X-1 X IOXY 118: Q 119: ; 120: POS(R,C,F) ;Pos cursor based on char pos C 121: N DDWX 122: S:$G(C)="E" C=$L($G(DDWL(R)))+1 123: S:$G(F)["N" DDWN=$G(DDWL(R)) 124: S:$G(F)["R" DDWRW=R,DDWC=C 125: ; 126: S DDWX=C-DDWOFS 127: I DDWX>IOM!(DDWX<1) D SHIFT^DDW3(C,.DDWOFS) 128: S DY=IOTM+R-2,DX=C-DDWOFS-1 X IOXY 129: Q