%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM (PW);09/23/96 11:22 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**24,36**;JUL 10, 1995
;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 2/19/97; IHS/ANMC/LJF 2/19/97
;THIS IS ROUTINE ZISHPW
;
OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File
I $$IHS^ZISHMSMU Q $$OPEN^ZISHMSMU(X1,X2,X3) ; IHS/ADC/GTH 2/19/97
;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.
;X5=Max record size for a new file
N %,%1,%2,%I,%T,%ZA,%ZISHIO
S %I=$I,%T=0,POP=0 M %ZISHIO=IO
F %=51:1:54 O %::0 I $T S %T=% Q
I '%T U:%I]"" %I S POP=1 Q
S %1=$$MODE^%ZISF(X2_X3,X4)
S %2=%_":"_%1
U @%2 S %ZA=$ZA
I %ZA=-1 U:%I]"" %I C % S POP=1 Q
S IO=%,IO(1,IO)=""
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(%ZISHX1,%ZISHX2) ;SR. Del fl(s)
I $$IHS^ZISHMSMU Q $$DEL^ZISHMSMU(%ZISHX1,%ZISHX2) ; IHS/ADC/GTH 2/19/97
;S Y=$$DEL^ZOSHMSM("\dir\","fl")
; ,.array)
;Changed X2 to a $NAME string
N %,%ZISH
N ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
S %ZISHX1=$TR(%ZISHX1,"/","\")
;Get fls to act on
;No '*' allowed
S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:'%ZISH I %ZISH["*" S ZOSHQ=1 Q
I $D(ZOSHQ) Q 0
S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D
.;S ZOSHC="rm "_X1_%
.S ZOSHC=$ZOS(2,%ZISHX1_%ZISH)
.;D JW
Q 1
;
LIST(%ZISHX1,%ZISHX2,%ZISHX3) ;SR. Create a local array holding fl names
I $$IHS^ZISHMSMU Q $$LIST^ZISHMSMU(%ZISHX1,%ZISHX2,.%ZISHX3) ; IHS/ADC/GTH 2/19/97
;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,%ZISHX,%ZISHY
S %ZISHN=0
;Get fls to act on
S %ZISH="" F S %ZISH=$O(@%ZISHX2@(%ZISH)) Q:%ZISH="" D
.S %ZISHX=%ZISHX1_%ZISH
.F %ZISHN=1:1 D Q:$P(%ZISHY,"^")=""!(%ZISHY<0) S @%ZISHX3@($P(%ZISHY,"^"))="" ;S @%ZISHX3@(%ZISHN)=$P(%ZISHY,"^")
..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY)
..E S %ZISHY=$ZOS(12,%ZISHX,0)
Q $O(@%ZISHX3@(""))]""
;
MV(X1,X2,Y1,Y2) ;SR. Rename a fl
I $$IHS^ZISHMSMU Q $$MV^ZISHMSMU(X1,X2,Y1,Y2) ; IHS/ADC/GTH 2/19/97
;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")
;
N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y
S X=X1_X2
S Y=Y1_Y2
I X1=Y1 Q $ZOS(3,X,Y)'<0
;
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) ;SR. Print working directory
Q $$PWD^ZISHMSMU(.X) ; IHS/ANMC/LFJ 2/19/97
I $ZV["UNIX" Q $$PWD^ZISHMSMU() ; IHS/ADC/GTH 2/19/97
N 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
Q:X=""
S X=$TR(X,"/","\")
I $E(X,$L(X))'="\" S X=X_"\"
Q
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
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() ;SR. Return EOF status
;U $I
Q $ZC
;
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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;SR. Unload contents of host file into global
;p1=hostf 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,X,%OVFCNT,%CONT
N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZISHX,%ZISHY,POP,%ZISUB
S %ZISHOF=$G(%ZISHX5,"OVF")
D MAKEREF(%ZISHX3,%ZISHX4,"%ZISHOF")
D OPEN^%ZISH(,%ZISHX1,%ZISHX2,"R")
I POP Q 0
S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
U IO F K %XX D READNXT(.%XX) Q:$$EOF(%ZC) D
. 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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"W")
Q %ZISHY
;
GATF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"A")
Q %ZISHY
MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;
;p1=$NAME of global reference
;p2=incrementing subscript
;p3=host file directory
;p4=host file name
N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZISHX,Y
D MAKEREF(%ZISHX1,%ZISHX2)
D OPEN^%ZISH(,%ZISHX3,%ZISHX4,%ZISHX5)
I POP Q 0
N X
S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
F Q:'($D(@%ZISHF)#2) S %ZISHX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZISHX,!
D CLOSE()
Q 1
;
%ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM (PW);09/23/96 11:22 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**24,36**;JUL 10, 1995
+3 ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ADC/GTH 2/19/97; IHS/ANMC/LJF 2/19/97
+4 ;THIS IS ROUTINE ZISHPW
+5 ;
OPEN(X1,X2,X3,X4,X5) ;SR. Open Host File
+1 ; IHS/ADC/GTH 2/19/97
IF $$IHS^ZISHMSMU
QUIT $$OPEN^ZISHMSMU(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.
+6 ;X5=Max record size for a new file
+7 NEW %,%1,%2,%I,%T,%ZA,%ZISHIO
+8 SET %I=$IO
SET %T=0
SET POP=0
MERGE %ZISHIO=IO
+9 FOR %=51:1:54
OPEN %::0
IF $TEST
SET %T=%
QUIT
+10 IF '%T
IF %I]""
USE %I
SET POP=1
QUIT
+11 SET %1=$$MODE^%ZISF(X2_X3,X4)
+12 SET %2=%_":"_%1
+13 USE @%2
SET %ZA=$ZA
+14 IF %ZA=-1
IF %I]""
USE %I
CLOSE %
SET POP=1
QUIT
+15 SET IO=%
SET IO(1,IO)=""
+16 IF $GET(X1)]""
DO SAVDEV^%ZISUTL(X1)
+17 QUIT
+18 ;
CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
+1 ;X=HANDLE NAME
+2 ;IO=Device
+3 NEW %
+4 IF $GET(IO)]""
CLOSE IO
KILL IO(1,IO)
+5 IF $GET(X)]""
DO RMDEV^%ZISUTL(X)
+6 DO HOME^%ZIS
+7 QUIT
+8 ;
OPENERR ;
+1 QUIT 0
+2 ;
DEL(%ZISHX1,%ZISHX2) ;SR. Del fl(s)
+1 ; IHS/ADC/GTH 2/19/97
IF $$IHS^ZISHMSMU
QUIT $$DEL^ZISHMSMU(%ZISHX1,%ZISHX2)
+2 ;S Y=$$DEL^ZOSHMSM("\dir\","fl")
+3 ; ,.array)
+4 ;Changed X2 to a $NAME string
+5 NEW %,%ZISH
+6 NEW ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
+7 SET %ZISHX1=$TRANSLATE(%ZISHX1,"/","\")
+8 ;Get fls to act on
+9 ;No '*' allowed
+10 SET %ZISH=""
FOR
SET %ZISH=$ORDER(@%ZISHX2@(%ZISH))
IF '%ZISH
QUIT
IF %ZISH["*"
SET ZOSHQ=1
QUIT
+11 IF $DATA(ZOSHQ)
QUIT 0
+12 SET %ZISH=""
FOR
SET %ZISH=$ORDER(@%ZISHX2@(%ZISH))
IF %ZISH=""
QUIT
Begin DoDot:1
+13 ;S ZOSHC="rm "_X1_%
+14 SET ZOSHC=$ZOS(2,%ZISHX1_%ZISH)
+15 ;D JW
End DoDot:1
+16 QUIT 1
+17 ;
LIST(%ZISHX1,%ZISHX2,%ZISHX3) ;SR. Create a local array holding fl names
+1 ; IHS/ADC/GTH 2/19/97
IF $$IHS^ZISHMSMU
QUIT $$LIST^ZISHMSMU(%ZISHX1,%ZISHX2,.%ZISHX3)
+2 ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
+3 ; "fl*",
+4 ; .array,
+5 ;
+6 ;Change X2 = $NAME OF CLOSE ROOT
+7 ;Change X3 = $NAME OF CLOSE ROOT
+8 ;
+9 NEW %ZISH,%ZISHN,%ZISHX,%ZISHY
+10 SET %ZISHN=0
+11 ;Get fls to act on
+12 SET %ZISH=""
FOR
SET %ZISH=$ORDER(@%ZISHX2@(%ZISH))
IF %ZISH=""
QUIT
Begin DoDot:1
+13 SET %ZISHX=%ZISHX1_%ZISH
+14 ;S @%ZISHX3@(%ZISHN)=$P(%ZISHY,"^")
FOR %ZISHN=1:1
Begin DoDot:2
+15 IF %ZISHN>1
SET %ZISHY=$ZOS(13,%ZISHY)
+16 IF '$TEST
SET %ZISHY=$ZOS(12,%ZISHX,0)
End DoDot:2
IF $PIECE(%ZISHY,"^")=""!(%ZISHY<0)
QUIT
SET @%ZISHX3@($PIECE(%ZISHY,"^"))=""
End DoDot:1
+17 QUIT $ORDER(@%ZISHX3@(""))]""
+18 ;
MV(X1,X2,Y1,Y2) ;SR. Rename a fl
+1 ; IHS/ADC/GTH 2/19/97
IF $$IHS^ZISHMSMU
QUIT $$MV^ZISHMSMU(X1,X2,Y1,Y2)
+2 ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")
+3 ;
+4 NEW %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y
+5 SET X=X1_X2
+6 SET Y=Y1_Y2
+7 IF X1=Y1
QUIT $ZOS(3,X,Y)'<0
+8 ;
+9 SET %ZISHDV1=51
SET %ZISHDV2=52
SET %ZISHFN1=X
SET %ZISHFN2=Y
+10 OPEN %ZISHDV1:(%ZISHFN1)
+11 OPEN %ZISHDV2:(%ZISHFN2:"W")
+12 USE %ZISHDV1:(::0:2)
SET %ZISHSIZ=$ZB
USE %ZISHDV1:(::0:0)
SET (%ZISHPCT,%ZB,%ZC)=0
+13 DO SLOWCOPY
SET %ZISHX(X2)=""
SET Y=$$DEL^%ZISH(X1,$NAME(%ZISHX))
+14 QUIT 1
+15 ;
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) ;SR. Print working directory
+1 ; IHS/ANMC/LFJ 2/19/97
QUIT $$PWD^ZISHMSMU(.X)
+2 ; IHS/ADC/GTH 2/19/97
IF $ZV["UNIX"
QUIT $$PWD^ZISHMSMU()
+3 NEW 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
+1 IF X=""
QUIT
+2 SET X=$TRANSLATE(X,"/","\")
+3 IF $EXTRACT(X,$LENGTH(X))'="\"
SET X=X_"\"
+4 QUIT
FL(X) ;Fl len
+1 NEW ZOSHP1,ZOSHP2
+2 SET ZOSHP1=$PIECE(X,".")
SET ZOSHP2=$PIECE(X,".",2)
+3 IF $LENGTH(ZOSHP1)>8
SET X=4
QUIT
+4 IF $LENGTH(ZOSHP2)>3
SET X=4
QUIT
+5 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() ;SR. Return EOF status
+1 ;U $I
+2 QUIT $ZC
+3 ;
+4 QUIT $$EOF($ZC)
+5 ;
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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;SR. Unload contents of host file into global
+1 ;p1=hostf 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,X,%OVFCNT,%CONT
+7 NEW I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZISHX,%ZISHY,POP,%ZISUB
+8 SET %ZISHOF=$GET(%ZISHX5,"OVF")
+9 DO MAKEREF(%ZISHX3,%ZISHX4,"%ZISHOF")
+10 DO OPEN^%ZISH(,%ZISHX1,%ZISHX2,"R")
+11 IF POP
QUIT 0
+12 SET X="ERREOF^%ZISH"
SET @^%ZOSF("TRAP")
+13 USE IO
FOR
KILL %XX
DO READNXT(.%XX)
IF $$EOF(%ZC)
QUIT
Begin DoDot:1
+14 SET @%ZISHF=%XX
+15 IF $DATA(%XX)>2
FOR %OVFCNT=1:1
IF '$DATA(%XX(%OVFCNT))
QUIT
SET @%ZISHO=%XX(%OVFCNT)
+16 SET %ZISHI=%ZISHI+1
+17 QUIT
End DoDot:1
+18 ;Normal exit
DO CLOSE()
+19 QUIT 1
+20 ;
ERREOF ;Error close and exit
DO CLOSE()
+1 QUIT 0
+2 ;
GTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;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
+5 ;p4=host file name
+6 NEW %ZISHY,%ZISHOX
+7 SET %ZISHY=$$MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"W")
+8 QUIT %ZISHY
+9 ;
GATF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4) ;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(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,"A")
+8 QUIT %ZISHY
MGTF(%ZISHX1,%ZISHX2,%ZISHX3,%ZISHX4,%ZISHX5) ;
+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,%ZISHX,Y
+6 DO MAKEREF(%ZISHX1,%ZISHX2)
+7 DO OPEN^%ZISH(,%ZISHX3,%ZISHX4,%ZISHX5)
+8 IF POP
QUIT 0
+9 NEW X
+10 SET X="ERREOF^%ZISH"
SET @^%ZOSF("TRAP")
+11 FOR
IF '($DATA(@%ZISHF)#2)
QUIT
SET %ZISHX=@%ZISHF
SET %ZISHI=%ZISHI+1
USE IO
WRITE %ZISHX,!
+12 DO CLOSE()
+13 QUIT 1
+14 ;
