| [613] | 1 | DDBR4 ;SFISC/DCL-LOAD CURRENT LIST ;NOV 04, 1996@13:49
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | LOADCL(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,DDBLST) ;
|
|---|
| 5 | ;DDBSA=source array by value
|
|---|
| 6 | ;DDGFLG=no flags currently available
|
|---|
| 7 | ;DDBPMSG=text to be displayed (centered) on top line
|
|---|
| 8 | ;DDBL=display line default 1st screen/line (22 in most cases)
|
|---|
| 9 | ;DDBC=location of column tab array used with right/left arrow keys
|
|---|
| 10 | ;DDBLST=location of current list (BROWSER expects ^TMP("DDBLST",$J))
|
|---|
| 11 | I $G(DDBSA)']"" N X S X(1)="SOURCE ARRAY("_DDBSA_")" D BLD^DIALOG(202,.X) Q
|
|---|
| 12 | I '$D(@DDBSA) N X S X(1)="SOURCE ARRAY("_DDBSA_")" D BLD^DIALOG(202,.X) Q
|
|---|
| 13 | N DDBRE,DDBLN,DDBRPE,DDBPSA,DDBTO,I,X,Y
|
|---|
| 14 | N DDBFNO,DDBDM,DDBSF,DDBTL,DDBTPG,DDBZN,DDBFTR,DDBHDR,DDBHDRC,DDBST
|
|---|
| 15 | S DDBHDR=$$CTXT($G(DDBPMSG,"VA FileMan Browser"),$J("",IOM+1),IOM)
|
|---|
| 16 | S DDBHDRC=+$G(DDBHDRC)
|
|---|
| 17 | S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
|
|---|
| 18 | I DDBTL'>0 D I DDBTL'>0 D BLD^DIALOG(1700,"*NO TEXT* "_DDBSA) Q
|
|---|
| 19 | .N I S I=0 F S I=$O(@DDBSA@(I)) Q:I'>0 S DDBTL=I
|
|---|
| 20 | .Q
|
|---|
| 21 | S DDBZN=$D(@DDBSA@(DDBTL,0))#2,DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1),DDBDM=DDBSA="^TMP(""DDB"",$J)",DDBSF=1
|
|---|
| 22 | S DDBC=$G(DDBC,"^TMP(""DDBC"",$J)")
|
|---|
| 23 | S DDBPSA=0,DDBFLG=$G(DDBFLG)
|
|---|
| 24 | S DDBL=$G(DDBL,0) S:DDBL<0 DDBL=0 S:DDBL>DDBTL DDBL=DDBTL
|
|---|
| 25 | S (DDBRE,DDBRPE)="",DDBTO=0,DDBST=IOM
|
|---|
| 26 | S DDBLST=$G(DDBLST,"^TMP(""DDBLST"",$J)"),DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
|
|---|
| 27 | D SAVEDDB^DDBR2(DDBLST,DDBLN,1)
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | CTXT(X,T,W) ;Center X in T which is W characters wide (usually spaces) and W for screen width
|
|---|
| 31 | Q:X="" $G(T)
|
|---|
| 32 | N HW
|
|---|
| 33 | S W=$G(W,79),HW=W\2
|
|---|
| 34 | S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q T
|
|---|
| 35 | OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
|
|---|
| 36 | OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
|
|---|
| 37 | ;
|
|---|
| 38 | CHDR(D) ;Change Header Message in Window Title
|
|---|
| 39 | ;D=direction 1 is down, -1 is up, if 0 restore back to original msg.
|
|---|
| 40 | N C
|
|---|
| 41 | S C=DDBHDRC+D
|
|---|
| 42 | I C<0!(C>DDBTL) W $C(7) Q
|
|---|
| 43 | S DDBHDRC=C
|
|---|
| 44 | ENCHDR I 'DDBHDRC S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
|
|---|
| 45 | E D
|
|---|
| 46 | .I DDBZN S DDBHDR=$$CTXT^DDBR($E(@DDBSA@(DDBHDRC,0),DDBSF,DDBST)_$J("",IOM+1),"",IOM) Q
|
|---|
| 47 | .S DDBHDR=$$CTXT^DDBR($E(@DDBSA@(DDBHDRC),DDBSF,DDBST)_$J("",IOM+1),"",IOM)
|
|---|
| 48 | .Q
|
|---|
| 49 | I DDBRSA S DDBRSA(DDBRSA,"DDBHDRC")=DDBHDRC,DDBRSA(DDBRSA,"DDBHDR")=DDBHDR
|
|---|
| 50 | ; repaint screen
|
|---|
| 51 | D RPS^DDBRGE
|
|---|
| 52 | Q
|
|---|
