Return to DDGF4.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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