Routine: ZISHMSM

%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;01/04/2005  08:44

 ;;8.0;KERNEL;**24,36,49,65,84,104,306**;JUL 10, 1995

OPEN(X1,X2,X3,X4,X5,X6)    ;SR. Open Host File

 ;X1=handle name

 ;X2=directory name \dir\

 ;X3=file name

 ;X4=file access mode e.g.: W for write, R for read, A for append, B for block.

 ;X5=Max record size for a new file, X6=Subtype

 N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO

 S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO

 S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R")

 S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10))

 F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q

 I '%T S POP=1 Q

 ;S %1=$$MODE^%ZISF(X2_X3,X4)

 U %2 S %ZA=$ZA

 I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q

 S IO=%2,IO(1,IO)="",IOT="HFS",POP=0 D SUBTYPE^%ZIS3($G(X6))

 I $G(X1)]"" D SAVDEV^%ZISUTL(X1)

CLOSE(X) ;SR. Close HFS device not opened by %ZIS.

 ;X=HANDLE NAME, IO=Device

N %

 I $G(IO)]"" C IO K IO(1,IO)

 I $G(X)]"" D RMDEV^%ZISUTL(X)

 D HOME^%ZIS

OPENERR ;

Q 0

DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)

 ;S Y=$$DEL^ZOSHMSM("\dir\","fl")

 ;                         ,.array)

 ;Changed %ZX2 to a $NAME string

 N %,%ZH,%ZXDEL,ZOSHDA,ZOSHF,ZOSHX,ZOSHDF,ZOSHC

 S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""

 ;Get fls to act on

 ;No '*' allowed

 S %ZH="",%ZXDEL=1

 F  S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH=""  D

 . I %ZH["*" S %ZXDEL=0 Q  ; Wild card not allowed.

 .;S ZOSHC="rm "_X1_%

 .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file

 Q %ZXDEL

LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names

 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")

 ;                           "fl*",

 ;                           .array,

 ;Change X2 = $NAME OF CLOSE ROOT

 ;Change X3 = $NAME OF CLOSE ROOT

 N %ZISH,%ZISHN,%ZX,%ZISHY

 S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""

 ;Get fls to act on

 S %ZISH="" F  S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH=""  D

 .S %ZX=%ZX1_%ZISH

 .F %ZISHN=1:1 D  Q:$P(%ZISHY,"^")=""!(%ZISHY<0)  S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^")

 ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY)

 ..E  S %ZISHY=$ZOS(12,%ZX,0)

 Q $O(@%ZX3@(""))]""

MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl

 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")

 N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y

 S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))

 I X1=Y1 Q $ZOS(3,X2,Y2)'<0

 S X=X1_X2,Y=Y1_Y2

 S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y

 O %ZISHDV1:(%ZISHFN1)

 O %ZISHDV2:(%ZISHFN2:"W")

 U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0

 D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX))

Q 1

SLOWCOPY ; Copy without view buffer

 N X,Y

 O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"")

 FOR  DO  Q:%ZC!(%ZB=%ZISHSIZ)

 . U %ZISHDV1 R X#1024 Q:$L(X)=0

 . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC

 . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1)

 . S X=%ZB/%ZISHSIZ*100\1 ; %done

 . Q:X=%ZISHPCT  S %ZISHPCT=X

 . Q  ;U 0 W $J(%ZISHPCT,3),*13

PWD() ;ef,SR. Print working directory

N Y

 S Y=$$DEFDIR("") I $L(Y) Q Y

 S Y=$ZOS(11,$ZOS(14))

 Q:Y<0 ""

 S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"")

 Q $ZOS(14)_":"_Y

JW ;Call dos $ZOS

 S ZOSHX=$ZOS(ZOSHNUM,ZOSHC)

DEFDIR(DF) ;ef. Default Dir and frmt

 Q:DF="." "" ;Special way to get current dir.

 S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\")

 I $E(DF,$L(DF))'="\" S DF=DF_"\"

 Q DF

FL(X) ;Fl len

 N ZOSHP1,ZOSHP2

 S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)

 I $L(ZOSHP1)>8 S X=4 Q

 I $L(ZOSHP2)>3 S X=4 Q

READNXT(REC) ;Read any sized record into array.

 N T,I,X,LB

 U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC)

 Q:%ZA<255

 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

STATUS() ;ef,SR. Return EOF status

 U $I

 Q $$EOF($ZC)

EOF(X) ;Eof flag, pass in $ZC

 Q (X=-1)

READREC(X) ;Read record from host file.

N Y

 U IO R X S Y=$ZC

 U $P

Q Y

MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.

 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB

 N I,F,MX

 S OVF=$G(OVF,"%ZISHOF")

 S %ZISHI=$QS(HF,IX),MX=$QL(HF) ;

 S F=$NA(@HF,IX-1) ;Get first part

 I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1

 I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root

 S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow

 F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I)

 S %ZISHF=%ZISHF_")"

FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global

 ;p1=host file directory

 ;p2=host file name

 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT

 ;p4=INCREMENT SUBSCRIPT

 ;p5=Overflow subscript, defaults to "OVF"

 N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX

 N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB

 S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF")

 D MAKEREF(%ZX3,%ZX4,"%ZISHOF")

 D OPEN^%ZISH(,%ZX1,%ZX2,"R")

 I POP Q 0

 S X="ERREOF^%ZISH",@^%ZOSF("TRAP")

 U IO F  K %XX D READNXT(.%XX) D  Q:$$EOF(%ZC)

 . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I

 . S @%ZISHF=%XX

 . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT))  S @%ZISHO=%XX(%OVFCNT)

 . S %ZISHI=%ZISHI+1

. Q

 D CLOSE() ;Normal exit

Q 1

ERREOF D CLOSE() ;Error close and exit

Q 0

GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.

 ;Previously name LOAD

 ;p1=$NAME of global reference

 ;p2=incrementing subscript

 ;p3=host file directory, p4=host file name

 N %ZISHY,%ZISHOX

 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W")

 Q %ZISHY

GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.

 ;p1=$NAME of global reference

 ;p2=incrementing subscript

 ;p3=host file directory

 ;p4=host file name

 N %ZISHY

 S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A")

 Q %ZISHY

MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;

 ;p1=$NAME of global reference

 ;p2=incrementing subscript

 ;p3=host file directory

 ;p4=host file name

 N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y

 D MAKEREF(%ZX1,%ZX2)

 D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open

 I POP Q 0

N X

 S X="ERREOF^%ZISH",@^%ZOSF("TRAP")

 F  Q:'($D(@%ZISHF)#2)  S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,!

 D CLOSE()

Q 1

ZISHMSM.m