source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDGLBXA.m@ 623

DDGLBXA ;SFISC/MKO-A LIST BOX ;1:58 PM  26 Apr 1996
 ;;22.0;VA FileMan;;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
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"
 ;;