Changeset 636 for FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZIS.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZIS.m
r628 r636 1 %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;1/24/08 16:06 2 ;;8.0;KERNEL;**18,23,69,112,199,191,275,363,440**;JUL 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified 1 %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;10/14/2004 08:46 2 ;;8.0;KERNEL;**18,23,69,112,199,191,275,363**;JUL 10, 1995 4 3 N %ZISOS,%ZISV 5 4 S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")) … … 9 8 I '$D(%ZIS),$D(%IS) M %ZIS=%IS 10 9 S:'($D(%ZIS)#2) %ZIS="M" M %IS=%ZIS ;update %IS for now 11 I '$D(^XUTL("XQ",$J,"MIXED OS")) S ^XUTL("XQ",$J,"MIXED OS")=$$PRI^%ZOSV12 S %ZIS("PRI")=$G(^XUTL("XQ",$J,"MIXED OS"),1)13 10 ; 14 11 I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1 15 12 .I $D(ZTIO)#2,ZTIO="" S:%IS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" 16 13 I '$D(ZTQUEUED),%IS["T",$P($G(IOP),";")="Q" S POP=1 G EXIT^%ZIS1 17 N %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z 2,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE14 N %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE 18 15 N %ZHFN,%ZISOLD,DTOUT,DUOUT 19 16 ;Save symbols to restore if don't open a device … … 34 31 S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q 35 32 S %ZISVT=$I D VTLKUP I '%E S %ZISVT=$I D VIRTUAL 36 I %ZISVT=""!(%E'>0) I %IS'[0 O IO(0)::0 I $T U IO(0) W !,"HOME DEVICE ("_$I_")DOES NOT EXIST IN THE DEVICE FILE",!,"PLEASE CONTACT YOUR SYSTEM MANAGER!",*733 I %ZISVT=""!(%E'>0) I %IS'[0 O IO(0)::0 I $T U IO(0) W !,"HOME DEVICE DOES NOT EXIST IN THE DEVICE FILE",!,"PLEASE CONTACT YOUR SYSTEM MANAGER!",*7 37 34 S %H=%E S:'%H&(%IS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I 38 35 Q … … 63 60 ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS. 64 61 CLEAN ;Cleanup env. Called from %ZISC also. 65 I $G(IOT)'="SPL" K IO("DOC"),IO("SPOOL") ;(p446) 66 I $G(IOT)'="HFS" K IO("HFSIO") ;p446 62 K IO("DOC"),IO("HFSIO"),IO("SPOOL") ;(p366) 67 63 S (IOPAR,IOUPAR)="" 68 64 Q … … 70 66 RESETVAR ;Reset home IO* variables. 71 67 I '$D(^XUTL("XQ",$J,"IO")) Q 72 N % 73 F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) 74 F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) 75 S POP=0,IO(0)=IO 68 N % F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%) 69 S POP=0,IO(0)=IO,(IOPAR,IOUPAR)="" 76 70 Q 77 SAVEVAR ;Save home IO* variables, called from XUS1,%ZTMS3 78 N % 79 F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(@%) S ^XUTL("XQ",$J,%)=@% 80 F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(@%) S ^XUTL("XQ",$J,%)=@% 71 SAVEVAR ;Save home IO* variables, called from XUS1 72 N % F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY" I $D(@%) S ^XUTL("XQ",$J,%)=@% 81 73 Q 82 74 ZISLPC Q ;No longer called in Kernel v8.
Note:
See TracChangeset
for help on using the changeset viewer.