%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98 11:17 [ 05/01/2003 12:51 PM ]
;;8.0;KERNEL;**1005,1006,1007,1008**;APR 1, 2003
;;8.0;KERNEL;**24,36,49,65,84**;JUL 10, 1995
;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/LJF 6/1/98; IHS/HQW/JLB 2/16/99; IHS/OKCAO/POC 1/22/99; IHS/AAO/RPL 4/14/99; IHS/ANMC/LJF 2/19/97; IHS/MFD; IHS/OKCAO/POC 1/25/99; IHS/OIRM/DSD/AEF/02/19/03
;THIS IS ROUTINE ZISHMNT
;
OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File
I '$D(X4) Q $$OPEN^ZISHMSMD(X1,X2,X3); IHS/ANMC/LJF 6/1/98
;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
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
I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
Q
;
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
Q
;
OPENERR ;
Q 0
;
DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
;S Y=$$DEL^ZOSHMSM("\dir\","fl")
; ,.array)
;----- BEGIN IHS MODIFICATION - XU*8.0*1007
;LINE ADDED TO REDIRECT TO DEL^ZISHMSMD AS CODE BELOW DOES NOT WORK
;ORIGINAL MODIFICATION BY IHS/OIRM/DSD/AEF/02/19/03
Q $$DEL^ZISHMSMD(%ZX1,%ZX2)
;----- END IHS MODIFICATION
;Changed %ZX2 to a $NAME string
N %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""
;Get fls to act on
;No '*' allowed
S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:'%ZH I %ZH["*" S ZOSHQ=1 Q
Q:$D(ZOSHQ) 0
S %ZH="" F S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH="" D
.;S ZOSHC="rm "_X1_%
.S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file
Q 1
;
LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names
;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
; "fl*",
; .array,
;IHS/HQW/JLB 2/16/99 Enables NT to read directory of files
;IHS/OKCAO/POC 1/22/99
D LIST1
Q VAR
LIST1 ;
S VAR=1 ;VAR=1 MEANS NO FILES OR A PROBLEM
I $G(%ZX1)']""!($G(%ZX2)']"") Q ;PROBLEM
D DF(.%ZX1); IHS/AAO/RPL 4/21/99
S X=$ZOS(12,%ZX1_%ZX2,0) Q:$P(X,"^")="" S %ZX3(1)=$P(X,"^",1); IHS/AAO/RPL 4/14/99 changed %ZX3(0) to %ZX3(1) to start counting with 1 not 0
F I=2:1 S X=$ZOS(13,X) Q:$P(X,"^",1)="" S %ZX3(I)=$P(X,"^",1); IHS/AAO/RPL changed F I=1:1 to F I=2:1
I $P(X,"^")'="" S X=$ZOS(16,X)
S VAR='$D(%ZX3)
Q
;
;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")
;
;----- BEGIN IHS MODIFICATION - XU*8.0*1008
;This subroutine is rewritten to make sure the correct path is used
;when renaming or moving a file. IHS/ITSC/AEF/04/28/03
N X,Y,%ZISHMVC
S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
S X=X1_X2,Y=Y1_Y2
S %ZISHMVC=$S($ZV["UNIX":"mv",1:"move")
Q $$JOBWAIT^%HOSTCMD(%ZISHMVC_" "_X_" "_Y)
;----- END IHS MODIFICATION - XU*8.0*1008
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
Q
;
PWD(X) ;ef,SR. Print working directory
Q $$PWD^ZISHMSMD(.X) ; IHS/ANMC/LJF 2/19/97
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)
Q
DF(X) ;Dir frmt ; IHS/MFD added subroutine and edited for NT/DOS
Q:X=""
S X=$TR(X,"/","\")
I $E(X,$L(X))'="\" S X=X_"\"
Q
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)
;DONT CARE IF LESS THAN 3 OR GREATER THAN 8 ON NT BOX IHS/OKCAO/POC 1/25/99
;I $L(ZOSHP1)>8 S X=4 Q
;I $L(ZOSHP2)>3 S X=4 Q
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
Q
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_")"
Q
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
;
;----- BEGIN IHS MODIFICATION - XU*8.0*1007
SEND(ZISH1,ZISH2,ZISH3) ;SEND FILE
;
;THIS IS A PLACE HOLDER WAITING FOR NT SCRIPT - THIS IS HERE TO
;PREVENT A <NOPGM> ERROR ON NT SYSTEMS - IHS/ITSC/AEF/02/12/03
;
Q
SENDTO1(ZISH1,ZISH2) ;
;
Q
;----- END IHS MODIFICATION
%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98 11:17 [ 05/01/2003 12:51 PM ]
+1 ;;8.0;KERNEL;**1005,1006,1007,1008**;APR 1, 2003
+2 ;;8.0;KERNEL;**24,36,49,65,84**;JUL 10, 1995
+3 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/LJF 6/1/98; IHS/HQW/JLB 2/16/99; IHS/OKCAO/POC 1/22/99; IHS/AAO/RPL 4/14/99; IHS/ANMC/LJF 2/19/97; IHS/MFD; IHS/OKCAO/POC 1/25/99; IHS/OIRM/DSD/AEF/02/19/03
+4 ;THIS IS ROUTINE ZISHMNT
+5 ;
OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File
+1 ; IHS/ANMC/LJF 6/1/98
IF '$DATA(X4)
QUIT $$OPEN^ZISHMSMD(X1,X2,X3
+2 ;X1=handle name
+3 ;X2=directory name \dir\
+4 ;X3=file name
+5 ;X4=file access mode e.g.: W for write, R for read, A for append, B for block.
+6 ;X5=Max record size for a new file
+7 NEW %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO
+8 SET %I=$IO
SET %T=0
SET POP=0
SET X2=$$DEFDIR($GET(X2))
SET %Q=$CHAR(34)
MERGE %ZISHIO=IO
+9 SET %P2=$SELECT(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R")
+10 SET %P1=X2_X3
SET %P6=$SELECT(X4["B":%Q_%Q,1:$CHAR(13,10))
+11 FOR %2=51:1:54
IF '$DATA(IO(1,%2))
OPEN %2:(%P1:%P2::::%P6):0
IF $TEST
SET %T=%2
QUIT
+12 IF '%T
SET POP=1
QUIT
+13 ;S %1=$$MODE^%ZISF(X2_X3,X4)
+14 USE %2
SET %ZA=$ZA
+15 IF %ZA=-1
IF %I]""
USE %I
CLOSE %2
SET POP=1
QUIT
+16 SET IO=%2
SET IO(1,IO)=""
SET IOT="HFS"
SET POP=0
+17 IF $GET(X1)]""
DO SAVDEV^%ZISUTL(X1)
+18 QUIT
+19 ;
CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
+1 ;X=HANDLE NAME, IO=Device
+2 NEW %
+3 IF $GET(IO)]""
CLOSE IO
KILL IO(1,IO)
+4 IF $GET(X)]""
DO RMDEV^%ZISUTL(X)
+5 DO HOME^%ZIS
+6 QUIT
+7 ;
OPENERR ;
+1 QUIT 0
+2 ;
DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
+1 ;S Y=$$DEL^ZOSHMSM("\dir\","fl")
+2 ; ,.array)
+3 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007
+4 ;LINE ADDED TO REDIRECT TO DEL^ZISHMSMD AS CODE BELOW DOES NOT WORK
+5 ;ORIGINAL MODIFICATION BY IHS/OIRM/DSD/AEF/02/19/03
+6 QUIT $$DEL^ZISHMSMD(%ZX1,%ZX2)
+7 ;----- END IHS MODIFICATION
+8 ;Changed %ZX2 to a $NAME string
+9 NEW %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
+10 SET %ZX1=$$DEFDIR($GET(%ZX1))
IF $DATA(@%ZX2)=1
SET @%ZX2(@%ZX2)=""
+11 ;Get fls to act on
+12 ;No '*' allowed
+13 SET %ZH=""
FOR
SET %ZH=$ORDER(@%ZX2@(%ZH))
IF '%ZH
QUIT
IF %ZH["*"
SET ZOSHQ=1
QUIT
+14 IF $DATA(ZOSHQ)
QUIT 0
+15 SET %ZH=""
FOR
SET %ZH=$ORDER(@%ZX2@(%ZH))
IF %ZH=""
QUIT
Begin DoDot:1
+16 ;S ZOSHC="rm "_X1_%
+17 ;Use system function to delete file
SET ZOSHC=$ZOS(2,%ZX1_%ZH)
End DoDot:1
+18 QUIT 1
+19 ;
LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names
+1 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
+2 ; "fl*",
+3 ; .array,
+4 ;IHS/HQW/JLB 2/16/99 Enables NT to read directory of files
+5 ;IHS/OKCAO/POC 1/22/99
+6 DO LIST1
+7 QUIT VAR
LIST1 ;
+1 ;VAR=1 MEANS NO FILES OR A PROBLEM
SET VAR=1
+2 ;PROBLEM
IF $GET(%ZX1)']""!($GET(%ZX2)']"")
QUIT
+3 ; IHS/AAO/RPL 4/21/99
DO DF(.%ZX1
+4 ; IHS/AAO/RPL 4/14/99 changed %ZX3(0) to %ZX3(1) to start counting with 1 not 0
SET X=$ZOS(12,%ZX1_%ZX2,0)
IF $PIECE(X,"^")=""
QUIT
SET %ZX3(1)=$PIECE(X,"^",1
+5 ; IHS/AAO/RPL changed F I=1:1 to F I=2:1
FOR I=2:1
SET X=$ZOS(13,X)
IF $PIECE(X,"^",1)=""
QUIT
SET %ZX3(I)=$PIECE(X,"^",1
+6 IF $PIECE(X,"^")'=""
SET X=$ZOS(16,X)
+7 SET VAR='$DATA(%ZX3)
+8 QUIT
+9 ;
+10 ;Change X2 = $NAME OF CLOSE ROOT
+11 ;Change X3 = $NAME OF CLOSE ROOT
+12 ;
+13 NEW %ZISH,%ZISHN,%ZX,%ZISHY
+14 SET %ZISHN=0
SET %ZX1=$$DEFDIR($GET(%ZX1))
IF $DATA(@%ZX2)=1
SET @%ZX2(@%ZX2)=""
+15 ;Get fls to act on
+16 SET %ZISH=""
FOR
SET %ZISH=$ORDER(@%ZX2@(%ZISH))
IF %ZISH=""
QUIT
Begin DoDot:1
+17 SET %ZX=%ZX1_%ZISH
+18 ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^")
FOR %ZISHN=1:1
Begin DoDot:2
+19 IF %ZISHN>1
SET %ZISHY=$ZOS(13,%ZISHY)
+20 IF '$TEST
SET %ZISHY=$ZOS(12,%ZX,0)
End DoDot:2
IF $PIECE(%ZISHY,"^")=""!(%ZISHY<0)
QUIT
SET @%ZX3@($PIECE(%ZISHY,"^"))=""
End DoDot:1
+21 QUIT $ORDER(@%ZX3@(""))]""
+22 ;
MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl
+1 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")
+2 ;
+3 ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
+4 ;This subroutine is rewritten to make sure the correct path is used
+5 ;when renaming or moving a file. IHS/ITSC/AEF/04/28/03
+6 NEW X,Y,%ZISHMVC
+7 SET X1=$$DEFDIR($GET(X1))
SET Y1=$$DEFDIR($GET(Y1))
+8 SET X=X1_X2
SET Y=Y1_Y2
+9 SET %ZISHMVC=$SELECT($ZV["UNIX":"mv",1:"move")
+10 QUIT $$JOBWAIT^%HOSTCMD(%ZISHMVC_" "_X_" "_Y)
+11 ;----- END IHS MODIFICATION - XU*8.0*1008
+12 NEW %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y
+13 SET X1=$$DEFDIR($GET(X1))
SET Y1=$$DEFDIR($GET(Y1))
+14 IF X1=Y1
QUIT $ZOS(3,X2,Y2)'<0
+15 SET X=X1_X2
SET Y=Y1_Y2
+16 ;
+17 SET %ZISHDV1=51
SET %ZISHDV2=52
SET %ZISHFN1=X
SET %ZISHFN2=Y
+18 OPEN %ZISHDV1:(%ZISHFN1)
+19 OPEN %ZISHDV2:(%ZISHFN2:"W")
+20 USE %ZISHDV1:(::0:2)
SET %ZISHSIZ=$ZB
USE %ZISHDV1:(::0:0)
SET (%ZISHPCT,%ZB,%ZC)=0
+21 DO SLOWCOPY
SET %ZISHX(X2)=""
SET Y=$$DEL^%ZISH(X1,$NAME(%ZISHX))
+22 QUIT 1
+23 ;
SLOWCOPY ; Copy without view buffer
+1 NEW X,Y
+2 OPEN %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"")
+3 FOR
Begin DoDot:1
+4 USE %ZISHDV1
READ X#1024
IF $LENGTH(X)=0
QUIT
+5 USE %ZISHDV2
WRITE X
SET %ZB=$ZB
SET %ZC=$ZC
IF %ZC
QUIT
+6 IF %ZB=%ZISHSIZ
CLOSE %ZISHDV2
SET %ZC=($ZA=-1)
+7 ; %done
SET X=%ZB/%ZISHSIZ*100\1
+8 IF X=%ZISHPCT
QUIT
SET %ZISHPCT=X
+9 ;U 0 W $J(%ZISHPCT,3),*13
QUIT
End DoDot:1
IF %ZC!(%ZB=%ZISHSIZ)
QUIT
+10 QUIT
+11 ;
PWD(X) ;ef,SR. Print working directory
+1 ; IHS/ANMC/LJF 2/19/97
QUIT $$PWD^ZISHMSMD(.X)
+2 NEW Y
+3 SET Y=$$DEFDIR("")
IF $LENGTH(Y)
QUIT Y
+4 SET Y=$ZOS(11,$ZOS(14))
+5 IF Y<0
QUIT ""
+6 SET Y=Y_$SELECT($EXTRACT(Y,$LENGTH(Y))'="\":"\",1:"")
+7 QUIT $ZOS(14)_":"_Y
+8 ;
JW ;Call dos $ZOS
+1 SET ZOSHX=$ZOS(ZOSHNUM,ZOSHC)
+2 QUIT
DF(X) ;Dir frmt ; IHS/MFD added subroutine and edited for NT/DOS
+1 IF X=""
QUIT
+2 SET X=$TRANSLATE(X,"/","\")
+3 IF $EXTRACT(X,$LENGTH(X))'="\"
SET X=X_"\"
+4 QUIT
DEFDIR(DF) ;ef. Default Dir and frmt
+1 ;Special way to get current dir.
IF DF="."
QUIT ""
+2 IF DF=""
SET DF=$GET(^XTV(8989.3,1,"DEV"))
SET DF=$TRANSLATE(DF,"/","\")
+3 IF $EXTRACT(DF,$LENGTH(DF))'="\"
SET DF=DF_"\"
+4 QUIT DF
FL(X) ;Fl len
+1 NEW ZOSHP1,ZOSHP2
+2 SET ZOSHP1=$PIECE(X,".")
SET ZOSHP2=$PIECE(X,".",2)
+3 ;DONT CARE IF LESS THAN 3 OR GREATER THAN 8 ON NT BOX IHS/OKCAO/POC 1/25/99
+4 ;I $L(ZOSHP1)>8 S X=4 Q
+5 ;I $L(ZOSHP2)>3 S X=4 Q
+6 QUIT
READNXT(REC) ;Read any sized record into array.
+1 NEW T,I,X,LB
+2 USE IO
SET LB=$ZB
READ REC#255
SET %ZA=$ZA
SET %ZB=$ZB
SET %ZC=$ZC
SET %ZL=%ZA
IF $$EOF(%ZC)
QUIT
+3 IF %ZA<255
QUIT
+4 FOR I=1:1
SET LB=LB+%ZA
IF LB<%ZB
QUIT
READ X#255
SET %ZA=$ZA
SET %ZB=$ZB
SET %ZC=$ZC
IF $$EOF(%ZC)!('$LENGTH(X))
QUIT
SET REC(I)=X
+5 QUIT
STATUS() ;ef,SR. Return EOF status
+1 USE $IO
+2 QUIT $$EOF($ZC)
+3 ;
EOF(X) ;Eof flag, pass in $ZC
+1 QUIT (X=-1)
+2 ;
READREC(X) ;Read record from host file.
+1 NEW Y
+2 USE IO
READ X
SET Y=$ZC
+3 USE $PRINCIPAL
+4 QUIT Y
MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.
+1 ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB
+2 NEW I,F,MX
+3 SET OVF=$GET(OVF,"%ZISHOF")
+4 ;
SET %ZISHI=$QSUBSCRIPT(HF,IX)
SET MX=$QLENGTH(HF)
+5 ;Get first part
SET F=$NAME(@HF,IX-1)
+6 ;Build root, IX=1
IF IX=1
SET %ZISHF=F_"(%ZISHI"
+7 ;Build root
IF IX>1
SET %ZISHF=$EXTRACT(F,1,$LENGTH(F)-1)_",%ZISHI"
+8 ;Make overflow
SET %ZISHO=%ZISHF_","_OVF_",%OVFCNT)"
+9 FOR I=IX+1:1:MX
SET %ZISHF=%ZISHF_",%ZISUB("_I_")"
SET %ZISUB(I)=$QSUBSCRIPT(HF,I)
+10 SET %ZISHF=%ZISHF_")"
+11 QUIT
FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global
+1 ;p1=host file directory
+2 ;p2=host file name
+3 ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
+4 ;p4=INCREMENT SUBSCRIPT
+5 ;p5=Overflow subscript, defaults to "OVF"
+6 NEW %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX
+7 NEW I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB
+8 SET %ZX1=$$DEFDIR($GET(%ZX1))
SET %ZISHOF=$GET(%ZX5,"OVF")
+9 DO MAKEREF(%ZX3,%ZX4,"%ZISHOF")
+10 DO OPEN^%ZISH(,%ZX1,%ZX2,"R")
+11 IF POP
QUIT 0
+12 SET X="ERREOF^%ZISH"
SET @^%ZOSF("TRAP")
+13 USE IO
FOR
KILL %XX
DO READNXT(.%XX)
Begin DoDot:1
+14 SET I=('$$EOF(%ZC))!($$EOF(%ZC)&$LENGTH(%XX))
IF 'I
QUIT
+15 SET @%ZISHF=%XX
+16 IF $DATA(%XX)>2
FOR %OVFCNT=1:1
IF '$DATA(%XX(%OVFCNT))
QUIT
SET @%ZISHO=%XX(%OVFCNT)
+17 SET %ZISHI=%ZISHI+1
+18 QUIT
End DoDot:1
IF $$EOF(%ZC)
QUIT
+19 ;Normal exit
DO CLOSE()
+20 QUIT 1
+21 ;
ERREOF ;Error close and exit
DO CLOSE()
+1 QUIT 0
+2 ;
GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.
+1 ;Previously name LOAD
+2 ;p1=$NAME of global reference
+3 ;p2=incrementing subscript
+4 ;p3=host file directory, p4=host file name
+5 NEW %ZISHY,%ZISHOX
+6 SET %ZISHY=$$MGTF(%ZX1,%ZX2,$GET(%ZX3),%ZX4,"W")
+7 QUIT %ZISHY
+8 ;
GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.
+1 ;
+2 ;p1=$NAME of global reference
+3 ;p2=incrementing subscript
+4 ;p3=host file directory
+5 ;p4=host file name
+6 NEW %ZISHY
+7 SET %ZISHY=$$MGTF(%ZX1,%ZX2,$GET(%ZX3),%ZX4,"A")
+8 QUIT %ZISHY
MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;
+1 ;p1=$NAME of global reference
+2 ;p2=incrementing subscript
+3 ;p3=host file directory
+4 ;p4=host file name
+5 NEW %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y
+6 DO MAKEREF(%ZX1,%ZX2)
+7 ;Default dir set in open
DO OPEN^%ZISH(,%ZX3,%ZX4,%ZX5)
+8 IF POP
QUIT 0
+9 NEW X
+10 SET X="ERREOF^%ZISH"
SET @^%ZOSF("TRAP")
+11 FOR
IF '($DATA(@%ZISHF)#2)
QUIT
SET %ZX=@%ZISHF
SET %ZISHI=%ZISHI+1
USE IO
WRITE %ZX,!
+12 DO CLOSE()
+13 QUIT 1
+14 ;
+15 ;----- BEGIN IHS MODIFICATION - XU*8.0*1007
SEND(ZISH1,ZISH2,ZISH3) ;SEND FILE
+1 ;
+2 ;THIS IS A PLACE HOLDER WAITING FOR NT SCRIPT - THIS IS HERE TO
+3 ;PREVENT A <NOPGM> ERROR ON NT SYSTEMS - IHS/ITSC/AEF/02/12/03
+4 ;
+5 QUIT
SENDTO1(ZISH1,ZISH2) ;
+1 ;
+2 QUIT
+3 ;----- END IHS MODIFICATION
