source: IHS-VA_UTILITIES-XB/XBLM.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 7.0 KB
RevLine 
[641]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.