ZIS1.m

%ZIS1 ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;08/30/2011

 ;;8.0;KERNEL;**18,49,69,104,112,199,391,440,499,518,546,572**;JUL 10, 1995;Build 10

 ;Per VHA Directive 2004-038, this routine should not be modified

MAIN ;Called from %ZIS with a GOTO

 ;Check for "ASK DEVICE"

 I '$D(IOP),$D(^%ZIS(1,%E,0)),'$P(^(0),"^",3) S %A=%H,%Z=^(0) D L2^%ZIS2 G EXIT

L1 ;Main Device Lookup Loop

 I '$D(IOP),$D(IO("Q")),POP D AQUE^%ZIS3 K:%=2 IO("Q") S:%=2 %ZISB=$S(%ZIS'["N":2,1:0) I %=-1 S POP=1 G EXIT

 S %E=%H,POP=0,%IS=%ZIS ;Reset %IS from %ZIS

 I %ZIS'["Q",$D(XQNOGO) S POP=1 W:'$D(IOP) !,$C(7),"OUTPUT IS NEVER ALLOWED FOR THIS OPTION" G EXIT

 D IOP:$D(IOP),R:'$D(IOP)

 G EXIT:$D(DTOUT)!$D(DUOUT)!(POP&$D(IOP)),L1:POP&'$D(IOP)

 D LKUP I %A'>0 S POP=1 D:'$D(DUOUT) MSG1 K DUOUT

 I %A>0,'$D(^%ZIS(1,%A,0)) D MSG2 K %ZISIOS S POP=1

 I POP G EXIT:$D(IOP),L1:'$D(IOP)

 S %E=%A,%Z1=$G(^%ZIS(1,%A,1)),%Z=^(0) ;Set naked for screen

 I $D(%ZIS("S")) N Y S Y=%E D XS^ZISX S:'$T POP=1 G G:POP ;Screen Code

 W:'$D(IOP)&($P(%Z,"^",2)'=$I)&($P(%Z1,"^")]"") "  ",$P(%Z1,"^")

 D L2^%ZIS2 ;Call

G G L1:POP&'$D(IOP)&'($D(DTOUT)!$D(DUOUT)) ;Didn't get it

 ;

