Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISHONT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZISHONT.m
r613 r623 1 %ZISH ;IHS/PR,SFISC/AC - Host File Control for Cache for VMS/NT/UNIX ;1/24/08 16:11 2 ;;8.0;KERNEL;**34,65,84,104,191,306,385,440**;JUL 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified 4 ; **MODIFIED VERSION FOR CACHE/VMS -- 9/7/01** 5 ; 6 OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File 7 ;X1=handle name 8 ;X2=directory name \dir\ 9 ;X3=file name 10 ;X4=file access mode e.g.: W for write, R for read, A for append. 11 ;X5=Max record size for a new file, X6=Subtype 12 N %,%1,%2,%I,%ZOS,%T,%ZA,%ZISHIO,$ET 13 S $ET="D OPNERR^%ZISH" 14 S U="^",%I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%ZOS=$$OS^%ZOSV M %ZISHIO=IO 15 I %ZOS'="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"R")_$S(X4["B":"U",1:"S") ;NT & Unix 16 I %ZOS="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"RH")_$S(X4["B":"U",1:"S") 17 ;The next line eliminates the <ENDOFFILE> error for sequential files for the current process. 18 S %ZA=$ZUTIL(68,40,1) ;Work like DSM 19 S %=X2_X3 O %:(%1):2 I '$T S POP=1 Q 20 ;U % S %ZA=$ZA ;Comment out, $ZA is for READ status 21 ;I %ZA=-1 U:%I]"" %I C % S POP=1 Q 22 S IO=%,IO(1,IO)="",IOT="HFS",IOM=80,IOSL=60,POP=0 D SUBTYPE^%ZIS3($G(X6,"P-OTHER")) 23 I $G(X1)]"" D SAVDEV^%ZISUTL(X1) 24 U $S(%I]"":%I,1:$P) 25 Q 26 ; 27 OPNERR ;Handle open error 28 S POP=1,$ECODE="" 29 U:$P]"" $P 30 Q 31 ; 32 CLOSE(X) ;SR. Close HFS device not opened by %ZIS. 33 ;X=HANDLE NAME 34 ;IO=Device 35 N % 36 I $G(IO)]"" C IO K IO(1,IO) 37 I $G(X)]"" D RMDEV^%ZISUTL(X) 38 ;Only reset home if one setup. 39 I $D(IO("HOME"))!$D(^XUTL("XQ",$J,"IOS")) D HOME^%ZIS 40 Q 41 ; 42 OPENERR ; 43 Q 0 44 ; 45 DEL(%ZX1,%ZX2) ;ef,SR. Del files, return 1 if deleted all requested. 46 ;S Y=$$DEL^%ZISH("dir path",$NA(array)) 47 ; will invoke an OS command to delete file(s) 48 ; UNIX: rm -f filespec[ ...] 49 ; VMS: del filespec[,...] 50 N %ZARG,%ZXDEL,%ZOS,%ZDELIM,%ZCOMND,%ZLIST 51 S %ZARG="",%ZXDEL=1 52 S %ZX1=$$DEFDIR($G(%ZX1)) 53 S %ZOS=$$OS^%ZOSV 54 S %ZDELIM=$S(%ZOS="UNIX":" ",1:",") 55 S %ZCOMND=$S(%ZOS="UNIX":"rm -f ",1:"del ") 56 D 57 . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" 58 . N %,%ZI,%ZISH,%ZX,%ZFOUND S %ZISH="" 59 . F %ZI=1:1 S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D 60 . . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" 61 . . I %ZISH["*" S %ZXDEL=0 Q ; Wild card not allowed. 62 . . S %ZX=$S(%ZISH[%ZX1:%ZISH,1:%ZX1_%ZISH) ; prepend directory path 63 . . I %ZOS="VMS",%ZX'[";" S %ZX=%ZX_";*" 64 . . S %ZFOUND=$ZSEARCH(%ZX)]"" ; File exists 65 . . S:%ZFOUND %ZARG=$S(%ZARG="":%ZX,1:%ZARG_%ZDELIM_%ZX) ; join files 66 . . I $L(%ZARG)>2000 S %=$ZF(-1,%ZCOMND_%ZARG),%ZARG="" H 1 ; delete files at a time 67 . ; 68 . I $L(%ZARG) S %=$ZF(-1,%ZCOMND_%ZARG) ; delete remaining files 69 ; 70 I %ZXDEL S %ZXDEL='$$LIST(%ZX1,%ZX2,"%ZLIST") 71 Q %ZXDEL 72 ; 73 DELERR ;Trap any $ETRAP error, unwind and return. 74 S $ETRAP="D UNWIND^%ZTER" 75 S %ZXDEL=0,%ZARG="" 76 D UNWIND^%ZTER 77 Q 78 ; 79 DEL1(%ZX3) ;ef,SR. Delete one file 80 N %ZI1,%ZI2 81 D SPLIT(%ZX3,.%ZI1,.%ZI2) S %ZI2(%ZI2)="" 82 Q $$DEL(%ZI1,$NA(%ZI2)) 83 ; 84 SPLIT(%I,%O1,%O2) ;Split to path,file 85 N %ZOS,%D,D S %ZOS=$$OS^%ZOSV 86 I %ZOS["VMS" D Q 87 . S D=$S(%I["]":"]",1:":") 88 . S %O1=$P(%I,D,1)_D,%O2=$P(%I,D,2) 89 . Q 90 S %D=$S(%ZOS="UNIX":"/",%ZOS="NT":"\",1:""),%O1="",%O2="" Q:%D="" 91 S D=$L(%I,%D),%O1=$P(%I,%D,1,D-1),%O2=$P(%I,%D,D) 92 Q 93 ; 94 FEXIST(%PATH,%FL) ;Check if files exsist. 95 ;S Y=$$DTEST("/usr/var",$NA(array)) 96 N %ZISH,%ZISHY 97 S %ZISH=$$LIST(%PATH,%FL,"%ZISHY") 98 Q %ZISH 99 ; 100 LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding file names 101 ;S Y=$$LIST^%ZISH("\dir\",$NA(array),$NA(return array)) Return 1 if found anything 102 ; 103 N %ZISH,%ZISHN,%ZX,%ZISHY,%ZY,%ZOS 104 S %ZX1=$$DEFDIR($G(%ZX1)),%ZOS=$$OS^%ZOSV 105 ;S %ZX1=$$TRNLNM(%ZX1) 106 ;Get fls to act on 107 S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D 108 . S %ZISHY=$P(%ZISH,"*") 109 . I %ZOS="VMS",%ZISH'["." S %ZISH=%ZISH_".*" ;Allways upper 110 . ;NT, display case, ignore for lookup 111 . S %ZX=%ZX1_%ZISH 112 . F %ZISHN=0:1 D Q:(%ZX="") 113 . . S %ZX=$ZSEARCH($S(%ZISHN:"",1:%ZX)) 114 . . ;Q:(%ZX="")!($$UP^XLFSTR(%ZX)'[%ZISHY)!(%ZX?.E1.2".") 115 . . Q:(%ZX="")!(%ZX?.E1.2".") 116 . . I %ZOS="VMS" S %ZX=$P(%ZX,"]",2),@%ZX3@(%ZX)="" 117 . . I %ZOS="NT" S %ZY=$P(%ZX,"\",$L(%ZX,"\")),@%ZX3@(%ZY)="" 118 . . I %ZOS="UNIX" S %ZY=$P(%ZX,"/",$L(%ZX,"/")) Q:%ZX'[%ZISHY S @%ZX3@(%ZY)="" 119 . . Q 120 Q $O(@%ZX3@(""))]"" 121 ; 122 MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl 123 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") 124 ;Unix use mv, NT/VMS use COPY and DEL 125 N %,X,Y,%ZOS,%ZISHX S %ZOS=$$OS^%ZOSV 126 S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) 127 S X=$ZSEARCH(X1_X2),Y=Y1_Y2 ;move X to Y 128 I X="" Q 0 129 S %=$ZF(-1,$S(%ZOS="UNIX":"mv ",1:"copy ")_X_" "_Y) ;Use NT/VMS copy 130 I %ZOS'="UNIX" D 131 . S X2=$P(X,X1,2),%ZISHX(X2)="" 132 . S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) 133 Q 1 134 ; 135 PWD() ;ef,SR. Print working directory 136 N Y,%ZOS 137 S Y=$$DEFDIR(""),%ZOS=$$OS^%ZOSV 138 I Y="" S Y=$ZSEARCH("*") 139 Q $S(%ZOS["VMS":Y,1:$P(Y,".",1)) 140 ; 141 TRNLNM(PATH) ;ef. Expand logical path 142 N %ZOS,P1,P2 143 S %ZOS=$$OS^%ZOSV,PATH=$G(PATH) 144 I %ZOS="VMS" D Q PATH 145 . S P1=PATH_$S(PATH[":":"*.*",1:":*.*") 146 . S P2=$ZSEARCH(P1) 147 . S:$L(P2) PATH=$S(P2["]":$P(P2,"]",1)_"]",1:$P(P2,":",1)_":") 148 . Q 149 I %ZOS="NT" D Q PATH 150 . S P1=PATH_$S($E(PATH,$L(PATH))'="\":"\*",1:"*"),P2=$ZSEARCH(P1) 151 . S:$L(P2) PATH=$P(P2,"\",1,$L(P2,"\")-1)_"\" 152 . Q 153 I %ZOS="UNIX" D Q PATH 154 . S P1=PATH_$S($E(PATH,$L(PATH))'="/":"/*",1:"*"),P2=$ZSEARCH(P1) 155 . S:$L(P2) PATH=$P(P2,"/",1,$L(P2,"/")-1)_"/" 156 . Q 157 Q PATH 158 ; 159 DEFDIR(DF) ;ef. Default Dir and frmt 160 ;Need to handle NT, VMS and Linux 161 N %ZOS,P1,P2 S %ZOS=$$OS^%ZOSV,DF=$G(DF) 162 Q:DF="." "" ;Special way to get current dir. 163 S:DF="" DF=$G(^XTV(8989.3,1,"DEV")),DF=$P(DF,"^",$S($$PRI^%ZOSV<2:1,1:2)) 164 Q:DF="" "" 165 ;Check syntax, VMS needs disk:[dir] or logical: 166 I %ZOS="VMS" D 167 . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) 168 . E S P1="",P2=DF 169 . I P1="",P2["$" S P1=P2,P2="" ;Could be a logical 170 . I $L(P2) S:P2'["[" P2="["_P2 S:P2'["]" P2=P2_"]" 171 . S DF=P1_P2 S:DF'[":" DF=DF_":" 172 . Q 173 ;Check syntax, Unix needs /mnt/fl, ./fl, ~/fl $HOME/fl 174 I %ZOS="UNIX" D 175 . S DF=$TR(DF,"\","/") 176 . S:$E(DF,$L(DF))'="/" DF=DF_"/" 177 . Q 178 ;Check syntax, NT needs c:\dir\ 179 I %ZOS="NT" D 180 . N P1,P2 181 . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) 182 . E S P1="",P2=DF 183 . S P2=$TR(P2,"/","\") 184 . I $L(P2) S:".\"'[$E(P2,1) P2="\"_P2 S:$E(P2,$L(P2))'="\" P2=P2_"\" 185 . S DF=P1_P2 186 . Q 187 S DF=$$TRNLNM(DF) ;Resolve logicals 188 Q DF 189 ; 190 FL(X) ;Fl len 191 N ZOSHP1,ZOSHP2 192 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) 193 I $L(ZOSHP1)>8 S X=4 Q 194 I $L(ZOSHP2)>3 S X=4 Q 195 Q 196 ; 197 STATUS() ;ef,SR. Return EOF status 198 U $I 199 Q $$EOF($ZEOF) 200 ; 201 EOF(X) ;Eof flag, pass in $ZEOF 202 Q (X=-1) 203 ; 204 MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. 205 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB 206 N I,F,MX 207 S OVF=$G(OVF,"%ZISHOF") 208 S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; 209 S F=$NA(@HF,IX-1) ;Get first part 210 I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 211 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root 212 S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow 213 F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) 214 S %ZISHF=%ZISHF_")" 215 Q 216 ; 217 READNXT(REC) ;Read any sized record into array. %ZB has terminator 218 N %,I,X,$ES,$ET S REC="",$ET="D READNX^%ZISH Q" 219 U IO R X:5 S %ZB=$A($ZB),REC=$E(X,1,255) 220 Q:$L(X)<256 221 S %=256 F I=1:1 Q:$L(X)<% S REC(I)=$E(X,%,%+254),%=%+255 222 Q 223 READNX ;Check for EOF 224 I $ZE["ENDOFFILE" S %ZA=-1 225 S $EC="" 226 Q 227 ; 228 FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global 229 ;p1=hostf file directory 230 ;p2=host file name 231 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT 232 ;p4=INCREMENT SUBSCRIPT 233 ;p5=Overflow subscript, defaults to "OVF" 234 N %ZA,%ZB,%ZC,X,%OVFCNT,%ZISHF,%ZISHO,POP,%ZISUB,$ES,$ET 235 N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY 236 S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") 237 D MAKEREF(%ZX3,%ZX4,"%ZISHOF") 238 D OPEN^%ZISH(,%ZX1,%ZX2,"R") 239 I POP Q 0 240 S %ZC=1,%ZA=0,$ET="S %ZC=0,%ZA=-1,$EC="""" Q" 241 U IO F K %XX D READNXT(.%XX) Q:$$EOF($ZEOF)!%ZA D 242 . S @%ZISHF=%XX 243 . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) 244 . S %ZISHI=%ZISHI+1 245 . Q 246 D CLOSE() ;Normal exit 247 Q %ZC 248 ; 249 GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. 250 ;p1=$NAME of global reference 251 ;p2=incrementing subscript 252 ;p3=host file directory 253 ;p4=host file name 254 N %ZISHY,%ZISHOX 255 S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"W") 256 Q %ZISHY 257 ; 258 GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. 259 ; 260 ;p1=$NAME of global reference 261 ;p2=incrementing subscript 262 ;p3=host file directory 263 ;p4=host file name 264 N %ZISHY 265 S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"A") 266 Q %ZISHY 267 ; 268 MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; 269 ;p1=$NAME of global reference 270 ;p2=incrementing subscript 271 ;p3=host file directory 272 ;p4=host file name 273 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y,%ZC 274 D MAKEREF(%ZX1,%ZX2) 275 D OPEN^%ZISH(,$G(%ZX3),%ZX4,%ZX5) ;Default dir set in open 276 I POP Q 0 277 N $ETRAP S $ETRAP="S $EC="""" D CLOSE^%ZISH() Q 0" 278 F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! 279 D CLOSE() 280 Q 1 281 ; 1 %ZISH ;IHS\PR,SFISC/AC - Host File Control for OpenM/Cache for NT/VMS ;12/13/2005 2 ;;8.0;KERNEL;**34,65,84,104,191,306,385**;JUL 10, 1995;Build 3 3 ; 4 ; **MODIFIED VERSION FOR CACHE/VMS -- 9/7/01** 5 ; 6 OPEN(X1,X2,X3,X4,X5,X6) ;SR. Open Host File 7 ;X1=handle name 8 ;X2=directory name \dir\ 9 ;X3=file name 10 ;X4=file access mode e.g.: W for write, R for read, A for append. 11 ;X5=Max record size for a new file, X6=Subtype 12 N %,%1,%2,%I,%ZOS,%T,%ZA,%ZISHIO,$ET 13 S $ET="D OPNERR^%ZISH" 14 S U="^",%I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%ZOS=$$OS^%ZOSV M %ZISHIO=IO 15 I %ZOS'="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"R")_$S(X4["B":"U",1:"S") ;NT & Unix 16 I %ZOS="VMS" S %1=$S(X4["A":"AW",X4["W":"WN",1:"RH")_$S(X4["B":"U",1:"S") 17 ;The next line eliminates the <ENDOFFILE> error for sequential files for the current process. 18 S %ZA=$ZUTIL(68,40,1) ;Work like DSM 19 S %=X2_X3 O %:(%1):2 I '$T S POP=1 Q 20 ;U % S %ZA=$ZA ;Comment out, $ZA is for READ status 21 ;I %ZA=-1 U:%I]"" %I C % S POP=1 Q 22 S IO=%,IO(1,IO)="",IOT="HFS",IOM=80,IOSL=60,POP=0 D SUBTYPE^%ZIS3($G(X6,"P-OTHER")) 23 I $G(X1)]"" D SAVDEV^%ZISUTL(X1) 24 U $S(%I]"":%I,1:$P) 25 Q 26 ; 27 OPNERR ;Handle open error 28 S POP=1,$ECODE="" 29 U:$P]"" $P 30 Q 31 ; 32 CLOSE(X) ;SR. Close HFS device not opened by %ZIS. 33 ;X=HANDLE NAME 34 ;IO=Device 35 N % 36 I $G(IO)]"" C IO K IO(1,IO) 37 I $G(X)]"" D RMDEV^%ZISUTL(X) 38 ;Only reset home if one setup. 39 I $D(IO("HOME"))!$D(^XUTL("XQ",$J,"IOS")) D HOME^%ZIS 40 Q 41 ; 42 OPENERR ; 43 Q 0 44 ; 45 DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s) 46 ;S Y=$$DEL^%ZISH("dir path",$NA(array)) 47 N %,%ZX,%ZXDEL,%ZISH,%ZOS 48 S %ZX1=$$DEFDIR($G(%ZX1)),%ZOS=$$OS^%ZOSV,%ZXDEL=1,%ZISH="" 49 F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D 50 . N $ETRAP,$ESTACK S $ETRAP="D DELERR^%ZISH" 51 . I %ZISH["*" S %ZXDEL=0 Q ; Wild card not allowed. 52 . S %ZX=$S(%ZISH[%ZX1:%ZISH,1:%ZX1_%ZISH) 53 . I %ZOS="VMS",%ZX'[";" S %ZX=%ZX_";*" 54 . Q:$ZSEARCH(%ZX)']"" ; File doesn't exist 55 . S %=$ZF(-1,$S(%ZOS="UNIX":"rm ",1:"del ")_%ZX) 56 . I $ZSEARCH(%ZX)]"" S %ZXDEL=0 ; Delete was not successful. 57 Q %ZXDEL 58 ; 59 DELERR ;Trap any $ETRAP error, unwind and return. 60 S $ETRAP="D UNWIND^%ZTER" 61 S %ZXDEL=0 62 D UNWIND^%ZTER 63 Q 64 ; 65 LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding file names 66 ;S Y=$$LIST^ZOSHDOS("\dir\",$NA(array),$NA(return array)) Return 1 if found anything 67 ; 68 N %ZISH,%ZISHN,%ZX,%ZISHY,%ZY,%ZOS 69 S %ZX1=$$DEFDIR($G(%ZX1)),%ZOS=$$OS^%ZOSV 70 ;S %ZX1=$$TRNLNM(%ZX1) 71 ;Get fls to act on 72 S %ZISH="" F S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH="" D 73 . S %ZISHY=$P(%ZISH,"*") 74 . I %ZOS="VMS",%ZISH'["." S %ZISH=%ZISH_".*" ;Allways upper 75 . ;NT, display case, ignore for lookup 76 . S %ZX=%ZX1_%ZISH 77 . F %ZISHN=0:1 D Q:(%ZX="") 78 . . S %ZX=$ZSEARCH($S(%ZISHN:"",1:%ZX)) 79 . . ;Q:(%ZX="")!($$UP^XLFSTR(%ZX)'[%ZISHY)!(%ZX?.E1.2".") 80 . . Q:(%ZX="")!(%ZX?.E1.2".") 81 . . I %ZOS="VMS" S %ZX=$P(%ZX,"]",2),@%ZX3@(%ZX)="" 82 . . I %ZOS="NT" S %ZY=$P(%ZX,"\",$L(%ZX,"\")),@%ZX3@(%ZY)="" 83 . . I %ZOS="UNIX" S %ZY=$P(%ZX,"/",$L(%ZX,"/")) Q:%ZX'[%ZISHY S @%ZX3@(%ZY)="" 84 . . Q 85 Q $O(@%ZX3@(""))]"" 86 ; 87 MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl 88 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl") 89 ;Unix use mv, NT/VMS use COPY and DEL 90 N %,X,Y,%ZOS,%ZISHX S %ZOS=$$OS^%ZOSV 91 S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1)) 92 S X=$ZSEARCH(X1_X2),Y=Y1_Y2 ;move X to Y 93 I X="" Q 0 94 S %=$ZF(-1,$S(%ZOS="UNIX":"mv ",1:"copy ")_X_" "_Y) ;Use NT/VMS copy 95 I %ZOS'="UNIX" D 96 . S X2=$P(X,X1,2),%ZISHX(X2)="" 97 . S Y=$$DEL^%ZISH(X1,$NA(%ZISHX)) 98 Q 1 99 ; 100 PWD() ;ef,SR. Print working directory 101 N Y,%ZOS 102 S Y=$$DEFDIR(""),%ZOS=$$OS^%ZOSV 103 I Y="" S Y=$ZSEARCH("*") 104 Q $S(%ZOS["VMS":Y,1:$P(Y,".",1)) 105 ; 106 TRNLNM(PATH) ;ef. Expand logical path 107 N %ZOS,P1,P2 108 S %ZOS=$$OS^%ZOSV,PATH=$G(PATH) 109 I %ZOS="VMS" D Q PATH 110 . S P1=PATH_$S(PATH[":":"*.*",1:":*.*") 111 . S P2=$ZSEARCH(P1) 112 . S:$L(P2) PATH=$S(P2["]":$P(P2,"]",1)_"]",1:$P(P2,":",1)_":") 113 . Q 114 I %ZOS="NT" D Q PATH 115 . S P1=PATH_$S($E(PATH,$L(PATH))'="\":"\*",1:"*"),P2=$ZSEARCH(P1) 116 . S:$L(P2) PATH=$P(P2,"\",1,$L(P2,"\")-1)_"\" 117 . Q 118 I %ZOS="UNIX" D Q PATH 119 . S P1=PATH_$S($E(PATH,$L(PATH))'="/":"/*",1:"*"),P2=$ZSEARCH(P1) 120 . S:$L(P2) PATH=$P(P2,"/",1,$L(P2,"/")-1)_"/" 121 . Q 122 Q PATH 123 ; 124 DEFDIR(DF) ;ef. Default Dir and frmt 125 ;Need to handle NT, VMS and Linux 126 N %ZOS,P1,P2 S %ZOS=$$OS^%ZOSV,DF=$G(DF) 127 Q:DF="." "" ;Special way to get current dir. 128 S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) 129 Q:DF="" "" 130 ;Check syntax, VMS needs disk:[dir] or logical: 131 I %ZOS="VMS" D 132 . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) 133 . E S P1="",P2=DF 134 . I P1="",P2["$" S P1=P2,P2="" ;Could be a logical 135 . I $L(P2) S:P2'["[" P2="["_P2 S:P2'["]" P2=P2_"]" 136 . S DF=P1_P2 S:DF'[":" DF=DF_":" 137 . Q 138 ;Check syntax, Unix needs /mnt/fl, ./fl 139 I %ZOS="UNIX" D 140 . S DF=$TR(DF,"\","/") 141 . S:$E(DF,$L(DF))'="/" DF=DF_"/" 142 . Q 143 ;Check syntax, NT needs c:\dir\ 144 I %ZOS="NT" D 145 . N P1,P2 146 . I DF[":" S P1=$P(DF,":")_":",P2=$P(DF,":",2) 147 . E S P1="",P2=DF 148 . S P2=$TR(P2,"/","\") 149 . I $L(P2) S:".\"'[$E(P2,1) P2="\"_P2 S:$E(P2,$L(P2))'="\" P2=P2_"\" 150 . S DF=P1_P2 151 . Q 152 S DF=$$TRNLNM(DF) ;Resolve logicals 153 Q DF 154 ; 155 FL(X) ;Fl len 156 N ZOSHP1,ZOSHP2 157 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2) 158 I $L(ZOSHP1)>8 S X=4 Q 159 I $L(ZOSHP2)>3 S X=4 Q 160 Q 161 ; 162 STATUS() ;ef,SR. Return EOF status 163 U $I 164 Q $$EOF($ZEOF) 165 ; 166 EOF(X) ;Eof flag, pass in $ZEOF 167 Q (X=-1) 168 ; 169 MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref. 170 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB 171 N I,F,MX 172 S OVF=$G(OVF,"%ZISHOF") 173 S %ZISHI=$QS(HF,IX),MX=$QL(HF) ; 174 S F=$NA(@HF,IX-1) ;Get first part 175 I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1 176 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root 177 S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow 178 F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I) 179 S %ZISHF=%ZISHF_")" 180 Q 181 ; 182 READNXT(REC) ;Read any sized record into array. %ZB has terminator 183 N %,I,X,$ES,$ET S REC="",$ET="D READNX^%ZISH Q" 184 U IO R X:5 S %ZB=$A($ZB),REC=$E(X,1,255) 185 Q:$L(X)<256 186 S %=256 F I=1:1 Q:$L(X)<% S REC(I)=$E(X,%,%+254),%=%+255 187 Q 188 READNX ;Check for EOF 189 I $ZE["ENDOFFILE" S %ZA=-1 190 S $EC="" 191 Q 192 ; 193 FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global 194 ;p1=hostf file directory 195 ;p2=host file name 196 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT 197 ;p4=INCREMENT SUBSCRIPT 198 ;p5=Overflow subscript, defaults to "OVF" 199 N %ZA,%ZB,%ZC,X,%OVFCNT,%ZISHF,%ZISHO,POP,%ZISUB,$ES,$ET 200 N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY 201 S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF") 202 D MAKEREF(%ZX3,%ZX4,"%ZISHOF") 203 D OPEN^%ZISH(,%ZX1,%ZX2,"R") 204 I POP Q 0 205 S %ZC=1,%ZA=0,$ET="S %ZC=0,%ZA=-1,$EC="""" Q" 206 U IO F K %XX D READNXT(.%XX) Q:$$EOF($ZEOF)!%ZA D 207 . S @%ZISHF=%XX 208 . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT)) S @%ZISHO=%XX(%OVFCNT) 209 . S %ZISHI=%ZISHI+1 210 . Q 211 D CLOSE() ;Normal exit 212 Q %ZC 213 ; 214 GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file. 215 ;p1=$NAME of global reference 216 ;p2=incrementing subscript 217 ;p3=host file directory 218 ;p4=host file name 219 N %ZISHY,%ZISHOX 220 S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"W") 221 Q %ZISHY 222 ; 223 GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file. 224 ; 225 ;p1=$NAME of global reference 226 ;p2=incrementing subscript 227 ;p3=host file directory 228 ;p4=host file name 229 N %ZISHY 230 S %ZISHY=$$MGTF(%ZX1,%ZX2,%ZX3,%ZX4,"A") 231 Q %ZISHY 232 ; 233 MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ; 234 ;p1=$NAME of global reference 235 ;p2=incrementing subscript 236 ;p3=host file directory 237 ;p4=host file name 238 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y,%ZC 239 D MAKEREF(%ZX1,%ZX2) 240 D OPEN^%ZISH(,$G(%ZX3),%ZX4,%ZX5) ;Default dir set in open 241 I POP Q 0 242 N $ETRAP S $ETRAP="S $EC="""" D CLOSE^%ZISH() Q 0" 243 F Q:'($D(@%ZISHF)#2) S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,! 244 D CLOSE() 245 Q 1 246 ;
Note:
See TracChangeset
for help on using the changeset viewer.
