| 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 | ;
|
|---|
