Annotation of freem_fileman/DDGF4.m, revision 1.1

1.1     ! snw         1: DDGF4  ;SFISC/MKO-ACTIONS AFTER BLOCK SELECTION ;02:49 PM  12 Oct 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;Input:
        !             5:        ;  B     = Block number
        !             6:        ;  C     = Block name
        !             7:        ;  C1    = Block $Y
        !             8:        ;  C2    = Block $X1
        !             9:        ;  C3    = Block $X2
        !            10:        ;  DDGFHDR = 1, if block is immobile (header block)
        !            11:        ;
        !            12:        N DDGFE
        !            13:        S:'$G(DDGFHDR) DDGFHDR=0
        !            14:        D PAINTS
        !            15:        ;
        !            16:        S DDGFE=0 F  S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
        !            17:        D CLEANUP
        !            18:        Q
        !            19:        ;
        !            20: LNU    Q:C1'>$P(DDGFLIM,U)!DDGFHDR
        !            21:        D REDRAW
        !            22:        S C1=C1-1,DY=DY-1
        !            23:        D PAINTS
        !            24:        Q
        !            25: LND    Q:C1'<$P(DDGFLIM,U,3)!DDGFHDR
        !            26:        D REDRAW
        !            27:        S C1=C1+1,DY=DY+1
        !            28:        D PAINTS
        !            29:        Q
        !            30: CHR    Q:C2'<$P(DDGFLIM,U,4)!DDGFHDR
        !            31:        D REDRAW
        !            32:        S C2=C2+1,DX=DX+1
        !            33:        D PAINTS
        !            34:        Q
        !            35: CHL    Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
        !            36:        D REDRAW
        !            37:        S C2=C2-1,DX=DX-1
        !            38:        D PAINTS
        !            39:        Q
        !            40: TBR    N X
        !            41:        Q:C2+$L(C)>$P(DDGFLIM,U,4)!DDGFHDR
        !            42:        D REDRAW
        !            43:        S X=$$MIN(5,$P(DDGFLIM,U,4)-C2-$L(C)+1)
        !            44:        S C2=C2+X,DX=DX+X
        !            45:        D PAINTS
        !            46:        Q
        !            47: TBL    N X
        !            48:        Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
        !            49:        D REDRAW
        !            50:        S X=$$MIN(5,C2-$P(DDGFLIM,U,2))
        !            51:        S C2=C2-X,DX=DX-X
        !            52:        D PAINTS
        !            53:        Q
        !            54: SCT    Q:C1'>$P(DDGFLIM,U)!DDGFHDR
        !            55:        D REDRAW
        !            56:        S (C1,DY)=$P(DDGFLIM,U)
        !            57:        D PAINTS
        !            58:        Q
        !            59: SCB    Q:C1'<$P(DDGFLIM,U,3)!DDGFHDR
        !            60:        D REDRAW
        !            61:        S (C1,DY)=$P(DDGFLIM,U,3)
        !            62:        D PAINTS
        !            63:        Q
        !            64: SCR    N X
        !            65:        Q:C2+$L(C)>$P(DDGFLIM,U,4)!DDGFHDR
        !            66:        D REDRAW
        !            67:        S X=$P(DDGFLIM,U,4)-C2-$L(C)+1
        !            68:        S C2=C2+X,DX=DX+X
        !            69:        D PAINTS
        !            70:        Q
        !            71: SCL    N X
        !            72:        Q:C2'>$P(DDGFLIM,U,2)!DDGFHDR
        !            73:        D REDRAW
        !            74:        S X=C2-$P(DDGFLIM,U,2)
        !            75:        S C2=C2-X,DX=DX-X
        !            76:        D PAINTS
        !            77:        Q
        !            78:        ;
        !            79: EDIT   ;Edit block parameters
        !            80:        G:'$G(DDGFHDR) EDIT^DDGFBK
        !            81:        G EDIT^DDGFHBK
        !            82:        ;
        !            83: REORDER        ;Reorder fields on block
        !            84:        D EN^DDGFORD(B)
        !            85:        Q
        !            86:        ;
        !            87: TO     ;Time-out
        !            88:        W $C(7)
        !            89:        G DESELECT
        !            90:        ;
        !            91: DESELECT       ;
        !            92:        S DDGFE=1
        !            93:        Q
        !            94:        ;
        !            95: CLEANUP        ;
        !            96:        I '$G(DDGFBDEL) D
        !            97:        . S C3=C2+$L(C)-1
        !            98:        . S @DDGFREF@("F",DDGFPG,B)=C1_U_C2_U_C3_U_C_U_1,DDGFCHG=1
        !            99:        . S @DDGFREF@("BKRC",DDGFWIDB,C1,C2,C3,B)=$S($G(DDGFHDR):"H",1:"")
        !           100:        ;
        !           101:        I '$G(DDGFEBV),'$G(DDGFBDEL) D
        !           102:        . D WRITE^DDGLIBW(DDGFWIDB,C,C1-$P(DDGFLIM,U),C2-$P(DDGFLIM,U,2))
        !           103:        . X IOXY
        !           104:        K DDGFHDR,DDGFBDEL
        !           105:        Q
        !           106:        ;
        !           107: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
        !           108:        N S
        !           109:        I DDGFR D
        !           110:        . S DY=IOSL-6,DX=IOM-9,S="R"_(DDGFY+1)_",C"_(DDGFX+1)
        !           111:        . X IOXY W S_$J("",7-$L(S))
        !           112:        S DY=DDGFY,DX=DDGFX X IOXY
        !           113:        Q
        !           114:        ;
        !           115: REDRAW ;
        !           116:        D REPAINT^DDGLIBW(DDGFWIDB,(C1-$P(DDGFLIM,U))_U_(C2-$P(DDGFLIM,U,2))_U_1_U_$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))
        !           117:        Q
        !           118:        ;
        !           119: PAINTS ;
        !           120:        N Y,X
        !           121:        S Y=DY,X=DX
        !           122:        S DY=C1,DX=C2 X IOXY
        !           123:        W $P(DDGLVID,DDGLDEL,6)_$E(C,1,$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))_$P(DDGLVID,DDGLDEL,10)
        !           124:        D RC(Y,X)
        !           125:        Q
        !           126:        ;
        !           127: MIN(X,Y,Z)     ;Return the minimum of two or three numbers
        !           128:        N A
        !           129:        S A=$S(X<Y:X,1:Y)
        !           130:        Q:$G(Z)="" A
        !           131:        Q $S(A<Z:A,1:Z)
        !           132:        ;
        !           133: READ() N S,Y
        !           134:        F  R *Y:DTIME D C Q:Y'=-1
        !           135:        Q Y
        !           136:        ;
        !           137: C      I Y<0 S Y="TO" Q
        !           138:        S S=""
        !           139: C1     S S=S_$C(Y)
        !           140:        I DDGF("SIN")'[(U_S) D  I Y=-1 W $C(7) Q
        !           141:        . I $C(Y)'?1L S Y=-1 Q
        !           142:        . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
        !           143:        ;
        !           144:        I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
        !           145:        R *Y:5 G:Y'=-1 C1 W $C(7)
        !           146:        Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>