source: FOIAVistA/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISHDTM.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 6.5 KB
Line 
1ZISHDTM ;IHS/PR,SFISC/AC HOST FILE COMMANDS FOR DTM ;06/30/95 13:34
2 ;;8.0;KERNEL;;JUL 10, 1995
3 ;
4 ;
5OPEN(X1,X2,X3,X4) ;
6 ;X1=handle name
7 ;X2=directory name \dir\
8 ;X3=file name
9 ;X4=file access mode e.g.: W for write, R for read, A for append.
10 N %,%1,%2,%I,%T,%ZIOS,X
11 S %I=$I
12 S %1=$$MODE^%ZISF(X2_X3,X4)
13 S X="OPNERR^%ZISH",@^%ZOSF("TRAP")
14 F %=10:1:19 D O @%2 S %T=$T Q:%T
15 .S %2=%_":"_%1_":0"
16 I %T S IO=%,IO(1,IO)="",POP=0
17 E U:$D(IO(1,%I)) %I S POP=1 Q ;Q 0
18 U @% S %ZIOS=$ZIOS
19 I %ZIOS=4 U:$D(IO(1,%I)) %I C % S POP=1 Q ; Q 0
20 ;S IO=%,IO(1,IO)=""
21 I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
22 Q ;Q 1
23 ;
24OPNERR ;process errors during open of host file.
25 S POP=1
26 Q
27CLOSE(X) ;Close HFS device not opened by %ZIS.
28 ;X=HANDLE NAME
29 N %
30 I $G(X)]"" C IO K IO(1,IO) D RMDEV^%ZISUTL(X),HOME^%ZIS Q
31 C IO K IO(1,IO) D HOME^%ZIS
32 Q
33 ;
34OPENERR ;
35 Q 0
36 ;
37DEL(%ZISHX1,%ZISHX2) ;Del fl(s)
38 ;S Y=$$DEL^ZOSHMSM("\dir\",$NAME STRING)
39 ; ,.array)
40 ;Changed X2 to a $NAME string
41 N %ZISH,%ZISHLGR
42 N ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
43 S %ZISHX1=$TR(%ZISHX1,"/","\")
44 ;Get fls to act on
45 ;No '*' allowed
46 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
47 S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S ZOSHQ=1 Q
48 I $D(ZOSHQ) X "I $G(%ZISHLGR)]"""",$D(@%ZISHLGR)" Q 0
49 S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D
50 .;S ZOSHC="rm "_X1_%
51 .;S ZOSHC=$ZOS(2,%ZISHX1_%ZISH)
52 .D del^%dos(%ZISHX1_%ZISH)
53 .;D JW
54 I $G(%ZISHLGR)]"",$D(@%ZISHLGR)
55 Q 1
56 ;
57LIST(%ZISHX1,%ZISHX2,%ZISHX3) ;Create a local array holding fl names
58 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
59 ; "fl*",
60 ; .array,
61 ;
62 ;Change X2 = $NAME OF CLOSE ROOT
63 ;Change X3 = $NAME OF CLOSE ROOT
64 ;
65 N %ZISH,%ZISH1,%ZISH2,%ZISHLGR,%ZISHX,%ZISHY
66 ;Get fls to act on
67 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
68 S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D
69 .S %ZISHX=%ZISHX1_%ZISH
70 .S %ZISHY=$$files^%dos(%ZISHX)
71 .F %ZISH1=1:1:$L(%ZISHY,$C(10))-1 D
72 ..S %ZISH2=$P($P(%ZISHY,$C(10),%ZISH1),";")
73 ..I %ZISH2="."!(%ZISH2="..") Q
74 ..S @%ZISHX3@(%ZISH2)=""
75 I $G(%ZISHLGR)]"",$D(@%ZISHLGR)
76 Q $O(@%ZISHX3@(""))]""
77 ;
78MV(X1,X2,Y1,Y2) ;Rename a fl
79 ;S Y=$$MV^ZOSHMSM("/dir/","fl","/dir/","fl")
80 N %ZISHLGR
81 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
82 ;
83 ;Dir frmt
84 S X1=$TR(X1,"/","\"),Y1=$TR(Y1,"/","\")
85 I X1=Y1 D rename^%dos(X1_X2,Y1_Y2) Q 1
86 D copy^%dos(X1_X2,Y1_Y2)
87 D del^%dos(X1_X2)
88 I $G(%ZISHLGR)]"",$D(@%ZISHLGR)
89 Q 1
90 Q
91 ;
92PWD() ;Print working directory
93 ;S Y=$$PWD^ZOSHMSM(.return array)
94 ;
95 N Y
96 S Y=$$curdrive^%dos
97 S Y=Y_":\"_$$subdir^%dos(Y)
98 S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"")
99 Q Y
100 ;
101JW ;msm extrinsic
102 S ZOSHX=$$JOBWAIT^%HOSTCMD(ZOSHC)
103 Q
104DF(X) ;Dir frmt
105 Q:X=""
106 S X=$TR(X,"\","/")
107 I $E(X,$L(X))'="/" S X=X_"/"
108 Q
109STATUS() ;Eof flag
110 Q $ZIOS=3
111QL(X) ;Qlfrs
112 Q:X=""
113 S:$E(X)'="-" X="-"_X
114 Q
115FL(X) ;Fl len
116 N ZOSHP1,ZOSHP2
117 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)
118 I $L(ZOSHP1)>14 S X=4 Q
119 I $L(ZOSHP2)>8 S X=4 Q
120 Q
121 ;
122FTG(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;Unload contents of host file into global
123 ;p1=hostf file directory
124 ;p2=host file name
125 ;p3= NOW $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
126 ;p4=INCREMENT SUBSCRIPT
127 ;p5=Overflow subscript, defaults to "OVL"
128 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHLGR,%ZISHS,ZISHIO,%ZISHOVL,%ZISHX,ZISHY
129 N %CONT,%OVLCNT,%XX,%ZA,%ZB,%ZISH2,%ZISHNREC,%ZL,%ZPL,%ZPZB,ZIOS
130 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
131 S %ZISHOVL=$G(%ZISHX5,"OVL")
132 S %ZISHI=$$QS^XLFUTL(%ZISHX3,%ZISHX4)
133 S %ZISHL=$$QL^XLFUTL(%ZISHX3)
134 I %ZISHX4=(%ZISHL+1),%ZISHI="" S %ZISHI=1
135 S %ZISH1=$NA(@%ZISHX3,%ZISHX4-1) ;name string before incrementing subscript
136 F %ZISH=%ZISHX4+1:1:%ZISHL S %ZISHS(%ZISH)=$$QS^XLFUTL(%ZISHX3,%ZISH)
137 D OPEN^%ZISH("",%ZISHX1,%ZISHX2,"R")
138 S %ZISHX="",%ZPZB=0,%ZPL="",%OVLCNT=0,%CONT=0,%ZISHNREC=1
139 U IO F D READNXT(.%XX) Q:$$STATUS&'$L(%XX) D
140 .S ZIOS=$ZIOS
141 .I %ZISHNREC D
142 ..I $G(%ZISHRMD),%ZISHX]"" S %ZISHI=%ZISHI-1 D SETOVL S %ZISHI=%ZISHI+1
143 ..S %ZISHX=%XX K %ZISHRMD
144 ..S %ZISH2=$NA(@%ZISH1@(%ZISHI))
145 ..S %ZISH=%ZISH+1
146 ..F %ZISH=%ZISHX4+1:1:%ZISHL S %ZISH2=$NA(@%ZISH2@(%ZISHS(%ZISH)))
147 ..S @%ZISH2=$E(%ZISHX,1,255)
148 ..S %OVLCNT=0,%CONT=0
149 ..Q:%ZL'>255
150 ..D LOOP S %ZISHRMD=1
151 .E D
152 ..S %ZL2=$L(%ZISHX),%ZISHX=%ZISHX_$E(%XX,1,255-%ZL2)
153 ..K %ZISHRMD
154 ..D SETOVL
155 ..S %XX=$E(%XX,256-%ZL2,$L(%XX))
156 ..S %ZISHX=%XX
157 ..D:%ZISHX]"" SETOVL
158 ..I $L(%ZISHX)>255 D LOOP S %ZISHRMD=1
159 .S %ZISHNREC=($ZIOS=0)
160 .I %ZISHNREC D
161 ..S %ZISHI=%ZISHI+1 ;B:%ZISHI=2
162 I $G(%ZISHRMD),%ZISHX]"" D SETOVL
163EOF2 C IO K IO(1,IO)
164 I $G(%ZISHLGR)]"",$D(@%ZISHLGR) ;restore last global reference.
165 Q 1
166LOOP S %CONT=1 F Q:$L(%ZISHX)'>255 D
167 .S %ZISHX=$E(%ZISHX,256,$L(%ZISHX))
168 .D SETOVL:$L(%ZISHX)>255
169 Q
170NEXTLUP F Q:%ZA=%ZL D
171 .D READNXT(.%XX) Q:$$STATUS
172 .S %ZL2=$L(%ZISHX),%ZISHX=%ZISHX_$E(%XX,1,255-%L2)
173 .D SETOVL
174 .S %XX=$E(%XX,256-%L2,$L(%XX))
175 .I $L(%XX)>255 S %ZISHX=%XX D LOOP
176 .E S %ZISHX=%XX D SETOVL
177 Q
178READNXT(%XX) ;
179 U IO R %XX Q:$$STATUS&(%XX="") S %ZA=$ZA,%ZB=$ZB,%ZL=$L(%XX)
180 Q
181SETOVL ;
182 S %OVLCNT=%OVLCNT+1
183 S @$NA(@%ZISH1@(%ZISHI))@(%ZISHOVL,%OVLCNT)=$E(%ZISHX,1,255)
184 Q
185 Q 1
186GTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;Load contents of global to host file.
187 ;p1=$NAME of global reference
188 ;p2=incrementing subscript
189 ;p3=host file directory
190 ;p4=host file name
191 ;
192 N %ZISHLGR,%ZISHY
193 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
194 S %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"W")
195 I $G(%ZISHLGR)]"",$D(@%ZISHLGR)
196 Q %ZISHY
197GATF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;Load contents of global to host file.
198 ;p1=$NAME of global reference
199 ;p2=incrementing subscript
200 ;p3=host file directory
201 ;p4=host file name
202 N %ZISHLGR,%ZISHY
203 S %ZISHLGR=$$LGR^%ZOSV ;if possible, save off last global reference
204 S %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"A")
205 I $G(%ZISHLGR)]"",$D(@%ZISHLGR)
206 Q %ZISHY
207 ;
208MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;Load contents of global to host file.
209 ;p1=$NAME of global reference
210 ;p2=incrementing subscript
211 ;p3=host file directory
212 ;p4=host file name
213 ;p5=access mode
214 N %ZISH,%ZISH1,%ZISH2,%ZISHI,%ZISHL,%ZISHS,%ZISHIO,%ZISHX,%ZISHY
215 S %ZISHI=$$QS^XLFUTL(%ZISHX1,%ZISHX2)
216 S %ZISHL=$$QL^XLFUTL(%ZISHX1)
217 S %ZISH1=$NA(@%ZISHX1,%ZISHX2-1)
218 F %ZISH=%ZISHX2+1:1:%ZISHL S %ZISHS(%ZISH)=$$QS^XLFUTL(%ZISHX1,%ZISH)
219 D OPEN^%ZISH("",%ZISHX3,%ZISHX4,%ZISHX5)
220 S %ZISHX="EOF3^%ZISH"
221 F D Q:'($D(@%ZISH2)#2) S %ZISHX=@%ZISH2,%ZISHI=%ZISHI+1 U IO W %ZISHX,!
222 .S %ZISH2=$NA(@%ZISH1@(%ZISHI))
223 .F %ZISH=%ZISHX2+1:1:%ZISHL S %ZISH2=$NA(@%ZISH2@(%ZISHS(%ZISH)))
224 ;C %ZISHIO
225 D CLOSE^%ZISH("")
226 Q 1
227 Q
228 ;
Note: See TracBrowser for help on using the repository browser.