Return to DDGF2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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