DDGFADL ;SFISC/MKO-ADJUST DATA LENGTH ;11:28 AM 22 Dec 1993
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
N DDGFE
D DRAW(1)
S DDGFE=0 F S Y=$$READ W:$T(@Y)="" $C(7) D:$T(@Y)]"" @Y Q:DDGFE
Q
;
CHR Q:L'<($P(DDGFLIM,U,4)-D2+1)
S L=L+1,D=D_"_"
D DRAW(1)
Q
CHL Q:L<2
S L=L-1,D=$E(D,1,$L(D)-1)
D DRAW(-1)
Q
DONE ;
S DDGFE=1,D3=D2+L-1,DDGFDY=DY,DDGFDX=DX
S DY=IOSL-6,DX=IOM-9
X IOXY W $J("",7)
S DY=DDGFDY,DX=DDGFDX X IOXY
K DDGFDY,DDGFDX
Q
DRAW(I) ;Draw line
;I = 1 if we've increased the data length, -1 if we've decreased it
;
N S,X,Y
S X=DX,Y=DY
S DY=D1,DX=D2 X IOXY
W $P(DDGLVID,DDGLDEL,6)_D_$P(DDGLVID,DDGLDEL,10)_$E(" ",1,I=-1)
S DY=IOSL-6,DX=IOM-9,S="L="_L X IOXY W S_$J("",7-$L(S))
I I=-1 D REPAINT^DDGLIBW(DDGFWID,D1_U_(D2+L)_U_1_U_1)
;
S DX=X,DY=Y X IOXY
Q
;
READ() N S,Y
F R *Y:DTIME D C Q:Y'=-1
Q Y
;
C I Y<0 S Y="TO" Q
S S=""
C1 S S=S_$C(Y)
I DDGF("DIN")'[(U_S) D I Y=-1 W $C(7) Q
. I $C(Y)'?1L S Y=-1 Q
. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGF("DIN")'[(U_S_U) Y=-1
;
I DDGF("DIN")[(U_S_U),S'=$C(27) S Y=$P(DDGF("DOUT"),U,$L($P(DDGF("DIN"),U_S_U),U)) Q
R *Y:5 G:Y'=-1 C1 W $C(7)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGFADL 1441 printed Oct 16, 2024@18:42:49 Page 2
DDGFADL ;SFISC/MKO-ADJUST DATA LENGTH ;11:28 AM 22 Dec 1993
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 NEW DDGFE
+8 DO DRAW(1)
+9 SET DDGFE=0
FOR
SET Y=$$READ
if $TEXT(@Y)=""
WRITE $CHAR(7)
if $TEXT(@Y)]""
DO @Y
if DDGFE
QUIT
+10 QUIT
+11 ;
CHR if L'<($PIECE(DDGFLIM,U,4)-D2+1)
QUIT
+1 SET L=L+1
SET D=D_"_"
+2 DO DRAW(1)
+3 QUIT
CHL if L<2
QUIT
+1 SET L=L-1
SET D=$EXTRACT(D,1,$LENGTH(D)-1)
+2 DO DRAW(-1)
+3 QUIT
DONE ;
+1 SET DDGFE=1
SET D3=D2+L-1
SET DDGFDY=DY
SET DDGFDX=DX
+2 SET DY=IOSL-6
SET DX=IOM-9
+3 XECUTE IOXY
WRITE $JUSTIFY("",7)
+4 SET DY=DDGFDY
SET DX=DDGFDX
XECUTE IOXY
+5 KILL DDGFDY,DDGFDX
+6 QUIT
DRAW(I) ;Draw line
+1 ;I = 1 if we've increased the data length, -1 if we've decreased it
+2 ;
+3 NEW S,X,Y
+4 SET X=DX
SET Y=DY
+5 SET DY=D1
SET DX=D2
XECUTE IOXY
+6 WRITE $PIECE(DDGLVID,DDGLDEL,6)_D_$PIECE(DDGLVID,DDGLDEL,10)_$EXTRACT(" ",1,I=-1)
+7 SET DY=IOSL-6
SET DX=IOM-9
SET S="L="_L
XECUTE IOXY
WRITE S_$JUSTIFY("",7-$LENGTH(S))
+8 IF I=-1
DO REPAINT^DDGLIBW(DDGFWID,D1_U_(D2+L)_U_1_U_1)
+9 ;
+10 SET DX=X
SET DY=Y
XECUTE IOXY
+11 QUIT
+12 ;
READ() NEW S,Y
+1 FOR
READ *Y:DTIME
DO C
if Y'=-1
QUIT
+2 QUIT Y
+3 ;
C IF Y<0
SET Y="TO"
QUIT
+1 SET S=""
C1 SET S=S_$CHAR(Y)
+1 IF DDGF("DIN")'[(U_S)
Begin DoDot:1
+2 IF $CHAR(Y)'?1L
SET Y=-1
QUIT
+3 SET S=$EXTRACT(S,1,$LENGTH(S)-1)_$CHAR(Y-32)
if DDGF("DIN")'[(U_S_U)
SET Y=-1
End DoDot:1
IF Y=-1
WRITE $CHAR(7)
QUIT
+4 ;
+5 IF DDGF("DIN")[(U_S_U)
IF S'=$CHAR(27)
SET Y=$PIECE(DDGF("DOUT"),U,$LENGTH($PIECE(DDGF("DIN"),U_S_U),U))
QUIT
+6 READ *Y:5
if Y'=-1
GOTO C1
WRITE $CHAR(7)
+7 QUIT