EXIT ;

 I POP G EX2 ;Did not get the device.

 ;For type[TRM reset $X & $Y

 I %ZTYPE["TRM",IO]"",$D(IO(1,IO)) U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0

 ;Do count of number of times device opened.  Field 51.

 I $L($G(IO)),$D(IO(1,IO))#2,$G(%ZISIOS) D

 . S $P(^(5),"^",1)=$P($G(^%ZIS(1,%ZISIOS,5)),"^",1)+1

 I %ZIS["H" S IO(0)=IO,IO("HOME")=%ZISIOS_"^"_IO ;Make home device

 I '$D(IO("Q")),$D(%ZISLOCK) S ^XUTL("XQ",$J,"lock",%ZISIOS)=%ZISLOCK

 I $D(IO)#2,IO]"",$D(IO(1,IO))#2,$D(%Z1),$P(%Z1,"^",11) S IO(1,IO,"NOFF")=1

EX2 ;

 I %ZIS'[0,$G(IO(0))]"" U IO(0) ;Make sure return with home active

 G SETVAR:'POP!(%ZIS["T"),KILVAR

 ;

IOP ;Request with IOP set

 S (%ZISVT,%X)=IOP S:%X'?1.UNP %X=$$UP(%X) I %X'="Q" D SETQ Q

 S %ZIS=%ZIS_%X,%IS=%ZIS K IOP W %X D SETQ

 Q

 ;Get ready to ask user for device

R I %ZIS["Q",$D(XQNOGO) W !,$C(7),"at this time, Output MUST be QUEUED"

 S %A=$S($D(%ZIS("B")):%ZIS("B"),1:"HOME") ;Setup default

 I %ZIS["P",%A="HOME",$D(^%ZIS(1,%E,99)),$D(^%ZIS(1,+^(99),0)) S %A=$P(^(0),"^",1)

RD W !,$S($D(%ZIS("A")):%ZIS("A"),1:"DEVICE: ") W:%A]"" %A,"// " D SBR S:%X="" %X=%A S %ZISVT=%X

 I %X?2"?".E D EN2^%ZIS7 G R

 I %X?1"?".E D EN1^%ZIS7 G R

 I $D(DTOUT)!$D(DUOUT)!(%X'?.ANP)!($L($P(%X,";"))>31) S:%ZIS["T" IO="" S POP=1 Q

 S:%X'?1.UNP %X=$$UP(%X) D SETQ G R:$T

 Q

SETQ ;User wants to queue output

 S %Y=$P(%X,";",2,9),%X=$P(%X,";",1) S:$L(";"_%Y,";/")=2 IO("P")=$P(";"_%Y,";/",2)

 I %X="Q",%ZIS'["Q" W:'$D(IOP) "  Application doesn't support Queuing",!

 I %ZIS["Q",%X="Q" S %X=%Y,%ZISVT=$P(%ZISVT,";",2,9),%ZISB=0,IO("Q")=1,%ZIS("A")="DEVICE: " S:$D(IOP) %Y=$P(%X,";",2,9),%X=$P(%X,";",1)

 I $T,'$D(IOP) W "UEUE TO PRINT ON" Q  ; Return $T value

 Q

 ;%X is uppercase of %ZISVT

LKUP ;Lookup device name

 S %ZISMY=$P(%ZISVT,";",2,999),%ZISVT=$P(%ZISVT,";")

 I %X="H" W:'$D(IOP) "ome" S %X=0

 I 0[%X!(%X="HOME")!(%X=$I) S %A=%H Q

 I $E(%ZISVT)="`",$D(IOP) S %A=+$E(%ZISVT,2,999) I $D(^%ZIS(1,%A,0))#2 Q

 S %A=0 I "P"[%X Q:$D(IOP)&('$D(^%ZIS(1,%E,99)))  I $D(^%ZIS(1,%E,99)) S %A=+^(99) Q  ;Closest Printer

 ;

 ;**P572 START CJM

 ;I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS(1,")) S %A=^("^%ZIS(1,") Q

 I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"ZIS","^%ZIS(1,")) S %A=^("^%ZIS(1,") Q

 I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS(1,")) S %A=^("^%ZIS(1,") Q

 ;**P572 END CJM

 ;

 S %A=+$O(^%ZIS(1,"B",%ZISVT,0)) Q:%A>0  ;mixed case lookup

 I %X'=%ZISVT S %A=+$O(^%ZIS(1,"B",%X,0)) Q:%A>0  ;uppercase lookup

 D VTLKUP^%ZIS S %A=%E Q:%A>0  ;mixed case lookup

 I %X'=%ZISVT S %ZISVT=%X D VTLKUP^%ZIS S %A=%E Q:%A>0  ;uppercase lookup

 N %XX,%YY S %XX=%X D 1^%ZIS5 S %A=+%YY

 Q

SBR ;Read Sub-routine, Output %X

 K DTOUT,DUOUT R %X:%ZISDTIM E  W $C(7) S DTOUT=1 Q

 S:%X="."!(%X="^") DUOUT=1,%X=""

 Q

 ;

LOW(%) Q $TR(%,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")

UP(%) Q $TR(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 ;

 ;Call/Return % = 1 (yes), 2 (no) -1 (^)

YN W "? ",$P("Yes// ^No// ",U,%)

RYN R %X:%ZISDTIM E  S DTOUT=1,%X=U W $C(7)

 S:$L(%X)!'% %X=$E(%X),%=$S("Yy"[%X:1,"Nn"[%X:2,"^"[%X:-1,1:0)

 I '%,%X'?."?" W $C(7),"??",!?4,"ANSWER 'Yes' OR 'No': " G RYN

 W:$X>73 ! W $P("  (Yes)^  (No)",U,%)

 Q

MSG1 I '$D(IOP) W ?20,$C(7),"  [DEVICE DOES NOT EXIST]"

 Q

MSG2 I '$D(IOP) W ?20,$C(7),"  [DEVICE FILE ERROR]"

 Q

 ;

SETVAR ;Come here to setup the variables for the selected device

 S:$D(IO)[0 IO="" G KILVAR:%ZIS["T"&(IO="")

 I $G(%Z)="" S ION="Unknown device",POP=1 G KILVAR

 ;**P572 START CJM

 ;S:IO'=IO(0)&($D(DUZ)#2) ^DISV(+DUZ,"^%ZIS(1,")=%E

 I IO'=IO(0)&($D(DUZ)#2),'$D(IOP) S ^DISV(+DUZ,"ZIS","^%ZIS(1,")=%E

 ;**P572 END CJM

 S ION=$P(%Z,"^",1),IOM=+%Z91,IOF=$P(%Z91,"^",2),IOSL=$P(%Z91,"^",3),IOBS=$P(%Z91,"^",4),IOXY=$P(%Z91,"^",5)

 I IOSL>65534 S IOSL=65534 ;Cache rolls $Y at 65535

 S IOT=%ZTYPE,IOST(0)=%ZISIOST(0),IOST=%ZISIOST,IOPAR=%ZISOPAR,IOUPAR=%ZISUPAR,IOHG="" ;p546 %ZISHG

 S:IOF="" IOF="#" ;See that IOF has something

 I $D(IO("Q")),'$D(%ZIS("afn")) K IO("HFSIO") ;Let TM build it at run time.

 K IOCPU S:$D(%ZISCPU) IOCPU=%ZISCPU

 G KIL

 ;

KILVAR ;Come here to restore the calling variables

 D SYMBOL^%ZISUTL(1,"%ZISOLD")

 S:'$L($G(IOF)) IOF="#" S:'$D(IOST(0)) IOST(0)=0

 ;See that all standard variables are defined

 F %I="IO","ION","IOM","IOBS","IOSL","IOST" S:$D(@%I)[0 @%I=""

 K IO("HFSIO"),IO("OPEN") I $D(%ZISCPU) S:'$D(IOCPU) IOCPU=%ZISCPU

KIL ;Final exit cleanup

 S:'POP IOS=%ZISIOS I POP K:%ZIS'["T" %ZISIOS I %ZIS["T" K IOS S:$D(%ZISIOS) IOS=%ZISIOS

 S:%ZIS["T" IO("T")=1

 K %ZIS,%IS,%ZISOS,%ZISV,IOP

K2 ;Called from %ZIS

 K %ZISCHK,%ZISCPU,%ZISI,%ZISR,%ZISVT,%ZISB,%ZISX,ZISI,%ZISHP,%ZISIO,%ZISIOS,%ZISIOM

 K %ZISIOF,%ZISIOSL,%ZISIOBS,%ZISIOST,%ZISIOST(0),%ZISTO,%ZISTP,%ZISSIO,%ZISOPEN,%ZISOPAR,%ZISUPAR

 K %ZISMY,%ZISQUIT,%ZISLOCK

 Q

%ZIS1     ;SFISC/AC,RWF -- DEVICE HANDLER (DEVICE INPUT) ;08/30/2011

 +1       ;;8.0;KERNEL;**18,49,69,104,112,199,391,440,499,518,546,572**;JUL 10, 1995;Build 10

 +2       ;Per VHA Directive 2004-038, this routine should not be modified

MAIN      ;Called from %ZIS with a GOTO

 +1       ;Check for "ASK DEVICE"

 +2        IF '$DATA(IOP)

               IF $DATA(^%ZIS(1,%E,0))

                   IF '$PIECE(^(0),"^",3)

                       SET %A=%H

                       SET %Z=^(0)

                       DO L2^%ZIS2

                       GOTO EXIT

L1        ;Main Device Lookup Loop

 +1        IF '$DATA(IOP)

               IF $DATA(IO("Q"))

                   IF POP

                       DO AQUE^%ZIS3

                       IF %=2

                           KILL IO("Q")

                       IF %=2

                           SET %ZISB=$SELECT(%ZIS'["N":2,1:0)

                       IF %=-1

                           SET POP=1

                           GOTO EXIT

 +2       ;Reset %IS from %ZIS

           SET %E=%H

           SET POP=0

           SET %IS=%ZIS

 +3        IF %ZIS'["Q"

               IF $DATA(XQNOGO)

                   SET POP=1

                   IF '$DATA(IOP)

                       WRITE !,$CHAR(7),"OUTPUT IS NEVER ALLOWED FOR THIS OPTION"

                   GOTO EXIT

 +4        IF $DATA(IOP)

               DO IOP

           IF '$DATA(IOP)

               DO R

 +5        IF $DATA(DTOUT)!$DATA(DUOUT)!(POP&$DATA(IOP))

               GOTO EXIT

           IF POP&'$DATA(IOP)

               GOTO L1

 +6        DO LKUP

           IF %A'>0

               SET POP=1

               IF '$DATA(DUOUT)

                   DO MSG1

               KILL DUOUT

 +7        IF %A>0

               IF '$DATA(^%ZIS(1,%A,0))

                   DO MSG2

                   KILL %ZISIOS

                   SET POP=1

 +8        IF POP

               IF $DATA(IOP)

                   GOTO EXIT

               IF '$DATA(IOP)

                   GOTO L1

 +9       ;Set naked for screen

           SET %E=%A

           SET %Z1=$GET(^%ZIS(1,%A,1))

           SET %Z=^(0)

 +10      ;Screen Code

           IF $DATA(%ZIS("S"))

               NEW Y

               SET Y=%E

               DO XS^ZISX

               IF '$TEST

                   SET POP=1

               IF POP

                   GOTO G

 +11       IF '$DATA(IOP)&($PIECE(%Z,"^",2)'=$IO)&($PIECE(%Z1,"^")]"")

               WRITE "  ",$PIECE(%Z1,"^")

 +12      ;Call

           DO L2^%ZIS2

G         ;Didn't get it

           IF POP&'$DATA(IOP)&'($DATA(DTOUT)!$DATA(DUOUT))

               GOTO L1

 +1       ;

EXIT      ;

 +1       ;Did not get the device.

           IF POP

               GOTO EX2

 +2       ;For type[TRM reset $X & $Y

 +3        IF %ZTYPE["TRM"

               IF IO]""

                   IF $DATA(IO(1,IO))

                       USE IO

                       IF '(IO=IO(0)&'$DATA(IO("S"))&'$DATA(ZTQUEUED))

                           SET $X=0

                           SET $Y=0

 +4       ;Do count of number of times device opened.  Field 51.

 +5        IF $LENGTH($GET(IO))

               IF $DATA(IO(1,IO))#2

                   IF $GET(%ZISIOS)

                       Begin DoDot:1

 +6                        SET $PIECE(^(5),"^",1)=$PIECE($GET(^%ZIS(1,%ZISIOS,5)),"^",1)+1

                       End DoDot:1

 +7       ;Make home device

           IF %ZIS["H"

               SET IO(0)=IO

               SET IO("HOME")=%ZISIOS_"^"_IO

 +8        IF '$DATA(IO("Q"))

               IF $DATA(%ZISLOCK)

                   SET ^XUTL("XQ",$JOB,"lock",%ZISIOS)=%ZISLOCK

 +9        IF $DATA(IO)#2

               IF IO]""

                   IF $DATA(IO(1,IO))#2

                       IF $DATA(%Z1)

                           IF $PIECE(%Z1,"^",11)

                               SET IO(1,IO,"NOFF")=1

EX2       ;

 +1       ;Make sure return with home active

           IF %ZIS'[0

               IF $GET(IO(0))]""

                   USE IO(0)

 +2        IF 'POP!(%ZIS["T")

               GOTO SETVAR

           GOTO KILVAR

 +3       ;

IOP       ;Request with IOP set

 +1        SET (%ZISVT,%X)=IOP

           IF %X'?1.UNP

               SET %X=$$UP(%X)

           IF %X'="Q"

               DO SETQ

               QUIT 

 +2        SET %ZIS=%ZIS_%X

           SET %IS=%ZIS

           KILL IOP

           WRITE %X

           DO SETQ

 +3        QUIT 

 +4       ;Get ready to ask user for device

R          IF %ZIS["Q"

               IF $DATA(XQNOGO)

                   WRITE !,$CHAR(7),"at this time, Output MUST be QUEUED"

 +1       ;Setup default

           SET %A=$SELECT($DATA(%ZIS("B")):%ZIS("B"),1:"HOME")

 +2        IF %ZIS["P"

               IF %A="HOME"

                   IF $DATA(^%ZIS(1,%E,99))

                       IF $DATA(^%ZIS(1,+^(99),0))

                           SET %A=$PIECE(^(0),"^",1)

RD         WRITE !,$SELECT($DATA(%ZIS("A")):%ZIS("A"),1:"DEVICE: ")

           IF %A]""

               WRITE %A,"// "

           DO SBR

           IF %X=""

               SET %X=%A

           SET %ZISVT=%X

 +1        IF %X?2"?".E

               DO EN2^%ZIS7

               GOTO R

 +2        IF %X?1"?".E

               DO EN1^%ZIS7

               GOTO R

 +3        IF $DATA(DTOUT)!$DATA(DUOUT)!(%X'?.ANP)!($LENGTH($PIECE(%X,";"))>31)

               IF %ZIS["T"

                   SET IO=""

               SET POP=1

               QUIT 

 +4        IF %X'?1.UNP

               SET %X=$$UP(%X)

           DO SETQ

           IF $TEST

               GOTO R

 +5        QUIT 

SETQ      ;User wants to queue output

 +1        SET %Y=$PIECE(%X,";",2,9)

           SET %X=$PIECE(%X,";",1)

           IF $LENGTH(";"_%Y,";/")=2

               SET IO("P")=$PIECE(";"_%Y,";/",2)

 +2        IF %X="Q"

               IF %ZIS'["Q"

                   IF '$DATA(IOP)

                       WRITE "  Application doesn't support Queuing",!

 +3        IF %ZIS["Q"

               IF %X="Q"

                   SET %X=%Y

                   SET %ZISVT=$PIECE(%ZISVT,";",2,9)

                   SET %ZISB=0

                   SET IO("Q")=1

                   SET %ZIS("A")="DEVICE: "

                   IF $DATA(IOP)

                       SET %Y=$PIECE(%X,";",2,9)

                       SET %X=$PIECE(%X,";",1)

 +4       ; Return $T value

           IF $TEST

               IF '$DATA(IOP)

                   WRITE "UEUE TO PRINT ON"

                   QUIT 

 +5        QUIT 

 +6       ;%X is uppercase of %ZISVT

LKUP      ;Lookup device name

 +1        SET %ZISMY=$PIECE(%ZISVT,";",2,999)

           SET %ZISVT=$PIECE(%ZISVT,";")

 +2        IF %X="H"

               IF '$DATA(IOP)

                   WRITE "ome"

               SET %X=0

 +3        IF 0[%X!(%X="HOME")!(%X=$IO)

               SET %A=%H

               QUIT 

 +4        IF $EXTRACT(%ZISVT)="`"

               IF $DATA(IOP)

                   SET %A=+$EXTRACT(%ZISVT,2,999)

                   IF $DATA(^%ZIS(1,%A,0))#2

                       QUIT 

 +5       ;Closest Printer

           SET %A=0

           IF "P"[%X

               IF $DATA(IOP)&('$DATA(^%ZIS(1,%E,99)))

                   QUIT 

               IF $DATA(^%ZIS(1,%E,99))

                   SET %A=+^(99)

                   QUIT 

 +6       ;

 +7       ;**P572 START CJM

 +8       ;I %X=" ",$D(DUZ)#2,$D(^DISV(+DUZ,"^%ZIS(1,")) S %A=^("^%ZIS(1,") Q

 +9        IF %X=" "

               IF $DATA(DUZ)#2

                   IF $DATA(^DISV(+DUZ,"ZIS","^%ZIS(1,"))

                       SET %A=^("^%ZIS(1,")

                       QUIT 

 +10       IF %X=" "

               IF $DATA(DUZ)#2

                   IF $DATA(^DISV(+DUZ,"^%ZIS(1,"))

                       SET %A=^("^%ZIS(1,")

                       QUIT 

 +11      ;**P572 END CJM

 +12      ;

 +13      ;mixed case lookup

           SET %A=+$ORDER(^%ZIS(1,"B",%ZISVT,0))

           IF %A>0

               QUIT 

 +14      ;uppercase lookup

           IF %X'=%ZISVT

               SET %A=+$ORDER(^%ZIS(1,"B",%X,0))

               IF %A>0

                   QUIT 

 +15      ;mixed case lookup

           DO VTLKUP^%ZIS

           SET %A=%E

           IF %A>0

               QUIT 

 +16      ;uppercase lookup

           IF %X'=%ZISVT

               SET %ZISVT=%X

               DO VTLKUP^%ZIS

               SET %A=%E

               IF %A>0

                   QUIT 

 +17       NEW %XX,%YY

           SET %XX=%X

           DO 1^%ZIS5

           SET %A=+%YY

 +18       QUIT 

SBR       ;Read Sub-routine, Output %X

 +1        KILL DTOUT,DUOUT

           READ %X:%ZISDTIM

          IF '$TEST

               WRITE $CHAR(7)

               SET DTOUT=1

               QUIT 

 +2        IF %X="."!(%X="^")

               SET DUOUT=1

               SET %X=""

 +3        QUIT 

 +4       ;

LOW(%)     QUIT $TRANSLATE(%,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")

UP(%)      QUIT $TRANSLATE(%,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +1       ;

 +2       ;Call/Return % = 1 (yes), 2 (no) -1 (^)

YN         WRITE "? ",$PIECE("Yes// ^No// ",U,%)

RYN        READ %X:%ZISDTIM

          IF '$TEST

               SET DTOUT=1

               SET %X=U

               WRITE $CHAR(7)

 +1        IF $LENGTH(%X)!'%

               SET %X=$EXTRACT(%X)

               SET %=$SELECT("Yy"[%X:1,"Nn"[%X:2,"^"[%X:-1,1:0)

 +2        IF '%

               IF %X'?."?"

                   WRITE $CHAR(7),"??",!?4,"ANSWER 'Yes' OR 'No': "

                   GOTO RYN

 +3        IF $X>73

               WRITE !

           WRITE $PIECE("  (Yes)^  (No)",U,%)

 +4        QUIT 

MSG1       IF '$DATA(IOP)

               WRITE ?20,$CHAR(7),"  [DEVICE DOES NOT EXIST]"

 +1        QUIT 

MSG2       IF '$DATA(IOP)

               WRITE ?20,$CHAR(7),"  [DEVICE FILE ERROR]"

 +1        QUIT 

 +2       ;

SETVAR    ;Come here to setup the variables for the selected device

 +1        IF $DATA(IO)[0

               SET IO=""

           IF %ZIS["T"&(IO="")

               GOTO KILVAR

 +2        IF $GET(%Z)=""

               SET ION="Unknown device"

               SET POP=1

               GOTO KILVAR

 +3       ;**P572 START CJM

 +4       ;S:IO'=IO(0)&($D(DUZ)#2) ^DISV(+DUZ,"^%ZIS(1,")=%E

 +5        IF IO'=IO(0)&($DATA(DUZ)#2)

               IF '$DATA(IOP)

                   SET ^DISV(+DUZ,"ZIS","^%ZIS(1,")=%E

 +6       ;**P572 END CJM

 +7        SET ION=$PIECE(%Z,"^",1)

           SET IOM=+%Z91

           SET IOF=$PIECE(%Z91,"^",2)

           SET IOSL=$PIECE(%Z91,"^",3)

           SET IOBS=$PIECE(%Z91,"^",4)

           SET IOXY=$PIECE(%Z91,"^",5)

 +8       ;Cache rolls $Y at 65535

           IF IOSL>65534

               SET IOSL=65534

 +9       ;p546 %ZISHG

           SET IOT=%ZTYPE

           SET IOST(0)=%ZISIOST(0)

           SET IOST=%ZISIOST

           SET IOPAR=%ZISOPAR

           SET IOUPAR=%ZISUPAR

           SET IOHG=""

 +10      ;See that IOF has something

           IF IOF=""

               SET IOF="#"

 +11      ;Let TM build it at run time.

           IF $DATA(IO("Q"))

               IF '$DATA(%ZIS("afn"))

                   KILL IO("HFSIO")

 +12       KILL IOCPU

           IF $DATA(%ZISCPU)

               SET IOCPU=%ZISCPU

 +13       GOTO KIL

 +14      ;

KILVAR    ;Come here to restore the calling variables

 +1        DO SYMBOL^%ZISUTL(1,"%ZISOLD")

 +2        IF '$LENGTH($GET(IOF))

               SET IOF="#"

           IF '$DATA(IOST(0))

               SET IOST(0)=0

 +3       ;See that all standard variables are defined

 +4        FOR %I="IO","ION","IOM","IOBS","IOSL","IOST"

               IF $DATA(@%I)[0

                   SET @%I=""

 +5        KILL IO("HFSIO"),IO("OPEN")

           IF $DATA(%ZISCPU)

               IF '$DATA(IOCPU)

                   SET IOCPU=%ZISCPU

KIL       ;Final exit cleanup

 +1        IF 'POP

               SET IOS=%ZISIOS

           IF POP

               IF %ZIS'["T"

                   KILL %ZISIOS

               IF %ZIS["T"

                   KILL IOS

                   IF $DATA(%ZISIOS)

                       SET IOS=%ZISIOS

 +2        IF %ZIS["T"

               SET IO("T")=1

 +3        KILL %ZIS,%IS,%ZISOS,%ZISV,IOP

K2        ;Called from %ZIS

 +1        KILL %ZISCHK,%ZISCPU,%ZISI,%ZISR,%ZISVT,%ZISB,%ZISX,ZISI,%ZISHP,%ZISIO,%ZISIOS,%ZISIOM

 +2        KILL %ZISIOF,%ZISIOSL,%ZISIOBS,%ZISIOST,%ZISIOST(0),%ZISTO,%ZISTP,%ZISSIO,%ZISOPEN,%ZISOPAR,%ZISUPAR

 +3        KILL %ZISMY,%ZISQUIT,%ZISLOCK

 +4        QUIT