Annotation of freem_fileman/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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DDGF2.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman