Routine: ZISHPW

%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)

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(%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

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)

DF(X) ;Dir frmt

 Q:X=""

 S X=$TR(X,"/","\")

 I $E(X,$L(X))'="\" S X=X_"\"

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() ;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_")"

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      ;

ZISHPW.m