Annotation of freem_fileman/USER/DDGF2.m, revision 1.1

1.1     ! snw         1: DDGF2  ;SFISC/MKO-ACTIONS FOR SELECTED FIELDS ;02:48 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  = internal block number
        !             6:        ;  F  = internal field order
        !             7:        ;  T  = type of element ("C" = caption, "D" = data)
        !             8:        ;  C  = caption
        !             9:        ;  C1 = $Y of caption
        !            10:        ;  C2 = $X of caption
        !            11:        ;  D  = data representation (underlines)
        !            12:        ;  D1 = $Y of data
        !            13:        ;  D2 = $X of data
        !            14:        ;  L  = length of data
        !            15:        ;  P1 = page $Y
        !            16:        ;  P2 = page $X
        !            17:        N DDGFE
        !            18:        S DDGFE=0,DDGFLSV=DDGFLIM
        !            19:        S DDGFLIM=$P(@DDGFREF@("F",DDGFPG,B),U,1,2)_U_$P(DDGFLIM,U,3,4)
        !            20:        ;
        !            21:        D PAINTS
        !            22:        S DDGFE=0 F  S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
        !            23:        D END
        !            24:        D:$G(DDGFSUBP) SUBPG1^DDGFPG
        !            25:        Q
        !            26:        ;
        !            27: END    ;Redraw the field
        !            28:        S DDGFLIM=DDGFLSV K DDGFLSV
        !            29:        Q:$D(^DIST(.404,B,40,F,0))[0
        !            30:        ;
        !            31:        S C3=C2+$L(C)-1
        !            32:        I T="C",C]"" D
        !            33:        . D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2)
        !            34:        . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
        !            35:        ;
        !            36:        I $D(D) D
        !            37:        . S D3=D2+L-1
        !            38:        . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
        !            39:        . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
        !            40:        ;
        !            41:        S @DDGFREF@("F",DDGFPG,B,F)=C1_U_C2_U_C3_U_C_U_$S($D(D):D1_U_D2_U_D3_U_L,1:"^^^")_U_1,DDGFCHG=1
        !            42:        X IOXY
        !            43:        Q
        !            44:        ;
        !            45: TO     ;Time-out
        !            46:        W $C(7)
        !            47:        G DESELECT
        !            48:        ;
        !            49: DESELECT       ;
        !            50:        S DDGFE=1
        !            51:        Q
        !            52:        ;
        !            53: LNU    I T="C" Q:C1'>$P(DDGFLIM,U)
        !            54:        I $D(D),D1'>$P(DDGFLIM,U) Q
        !            55:        D REDRAW S:T="C" C1=C1-1
        !            56:        S:$D(D) D1=D1-1
        !            57:        S DY=DY-1
        !            58:        D PAINTS
        !            59:        Q
        !            60: LND    I T="C" Q:C1'<$P(DDGFLIM,U,3)
        !            61:        I $D(D),D1'<$P(DDGFLIM,U,3) Q
        !            62:        D REDRAW
        !            63:        S:T="C" C1=C1+1
        !            64:        S:$D(D) D1=D1+1
        !            65:        S DY=DY+1
        !            66:        D PAINTS
        !            67:        Q
        !            68: CHR    I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
        !            69:        I $D(D),D2+L>$P(DDGFLIM,U,4) Q
        !            70:        D REDRAW S:T="C" C2=C2+1
        !            71:        S:$D(D) D2=D2+1
        !            72:        S DX=DX+1
        !            73:        D PAINTS
        !            74:        Q
        !            75: CHL    I T="C" Q:C2'>$P(DDGFLIM,U,2)
        !            76:        I $D(D),D2'>$P(DDGFLIM,U,2) Q
        !            77:        D REDRAW S:T="C" C2=C2-1
        !            78:        S:$D(D) D2=D2-1
        !            79:        S DX=DX-1
        !            80:        D PAINTS
        !            81:        Q
        !            82: TBR    N X
        !            83:        I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
        !            84:        I $D(D),D2+L>$P(DDGFLIM,U,4) Q
        !            85:        D REDRAW
        !            86:        I T="C" D
        !            87:        . S X=$$MIN(5,$P(DDGFLIM,U,4)-(C2+$L(C)),$S($D(D):$P(DDGFLIM,U,4)-(D2+L)+1,1:""))
        !            88:        . S C2=C2+X
        !            89:        E  S X=$$MIN(5,$P(DDGFLIM,U,4)-(D2+L)+1)
        !            90:        S:$D(D) D2=D2+X
        !            91:        S DX=DX+X
        !            92:        D PAINTS
        !            93:        Q
        !            94: TBL    N X
        !            95:        I T="C" Q:C2'>$P(DDGFLIM,U,2)
        !            96:        I $D(D),D2'>$P(DDGFLIM,U,2) Q
        !            97:        D REDRAW
        !            98:        I T="C" D
        !            99:        . S X=$$MIN(5,C2-$P(DDGFLIM,U,2),$S($D(D):D2-$P(DDGFLIM,U,2),1:""))
        !           100:        . S C2=C2-X
        !           101:        E  S X=$$MIN(5,D2-$P(DDGFLIM,U,2))
        !           102:        S:$D(D) D2=D2-X
        !           103:        S DX=DX-X
        !           104:        D PAINTS
        !           105:        Q
        !           106: SCT    N Y
        !           107:        I T="C" Q:C1'>$P(DDGFLIM,U)
        !           108:        I $D(D),D1'>$P(DDGFLIM,U) Q
        !           109:        D REDRAW
        !           110:        I T="C" S Y=$S('$D(D):C1,C1<D1:C1,1:D1)-$P(DDGFLIM,U),C1=C1-Y
        !           111:        E  S Y=D1-$P(DDGFLIM,U)
        !           112:        S:$D(D) D1=D1-Y
        !           113:        S DY=DY-Y
        !           114:        D PAINTS
        !           115:        Q
        !           116: SCB    N Y
        !           117:        I T="C" Q:C1'<$P(DDGFLIM,U,3)
        !           118:        I $D(D),D1'<$P(DDGFLIM,U,3) Q
        !           119:        D REDRAW
        !           120:        I T="C" S Y=$P(DDGFLIM,U,3)-$S('$D(D):C1,C1>D1:C1,1:D1),C1=C1+Y
        !           121:        E  S Y=$P(DDGFLIM,U,3)-D1
        !           122:        S:$D(D) D1=D1+Y
        !           123:        S DY=DY+Y
        !           124:        D PAINTS
        !           125:        Q
        !           126: SCR    N X
        !           127:        I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
        !           128:        I $D(D),D2+L>$P(DDGFLIM,U,4) Q
        !           129:        D REDRAW
        !           130:        I T="C" D
        !           131:        . S X=$P(DDGFLIM,U,4)-$S('$D(D):C2+$L(C),C2+$L(C)>(D2+L):C2+$L(C),1:D2+L)+1
        !           132:        . S C2=C2+X
        !           133:        E  S X=$P(DDGFLIM,U,4)-(D2+L)+1
        !           134:        S:$D(D) D2=D2+X
        !           135:        S DX=DX+X
        !           136:        D PAINTS
        !           137:        Q
        !           138: SCL    N X
        !           139:        I T="C" Q:C2'>$P(DDGFLIM,U,2)
        !           140:        I $D(D),D2'>$P(DDGFLIM,U,2) Q
        !           141:        D REDRAW
        !           142:        I T="C" S X=$S('$D(D):C2,C2<D2:C2,1:D2)-$P(DDGFLIM,U,2),C2=C2-X
        !           143:        E  S X=D2-$P(DDGFLIM,U,2)
        !           144:        S:$D(D) D2=D2-X
        !           145:        S DX=DX-X
        !           146:        D PAINTS
        !           147:        Q
        !           148: EDIT   ;
        !           149:        G EDIT^DDGFFLD
        !           150: SUBPG  ;
        !           151:        G SUBPG^DDGFPG
        !           152:        ;
        !           153: RC(DDGFY,DDGFX)        ;Update status line, reset DX and DY, move cursor
        !           154:        N DDGFS
        !           155:        I DDGFR D
        !           156:        . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
        !           157:        . X IOXY W DDGFS_$J("",7-$L(DDGFS))
        !           158:        S DY=DDGFY,DX=DDGFX X IOXY
        !           159:        Q
        !           160:        ;
        !           161: REDRAW ;
        !           162:        D:T="C" REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C2-P2)_U_1_U_$L(C))
        !           163:        D:$D(D) REPAINT^DDGLIBW(DDGFWID,(D1-P1)_U_(D2-P2)_U_1_U_L)
        !           164:        Q
        !           165:        ;
        !           166: PAINTS ;
        !           167:        N Y,X
        !           168:        S Y=DY,X=DX
        !           169:        I T="C" S DY=C1,DX=C2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(C,1,$$MIN($L(C),$P(DDGFLIM,U,4)-C2+1))_$P(DDGLVID,DDGLDEL,10)
        !           170:        I $D(D) S DY=D1,DX=D2 X IOXY W $P(DDGLVID,DDGLDEL,6)_$E(D,1,$$MIN(L,$P(DDGFLIM,U,4)-D2+1))_$P(DDGLVID,DDGLDEL,10)
        !           171:        D RC(Y,X)
        !           172:        Q
        !           173:        ;
        !           174: MIN(X,Y,Z)     ;Return the minimum of two or three numbers
        !           175:        N A
        !           176:        S A=$S(X<Y:X,1:Y)
        !           177:        Q:$G(Z)="" A
        !           178:        Q $S(A<Z:A,1:Z)
        !           179:        ;
        !           180: READ() N S,Y
        !           181:        F  R *Y:DTIME D C Q:Y'=-1
        !           182:        Q Y
        !           183:        ;
        !           184: C      I Y<0 S Y="TO" Q
        !           185:        S S=""
        !           186: C1     S S=S_$C(Y)
        !           187:        I DDGF("SIN")'[(U_S) D  I Y=-1 W $C(7) Q
        !           188:        . I $C(Y)'?1L S Y=-1 Q
        !           189:        . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
        !           190:        ;
        !           191:        I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
        !           192:        R *Y:5 G:Y'=-1 C1 W $C(7)
        !           193:        Q

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