[BACK]Return to DDBR.m CVS log [TXT] [DIR] Up to [Coherent Logic Development] / freem_fileman / USER
File:  [Coherent Logic Development] / freem_fileman / USER / DDBR.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DDBR	;SFISC/DCL-VA FILEMAN BROWSER ;12/28/94  11:23
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: EN	N DDBC,DDBFLG,DDBL,DDBPMSG,DDBSA,DDBX,IOTM,IOBM
    5: 	I '$$TEST^DDBRT W $C(7),!!,"This terminal does not support scroll region or reverse index",!! Q
    6: 	D LIST^DDBR3(.DDBX)
    7: 	I DDBX'>0 W:DDBX=0 $C(7),!!,"No Text",!! Q
    8: 	S DDBSA=DDBX(6)
    9: 	S DDBFLG=DDBX(4)
   10: 	S DDBPMSG=DDBX(5)
   11: 	D CONTNU
   12: 	D KTMP^DDBRU
   13: 	Q
   14: WP(DDBFN,DDBRN,DDBFLD,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM)	N DDBSA
   15: 	S DDBSA=$$GET^DIQG($G(DDBFN),$G(DDBRN),$G(DDBFLD),"B")
   16: 	I $G(DIERR) D CLEAN Q
   17: 	S DDBSA=$P(DDBSA,"$CREF$",2)
   18: 	I DDBSA']"" D ERR("FILE, RECORD and/or FIELD") Q
   19: 	I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
   20: 	S DDBPMSG=$G(DDBPMSG,"VA FileMan Browser (wp) DOCUMENT 1")
   21: 	D CONTNU
   22: 	D:$G(DDBFLG)'["P" KTMP^DDBRU
   23: 	Q
   24: BROWSE(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM)	N DDBRLIST
   25: CONTNU	I $G(U)'="^" N U S U="^"
   26: 	S DDBPMSG=$G(DDBPMSG,"VA FileMan Browser DOCUMENT 1")
   27: 	N %,D,DX,IOP,XY,X,Y
   28: 	D:$G(DDBFLG)'["H" INIT I $G(DIERR) D CLEAN Q
   29: 	I $G(DDBSA)']"" D ERR("SOURCE ARRAY") Q
   30: 	I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
   31: 	I $G(DDBFLG)'["N",DDBSA'="^TMP(""DDB"",$J)" D
   32: 	.I $NA(@DDBSA)=$NA(^TMP("DDB",$J)) S DDBSA="^TMP(""DDB"",$J)" Q
   33: 	.K ^TMP("DDB",$J)
   34: 	.D XY^%RCR($$OREF(DDBSA),"^TMP(""DDB"",$J,")
   35: 	.;M ^TMP("DDB",$J)=@DDBSA
   36: 	.S DDBSA="^TMP(""DDB"",$J)"
   37: 	.Q
   38: 	N DDBRE,DDBRPE,DDBPSA,DDBTO,DDBDM,DDBFNO,I,DDBFLGS
   39: 	N DDBHDR,DDBFTR,DDBSP,DDBSF,DDBST,DDBTL,DDBTPG,DDBZN
   40: 	I '$G(DDBRLIST) N DDBSRL,DDBSX,DDBSY,DDBRSA
   41: 	S DDBFTR=$E("Col>     |<PF1>H=Help <PF1>E=Exit| Line>                 Screen>"_$J("",IOM),1,IOM)
   42: 	I '$G(DDBRLIST) S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
   43: 	S DDBRSA=0
   44: 	D TB^DDBRS(.IOTM,.IOBM,.DDBRSA)
   45: 	S DDBSX="0;4;40;65"
   46: 	S DDBSY=DDBRSA(0,"DDBSY")
   47: 	I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
   48: 	I IOTM<2 D ERR("TOP MARGIN") Q
   49: 	I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
   50: 	S DDBSRL=DDBRSA(0,"DDBSRL")
   51: 	I DDBSRL'>4 D ERR("SCROLL REGION (TOO SMALL)") Q
   52: 	I DDBRSA(1,"DDBSRL")'>4 K DDBRSA(1),DDBRSA(2)
   53: 	S DDBHDR=$$CTXT(DDBPMSG,$J("",IOM+1),IOM)
   54: 	S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
   55: 	I DDBTL'>0 D  I DDBTL'>0 D BLD^DIALOG(1700,"*NO TEXT*"_DDBSA) D CLEAN Q
   56: 	.N I S I=0 F  S I=$O(@DDBSA@(I)) Q:I'>0  S DDBTL=I
   57: 	.Q
   58: 	S DDBZN=$D(@DDBSA@(DDBTL,0))#2,DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1),DDBSF=1,DDBST=IOM
   59: 	S DDBDM=DDBSA="^TMP(""DDB"",$J)"
   60: 	I $G(DDBC)=+$G(DDBC) D ERR("TAB (Closed Array Root)") Q
   61: 	S:$G(DDBC)="" DDBC="^TMP(""DDBC"",$J)"
   62: 	I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
   63: 	I $D(@DDBC@(1))'>9 N DDBC0,DDBC1 S @DDBC@(1)="",DDBC1=1,DDBC0=DDBC
   64: 	S DDBPSA=0,DDBFLG=$G(DDBFLG)
   65: 	S DDBFLGS=DDBFLG["S"
   66: 	G EN^DDBRGE
   67: DOCLIST(DDBDSA,DDBFLG,IOTM,IOBM)	S IOP="HOME" D ^%ZIS
   68: 	N DDBPMSG,DDBL,DDBC,DDBSA,DDBSRL,DDBSX,DDBSY,DDBRSA,DDBRLIST
   69: 	S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
   70: 	S DDBSX="0;4;40;65"
   71: 	S DDBSY=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM)  ;hdr,txttop,txtbot,ftr
   72: 	I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
   73: 	I IOTM<2 D ERR("TOP MARGIN") Q
   74: 	I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
   75: 	S DDBSRL=(IOBM-IOTM)+1  ;scroll region lines
   76: 	I '$D(@DDBDSA) D ERR("DOCUMENT ARRAY INVALID") Q
   77: 	S DDBFLG=$TR($G(DDBFLG),"P")_"N"
   78: 	S DDBPMSG=$O(@DDBDSA@("")) S:DDBPMSG]"" DDBSA=@DDBDSA@(DDBPMSG)
   79: 	I DDBPMSG']""!(DDBSA']"") D ERR("DOCUMENT ARRAY INVALID") Q
   80: 	D  I $G(DIERR) K ^TMP("DDBLST",$J) D CLEAN Q
   81: 	.N DOC,DOCSA
   82: 	.S DOC=""
   83: 	.K ^TMP("DDBLST",$J)
   84: 	.F  S DOC=$O(@DDBDSA@(DOC)) Q:DOC=""  D
   85: 	..S DOCSA=@DDBDSA@(DOC)
   86: 	..D LOADCL^DDBR4(DOCSA,"",DOC)
   87: 	..Q
   88: 	.Q
   89: 	Q:$G(DDBENDR)
   90: 	S DDBRLIST=1
   91: 	G CONTNU
   92: RTN	G DR^DDBRU
   93: ROOT	G EN^DDBRU2
   94: CTXT(X,T,W)	Q:X="" $G(T)
   95: 	N HW
   96: 	S W=$G(W,79),HW=W\2
   97: 	S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q $E(T,1,W)
   98: OREF(X)	N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
   99: OR2(%)	Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
  100: INIT	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  101: 	D INIT^DDGLIB0()
  102: 	I $G(DIERR) Q
  103: 	I '$D(IOSTBM)!('$D(IOIL)) S X="IOSTBM;IORI" D ENDR^%ZISS
  104: 	D:$G(IOSTBM)="" TRMERR^DDGLIB0("Set top and bottom margins")
  105: 	D:$G(IORI)="" TRMERR^DDGLIB0("Reverse index")
  106: 	Q
  107: ERR(DDBERR)	N P S P(1)=DDBERR
  108: 	I $G(U)="^" N U S U="^"
  109: 	D BLD^DIALOG(202,.P),OUT^DDBRU:$D(DDGLDEL)
  110: CLEAN	D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
  111: 	Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>