source: IHS-VA_UTILITIES-XB/trunk/XBLM.m@ 850

Last change on this file since 850 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.
File size: 7.0 KB
Line 
1XBLM ; IHS/ADC/GTH - LIST MANAGER API'S ; [ 09/30/2004 12:07 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*5,6 IHS/ADC/GTH 10-31-97 Use %ZIS to open HF vs $$OPEN^%ZISH
4 ; XB*3*8 - IHS/ASDST/GTH 12-07-00 - Fix EOF bug in UNIX, timed READ.
5 ;
6 ; Documentation APIs for XBLM Generic Display.
7 ;
8 ; This utility uses the Veterans Administration List Manager
9 ; (VALM).
10 ;
11 ; APIs
12 ;
13 ; FILE^XBLM("Directory","File Name")
14 ; Displays file indicated.
15 ;
16 ; SFILE^XBLM
17 ; Selection of host file for display.
18 ;
19 ; VIEWR^XBLM("TAG^ROUTINE","Header")
20 ; Displays printout of the routine. (non - FM, using IO)
21 ;
22 ; VIEWD^XBLM("Tag^Routine","Header")
23 ; Displays printout of the routine. (FM - using EN1^DIP)
24 ;
25 ; DIQ^XBLM("DIC","DA")
26 ; Displays EN1^DIQ for the DIC,DA.
27 ;
28 ; ARRAY^XBLM("array(","Header")
29 ; Displays the array(..,n,0) (%RCR notation)
30 ;
31 ; >>GUI<<
32 ;
33 ; GUIR^XBLM("TAG^ROUTINE","root(")
34 ; Returns the hard coded output in the array specified.
35 ; "(" not required.
36 ;
37 ; GUID^XBLM("TAG^ROUTINE","root(")
38 ; Returns the output of the FM routine specified in the
39 ; array specified. Most often the call is "EN1^DIP".
40 ;
41 ; S XBGUI=1,XBY="root(" D entry_point^XBLM
42 ; The entry points sense these two variables and will
43 ; put the output into the array specified.
44 ;
45EN ;EP -- main entry point for XB DISPLAY
46 D EN^VALM("XB DISPLAY")
47 Q
48 ;
49HDR ;EP -- header code
50 I XBHDR]"" S VALMHDR(1)=XBHDR
51 Q
52 ;
53INIT ;EP -- init variables and list array
54MARKERS ;
55 I $G(XBLMMARK) F I=10:10 Q:'$D(@VALMAR@(I)) D
56 . F J=10:10:80 D CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
57 .Q
58 KILL XBLMMARK
59 S VALMCNT=$O(^TMP("XBLM",$J,XBNODE,""),-1)
60 Q
61 ;
62HELP ;EP -- help code
63 S X="?"
64 D DISP^XQORM1
65 W !!
66 Q
67 ;
68EXIT ;EP -- exit code
69 KILL ^TMP("XBLM",$J,XBNODE)
70K ;
71 KILL XBAR,XBDIR,XBFL,XBFN,XBHDR,XBI,XBROU,XBDIR
72 I '$G(XQORS) D CLEAR^VALM1
73 K IOPAR,IOUPAR
74 Q
75 ;
76EXPND ;EP -- expand code
77 Q
78 ;
79FILE(XBDIR,XBFN) ;PEP - pull up a file into the TMP global for display
80 ; or into an array for GUI (see GUIR and GUID entry points)
81 I '$D(XBHDR) S XBHDR=""
82 NEW Y,X,I,XBNODE
83 S XBNODE=$G(XQORS)+1
84 ;S Y=$$OPEN^%ZISH(XBDIR,XBFN,"M")
85 ;open hfs with zis
86 D DF^%ZISH(.XBDIR)
87 ;
88 ; IHS/ADC/GTH XB*3*5 start of open HF change
89 KILL %ZIS
90 I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
91 S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
92 D ^%ZIS
93 I POP W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'." S Y=$$DIR^XBDIR("E") G EFILE
94 KILL ^TMP("XBLM",$J,XBNODE)
95 ; F I=1:1 U IO R X:DTIME S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8
96 F I=1:1 U IO R X S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
97 D ^%ZISC
98 ; IHS/ADC/GTH XB*3*5 END of open HF change
99 ;
100 I $G(XBGUI) D KILL ^TMP("XBLM",$J,XBNODE) Q
101 . S I=0
102 . S XBY=$$OPENROOT(XBY)
103 . F S I=$O(^TMP("XBLM",$J,XBNODE,I)) Q:'+I S XBZ=XBY_"I)",@XBZ=^TMP("XBLM",$J,XBNODE,I,0)
104 .Q
105 D EN^XBLM
106 KILL ^TMP("XBLM",$J,XBNODE)
107EFILE ;
108 Q
109 ;
110SFILE ;PEP - Select a host file for display.
111OPEN ;
112 S IOP="HOME"
113 D ^%ZIS,DT^DICRW,^XBCLS
114 W !!,"Select a Directory and File",!!
115 S Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
116 KILL DIR
117 S DIR(0)="F^1:30",DIR("A")="Directory ",DIR("B")=XBDIR
118 K XBDIR
119 D ^DIR
120 KILL DIR
121 Q:$G(DTOUT)
122 Q:Y["^"
123 S XBDIR=Y
124FNAME ;PEP - Select a file (directory can be pre-loaded into XBDIR)
125 KILL DIR
126FNAME1 ;
127 S DIR(0)="FO^1:15",DIR("A")="File Name "
128 D ^DIR
129 KILL DIR
130 Q:$G(DTOUT)
131 G:Y["^" OPEN
132 G:Y="" OPEN
133 I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
134 I Y["*" K XBFL S X=$$LIST^%ZISH(XBDIR,Y,.XBFL) D G FNAME
135 . F XBI=1:1 Q:'$D(XBFL(XBI)) W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME
136 .Q
137 S XBFN=Y
138 ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"M")
139 ;open hfs with zis
140 D DF^%ZISH(.XBDIR)
141 ;
142 ; IHS/ADC/GTH XB*3*5 start of open HF change
143 KILL %ZIS
144 I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
145 S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
146 D ^%ZIS
147ES ;
148 I POP W !,"error on open of file ",XBDIR,XBFN,! S Y=$$DIR^XBDIR("E") Q:Y=1 G FNAME
149 D ^%ZISC
150 D FILE^XBLM(XBDIR,XBFN)
151 K XBFN
152ESFILE ;
153 G FNAME
154 Q
155 ;
156VIEWR(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
157 I '$D(XBHDR) S XBHDR=""
158 I +$G(IO(0)) U IO(0) D:'$G(XBGUI) WAIT^DICD
159 S Y=$$PWD^%ZISH(.XBDIR)
160 S XBDIR=XBDIR(1),XBFN="XB"_$J
161 ;open hfs with zis
162 D DF^%ZISH(.XBDIR)
163 K %ZIS
164 S XBIOM=IOM
165 I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
166 S IOP="XBLM HF DEVICE;"_IOM_";6000"
167 S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
168 D ^%ZIS
169 U IO
170 K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
171 D @XBROU
172 D ^%ZISC,HOME^%ZIS
173 D FILE^XBLM(XBDIR,XBFN)
174 S X=$$DEL^%ZISH(XBDIR,XBFN)
175 S IOM=XBIOM
176 KILL XBDIR,XBFN,XBHDR,XBNODE,XBDIR,XBFN,XBIOM
177 ; IHS/ADC/GTH XB*3*5 END of open HF change
178 ;
179 Q
180 ;
181GUIR(XBROU,XBY) ;PEP - give routine and target array
182 Q:$L(XBY)=0
183 ;
184 S XBGUI=1
185 D VIEWR^XBLM(XBROU,"")
186 KILL XBGUI,XBY
187 Q
188 ;
189GUID(XBROU,XBY) ;PEP give routine and target array for FM prints
190 Q:$L(XBY)=0
191 S:XBY["(" XBY=$P(XBY,"(")
192 S XBGUI=1
193 D VIEWD^XBLM(XBROU,"")
194 KILL XBGUI,XBY
195 Q
196 ;
197VIEWD(XBROU,XBHDR) ;PEP ** USING XBROU print to a host file for viewing
198 S:'$D(XBHDR) XBHDR=""
199 I +$G(IO(0)) I '$G(XBGUI) U IO(0) D WAIT^DICD
200 S XBFN="XB"_$J,Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
201 ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"W"),IOP=IO_";P-OTHER;"_IOM_";"_IOSL
202 ;open hfs with zis
203 D DF^%ZISH(.XBDIR)
204 ;
205 ; IHS/ADC/GTH XB*3*5 start of open HF change
206 KILL %ZIS
207 S XBIOM=IOM
208 I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
209 S IOP="XBLM HF DEVICE;"_IOM_";6000"
210 S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
211 ;D ^%ZIS ;XBROU must open device, XB*3*10, dmj
212 D @XBROU
213 K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
214 D ^%ZISC,HOME^%ZIS
215 D FILE^XBLM(XBDIR,XBFN)
216 S X=$$DEL^%ZISH(XBDIR,XBFN)
217 S IOM=XBIOM
218 KILL XBDIR,XBFN,XBNODE,XBDIR,XBFN,XBIOM
219 ; IHS/ADC/GTH XB*3*5 END of open HF change
220 ;
221 Q
222 ;
223DIQ(DIC,DA) ;PEP - Display DIC and DA after call to EN^DIQ
224 S IOSTO=IOST,IOST="P-DEC",IOSLO=IOSL,IOSL=6000
225 I DIC=+DIC S DIC=$$DIC^XBDIQ1(DIC)
226 I DA'=+DA D PARSE^XBDIQ1(DA)
227 NEW DIQ,DR
228 S DIQ(0)="C"
229 D VIEWR^XBLM("EN^DIQ")
230 S IOST=IOSTO
231 KILL IOSTO
232 S IOSL=IOSLO
233 KILL IOSLO,XBNODE,XBDIR,XBFN
234 Q
235 ;
236ARRAY(XBAR,XBHDR) ;PEP Display an array that has (...,n,0) structure
237 I '$D(XBHDR) S XBHDR=""
238 NEW Y,X,I,XBNODE
239 S XBNODE=$G(XQORS)+1
240 KILL ^TMP("XBLM",$J,XBNODE)
241 S %X=XBAR,%Y="^TMP(""XBLM"","_$J_","_XBNODE_","
242 D %XY^%RCR,EN^XBLM
243 KILL ^TMP("XBLM",$J,XBNODE),XBNODE,XBDIR,XBFN
244ARRAYE ;
245 Q
246 ;
247STRIP(Z) ;REMOVE CONTROLL CHARACTERS
248 NEW I
249 F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
250 Q Z
251 ;
252OPENROOT(XBY) ;EP - return OPen RooT form of XBY .. for %RCR use
253 NEW L
254 S L=$L(XBY)
255 I XBY["(",$E(XBY,L)="," G CONT
256 I XBY'["(" S XBY=XBY_"(" G CONT
257 I XBY["(",$E(XBY,L)=")" S XBY=$E(XBY,1,L-1)_"," G CONT
258CONT ;
259 Q XBY
260 ;
Note: See TracBrowser for help on using the repository browser.