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

DDGLBXA1.m

Go to the documentation of this file.
  1. DDGLBXA1 ;SFISC/MKO-SINGLE SELECTION LIST BOX ;11:33 AM 26 Apr 1996
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. N DDGLQT,Y
  1. D CUP(DDGLLINE,1)
  1. ;
  1. S DDGLQT=0
  1. F S Y=$$READ D Q:DDGLQT
  1. . I Y'[U,$T(@Y)="" W $C(7) Q
  1. . D @Y
  1. . D:$G(DDGLKEY("KMAP","KD"))]"" @DDGLKEY("KMAP","KD")
  1. ;
  1. S:$P(DDGLQT,U,2,999)]"" DDGLOUT("C")=$P(DDGLQT,U,2,999)
  1. Q
  1. ;
  1. UP ;Move up
  1. I DDGLLINE>1 D
  1. . D CUP(DDGLLINE,1)
  1. . W $E(DDGLSEL,1,DDGLNC)
  1. . S DDGLLINE=DDGLLINE-1
  1. . S DDGLSEL=DDGLITEM(DDGLLINE)
  1. . ;
  1. . D CUP(DDGLLINE,1)
  1. . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
  1. ;
  1. E D
  1. . N DDGLE
  1. . D SHIFTDN(1,.DDGLE) Q:$G(DDGLE)
  1. . S DDGLSEL=DDGLITEM(1)
  1. . D DISP(DDGLSEL)
  1. Q
  1. ;
  1. DN ;Move down
  1. I DDGLLINE<DDGLNL D
  1. . Q:DDGLITEM(DDGLLINE+1)=""
  1. . D CUP(DDGLLINE,1)
  1. . W $E(DDGLSEL,1,DDGLNC)
  1. . S DDGLLINE=DDGLLINE+1
  1. . S DDGLSEL=DDGLITEM(DDGLLINE)
  1. . ;
  1. . D CUP(DDGLLINE,1)
  1. . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
  1. ;
  1. E D
  1. . N DDGLE
  1. . D SHIFTUP(1,.DDGLE) Q:$G(DDGLE)
  1. . S DDGLSEL=DDGLITEM(DDGLNL)
  1. . D DISP(DDGLSEL)
  1. Q
  1. ;
  1. PUP ;Page up in list
  1. I DDGLLINE>1 D
  1. . D CUP(DDGLLINE,1)
  1. . W $E(DDGLSEL,1,DDGLNC)
  1. . S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
  1. . D CUP(1,1)
  1. . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
  1. ;
  1. E D
  1. . N DDGLE
  1. . D SHIFTDN(DDGLNL,.DDGLE) Q:$G(DDGLE)
  1. . S DDGLSEL=DDGLITEM(1)
  1. . D DISP(DDGLSEL)
  1. Q
  1. ;
  1. PDN ;Page down in list
  1. I DDGLLINE<DDGLNL D
  1. . D CUP(DDGLLINE,1)
  1. . W $E(DDGLSEL,1,DDGLNC)
  1. . F DDGLLINE=DDGLNL:-1:1 Q:DDGLITEM(DDGLLINE)]""
  1. . S DDGLSEL=DDGLITEM(DDGLLINE)
  1. . D CUP(DDGLLINE,1)
  1. . W $P(DDGLVID,DDGLDEL,6)_$E(DDGLSEL,1,DDGLNC)_$P(DDGLVID,DDGLDEL,10)
  1. ;
  1. E D
  1. . N DDGLE
  1. . D SHIFTUP(DDGLNL,.DDGLE) Q:$G(DDGLE)
  1. . S DDGLSEL=DDGLITEM(DDGLNL)
  1. . D DISP(DDGLSEL)
  1. Q
  1. ;
  1. TOP ;Move to top of list
  1. N DDGLFRST,DDGLI,DDGLT
  1. ;
  1. ;Check whether first item in list is the first displayed
  1. S DDGLFRST=$O(@DDGLGLO@(""))
  1. I DDGLFRST=DDGLITEM(1) D:DDGLLINE>1 PUP Q
  1. ;
  1. ;Fill DDGLITEM array
  1. S DDGLT=DDGLFRST
  1. F DDGLI=1:1:DDGLNL D
  1. . S DDGLITEM(DDGLI)=DDGLT
  1. . S:DDGLT]"" DDGLT=$O(@DDGLGLO@(DDGLT))
  1. ;
  1. S DDGLLINE=1,DDGLSEL=DDGLITEM(1)
  1. D DISP(DDGLSEL)
  1. Q
  1. ;
  1. BOT ;Move to bottom of list
  1. N DDGLAST,DDGLI,DDGLT,DDGLIND
  1. ;
  1. ;Set DDGLIND = index of last non-null DDGLITEM
  1. F DDGLIND=DDGLNL:-1:1 Q:DDGLITEM(DDGLIND)]""
  1. ;
  1. S DDGLAST=$O(@DDGLGLO@(""),-1)
  1. I DDGLAST=DDGLITEM(DDGLIND) D:DDGLLINE<DDGLIND PDN Q
  1. ;
  1. ;Fill DDGLITEM array
  1. S DDGLT=DDGLAST
  1. F DDGLI=DDGLNL:-1:1 D
  1. . S DDGLITEM(DDGLI)=DDGLT
  1. . S DDGLT=$O(@DDGLGLO@(DDGLT),-1)
  1. ;
  1. S DDGLLINE=DDGLNL,DDGLSEL=DDGLITEM(DDGLNL)
  1. D DISP(DDGLSEL)
  1. Q
  1. ;
  1. SEL ;Select item
  1. K DDGLOUT
  1. S DDGLOUT=$O(@DDGLGLO@(DDGLSEL,"")),DDGLOUT(0)=DDGLSEL
  1. S DDGLOUT("C")="SEL"
  1. S DDGLQT=1
  1. Q
  1. ;
  1. QT ;Quit
  1. K DDGLOUT
  1. S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="QT"
  1. S DDGLQT=1
  1. Q
  1. ;
  1. TO ;Timeout
  1. D:$G(DDGLKEY("KMAP","TO"))]"" @DDGLKEY("KMAP","TO")
  1. K DDGLOUT
  1. S DDGLOUT=-1,DDGLOUT(0)="",DDGLOUT("C")="TO"
  1. S DDGLQT=1
  1. Q
  1. ;
  1. READ() ;Read next key and return mnemonic
  1. N S,Y
  1. F R *Y:DTIME D C Q:Y'=-1
  1. Q Y
  1. ;
  1. C I Y<0 S Y="TO" Q
  1. S S=""
  1. C1 S S=S_$C(Y)
  1. I DDGLKEY("KMAP","IN")'[(U_S) D I Y=-1 W $C(7) D FLUSH Q
  1. . I $C(Y)'?1L S Y=-1 Q
  1. . S S=$E(S,1,$L(S)-1)_$C(Y-32) S:DDGLKEY("KMAP","IN")'[(U_S_U) Y=-1
  1. ;
  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
  1. R *Y:5 G:Y'=-1 C1
  1. W $C(7)
  1. Q
  1. ;
  1. SHIFTDN(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
  1. ;Out: DDGLE = 1, if no more items above
  1. ;
  1. N DDGLI,DDGLT,DDGLA
  1. S DDGLE=0
  1. S DDGLT=DDGLITEM(1) I DDGLT="" S DDGLE=1 Q
  1. ;
  1. F DDGLI=-1:-1:-DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT),-1) Q:DDGLT="" D
  1. . S DDGLA(DDGLI)=DDGLT
  1. S:DDGLT="" DDGLI=DDGLI+1
  1. I DDGLI=0 S DDGLE=1 Q
  1. S DDGLN=-DDGLI
  1. ;
  1. F DDGLI=DDGLNL:-1:DDGLN+1 S DDGLITEM(DDGLI)=DDGLITEM(DDGLI-DDGLN)
  1. F DDGLI=DDGLN:-1:1 S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLN-1)
  1. Q
  1. ;
  1. SHIFTUP(DDGLN,DDGLE) ;Shift DDGLITEM array down DDGLN times
  1. ;Out: DDGLE = 1, if no more items above
  1. ;
  1. N DDGLI,DDGLT,DDGLA
  1. S DDGLE=0
  1. S DDGLT=DDGLITEM(DDGLNL) I DDGLT="" S DDGLE=1 Q
  1. ;
  1. F DDGLI=1:1:DDGLN S DDGLT=$O(@DDGLGLO@(DDGLT)) Q:DDGLT="" D
  1. . S DDGLA(DDGLI)=DDGLT
  1. S:DDGLT="" DDGLI=DDGLI-1
  1. I DDGLI=0 S DDGLE=1 Q
  1. S DDGLN=DDGLI
  1. ;
  1. F DDGLI=1:1:DDGLNL-DDGLN S DDGLITEM(DDGLI)=DDGLITEM(DDGLI+DDGLN)
  1. F DDGLI=DDGLNL-DDGLN+1:1:DDGLNL S DDGLITEM(DDGLI)=DDGLA(DDGLI-DDGLNL+DDGLN)
  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. FLUSH ;Flush read buffer
  1. N DDGLX
  1. F R *DDGLX:0 E Q
  1. Q
  1. ;
  1. CUP(Y,X) ;Position cursor relative to list coords
  1. S DY=DDGLROW+Y,DX=DDGLCOL+X+1 X IOXY
  1. Q