| 1 | DDBR ;SFISC/DCL-VA FILEMAN BROWSER ;NOV 04, 1996@13:46
 | 
|---|
| 2 |  ;;22.0;VA FileMan;;Mar 30, 1999
 | 
|---|
| 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 |  I $G(DDBFLG)["A" D
 | 
|---|
| 21 |  .N DDBSAN
 | 
|---|
| 22 |  .S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA))
 | 
|---|
| 23 |  .I '$D(@DDBSAN) D WP^DDBRAP($NA(@DDBSA))
 | 
|---|
| 24 |  .Q:$G(DDBPMSG)]""
 | 
|---|
| 25 |  .I $D(@DDBSAN@("TITLE")) S DDBPMSG=@DDBSAN@("TITLE") Q
 | 
|---|
| 26 |  .Q
 | 
|---|
| 27 |  S DDBPMSG=$S($G(DDBPMSG)]"":DDBPMSG,1:"VA FileMan Browser (wp) DOCUMENT 1")
 | 
|---|
| 28 |  D CONTNU
 | 
|---|
| 29 |  D:$G(DDBFLG)'["P" KTMP^DDBRU
 | 
|---|
| 30 |  Q
 | 
|---|
| 31 | BROWSE(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM) N DDBRLIST
 | 
|---|
| 32 | CONTNU I $G(U)'="^" N U S U="^"
 | 
|---|
| 33 |  I $G(DDBFLG)["A" D
 | 
|---|
| 34 |  .N DDBSAN
 | 
|---|
| 35 |  .S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA))
 | 
|---|
| 36 |  .I '$D(@DDBSAN) D WP^DDBRAP($NA(@DDBSA))
 | 
|---|
| 37 |  .Q:$G(DDBPMSG)]""
 | 
|---|
| 38 |  .I $D(@DDBSAN@("TITLE")) S DDBPMSG=@DDBSAN@("TITLE") Q
 | 
|---|
| 39 |  .Q
 | 
|---|
| 40 |  S DDBPMSG=$S($G(DDBPMSG)]"":DDBPMSG,1:"VA FileMan Browser DOCUMENT 1")
 | 
|---|
| 41 |  N %,D,DX,IOP,XY,X,Y
 | 
|---|
| 42 |  D:$G(DDBFLG)'["H" INIT I $G(DIERR) D CLEAN Q
 | 
|---|
| 43 |  I $G(DDBSA)']"" D ERR("SOURCE ARRAY") Q
 | 
|---|
| 44 |  I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
 | 
|---|
| 45 |  I $G(DDBFLG)'["N",DDBSA'="^TMP(""DDB"",$J)" D
 | 
|---|
| 46 |  .I $NA(@DDBSA)=$NA(^TMP("DDB",$J)) S DDBSA="^TMP(""DDB"",$J)" Q
 | 
|---|
| 47 |  .K ^TMP("DDB",$J)
 | 
|---|
| 48 |  .D XY^%RCR($$OREF(DDBSA),"^TMP(""DDB"",$J,")
 | 
|---|
| 49 |  .;M ^TMP("DDB",$J)=@DDBSA
 | 
|---|
| 50 |  .S DDBSA="^TMP(""DDB"",$J)"
 | 
|---|
| 51 |  .Q
 | 
|---|
| 52 |  N DDBRE,DDBRPE,DDBPSA,DDBTO,DDBDM,DDBFNO,I,DDBFLGS,DDBRHT,DDBRHTF
 | 
|---|
| 53 |  N DDBHDR,DDBHDRC,DDBFTR,DDBSP,DDBSF,DDBST,DDBTL,DDBTPG,DDBZN
 | 
|---|
| 54 |  I '$G(DDBRLIST) N DDBSRL,DDBSX,DDBSY,DDBRSA
 | 
|---|
| 55 |  S DDBFTR=$E("Col>     |<PF1>H=Help <PF1>E=Exit| Line>                 Screen>"_$J("",IOM),1,IOM)
 | 
|---|
| 56 |  I '$G(DDBRLIST) S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
 | 
|---|
| 57 |  S DDBRSA=0
 | 
|---|
| 58 |  D TB^DDBRS(.IOTM,.IOBM,.DDBRSA)
 | 
|---|
| 59 |  S DDBSX="0;4;40;65"
 | 
|---|
| 60 |  S DDBSY=DDBRSA(0,"DDBSY")
 | 
|---|
| 61 |  I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
 | 
|---|
| 62 |  I IOTM<2 D ERR("TOP MARGIN") Q
 | 
|---|
| 63 |  I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
 | 
|---|
| 64 |  S DDBSRL=DDBRSA(0,"DDBSRL")
 | 
