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>