DDGLBXA ;SFISC/MKO-A LIST BOX ;1:58 PM 26 Apr 1996
;;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.
;
LIST(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG,DDGLMAP) ;
;Input:
; DDGLGLO = closed reference of local or global that contains
; the list of entries
; @DDGLGLO("B",entry,index)=""
; DDGLROW = $Y of top left corner
; DDGLCOL = $X of top left corner
; DDGLHT = height of box
; DDGLWD = width of box
; DDGLSEL = text of selected item
; DDGLFLG = flags
; DDGLMAP = array to customize key sequences
;
;Output:
; DDGLOUT = index of selected entry (if any)
; DDGLOUT(0) = selected entry
; DDGLOUT("C") = code indicates what terminated the read
;
;Other variables:
N DDGLCID ; window (control) id
N DDGLNL ; number of lines in list
N DDGLNC ; number of columns in list
N DDGLLINE ; current line number
N DDGLITEM ; item array
; DDGLITEM(1..DDGLNL) = text of item displayed
;
Q:$G(DDGLGLO)=""
D INIT
X DDGLZOSF("EOFF")
W $P(DDGLVID,DDGLDEL,11)
;
D ^DDGLBXA1
;
W $P(DDGLVID,DDGLDEL,12)
X DDGLZOSF("EON")
D DESTROY(DDGLCID,$G(DDGLFLG))
Q
;
CREATE(DDGLGLO,DDGLCID,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLMAP) ;
;Create a list box window
;Out:
; .DDGLCID array = properties of list box
; .DDGLCID(id,"SV") = cid^$Y^$X^NL^NC^LINE
; .DDGLCID(id,"ITEM",1..nl) = text of item n in display
; .DDGLCID(id,"GL") = DDGLGLO
; .DDGLCID(id,"KMAP","IN")
; .DDGLCID(id,"KMAP","OUT")
; .DDGLCID(id,"KMAP","KD")
; .DDGLCID(id,"KMAP","TO")
;
Q:$G(DDGLGLO)=""
N DDGLNL,DDGLNC,DDGLLINE,DDGLLAST,DDGLITEM
D INIT
D SETCID
Q
;
DESTROY(DDGLCID,DDGLFLG) ;Destroy the window and cleanup
D DESTROY^DDGLIBW(DDGLCID)
K DDGLCID(DDGLCID)
D KILL^DDGLIB0($G(DDGLFLG))
Q
;
READ(DDGLCID,DDGLOUT) ;
N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
N DX,DY
;
D SETPARM
X DDGLZOSF("EOFF")
W $P(DDGLVID,DDGLDEL,11)
;
D ^DDGLBXA1
;
D SETCID
W $P(DDGLVID,DDGLDEL,12)
X DDGLZOSF("EON")
Q
;
UPDATE(DDGLCID,DDGLVAL) ;
N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
N DDGLI,DDGLT,DX,DY
;
D SETPARM
;
;Get closest match incl. or foll. DDGLVAL
S DDGLSEL=$G(DDGLVAL)
I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
E I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
Q:DDGLSEL=""
;
;Check whether DDGLVAL is already on the screen
I DDGLITEM(1)']]DDGLSEL,DDGLSEL']]DDGLITEM(DDGLNL) D
. D CUP(DDGLLINE,1)
. W $E(DDGLITEM(DDGLLINE),1,DDGLNC)
. F DDGLLINE=1:1:DDGLNL Q:DDGLITEM(DDGLLINE)=DDGLSEL
. D CUP(DDGLLINE,1)
. W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
;
;If not, adjust the array
E D
. S DDGLT=DDGLSEL
. F DDGLI=1:1:DDGLNL D
.. S DDGLITEM(DDGLI)=DDGLT
.. S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
. D DISP(DDGLSEL)
;
D SETCID
Q
;
SETCID ;Set DDGLCID array
K DDGLCID(DDGLCID)
S DDGLCID(DDGLCID,"SV")=DDGLCID_U_DDGLROW_U_DDGLCOL_U_DDGLNL_U_DDGLNC_U_DDGLLINE
M DDGLCID(DDGLCID,"ITEM")=DDGLITEM
S DDGLCID(DDGLCID,"GL")=DDGLGLO
M DDGLCID(DDGLCID,"KMAP")=DDGLKEY("KMAP")
Q
;
SETPARM ;Set parameters from DDGLCID array
N DDGLI
S DDGLGLO=DDGLCID(DDGLCID,"GL")
;
K DDGLKEY("KMAP")
M DDGLKEY("KMAP")=DDGLCID(DDGLCID,"KMAP")
M DDGLITEM=DDGLCID(DDGLCID,"ITEM")
;
S DDGLI=DDGLCID(DDGLCID,"SV")
S DDGLROW=$P(DDGLI,U,2)
S DDGLCOL=$P(DDGLI,U,3)
S DDGLNL=$P(DDGLI,U,4)
S DDGLNC=$P(DDGLI,U,5)
S DDGLLINE=$P(DDGLI,U,6)
S DDGLSEL=DDGLITEM(DDGLLINE)
K DDGLCID(DDGLCID)
Q
;
INIT ;Create list box (window) and setup variables
;In: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLGLO,DDGLMAP
;Returns: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
; DDGLCID,DDGLNL,DDGLNC,DDGLLINE,DDGLITEM,DDGLKEY("KMAP")
;
N DDGLAREA,DDGLI,DDGLT
D INIT^DDGLIB0()
;
;Check and default DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
I $G(DDGLROW,-1)<0 S DDGLROW=5
E I DDGLROW+3>IOSL S DDGLROW=IOSL-3
I $G(DDGLCOL,-1)<0 S DDGLCOL=5
E I DDGLCOL+5>IOM S DDGLCOL=IOM-5
;
S DDGLHT=$S($D(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
S:DDGLROW+DDGLHT+1>IOSL DDGLHT=IOSL-DDGLROW
;
S DDGLWD=$S($D(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
S:DDGLCOL+DDGLWD+1>IOM DDGLWD=IOM-DDGLCOL
;
I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
E I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
;
;Initialize variables
F DDGLI=1:1 Q:'$$EXIST^DDGLIBW("LBOX"_DDGLI)
S DDGLCID="LBOX"_DDGLI
S DDGLAREA=DDGLROW_U_DDGLCOL_U_DDGLHT_U_DDGLWD
S DDGLNL=DDGLHT-2
S DDGLNC=DDGLWD-4
S DDGLLINE=1
;
;Fill DDGLITEM array
S DDGLT=DDGLSEL
F DDGLI=1:1:DDGLNL D
. S DDGLITEM(DDGLI)=DDGLT
. S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
;
;Get key sequences, create window, display list
D GETKEY
D CREATE^DDGLIBW(DDGLCID,DDGLAREA,1)
D DISP(DDGLSEL)
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
;
CUP(Y,X) ;Position cursor relative to list coordinates
S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
Q
;
GETKEY ;Get key sequences and defaults
N AU,AD,AR,AL,F1,F2,F3,F4
N FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
N I,K,N,T
S AU=$P(DDGLKEY,U,2)
S AD=$P(DDGLKEY,U,3)
S AR=$P(DDGLKEY,U,4)
S AL=$P(DDGLKEY,U,5)
S F1=$P(DDGLKEY,U,6)
S FIND=$P(DDGLKEY,U,10)
S SELECT=$P(DDGLKEY,U,11)
S PREVSC=$P(DDGLKEY,U,14)
S NEXTSC=$P(DDGLKEY,U,15)
;
S DDGLKEY("KMAP","IN")="",DDGLKEY("KMAP","OUT")=""
;
I $D(DDGLMAP)>9 S I=0 F S I=$O(DDGLMAP(I)) Q:'I D
. I $P(DDGLMAP(I),";",2)="KEYDOWN" S DDGLKEY("KMAP","KD")=$P(DDGLMAP(I),";") Q
. I $P(DDGLMAP(I),";",2)="TIMEOUT" S DDGLKEY("KMAP","TO")=$P(DDGLMAP(I),";") Q
. ;
. S @("K="_$P(DDGLMAP(I),";",2))
. I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
.. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
.. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(DDGLMAP(I),";")_";"
;
F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T="" D
. S @("K="_$P(T,";",2))
. I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
.. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
.. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(T,";")_";"
S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U
S DDGLKEY("KMAP","OUT")=$E(DDGLKEY("KMAP","OUT"),1,$L(DDGLKEY("KMAP","OUT"))-1)
Q
;
MAP ;Keys for main screen
;;UP;AU
;;UP;AL
;;DN;AD
;;DN;AR
;;PUP;F1_AU
;;PUP;PREVSC
;;PDN;F1_AD
;;PDN;NEXTSC
;;TOP;F1_"T"
;;TOP;F1_F1_AU
;;TOP;FIND
;;BOT;F1_"B"
;;BOT;F1_F1_AD
;;BOT;SELECT
;;SEL;$C(13)
;;SEL;F1_"E"
;;QT;$C(27)_$C(27)
;;QT;F1_"Q"
;;QT;F1_"C"
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLBXA 7060 printed Dec 13, 2024@02:42:32 Page 2
DDGLBXA ;SFISC/MKO-A LIST BOX ;1:58 PM 26 Apr 1996
+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 ;
LIST(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG,DDGLMAP) ;
+1 ;Input:
+2 ; DDGLGLO = closed reference of local or global that contains
+3 ; the list of entries
+4 ; @DDGLGLO("B",entry,index)=""
+5 ; DDGLROW = $Y of top left corner
+6 ; DDGLCOL = $X of top left corner
+7 ; DDGLHT = height of box
+8 ; DDGLWD = width of box
+9 ; DDGLSEL = text of selected item
+10 ; DDGLFLG = flags
+11 ; DDGLMAP = array to customize key sequences
+12 ;
+13 ;Output:
+14 ; DDGLOUT = index of selected entry (if any)
+15 ; DDGLOUT(0) = selected entry
+16 ; DDGLOUT("C") = code indicates what terminated the read
+17 ;
+18 ;Other variables:
+19 ; window (control) id
NEW DDGLCID
+20 ; number of lines in list
NEW DDGLNL
+21 ; number of columns in list
NEW DDGLNC
+22 ; current line number
NEW DDGLLINE
+23 ; item array
NEW DDGLITEM
+24 ; DDGLITEM(1..DDGLNL) = text of item displayed
+25 ;
+26 if $GET(DDGLGLO)=""
QUIT
+27 DO INIT
+28 XECUTE DDGLZOSF("EOFF")
+29 WRITE $PIECE(DDGLVID,DDGLDEL,11)
+30 ;
+31 DO ^DDGLBXA1
+32 ;
+33 WRITE $PIECE(DDGLVID,DDGLDEL,12)
+34 XECUTE DDGLZOSF("EON")
+35 DO DESTROY(DDGLCID,$GET(DDGLFLG))
+36 QUIT
+37 ;
CREATE(DDGLGLO,DDGLCID,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLMAP) ;
+1 ;Create a list box window
+2 ;Out:
+3 ; .DDGLCID array = properties of list box
+4 ; .DDGLCID(id,"SV") = cid^$Y^$X^NL^NC^LINE
+5 ; .DDGLCID(id,"ITEM",1..nl) = text of item n in display
+6 ; .DDGLCID(id,"GL") = DDGLGLO
+7 ; .DDGLCID(id,"KMAP","IN")
+8 ; .DDGLCID(id,"KMAP","OUT")
+9 ; .DDGLCID(id,"KMAP","KD")
+10 ; .DDGLCID(id,"KMAP","TO")
+11 ;
+12 if $GET(DDGLGLO)=""
QUIT
+13 NEW DDGLNL,DDGLNC,DDGLLINE,DDGLLAST,DDGLITEM
+14 DO INIT
+15 DO SETCID
+16 QUIT
+17 ;
DESTROY(DDGLCID,DDGLFLG) ;Destroy the window and cleanup
+1 DO DESTROY^DDGLIBW(DDGLCID)
+2 KILL DDGLCID(DDGLCID)
+3 DO KILL^DDGLIB0($GET(DDGLFLG))
+4 QUIT
+5 ;
READ(DDGLCID,DDGLOUT) ;
+1 NEW DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
+2 NEW DX,DY
+3 ;
+4 DO SETPARM
+5 XECUTE DDGLZOSF("EOFF")
+6 WRITE $PIECE(DDGLVID,DDGLDEL,11)
+7 ;
+8 DO ^DDGLBXA1
+9 ;
+10 DO SETCID
+11 WRITE $PIECE(DDGLVID,DDGLDEL,12)
+12 XECUTE DDGLZOSF("EON")
+13 QUIT
+14 ;
UPDATE(DDGLCID,DDGLVAL) ;
+1 NEW DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
+2 NEW DDGLI,DDGLT,DX,DY
+3 ;
+4 DO SETPARM
+5 ;
+6 ;Get closest match incl. or foll. DDGLVAL
+7 SET DDGLSEL=$GET(DDGLVAL)
+8 IF $GET(DDGLSEL)=""
SET DDGLSEL=$ORDER(@DDGLGLO@(""))
+9 IF '$TEST
IF '$DATA(@DDGLGLO@(DDGLSEL))
SET DDGLSEL=$ORDER(@DDGLGLO@(DDGLSEL))
+10 if DDGLSEL=""
QUIT
+11 ;
+12 ;Check whether DDGLVAL is already on the screen
+13 IF DDGLITEM(1)']]DDGLSEL
IF DDGLSEL']]DDGLITEM(DDGLNL)
Begin DoDot:1
+14 DO CUP(DDGLLINE,1)
+15 WRITE $EXTRACT(DDGLITEM(DDGLLINE),1,DDGLNC)
+16 FOR DDGLLINE=1:1:DDGLNL
if DDGLITEM(DDGLLINE)=DDGLSEL
QUIT
+17 DO CUP(DDGLLINE,1)
+18 WRITE $PIECE(DDGLVID,DDGLDEL,6)_$EXTRACT(DDGLSEL,1,DDGLNC)_$PIECE(DDGLVID,DDGLDEL,10)
End DoDot:1
+19 ;
+20 ;If not, adjust the array
+21 IF '$TEST
Begin DoDot:1
+22 SET DDGLT=DDGLSEL
+23 FOR DDGLI=1:1:DDGLNL
Begin DoDot:2
+24 SET DDGLITEM(DDGLI)=DDGLT
+25 if DDGLT]""
SET DDGLT=$ORDER(@DDGLGLO@(DDGLT))
End DoDot:2
+26 DO DISP(DDGLSEL)
End DoDot:1
+27 ;
+28 DO SETCID
+29 QUIT
+30 ;
SETCID ;Set DDGLCID array
+1 KILL DDGLCID(DDGLCID)
+2 SET DDGLCID(DDGLCID,"SV")=DDGLCID_U_DDGLROW_U_DDGLCOL_U_DDGLNL_U_DDGLNC_U_DDGLLINE
+3 MERGE DDGLCID(DDGLCID,"ITEM")=DDGLITEM
+4 SET DDGLCID(DDGLCID,"GL")=DDGLGLO
+5 MERGE DDGLCID(DDGLCID,"KMAP")=DDGLKEY("KMAP")
+6 QUIT
+7 ;
SETPARM ;Set parameters from DDGLCID array
+1 NEW DDGLI
+2 SET DDGLGLO=DDGLCID(DDGLCID,"GL")
+3 ;
+4 KILL DDGLKEY("KMAP")
+5 MERGE DDGLKEY("KMAP")=DDGLCID(DDGLCID,"KMAP")
+6 MERGE DDGLITEM=DDGLCID(DDGLCID,"ITEM")
+7 ;
+8 SET DDGLI=DDGLCID(DDGLCID,"SV")
+9 SET DDGLROW=$PIECE(DDGLI,U,2)
+10 SET DDGLCOL=$PIECE(DDGLI,U,3)
+11 SET DDGLNL=$PIECE(DDGLI,U,4)
+12 SET DDGLNC=$PIECE(DDGLI,U,5)
+13 SET DDGLLINE=$PIECE(DDGLI,U,6)
+14 SET DDGLSEL=DDGLITEM(DDGLLINE)
+15 KILL DDGLCID(DDGLCID)
+16 QUIT
+17 ;
INIT ;Create list box (window) and setup variables
+1 ;In: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLGLO,DDGLMAP
+2 ;Returns: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
+3 ; DDGLCID,DDGLNL,DDGLNC,DDGLLINE,DDGLITEM,DDGLKEY("KMAP")
+4 ;
+5 NEW DDGLAREA,DDGLI,DDGLT
+6 DO INIT^DDGLIB0()
+7 ;
+8 ;Check and default DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
+9 IF $GET(DDGLROW,-1)<0
SET DDGLROW=5
+10 IF '$TEST
IF DDGLROW+3>IOSL
SET DDGLROW=IOSL-3
+11 IF $GET(DDGLCOL,-1)<0
SET DDGLCOL=5
+12 IF '$TEST
IF DDGLCOL+5>IOM
SET DDGLCOL=IOM-5
+13 ;
+14 SET DDGLHT=$SELECT($DATA(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
+15 if DDGLROW+DDGLHT+1>IOSL
SET DDGLHT=IOSL-DDGLROW
+16 ;
+17 SET DDGLWD=$SELECT($DATA(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
+18 if DDGLCOL+DDGLWD+1>IOM
SET DDGLWD=IOM-DDGLCOL
+19 ;
+20 IF $GET(DDGLSEL)=""
SET DDGLSEL=$ORDER(@DDGLGLO@(""))
+21 IF '$TEST
IF '$DATA(@DDGLGLO@(DDGLSEL))
SET DDGLSEL=$ORDER(@DDGLGLO@(DDGLSEL))
+22 ;
+23 ;Initialize variables
+24 FOR DDGLI=1:1
if '$$EXIST^DDGLIBW("LBOX"_DDGLI)
QUIT
+25 SET DDGLCID="LBOX"_DDGLI
+26 SET DDGLAREA=DDGLROW_U_DDGLCOL_U_DDGLHT_U_DDGLWD
+27 SET DDGLNL=DDGLHT-2
+28 SET DDGLNC=DDGLWD-4
+29 SET DDGLLINE=1
+30 ;
+31 ;Fill DDGLITEM array
+32 SET DDGLT=DDGLSEL
+33 FOR DDGLI=1:1:DDGLNL
Begin DoDot:1
+34 SET DDGLITEM(DDGLI)=DDGLT
+35 if DDGLT]""
SET DDGLT=$ORDER(@DDGLGLO@(DDGLT))
End DoDot:1
+36 ;
+37 ;Get key sequences, create window, display list
+38 DO GETKEY
+39 DO CREATE^DDGLIBW(DDGLCID,DDGLAREA,1)
+40 DO DISP(DDGLSEL)
+41 QUIT
+42 ;
DISP(DDGLSEL) ;Display the list
+1 ;In: DDGLSEL = text of selected item
+2 ;
+3 NEW DDGLI,DDGLT
+4 FOR DDGLI=1:1:DDGLNL
Begin DoDot:1
+5 DO CUP(DDGLI,1)
+6 SET DDGLT=$EXTRACT(DDGLITEM(DDGLI),1,DDGLNC)
+7 SET DDGLT=$SELECT(DDGLT=DDGLSEL:$PIECE(DDGLVID,DDGLDEL,6)_DDGLT_$PIECE(DDGLVID,DDGLDEL,10),1:DDGLT)_$JUSTIFY("",DDGLNC-$LENGTH(DDGLT))
+8 WRITE DDGLT
End DoDot:1
+9 QUIT
+10 ;
CUP(Y,X) ;Position cursor relative to list coordinates
+1 SET DY=DDGLROW+Y
SET DX=DDGLCOL+X+1
XECUTE IOXY
+2 QUIT
+3 ;
GETKEY ;Get key sequences and defaults
+1 NEW AU,AD,AR,AL,F1,F2,F3,F4
+2 NEW FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
+3 NEW I,K,N,T
+4 SET AU=$PIECE(DDGLKEY,U,2)
+5 SET AD=$PIECE(DDGLKEY,U,3)
+6 SET AR=$PIECE(DDGLKEY,U,4)
+7 SET AL=$PIECE(DDGLKEY,U,5)
+8 SET F1=$PIECE(DDGLKEY,U,6)
+9 SET FIND=$PIECE(DDGLKEY,U,10)
+10 SET SELECT=$PIECE(DDGLKEY,U,11)
+11 SET PREVSC=$PIECE(DDGLKEY,U,14)
+12 SET NEXTSC=$PIECE(DDGLKEY,U,15)
+13 ;
+14 SET DDGLKEY("KMAP","IN")=""
SET DDGLKEY("KMAP","OUT")=""
+15 ;
+16 IF $DATA(DDGLMAP)>9
SET I=0
FOR
SET I=$ORDER(DDGLMAP(I))
if 'I
QUIT
Begin DoDot:1
+17 IF $PIECE(DDGLMAP(I),";",2)="KEYDOWN"
SET DDGLKEY("KMAP","KD")=$PIECE(DDGLMAP(I),";")
QUIT
+18 IF $PIECE(DDGLMAP(I),";",2)="TIMEOUT"
SET DDGLKEY("KMAP","TO")=$PIECE(DDGLMAP(I),";")
QUIT
+19 ;
+20 SET @("K="_$PIECE(DDGLMAP(I),";",2))
+21 IF DDGLKEY("KMAP","IN")'[(U_K)
IF K]""
Begin DoDot:2
+22 SET DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
+23 SET DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$PIECE(DDGLMAP(I),";")_";"
End DoDot:2
End DoDot:1
+24 ;
+25 FOR I=1:1
SET T=$PIECE($TEXT(MAP+I),";;",2,999)
if T=""
QUIT
Begin DoDot:1
+26 SET @("K="_$PIECE(T,";",2))
+27 IF DDGLKEY("KMAP","IN")'[(U_K)
IF K]""
Begin DoDot:2
+28 SET DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
+29 SET DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$PIECE(T,";")_";"
End DoDot:2
End DoDot:1
+30 SET DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U
+31 SET DDGLKEY("KMAP","OUT")=$EXTRACT(DDGLKEY("KMAP","OUT"),1,$LENGTH(DDGLKEY("KMAP","OUT"))-1)
+32 QUIT
+33 ;
MAP ;Keys for main screen
+1 ;;UP;AU
+2 ;;UP;AL
+3 ;;DN;AD
+4 ;;DN;AR
+5 ;;PUP;F1_AU
+6 ;;PUP;PREVSC
+7 ;;PDN;F1_AD
+8 ;;PDN;NEXTSC
+9 ;;TOP;F1_"T"
+10 ;;TOP;F1_F1_AU
+11 ;;TOP;FIND
+12 ;;BOT;F1_"B"
+13 ;;BOT;F1_F1_AD
+14 ;;BOT;SELECT
+15 ;;SEL;$C(13)
+16 ;;SEL;F1_"E"
+17 ;;QT;$C(27)_$C(27)
+18 ;;QT;F1_"Q"
+19 ;;QT;F1_"C"
+20 ;;
