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

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1DDBR2 ;SFISC/DCL-VA FILEMAN BROWSER ;NOV 04, 1996@13:48
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5SWITCH(DDBLST,DDBRET) ;Switch to another document in list or FileMan Database
6 I $E(DDBSA,1,11)="^DI(.84,920" D EXIT^DDBR0 Q ;!(DDBSA="^XTMP(""DDBDOC"")") Q
7 I DDBSA=$NA(^TMP("DDWB",$J)) G EXIT^DDBR0:$G(DDBRET)["R",SWITCH^DDBRWB Q
8 N DDBLN,DDBZ,DIC,DIR,X,Y,DIRUT,DIROUT,DUOUT,DILN
9 S DILN=DDBRSA(DDBRSA,"DDBSRL")-2
10 S:$G(DDBLST)="" DDBLST="^TMP(""DDBLST"",$J)" S DDBLN=$S($D(@DDBLST@("A",DDBSA)):^(DDBSA),1:$O(@DDBLST@(" "),-1)+1)
11 I DDBFLG["R",'$D(@DDBLST) D SFR() G PS
12 I DDBFLG["A" D SFR() G PS
13 I $G(DDBRET)["R" D G:$G(Y) PS Q
14 .Q:DDBPSA'>0
15 .Q:'$D(@DDBLST@("APSA",DDBPSA)) S X=^(DDBPSA) S:$D(@DDBLST@("A",X)) Y=^(X)
16 .I $G(Y) S DDBPSA=DDBPSA-1 N DDBPSA D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
17 .Q
18BRMC D BRM
19 I $D(@DDBLST) D
20 .I $O(@DDBLST@(" "),-1)=1,$G(@DDBLST@(1,"DDBSA"))=DDBSA Q
21 .;W "Current list: ",!
22 .S DDBZ=$G(@DDBLST@("A",DDBSA),0)
23 .;S X=0 F S X=$O(@DDBLST@(X)) Q:X'>0 W:X'=DDBZ !,$J(X,3)," ",$E(@DDBLST@(X,0),1,75)
24 .W !
25 .K DIR0
26 .S DIR(0)="Y",DIR("A")="Do you wish to select from current list? ",DIR("B")="YES" D ^DIR,SFR("to Current List"):Y=0&(DDBFLG["R") Q:$D(DIRUT)!(Y'>0)
27 .S DIC=$$OREF^DIQGU(DDBLST),DIC(0)="EMQ",DIC("S")="I +Y'=DDBZ",DIC("W")="W:$E(^(0))=U ^(0)",X="??" D ^DIC ;K DIC("S") Q:Y'>0
28 .S DIC(0)="AEMQ"
29 .D ^DIC K DIC("S") Q:Y'>0
30 .D SAVEDDB(DDBLST,DDBLN),USAVEDDB(DDBLST,+Y)
31 .S DIROUT=1
32 N DDBLNA
33 S:DDBFLG["R" DIROUT=1
34 I '$D(DIROUT) D LIST^DDBR3(.DDBLNA)
35 I $G(DDBLNA,-1)=-1 G PS
36 I $G(DDBLNA(6))=DDBSA G PS ;if current document selected again
37 I $G(DDBLNA(6))]"",$D(@DDBLST@("APSA",DDBSA)) G PS ;if already in list
38 I DDBLNA'>0 W $C(7),!!,"** NO TEXT** ",DDBLNA(5) H 3
39 D:DDBLNA>0 SAVEDDB(DDBLST,DDBLN),WP(.DDBLNA)
40PS D PSR^DDBR0(1)
41 Q
42 ;
43WP(DDBX) ;
44 S DDBSA=DDBX(6)
45 S DDBPMSG=DDBX(5)
46 S DDBHDR=$$CTXT^DDBR(DDBPMSG,$J("",IOM+1),IOM)
47 S DDBTL=$P(@DDBSA@(0),"^",3)
48 S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
49 S DDBZN=1
50 S DDBDM=0
51 S DDBSF=1
52 S DDBST=IOM
53 S DDBC="^TMP(""DDBC"",""DDBC"",$J)"
54 I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
55 S DDBL=0
56 Q
57 ;
58SAVEDDB(DDBLIST,IEN,NSAPSA) ;Save local varialbes into ^TMP("DDBLIST",$J,IEN)
59 ;DDBS array to save list
60 ;IEN internal entry
61 ;NSAPSA Not Set "APSA" x-ref if undefined, pass 1 to not set NSAPSA (optional - default is to set "APSA")
62 S NSAPSA=+$G(NSAPSA)
63 N I,X
64 F I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@DDBLIST@(IEN,X)=@X
65 ;I $D(DDBFNO) S @DDBLIST@(IEN,DDBFNO)=DDBFNO ;decided to keep it the same throughout the browse session (Next Find String)
66 S @DDBLIST@(IEN,0)=DDBPMSG
67 S:'$D(@DDBLIST@(0)) ^(0)="CURRENT LIST^1"
68 S:'$D(@DDBLIST@("A",DDBSA)) @DDBLIST@("A",DDBSA)=IEN
69 S:'$D(@DDBLIST@("B",DDBPMSG,IEN)) @DDBLIST@("B",DDBPMSG,IEN)=""
70 I $G(DDBRET)["R",DDBRPE=DDBRE Q
71 Q:NSAPSA
72 S X=$O(@DDBLST@("APSA"," "),-1)+1
73 I $G(@DDBLIST@("APSA",X-1))=DDBSA S DDBPSA=X-1 Q
74 S @DDBLIST@("APSA",X)=DDBSA,DDBPSA=X
75 Q
76 ;
77USAVEDDB(DDBLIST,IEN) ;Unsave varialbes in ^TMP("DDBLIST",$J,IEN) to locals
78 ;DDBS array to save list
79 ;IEN internal entry
80 N I,X
81 F I="HDR","HDRC","SA","ZN","DM","PMSG","L","C","TL","SF","ST","RE","RPE" S X="DDB"_I,@X=@DDBLIST@(IEN,X)
82 S DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1)
83 ;I $D(@DDBLIST@(IEN,"DDBFNO")) S DDBFNO=@DDBLIST@(IEN,"DDBFNO")
84 Q
85 ;
86 ;
87CTXT(X,T,W) ;Center X in T which is W characters wide (usually spaces) and W for screen width
88 Q:X="" $G(T)
89 N HW
90 S W=$G(W,79),HW=W\2
91 S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q T
92OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
93OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
94 ;
95BRM ;BROWSE MANAGER SCREEN
96 N DX,DY,X
97 S DX=0,DY=$P(DDBSY,";"),X=$$CTXT^DDBR("BROWSE SWITCH MANAGER",$J("",IOM+1),IOM)
98 X IOXY
99 W $P(DDGLVID,DDGLDEL,6) ;rvon
100 W $P(DDGLVID,DDGLDEL,4) ;uon
101 W X
102 W $P(DDGLVID,DDGLDEL,10) ;rvoff
103 F DY=$P(DDBSY,";",2):1:$P(DDBSY,";",4) X IOXY W $P(DDGLCLR,DDGLDEL)
104 W $P(DDGLVID,DDGLDEL,6) ;rvon
105 W $P(DDGLVID,DDGLDEL,4) ;uon
106 W X
107 W $P(DDGLVID,DDGLDEL,10) ;rvoff
108 W @IOSTBM
109 S DY=$P(DDBSY,";",2)
110 X IOXY
111 Q
112 ;
113SFR(Y) N X
114 S X(1)="",X(2)=$$CTXT^DDBR("<< SWITCH Function Restricted "_$G(Y)_" >>","",IOM)
115 W $$WS^DDBR1(.X),$C(7)
116 R X:3
117 Q
Note: See TracBrowser for help on using the repository browser.