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

DDGLBXA.m

Go to the documentation of this file. 
  1. DDGLBXA ;SFISC/MKO-A LIST BOX ;1:58 PM  26 Apr 1996
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. LIST(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG,DDGLMAP) ;
  1.  ;Input:
  1.  ;  DDGLGLO = closed reference of local or global that contains
  1.  ;            the list of entries
  1.  ;               @DDGLGLO("B",entry,index)=""
  1.  ;  DDGLROW = $Y of top left corner
  1.  ;  DDGLCOL = $X of top left corner
  1.  ;  DDGLHT  = height of box
  1.  ;  DDGLWD  = width of box
  1.  ;  DDGLSEL = text of selected item
  1.  ;  DDGLFLG = flags
  1.  ;  DDGLMAP = array to customize key sequences
  1.  ;
  1.  ;Output:
  1.  ;  DDGLOUT = index of selected entry (if any)
  1.  ;  DDGLOUT(0) = selected entry
  1.  ;  DDGLOUT("C") = code indicates what terminated the read
  1.  ;
  1.  ;Other variables:
  1.  N DDGLCID ;  window (control) id
  1.  N DDGLNL ; number of lines in list
  1.  N DDGLNC ; number of columns in list
  1.  N DDGLLINE ; current line number
  1.  N DDGLITEM ; item array
  1.  ;              DDGLITEM(1..DDGLNL) = text of item displayed
  1.  ;
  1.  Q:$G(DDGLGLO)=""
  1.  D INIT
  1.  X DDGLZOSF("EOFF")
  1.  W $P(DDGLVID,DDGLDEL,11)
  1.  ;
  1.  D ^DDGLBXA1
  1.  ;
  1.  W $P(DDGLVID,DDGLDEL,12)
  1.  X DDGLZOSF("EON")
  1.  D DESTROY(DDGLCID,$G(DDGLFLG))
  1.  Q
  1.  ;
  1. CREATE(DDGLGLO,DDGLCID,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLMAP) ;
  1.  ;Create a list box window
  1.  ;Out:
  1.  ; .DDGLCID array = properties of list box
  1.  ; .DDGLCID(id,"SV") = cid^$Y^$X^NL^NC^LINE
  1.  ; .DDGLCID(id,"ITEM",1..nl) = text of item n in display
  1.  ; .DDGLCID(id,"GL") = DDGLGLO
  1.  ; .DDGLCID(id,"KMAP","IN")
  1.  ; .DDGLCID(id,"KMAP","OUT")
  1.  ; .DDGLCID(id,"KMAP","KD")
  1.  ; .DDGLCID(id,"KMAP","TO")
  1.  ;
  1.  Q:$G(DDGLGLO)=""
  1.  N DDGLNL,DDGLNC,DDGLLINE,DDGLLAST,DDGLITEM
  1.  D INIT
  1.  D SETCID
  1.  Q
  1.  ;
  1. DESTROY(DDGLCID,DDGLFLG) ;Destroy the window and cleanup
  1.  D DESTROY^DDGLIBW(DDGLCID)
  1.  K DDGLCID(DDGLCID)
  1.  D KILL^DDGLIB0($G(DDGLFLG))
  1.  Q
  1.  ;
  1. READ(DDGLCID,DDGLOUT) ;
  1.  N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
  1.  N DX,DY
  1.  ;
  1.  D SETPARM
  1.  X DDGLZOSF("EOFF")
  1.  W $P(DDGLVID,DDGLDEL,11)
  1.  ;
  1.  D ^DDGLBXA1
  1.  ;
  1.  D SETCID
  1.  W $P(DDGLVID,DDGLDEL,12)
  1.  X DDGLZOSF("EON")
  1.  Q
  1.  ;
  1. UPDATE(DDGLCID,DDGLVAL) ;
  1.  N DDGLGLO,DDGLROW,DDGLCOL,DDGLNL,DDGLNC,DDGLLINE,DDGLSEL,DDGLITEM
  1.  N DDGLI,DDGLT,DX,DY
  1.  ;
  1.  D SETPARM
  1.  ;
  1.  ;Get closest match incl. or foll. DDGLVAL
  1.  S DDGLSEL=$G(DDGLVAL)
  1.  I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
  1.  E  I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
  1.  Q:DDGLSEL=""
  1.  ;
  1.  ;Check whether DDGLVAL is already on the screen
  1.  I DDGLITEM(1)']]DDGLSEL,DDGLSEL']]DDGLITEM(DDGLNL) D
  1.  . D CUP(DDGLLINE,1)
  1.  . W $E(DDGLITEM(DDGLLINE),1,DDGLNC)
  1.  . F DDGLLINE=1:1:DDGLNL Q:DDGLITEM(DDGLLINE)=DDGLSEL
  1.  . D CUP(DDGLLINE,1)
  1.  . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
  1.  ;
  1.  ;If not, adjust the array
  1.  E  D
  1.  . S DDGLT=DDGLSEL
  1.  . F DDGLI=1:1:DDGLNL D
  1.  .. S DDGLITEM(DDGLI)=DDGLT
  1.  .. S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
  1.  . D DISP(DDGLSEL)
  1.  ;
  1.  D SETCID
  1.  Q
  1.  ;
  1. SETCID ;Set DDGLCID array
  1.  K DDGLCID(DDGLCID)
  1.  S DDGLCID(DDGLCID,"SV")=DDGLCID_U_DDGLROW_U_DDGLCOL_U_DDGLNL_U_DDGLNC_U_DDGLLINE
  1.  M DDGLCID(DDGLCID,"ITEM")=DDGLITEM
  1.  S DDGLCID(DDGLCID,"GL")=DDGLGLO
  1.  M DDGLCID(DDGLCID,"KMAP")=DDGLKEY("KMAP")
  1.  Q
  1.  ;
  1. SETPARM ;Set parameters from DDGLCID array
  1.  N DDGLI
  1.  S DDGLGLO=DDGLCID(DDGLCID,"GL")
  1.  ;
  1.  K DDGLKEY("KMAP")
  1.  M DDGLKEY("KMAP")=DDGLCID(DDGLCID,"KMAP")
  1.  M DDGLITEM=DDGLCID(DDGLCID,"ITEM")
  1.  ;
  1.  S DDGLI=DDGLCID(DDGLCID,"SV")
  1.  S DDGLROW=$P(DDGLI,U,2)
  1.  S DDGLCOL=$P(DDGLI,U,3)
  1.  S DDGLNL=$P(DDGLI,U,4)
  1.  S DDGLNC=$P(DDGLI,U,5)
  1.  S DDGLLINE=$P(DDGLI,U,6)
  1.  S DDGLSEL=DDGLITEM(DDGLLINE)
  1.  K DDGLCID(DDGLCID)
  1.  Q
  1.  ;
  1. INIT ;Create list box (window) and setup variables
  1.  ;In:      DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLGLO,DDGLMAP
  1.  ;Returns: DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
  1.  ;         DDGLCID,DDGLNL,DDGLNC,DDGLLINE,DDGLITEM,DDGLKEY("KMAP")
  1.  ;
  1.  N DDGLAREA,DDGLI,DDGLT
  1.  D INIT^DDGLIB0()
  1.  ;
  1.  ;Check and default DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLIND
  1.  I $G(DDGLROW,-1)<0 S DDGLROW=5
  1.  E  I DDGLROW+3>IOSL S DDGLROW=IOSL-3
  1.  I $G(DDGLCOL,-1)<0 S DDGLCOL=5
  1.  E  I DDGLCOL+5>IOM S DDGLCOL=IOM-5
  1.  ;
  1.  S DDGLHT=$S($D(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
  1.  S:DDGLROW+DDGLHT+1>IOSL DDGLHT=IOSL-DDGLROW
  1.  ;
  1.  S DDGLWD=$S($D(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
  1.  S:DDGLCOL+DDGLWD+1>IOM DDGLWD=IOM-DDGLCOL
  1.  ;
  1.  I $G(DDGLSEL)="" S DDGLSEL=$O(@DDGLGLO@(""))
  1.  E  I '$D(@DDGLGLO@(DDGLSEL)) S DDGLSEL=$O(@DDGLGLO@(DDGLSEL))
  1.  ;
  1.  ;Initialize variables
  1.  F DDGLI=1:1 Q:'$$EXIST^DDGLIBW("LBOX"_DDGLI)
  1.  S DDGLCID="LBOX"_DDGLI
  1.  S DDGLAREA=DDGLROW_U_DDGLCOL_U_DDGLHT_U_DDGLWD
  1.  S DDGLNL=DDGLHT-2
  1.  S DDGLNC=DDGLWD-4
  1.  S DDGLLINE=1
  1.  ;
  1.  ;Fill DDGLITEM array
  1.  S DDGLT=DDGLSEL
  1.  F DDGLI=1:1:DDGLNL D
  1.  . S DDGLITEM(DDGLI)=DDGLT
  1.  . S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
  1.  ;
  1.  ;Get key sequences, create window, display list
  1.  D GETKEY
  1.  D CREATE^DDGLIBW(DDGLCID,DDGLAREA,1)
  1.  D DISP(DDGLSEL)
  1.  Q
  1.  ;
  1. DISP(DDGLSEL) ;Display the list
  1.  ;In: DDGLSEL = text of selected item
  1.  ;
  1.  N DDGLI,DDGLT
  1.  F DDGLI=1:1:DDGLNL D
  1.  . D CUP(DDGLI,1)
  1.  . S DDGLT=$E(DDGLITEM(DDGLI),1,DDGLNC)
  1.  . S DDGLT=$S(DDGLT=DDGLSEL:$P(DDGLVID,DDGLDEL,6)_DDGLT_$P(DDGLVID,DDGLDEL,10),1:DDGLT)_$J("",DDGLNC-$L(DDGLT))
  1.  . W DDGLT
  1.  Q
  1.  ;
  1. CUP(Y,X) ;Position cursor relative to list coordinates
  1.  S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
  1.  Q
  1.  ;
  1. GETKEY ;Get key sequences and defaults
  1.  N AU,AD,AR,AL,F1,F2,F3,F4
  1.  N FIND,SELECT,INSERT,REMOVE,PREVSC,NEXTSC
  1.  N I,K,N,T
  1.  S AU=$P(DDGLKEY,U,2)
  1.  S AD=$P(DDGLKEY,U,3)
  1.  S AR=$P(DDGLKEY,U,4)
  1.  S AL=$P(DDGLKEY,U,5)
  1.  S F1=$P(DDGLKEY,U,6)
  1.  S FIND=$P(DDGLKEY,U,10)
  1.  S SELECT=$P(DDGLKEY,U,11)
  1.  S PREVSC=$P(DDGLKEY,U,14)
  1.  S NEXTSC=$P(DDGLKEY,U,15)
  1.  ;
  1.  S DDGLKEY("KMAP","IN")="",DDGLKEY("KMAP","OUT")=""
  1.  ;
  1.  I $D(DDGLMAP)>9 S I=0 F  S I=$O(DDGLMAP(I)) Q:'I  D
  1.  . I $P(DDGLMAP(I),";",2)="KEYDOWN" S DDGLKEY("KMAP","KD")=$P(DDGLMAP(I),";") Q
  1.  . I $P(DDGLMAP(I),";",2)="TIMEOUT" S DDGLKEY("KMAP","TO")=$P(DDGLMAP(I),";") Q
  1.  . ;
  1.  . S @("K="_$P(DDGLMAP(I),";",2))
  1.  . I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
  1.  .. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
  1.  .. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(DDGLMAP(I),";")_";"
  1.  ;
  1.  F I=1:1 S T=$P($T(MAP+I),";;",2,999) Q:T=""  D
  1.  . S @("K="_$P(T,";",2))
  1.  . I DDGLKEY("KMAP","IN")'[(U_K),K]"" D
  1.  .. S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U_K
  1.  .. S DDGLKEY("KMAP","OUT")=DDGLKEY("KMAP","OUT")_$P(T,";")_";"
  1.  S DDGLKEY("KMAP","IN")=DDGLKEY("KMAP","IN")_U
  1.  S DDGLKEY("KMAP","OUT")=$E(DDGLKEY("KMAP","OUT"),1,$L(DDGLKEY("KMAP","OUT"))-1)
  1.  Q
  1.  ;
  1. MAP ;Keys for main screen
  1.  ;;UP;AU
  1.  ;;UP;AL
  1.  ;;DN;AD
  1.  ;;DN;AR
  1.  ;;PUP;F1_AU
  1.  ;;PUP;PREVSC
  1.  ;;PDN;F1_AD
  1.  ;;PDN;NEXTSC
  1.  ;;TOP;F1_"T"
  1.  ;;TOP;F1_F1_AU
  1.  ;;TOP;FIND
  1.  ;;BOT;F1_"B"
  1.  ;;BOT;F1_F1_AD
  1.  ;;BOT;SELECT
  1.  ;;SEL;$C(13)
  1.  ;;SEL;F1_"E"
  1.  ;;QT;$C(27)_$C(27)
  1.  ;;QT;F1_"Q"
  1.  ;;QT;F1_"C"
  1.  ;;