DDGLCBOX ;SFISC/MKO-COMBO BOX ;2:09 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.
;
CBOX(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG) ;
Q:$G(DDGLGLO)=""
;
N DDGLCBOX,DDGLSEL,DDGLI,DDGLNC,DDGLEMAP,DDGLTERM,DDGLDONE
;
;Create list box and set up defaults
D INIT
;
;Save the # columns and selected text
S DDGLI=DDGLCBOX(DDGLCBOX,"SV")
S DDGLNC=$P(DDGLI,U,5)
S DDGLSEL=DDGLCBOX(DDGLCBOX,"ITEM",$P(DDGLI,U,6))
K DDGLI
;
;Write the brackets for the edit field
S DY=DDGLROW,DX=DDGLCOL X IOXY
W "["_$J("",DDGLNC)_"]"
;
;Read for the edit box
S DDGLEMAP(1)="EKDN^DDGLCBOX;KEYDOWN"
S DDGLEMAP(2)="EQUIT^DDGLCBOX;$C(27,27)"
S DDGLEMAP(3)="EQUIT^DDGLCBOX;F1_""Q"""
S DDGLEMAP(4)="EQUIT^DDGLCBOX;F1_""C"""
S DDGLEMAP(5)="EEXIT^DDGLCBOX;F1_""E"""
;
F D Q:$G(DDGLDONE)
. D EN^DIR0(DDGLROW,DDGLCOL+1,DDGLNC,1,DDGLSEL,245,0,.DDGLEMAP,"KTW",.DDGLSEL,.DDGLTERM)
. I $P(DDGLTERM,U)="N" S DDGLDONE=1 Q
. I $P(DDGLTERM,U)="QUIT" S DDGLDONE=1 Q
. I $P(DDGLTERM,U)="TO" S DDGLDONE=1 Q
. ;
. D READ^DDGLBXA(.DDGLCBOX,.DDGLOUT)
. I DDGLOUT("C")'="TAB" S DDGLDONE=1 Q
. S DDGLSEL=DDGLOUT(0)
;
;Clear edit field and destroy list box
S DY=DDGLROW,DX=DDGLCOL X IOXY
W $J("",DDGLNC+2)
D DESTROY^DDGLBXA(DDGLCBOX,$G(DDGLFLG))
Q
;
EKDN ;
Q:"^UP^DOWN^RIGHT^LEFT^TAB^"[(U_Y_U)
;
D E1^DIR01
S DIR0CH=""
Q:DIR0A=""
;
N DDGLDX,DDGLDY
W $P(DDGLVID,DDGLDEL,10)
S DDGLDX=DX,DDGLDY=DY
;
D UPDATE^DDGLBXA(.DDGLCBOX,DIR0A)
;
W $P(DDGLVID,DDGLDEL,6)
S DX=DDGLDX,DY=DDGLDY
Q
EQUIT ;
S DIR0QT="1^QUIT"
Q
EEXIT ;
S DIR0QT="1^N"
Q
LTAB ;
K DDGLOUT
S DDGLOUT=$O(@DDGLGLO@(DDGLSEL,"")),DDGLOUT(0)=DDGLSEL
S DDGLOUT("C")="TAB"
S DDGLQT=1
Q
;
LKDN ;
N DY,DX
S DY=DDGLROW-1,DX=DDGLCOL X IOXY
W DDGLSEL_$J("",DDGLNC-$L(DDGLSEL))
Q
;
INIT ;Set defaults and create list box
;Returns: DDGLCBOX array
;
D INIT^DDGLIB0()
;
;Set defaults for row and column
N DDGLMAP
I $G(DDGLROW,-1)<0 S DDGLROW=5
E I DDGLROW+4>IOSL S DDGLROW=IOSL-4
I $G(DDGLCOL,-1)<0 S DDGLCOL=5
E I DDGLCOL+6>IOM S DDGLCOL=IOM-6
;
;Check DDGLHT and DDGLWD
S DDGLHT=$S($D(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
S:DDGLROW+DDGLHT+2>IOSL DDGLHT=IOSL-DDGLROW
;
S DDGLWD=$S($D(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
S:DDGLCOL+DDGLWD+2>IOM DDGLWD=IOM-DDGLCOL
;
S DDGLMAP(1)="LTAB^DDGLCBOX;$C(9)"
S DDGLMAP(2)="LKDN^DDGLCBOX;KEYDOWN"
;
D CREATE^DDGLBXA(DDGLGLO,.DDGLCBOX,DDGLROW+1,DDGLCOL+1,DDGLHT,DDGLWD,$G(DDGLSEL),.DDGLMAP)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDGLCBOX 2818 printed Dec 13, 2024@02:42:34 Page 2
DDGLCBOX ;SFISC/MKO-COMBO BOX ;2:09 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 ;
CBOX(DDGLGLO,DDGLOUT,DDGLROW,DDGLCOL,DDGLHT,DDGLWD,DDGLSEL,DDGLFLG) ;
+1 if $GET(DDGLGLO)=""
QUIT
+2 ;
+3 NEW DDGLCBOX,DDGLSEL,DDGLI,DDGLNC,DDGLEMAP,DDGLTERM,DDGLDONE
+4 ;
+5 ;Create list box and set up defaults
+6 DO INIT
+7 ;
+8 ;Save the # columns and selected text
+9 SET DDGLI=DDGLCBOX(DDGLCBOX,"SV")
+10 SET DDGLNC=$PIECE(DDGLI,U,5)
+11 SET DDGLSEL=DDGLCBOX(DDGLCBOX,"ITEM",$PIECE(DDGLI,U,6))
+12 KILL DDGLI
+13 ;
+14 ;Write the brackets for the edit field
+15 SET DY=DDGLROW
SET DX=DDGLCOL
XECUTE IOXY
+16 WRITE "["_$JUSTIFY("",DDGLNC)_"]"
+17 ;
+18 ;Read for the edit box
+19 SET DDGLEMAP(1)="EKDN^DDGLCBOX;KEYDOWN"
+20 SET DDGLEMAP(2)="EQUIT^DDGLCBOX;$C(27,27)"
+21 SET DDGLEMAP(3)="EQUIT^DDGLCBOX;F1_""Q"""
+22 SET DDGLEMAP(4)="EQUIT^DDGLCBOX;F1_""C"""
+23 SET DDGLEMAP(5)="EEXIT^DDGLCBOX;F1_""E"""
+24 ;
+25 FOR
Begin DoDot:1
+26 DO EN^DIR0(DDGLROW,DDGLCOL+1,DDGLNC,1,DDGLSEL,245,0,.DDGLEMAP,"KTW",.DDGLSEL,.DDGLTERM)
+27 IF $PIECE(DDGLTERM,U)="N"
SET DDGLDONE=1
QUIT
+28 IF $PIECE(DDGLTERM,U)="QUIT"
SET DDGLDONE=1
QUIT
+29 IF $PIECE(DDGLTERM,U)="TO"
SET DDGLDONE=1
QUIT
+30 ;
+31 DO READ^DDGLBXA(.DDGLCBOX,.DDGLOUT)
+32 IF DDGLOUT("C")'="TAB"
SET DDGLDONE=1
QUIT
+33 SET DDGLSEL=DDGLOUT(0)
End DoDot:1
if $GET(DDGLDONE)
QUIT
+34 ;
+35 ;Clear edit field and destroy list box
+36 SET DY=DDGLROW
SET DX=DDGLCOL
XECUTE IOXY
+37 WRITE $JUSTIFY("",DDGLNC+2)
+38 DO DESTROY^DDGLBXA(DDGLCBOX,$GET(DDGLFLG))
+39 QUIT
+40 ;
EKDN ;
+1 if "^UP^DOWN^RIGHT^LEFT^TAB^"[(U_Y_U)
QUIT
+2 ;
+3 DO E1^DIR01
+4 SET DIR0CH=""
+5 if DIR0A=""
QUIT
+6 ;
+7 NEW DDGLDX,DDGLDY
+8 WRITE $PIECE(DDGLVID,DDGLDEL,10)
+9 SET DDGLDX=DX
SET DDGLDY=DY
+10 ;
+11 DO UPDATE^DDGLBXA(.DDGLCBOX,DIR0A)
+12 ;
+13 WRITE $PIECE(DDGLVID,DDGLDEL,6)
+14 SET DX=DDGLDX
SET DY=DDGLDY
+15 QUIT
EQUIT ;
+1 SET DIR0QT="1^QUIT"
+2 QUIT
EEXIT ;
+1 SET DIR0QT="1^N"
+2 QUIT
LTAB ;
+1 KILL DDGLOUT
+2 SET DDGLOUT=$ORDER(@DDGLGLO@(DDGLSEL,""))
SET DDGLOUT(0)=DDGLSEL
+3 SET DDGLOUT("C")="TAB"
+4 SET DDGLQT=1
+5 QUIT
+6 ;
LKDN ;
+1 NEW DY,DX
+2 SET DY=DDGLROW-1
SET DX=DDGLCOL
XECUTE IOXY
+3 WRITE DDGLSEL_$JUSTIFY("",DDGLNC-$LENGTH(DDGLSEL))
+4 QUIT
+5 ;
INIT ;Set defaults and create list box
+1 ;Returns: DDGLCBOX array
+2 ;
+3 DO INIT^DDGLIB0()
+4 ;
+5 ;Set defaults for row and column
+6 NEW DDGLMAP
+7 IF $GET(DDGLROW,-1)<0
SET DDGLROW=5
+8 IF '$TEST
IF DDGLROW+4>IOSL
SET DDGLROW=IOSL-4
+9 IF $GET(DDGLCOL,-1)<0
SET DDGLCOL=5
+10 IF '$TEST
IF DDGLCOL+6>IOM
SET DDGLCOL=IOM-6
+11 ;
+12 ;Check DDGLHT and DDGLWD
+13 SET DDGLHT=$SELECT($DATA(DDGLHT)[0:7,DDGLHT<3:3,1:DDGLHT)
+14 if DDGLROW+DDGLHT+2>IOSL
SET DDGLHT=IOSL-DDGLROW
+15 ;
+16 SET DDGLWD=$SELECT($DATA(DDGLWD)[0:14,DDGLWD<5:5,1:DDGLWD)
+17 if DDGLCOL+DDGLWD+2>IOM
SET DDGLWD=IOM-DDGLCOL
+18 ;
+19 SET DDGLMAP(1)="LTAB^DDGLCBOX;$C(9)"
+20 SET DDGLMAP(2)="LKDN^DDGLCBOX;KEYDOWN"
+21 ;
+22 DO CREATE^DDGLBXA(DDGLGLO,.DDGLCBOX,DDGLROW+1,DDGLCOL+1,DDGLHT,DDGLWD,$GET(DDGLSEL),.DDGLMAP)
+23 QUIT
+24 ;
