VistA-WorldVistAEHR/r/VA_FILEMAN-ARJT-DI-DD-DM-DT.../DDGLBXA1.m

209 lines
4.7 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
DDGLBXA1 ;SFISC/MKO-SINGLE SELECTION LIST BOX ;11:33 AM 26 Apr 1996
;;22.0;VA FileMan;;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
N DDGLQT,Y
D CUP(DDGLLINE,1)
;
S DDGLQT=0
F S Y=$$READ D Q:DDGLQT
. I Y'[U,$T(@Y)="" W $C(7) Q
. D @Y
. D:$G(DDGLKEY("KMAP","KD"))]"" @DDGLKEY("KMAP","KD")
;
S:$P(DDGLQT,U,2,999)]"" DDGLOUT("C")=$P(DDGLQT,U,2,999)
Q
;
UP ;Move up
I DDGLLINE>1 D
. D CUP(DDGLLINE,1)
. W $E(DDGLSEL,1,DDGLNC)
. S DDGLLINE=DDGLLINE-1
. S DDGLSEL=DDGLITEM(DDGLLINE)
. ;
. D CUP(DDGLLINE,1)
. W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
;
E D
. N DDGLE
. D SHIFTDN(1,.DDGLE) Q:$G(DDGLE)
. S DDGLSEL=DDGLITEM(1)
. D DISP(DDGLSEL)
Q
;
DN ;Move down
I DDGLLINE<DDGLNL D
. Q:DDGLITEM(DDGLLINE+1)=""
. D CUP(DDGLLINE,1)
. W $E(DDGLSEL,1,DDGLNC)
. S DDGLLINE=DDGLLINE+1
. S DDGLSEL=DDGLITEM(DDGLLINE)
. ;
. D CUP(DDGLLINE,1)
. W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
;
E D
. N DDGLE
. D SHIFTUP(1,.DDGLE) Q:$G(DDGLE)
. S DDGLSEL=DDGLITEM(DDGLNL)
. D DISP(DDGLSEL)
Q
;
PUP ;Page up in list
I DDGLLINE>1 D
. D CUP(DDGLLINE,1)
. W $E(DDGLSEL,1,DDGLNC)
. S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
. D CUP(1,1)
. W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
;
E D
. N DDGLE
. D SHIFTDN(DDGLNL,.DDGLE) Q:$G(DDGLE)
. S DDGLSEL=DDGLITEM(1)
. D DISP(DDGLSEL)
Q
;
PDN ;Page down in list
I DDGLLINE<DDGLNL D
. D CUP(DDGLLINE,1)
. W $E(DDGLSEL,1,DDGLNC)
. F DDGLLINE=DDGLNL:-1:1 Q:DDGLITEM(DDGLLINE)]""
. S DDGLSEL=DDGLITEM(DDGLLINE)
. D CUP(DDGLLINE,1)
. W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
;
E D
. N DDGLE
. D SHIFTUP(DDGLNL,.DDGLE) Q:$G(DDGLE)
. S DDGLSEL=DDGLITEM(DDGLNL)
. D DISP(DDGLSEL)
Q
;
TOP ;Move to top of list
N DDGLFRST,DDGLI,DDGLT
;
;Check whether first item in list is the first displayed
S DDGLFRST=$O(@DDGLGLO@(""))
I DDGLFRST=DDGLITEM(1) D:DDGLLINE>1 PUP Q
;
;Fill DDGLITEM array
S DDGLT=DDGLFRST
F DDGLI=1:1:DDGLNL D
. S DDGLITEM(DDGLI)=DDGLT
. S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
;
S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
D DISP(DDGLSEL)
Q
;
BOT ;Move to bottom of list
N DDGLAST,DDGLI,DDGLT,DDGLIND
;
;Set DDGLIND = index of last non-null DDGLITEM
F DDGLIND=DDGLNL:-1:1 Q:DDGLITEM(DDGLIND)]""
;
S DDGLAST=$O(@DDGLGLO@(""),-1)
I DDGLAST=DDGLITEM(DDGLIND) D:DDGLLINE<DDGLIND PDN Q
;
;Fill DDGLITEM array
S DDGLT=DDGLAST
F DDGLI=DDGLNL:-1:1 D
. S DDGLITEM(DDGLI)=DDGLT
. S DDGLT=$O(@DDGLGLO@(DDGLT),-1)
;
S DDGLLINE=DDGLNL,DDGLSEL=DDGLITEM(DDGLNL)
D DISP(DDGLSEL)
Q
;
SEL ;Select item
K DDGLOUT
S DDGLOUT=$O(@DDGLGLO@(DDGLSEL,"")),DDGLOUT(0)=DDGLSEL
S DDGLOUT("C")="SEL"
S DDGLQT=1
Q
;
QT ;Quit
K DDGLOUT
S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="QT"
S DDGLQT=1
Q
;
TO ;Timeout
D:$G(DDGLKEY("KMAP","TO"))]"" @DDGLKEY("KMAP","TO")
K DDGLOUT
S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="TO"
S DDGLQT=1
Q
;
READ() ;Read next key and return mnemonic
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 DDGLKEY("KMAP","IN")'[(U_S) D I Y=-1 W $C(7) D FLUSH Q
. I $C(Y)'?1L S Y=-1 Q
. S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGLKEY("KMAP","IN")'[(U_S_U) Y=-1
;
I DDGLKEY("KMAP","IN")[(U_S_U),S'=$C(27) S Y=$P(DDGLKEY("KMAP","OUT"),";",$L($P(DDGLKEY("KMAP","IN"),U_S_U),U)) Q
R *Y:5 G:Y'=-1 C1
W $C(7)
Q
;
SHIFTDN(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
;Out: DDGLE = 1, if no more items above
;
N DDGLI,DDGLT,DDGLA
S DDGLE=0
S DDGLT=DDGLITEM(1) I DDGLT="" S DDGLE=1 Q
;
F DDGLI=-1:-1:-DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT),-1) Q:DDGLT="" D
. S DDGLA(DDGLI)=DDGLT
S:DDGLT="" DDGLI=DDGLI+1
I DDGLI=0 S DDGLE=1 Q
S DDGLN=-DDGLI
;
F DDGLI=DDGLNL:-1:DDGLN+1 S DDGLITEM(DDGLI)=DDGLITEM(DDGLI-DDGLN)
F DDGLI=DDGLN:-1:1 S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLN-1)
Q
;
SHIFTUP(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
;Out: DDGLE = 1, if no more items above
;
N DDGLI,DDGLT,DDGLA
S DDGLE=0
S DDGLT=DDGLITEM(DDGLNL) I DDGLT="" S DDGLE=1 Q
;
F DDGLI=1:1:DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT)) Q:DDGLT="" D
. S DDGLA(DDGLI)=DDGLT
S:DDGLT="" DDGLI=DDGLI-1
I DDGLI=0 S DDGLE=1 Q
S DDGLN=DDGLI
;
F DDGLI=1:1:DDGLNL-DDGLN S DDGLITEM(DDGLI)=DDGLITEM(DDGLI+DDGLN)
F DDGLI=DDGLNL-DDGLN+1:1:DDGLNL S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLNL+DDGLN)
Q
;
DISP(DDGLSEL) ;Display the list
;In: DDGLSEL = text of selected item
;
N DDGLI,DDGLT
F DDGLI=1:1:DDGLNL D
. D CUP(DDGLI,1)
. S DDGLT=$E(DDGLITEM(DDGLI),1,DDGLNC)
. S DDGLT=$S(DDGLT=DDGLSEL:$P(DDGLVID,DDGLDEL,6)_DDGLT_$P(DDGLVID,DDGLDEL,10),1:DDGLT)_$J("",DDGLNC-$L(DDGLT))
. W DDGLT
Q
;
FLUSH ;Flush read buffer
N DDGLX
F R *DDGLX:0 E Q
Q
;
CUP(Y,X) ;Position cursor relative to list coords
S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
Q