source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDBR.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1DDBR ;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.
4EN 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
14WP(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
31BROWSE(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM) N DDBRLIST
32CONTNU 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
82DOCLIST(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
107RTN G DR^DDBRU
108ROOT G EN^DDBRU2
109CTXT(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)
113OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
114OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
115INIT 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
122ERR(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)
125CLEAN D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
126 Q
Note: See TracBrowser for help on using the repository browser.