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