Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DDGF2

DDGF2.m

Go to the documentation of this file.
  1. DDGF2 ;SFISC/MKO - ACTIONS FOR SELECTED FIELDS ;1FEB2017
  1. ;;22.2;VA FileMan;**3,5**;Jan 05, 2016;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;GFT;**1055,1057**
  1. ;
  1. ;Input:
  1. ; B = internal block number
  1. ; F = internal field order
  1. ; T = type of element ("C" = caption, "D" = data)
  1. ; C = caption
  1. ; C1 = $Y of caption
  1. ; C2 = $X of caption
  1. ; D = data representation (underlines)
  1. ; D1 = $Y of data
  1. ; D2 = $X of data
  1. ; L = length of data
  1. ; P1 = page $Y
  1. ; P2 = page $X
  1. ; DDGFWID = "P1" or such
  1. N DDGFE
  1. S DDGFE=0,DDGFLSV=DDGFLIM
  1. S DDGFLIM=$P(@DDGFREF@("F",DDGFPG,B),U,1,2)_U_$P(DDGFLIM,U,3,4)
  1. ;
  1. D PAINTS
  1. S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE ;MOVE THE FIELD AROUND UNTIL SPACEBAR DESELECTS IT.
  1. D END
  1. D:$G(DDGFSUBP) SUBPG1^DDGFPG
  1. Q
  1. ;
  1. END ;Redraw field 'F' on block 'B'
  1. S DDGFLIM=DDGFLSV K DDGFLSV
  1. Q:$D(^DIST(.404,B,40,F,0))[0
  1. N OLD,NEW,CAP,DATA S (NEW,OLD)=$G(^(2)),CAP=$P(NEW,U,3),DATA=$P(NEW,U,1)
  1. ;^DIST(.404,D0,40,D1,2)= (#4.1) DATA COORDINATE [1F] ^ (#4.2) DATA LENGTH [2N] ^ (#5.1) CAPTION COORDINATE [3F] ^ (#5.2) SUPPRESS COLON AFTER CAPTION? [4S]
  1. S $P(NEW,U,2)=$G(L) ;LENGTH WILL NOT BE THERE, IF THIS IS A CAPTION
  1. S $P(CAP,",",1)=C1+1,$P(CAP,",",2)=C2+1
  1. S C3=C2+$L(C)-1 ;CAPTION END POINT
  1. I T="C",C]"" D
  1. . D WRITE^DDGLIBW(DDGFWID,C,C1-P1,C2-P2)
  1. . S @DDGFREF@("RC",DDGFWID,C1,C2,C3,B,F,"C")=""
  1. ;
  1. I $D(D) D
  1. . S $P(DATA,",",1)=D1+1,$P(DATA,",",2)=D2+1
  1. . S D3=D2+L-1 ;DATA END POINT
  1. . D WRITE^DDGLIBW(DDGFWID,D,D1-P1,D2-P2)
  1. . S @DDGFREF@("RC",DDGFWID,D1,D2,D3,B,F,"D")=""
  1. ;
  1. 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
  1. D KILLPGS^DDGFFLDA(B,DDGFWID) ;BLOCK MAY BE ON ANOTHER PAGE
  1. ;
  1. X IOXY
  1. Q
  1. ;
  1. TO ;Time-out
  1. W $C(7)
  1. G DESELECT
  1. ;
  1. DESELECT ;SPACE-BAR HAS DESELECTED FIELD
  1. S DDGFE=1
  1. Q
  1. ;
  1. LNU I T="C" Q:C1'>$P(DDGFLIM,U) ;LINE FEED UP
  1. I $D(D),D1'>$P(DDGFLIM,U) Q
  1. D REDRAW S:T="C" C1=C1-1
  1. S:$D(D) D1=D1-1
  1. S DY=DY-1
  1. D PAINTS
  1. Q
  1. LND I T="C" Q:C1'<$P(DDGFLIM,U,3) ;LINE FEED DOWN
  1. I $D(D),D1'<$P(DDGFLIM,U,3) Q
  1. D REDRAW
  1. S:T="C" C1=C1+1
  1. S:$D(D) D1=D1+1
  1. S DY=DY+1
  1. D PAINTS
  1. Q
  1. CHR I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
  1. I $D(D),D2+L>$P(DDGFLIM,U,4) Q
  1. D REDRAW S:T="C" C2=C2+1
  1. S:$D(D) D2=D2+1
  1. S DX=DX+1
  1. D PAINTS
  1. Q
  1. CHL I T="C" Q:C2'>$P(DDGFLIM,U,2)
  1. I $D(D),D2'>$P(DDGFLIM,U,2) Q
  1. D REDRAW S:T="C" C2=C2-1
  1. S:$D(D) D2=D2-1
  1. S DX=DX-1
  1. D PAINTS
  1. Q
  1. TBR N X
  1. I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
  1. I $D(D),D2+L>$P(DDGFLIM,U,4) Q
  1. D REDRAW
  1. I T="C" D
  1. . S X=$$MIN(5,$P(DDGFLIM,U,4)-(C2+$L(C)),$S($D(D):$P(DDGFLIM,U,4)-(D2+L)+1,1:""))
  1. . S C2=C2+X
  1. E S X=$$MIN(5,$P(DDGFLIM,U,4)-(D2+L)+1)
  1. S:$D(D) D2=D2+X
  1. S DX=DX+X
  1. D PAINTS
  1. Q
  1. TBL N X
  1. I T="C" Q:C2'>$P(DDGFLIM,U,2)
  1. I $D(D),D2'>$P(DDGFLIM,U,2) Q
  1. D REDRAW
  1. I T="C" D
  1. . S X=$$MIN(5,C2-$P(DDGFLIM,U,2),$S($D(D):D2-$P(DDGFLIM,U,2),1:""))
  1. . S C2=C2-X
  1. E S X=$$MIN(5,D2-$P(DDGFLIM,U,2))
  1. S:$D(D) D2=D2-X
  1. S DX=DX-X
  1. D PAINTS
  1. Q
  1. SCT N Y
  1. I T="C" Q:C1'>$P(DDGFLIM,U)
  1. I $D(D),D1'>$P(DDGFLIM,U) Q
  1. D REDRAW
  1. I T="C" S Y=$S('$D(D):C1,C1<D1:C1,1:D1)-$P(DDGFLIM,U),C1=C1-Y
  1. E S Y=D1-$P(DDGFLIM,U)
  1. S:$D(D) D1=D1-Y
  1. S DY=DY-Y
  1. D PAINTS
  1. Q
  1. SCB N Y
  1. I T="C" Q:C1'<$P(DDGFLIM,U,3)
  1. I $D(D),D1'<$P(DDGFLIM,U,3) Q
  1. D REDRAW
  1. I T="C" S Y=$P(DDGFLIM,U,3)-$S('$D(D):C1,C1>D1:C1,1:D1),C1=C1+Y
  1. E S Y=$P(DDGFLIM,U,3)-D1
  1. S:$D(D) D1=D1+Y
  1. S DY=DY+Y
  1. D PAINTS
  1. Q
  1. SCR N X
  1. I T="C" Q:C2+$L(C)>$P(DDGFLIM,U,4)
  1. I $D(D),D2+L>$P(DDGFLIM,U,4) Q
  1. D REDRAW
  1. I T="C" D
  1. . S X=$P(DDGFLIM,U,4)-$S('$D(D):C2+$L(C),C2+$L(C)>(D2+L):C2+$L(C),1:D2+L)+1
  1. . S C2=C2+X
  1. E S X=$P(DDGFLIM,U,4)-(D2+L)+1
  1. S:$D(D) D2=D2+X
  1. S DX=DX+X
  1. D PAINTS
  1. Q
  1. SCL N X
  1. I T="C" Q:C2'>$P(DDGFLIM,U,2)
  1. I $D(D),D2'>$P(DDGFLIM,U,2) Q
  1. D REDRAW
  1. I T="C" S X=$S('$D(D):C2,C2<D2:C2,1:D2)-$P(DDGFLIM,U,2),C2=C2-X
  1. E S X=D2-$P(DDGFLIM,U,2)
  1. S:$D(D) D2=D2-X
  1. S DX=DX-X
  1. D PAINTS
  1. Q
  1. EDIT ;A SEPARATE SCREENMAN FORM WILL EDIT THIS SINGLE FIELD
  1. G EDIT^DDGFFLD
  1. SUBPG ;
  1. G SUBPG^DDGFPG
  1. ;
  1. RC(DDGFY,DDGFX) ;Update status line, reset DX and DY, move cursor
  1. N DDGFS
  1. I DDGFR D
  1. . S DY=IOSL-6,DX=IOM-9,DDGFS="R"_(DDGFY+1)_",C"_(DDGFX+1)
  1. . X IOXY W DDGFS_$J("",7-$L(DDGFS))
  1. S DY=DDGFY,DX=DDGFX X IOXY
  1. Q
  1. ;
  1. REDRAW ;
  1. D:T="C" REPAINT^DDGLIBW(DDGFWID,(C1-P1)_U_(C2-P2)_U_1_U_$L(C))
  1. D:$D(D) REPAINT^DDGLIBW(DDGFWID,(D1-P1)_U_(D2-P2)_U_1_U_L)
  1. Q
  1. ;
  1. PAINTS ;
  1. N Y,X
  1. S Y=DY,X=DX
  1. 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)
  1. 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)
  1. D RC(Y,X)
  1. Q
  1. ;
  1. MIN(X,Y,Z) ;Return the minimum of two or three numbers
  1. N A
  1. S A=$S(X<Y:X,1:Y)
  1. Q:$G(Z)="" A
  1. Q $S(A<Z:A,1:Z)
  1. ;
  1. READ() N S,Y
  1. F R *Y:DTIME D C Q:Y'=-1
  1. Q Y
  1. ;
  1. C I Y<0 S Y="TO" Q
  1. S S=""
  1. C1 S S=S_$C(Y)
  1. I DDGF("SIN")'[(U_S) D I Y=-1 W $C(7) Q
  1. . I $C(Y)'?1L S Y=-1 Q
  1. . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("SIN")'[(U_S_U) Y=-1
  1. ;
  1. I DDGF("SIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("SOUT"),U,$L($P(DDGF("SIN"),U_S_U),U)) Q
  1. R *Y:5 G:Y'=-1 C1 W $C(7)
  1. Q