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/ZISHMSM.m@ 876

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

initial load of FOIAVistA 6/30/08 version

File size: 6.0 KB
Line 
1%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;01/04/2005 08:44
2 ;;8.0;KERNEL;**24,36,49,65,84,104,306**;JUL 10, 1995
3 ;
4OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File
5 ;X1=handle name
6 ;X2=directory name \dir\
7 ;X3=file name
8 ;X4=file access mode e.g.: W for write, R for read, A for append, B for block.
9 ;X5=Max record size for a new file, X6=Subtype
10 N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO
11 S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO
12 S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R")
13 S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10))
14 F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q
15 I '%T S POP=1 Q
16 ;S %1=$$MODE^%ZISF(X2_X3,X4)
17 U %2 S %ZA=$ZA
18 I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q
19 S IO=%2,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6))
20 I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
21 Q
22 ;
23CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
24 ;X=HANDLE NAME, IO=Device
25 N %
26 I $G(IO)]"" C IO K IO(1,IO)
27 I $G(X)]"" D RMDEV^%ZISUTL(X)
28 D HOME^%ZIS
29 Q
30 ;
31OPENERR ;
32 Q 0
33 ;
34DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
35 ;S Y=$$DEL^ZOSHMSM("\dir\","fl")
36 ; ,.array)
37 ;Changed %ZX2 to a $NAME string
38 N %,%ZH,%ZXDEL,ZOSHDA,ZOSHF,ZOSHX,ZOSHDF,ZOSHC
39 S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""
40 ;Get fls to act on
41 ;No '*' allowed
42 S %ZH="",%ZXDEL=1
43 F S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH="" D
44 . I %ZH["*" S %ZXDEL=0 Q ; Wild card not allowed.
45 .;S ZOSHC="rm "_X1_%
46 .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file
47 Q %ZXDEL
48 ;
49LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names
50 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
51 ; "fl*",
52 ; .array,
53 ;
54 ;Change X2 = $NAME OF CLOSE ROOT
55 ;Change X3 = $NAME OF CLOSE ROOT
56 ;
57 N %ZISH,%ZISHN,%ZX,%ZISHY
58 S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""
59 ;Get fls to act on
60 S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D
61 .S %ZX=%ZX1_%ZISH
62 .F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^")
63 ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY)
64 ..E S %ZISHY=$ZOS(12,%ZX,0)
65 Q $O(@%ZX3@(""))]""
66 ;
67MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl
68 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")
69 ;
70 N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y
71 S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
72 I X1=Y1 Q $ZOS(3,X2,Y2)'<0
73 S X=X1_X2,Y=Y1_Y2
74 ;
75 S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y
76 O %ZISHDV1:(%ZISHFN1)
77 O %ZISHDV2:(%ZISHFN2:"W")
78 U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0
79 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX))
80 Q 1
81 ;
82SLOWCOPY ; Copy without view buffer
83 N X,Y
84 O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"")
85 FOR DO Q:%ZC!(%ZB=%ZISHSIZ)
86 . U %ZISHDV1 R X#1024 Q:$L(X)=0
87 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC
88 . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1)
89 . S X=%ZB/%ZISHSIZ*100\1 ; %done
90 . Q:X=%ZISHPCT S %ZISHPCT=X
91 . Q ;U 0 W $J(%ZISHPCT,3),*13
92 Q
93 ;
94PWD() ;ef,SR. Print working directory
95 N Y
96 S Y=$$DEFDIR("") I $L(Y) Q Y
97 S Y=$ZOS(11,$ZOS(14))
98 Q:Y<0 ""
99 S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"")
100 Q $ZOS(14)_":"_Y
101 ;
102JW ;Call dos $ZOS
103 S ZOSHX=$ZOS(ZOSHNUM,ZOSHC)
104 Q
105DEFDIR(DF) ;ef. Default Dir and frmt
106 Q:DF="." "" ;Special way to get current dir.
107 S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\")
108 I $E(DF,$L(DF))'="\" S DF=DF_"\"
109 Q DF
110FL(X) ;Fl len
111 N ZOSHP1,ZOSHP2
112 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)
113 I $L(ZOSHP1)>8 S X=4 Q
114 I $L(ZOSHP2)>3 S X=4 Q
115 Q
116READNXT(REC) ;Read any sized record into array.
117 N T,I,X,LB
118 U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC)
119 Q:%ZA<255
120 F I=1:1 S LB=LB+%ZA Q:LB<%ZB R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X)) S REC(I)=X
121 Q
122STATUS() ;ef,SR. Return EOF status
123 U $I
124 Q $$EOF($ZC)
125 ;
126EOF(X) ;Eof flag, pass in $ZC
127 Q (X=-1)
128 ;
129READREC(X) ;Read record from host file.
130 N Y
131 U IO R X S Y=$ZC
132 U $P
133 Q Y
134MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.
135 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB
136 N I,F,MX
137 S OVF=$G(OVF,"%ZISHOF")
138 S %ZISHI=$QS(HF,IX),MX=$QL(HF) ;
139 S F=$NA(@HF,IX-1) ;Get first part
140 I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1
141 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root
142 S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow
143 F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I)
144 S %ZISHF=%ZISHF_")"
145 Q
146FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global
147 ;p1=host file directory
148 ;p2=host file name
149 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
150 ;p4=INCREMENT SUBSCRIPT
151 ;p5=Overflow subscript, defaults to "OVF"
152 N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX
153 N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB
154 S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF")
155 D MAKEREF(%ZX3,%ZX4,"%ZISHOF")
156 D OPEN^%ZISH(,%ZX1,%ZX2,"R")
157 I POP Q 0
158 S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
159 U IO F K %XX D READNXT(.%XX) D Q:$$EOF(%ZC)
160 . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I
161 . S @%ZISHF=%XX
162 . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT)
163 . S %ZISHI=%ZISHI+1
164 . Q
165 D CLOSE() ;Normal exit
166 Q 1
167 ;
168ERREOF D CLOSE() ;Error close and exit
169 Q 0
170 ;
171GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.
172 ;Previously name LOAD
173 ;p1=$NAME of global reference
174 ;p2=incrementing subscript
175 ;p3=host file directory, p4=host file name
176 N %ZISHY,%ZISHOX
177 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W")
178 Q %ZISHY
179 ;
180GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.
181 ;
182 ;p1=$NAME of global reference
183 ;p2=incrementing subscript
184 ;p3=host file directory
185 ;p4=host file name
186 N %ZISHY
187 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A")
188 Q %ZISHY
189MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;
190 ;p1=$NAME of global reference
191 ;p2=incrementing subscript
192 ;p3=host file directory
193 ;p4=host file name
194 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y
195 D MAKEREF(%ZX1,%ZX2)
196 D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open
197 I POP Q 0
198 N X
199 S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
200 F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,!
201 D CLOSE()
202 Q 1
203 ;
Note: See TracBrowser for help on using the repository browser.