Return to DDWG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DDWG.m, revision 1.1

1.1     ! snw         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