|---|
| 65 |  I DDBSRL'>4,$G(DDBFLG)'["H" D ERR("SCROLL REGION (TOO SMALL)") Q
 | 
|---|
| 66 |  I DDBRSA(1,"DDBSRL")'>4 K DDBRSA(1),DDBRSA(2)
 | 
|---|
| 67 |  S DDBHDR=$$CTXT(DDBPMSG,$J("",IOM+1),IOM),DDBHDRC=0
 | 
|---|
| 68 |  S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
 | 
|---|
| 69 |  I DDBTL'>0 D  I DDBTL'>0 D BLD^DIALOG(1700,"*NO TEXT*"_DDBSA) D CLEAN Q
 | 
|---|
| 70 |  .N I S I=0 F  S I=$O(@DDBSA@(I)) Q:I'>0  S DDBTL=I
 | 
|---|
| 71 |  .Q
 | 
|---|
| 72 |  S DDBZN=$D(@DDBSA@(DDBTL,0))#2,DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1),DDBSF=1,DDBST=IOM
 | 
|---|
| 73 |  S DDBDM=DDBSA="^TMP(""DDB"",$J)"
 | 
|---|
| 74 |  I $G(DDBC)=+$G(DDBC) D ERR("TAB (Closed Array Root)") Q
 | 
|---|
| 75 |  S:$G(DDBC)="" DDBC="^TMP(""DDBC"",$J)"
 | 
|---|
| 76 |  I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
 | 
|---|
| 77 |  I $D(@DDBC@(1))'>9 N DDBC0,DDBC1 S @DDBC@(1)="",DDBC1=1,DDBC0=DDBC
 | 
|---|
| 78 |  S DDBPSA=0,DDBFLG=$G(DDBFLG)
 | 
|---|
| 79 |  S DDBFLGS=DDBFLG["S",DDBRHTF=DDBFLG["A"
 | 
|---|
| 80 |  I DDBRHTF S $E(DDBFTR,1,9)="HYPER-TXT"
 | 
|---|
| 81 |  G EN^DDBRGE
 | 
|---|
| 82 | DOCLIST(DDBDSA,DDBFLG,IOTM,IOBM) S IOP="HOME" D ^%ZIS
 | 
|---|
| 83 |  N DDBPMSG,DDBL,DDBC,DDBSA,DDBSRL,DDBSX,DDBSY,DDBRSA,DDBRLIST
 | 
|---|
| 84 |  S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
 | 
|---|
| 85 |  S DDBSX="0;4;40;65"
 | 
|---|
| 86 |  S DDBSY=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM)  ;hdr,txttop,txtbot,ftr
 | 
|---|
| 87 |  I IOBM>(IOSL-1) D ERR("BOTTOM MARGIN") Q
 | 
|---|
| 88 |  I IOTM<2 D ERR("TOP MARGIN") Q
 | 
|---|
| 89 |  I IOBM'>IOTM D ERR("TOP & BOTTOM MARGINS") Q
 | 
|---|
| 90 |  S DDBSRL=(IOBM-IOTM)+1  ;scroll region lines
 | 
|---|
| 91 |  I '$D(@DDBDSA) D ERR("DOCUMENT ARRAY INVALID") Q
 | 
|---|
| 92 |  S DDBFLG=$TR($G(DDBFLG),"P")_"N"
 | 
|---|
| 93 |  S DDBPMSG=$O(@DDBDSA@("")) S:DDBPMSG]"" DDBSA=@DDBDSA@(DDBPMSG)
 | 
|---|
| 94 |  I DDBPMSG']""!(DDBSA']"") D ERR("DOCUMENT ARRAY INVALID") Q
 | 
|---|
| 95 |  D  I $G(DIERR) K ^TMP("DDBLST",$J) D CLEAN Q
 | 
|---|
| 96 |  .N DOC,DOCSA
 | 
|---|
| 97 |  .S DOC=""
 | 
|---|
| 98 |  .K ^TMP("DDBLST",$J)
 | 
|---|
| 99 |  .F  S DOC=$O(@DDBDSA@(DOC)) Q:DOC=""  D
 | 
|---|
| 100 |  ..S DOCSA=@DDBDSA@(DOC)
 | 
|---|
| 101 |  ..D LOADCL^DDBR4(DOCSA,"",DOC)
 | 
|---|
| 102 |  ..Q
 | 
|---|
| 103 |  .Q
 | 
|---|
| 104 |  Q:$G(DDBENDR)
 | 
|---|
| 105 |  S DDBRLIST=1
 | 
|---|
| 106 |  G CONTNU
 | 
|---|
| 107 | RTN G DR^DDBRU
 | 
|---|
| 108 | ROOT G EN^DDBRU2
 | 
|---|
| 109 | CTXT(X,T,W) Q:X="" $G(T)
 | 
|---|
| 110 |  N HW
 | 
|---|
| 111 |  S W=$G(W,79),HW=W\2
 | 
|---|
| 112 |  S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q $E(T,1,W)
 | 
|---|
| 113 | OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
 | 
|---|
| 114 | OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 %  S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
 | 
|---|
| 115 | INIT I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
 | 
|---|
| 116 |  D INIT^DDGLIB0()
 | 
|---|
| 117 |  I $G(DIERR) Q
 | 
|---|
| 118 |  I '$D(IOSTBM)!('$D(IOIL)) S X="IOSTBM;IORI" D ENDR^%ZISS
 | 
|---|
| 119 |  D:$G(IOSTBM)="" TRMERR^DDGLIB0("Set top and bottom margins")
 | 
|---|
| 120 |  D:$G(IORI)="" TRMERR^DDGLIB0("Reverse index")
 | 
|---|
| 121 |  Q
 | 
|---|
| 122 | ERR(DDBERR) N P S P(1)=DDBERR
 | 
|---|
| 123 |  I $G(U)="^" N U S U="^"
 | 
|---|
| 124 |  D BLD^DIALOG(202,.P),OUT^DDBRU:$D(DDGLDEL)
 | 
|---|
| 125 | CLEAN D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
 | 
|---|
| 126 |  Q
 | 
|---|