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
|
---|