Changeset 623 for WorldVistAEHR/trunk/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, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/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
r613 r623 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 4 N %ZISOS,%ZISV 5 S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")) 6 ;Check SPOOLER special case first 7 INIT I $D(ZTQUEUED),$G(IOT)="SPL",$D(IO)#2,$D(IO(0))#2,IO]"",IO=IO(0),$D(IO(1,IO))#2,%ZISOS["VAX DSM"!(%ZISOS["M/VX"),$G(IOP)[ION!(IOP[IO) K %ZIS,%IS,IOP Q 8 ; 9 I '$D(%ZIS),$D(%IS) M %ZIS=%IS 10 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^%ZOSV 12 S %ZIS("PRI")=$G(^XUTL("XQ",$J,"MIXED OS"),1) 13 ; 14 I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1 15 .I $D(ZTIO)#2,ZTIO="" S:%IS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" 16 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,%Z2,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE 18 N %ZHFN,%ZISOLD,DTOUT,DUOUT 19 ;Save symbols to restore if don't open a device 20 D SYMBOL^%ZISUTL(0,$NA(%ZISOLD)) 21 A D CLEAN ;(p363) K IO("CLOSE"),IO("HFSIO") 22 K IO("P"),IO("Q"),IO("S"),IO("T") 23 K2 D K2^%ZIS1 24 S %ZISB=%ZIS'["N",(%E,%H,POP)=0,%Y="" S:'$D(IO(0)) IO(0)=$I 25 I %ZISOS["VAX DSM",$I["SYS$INPUT:.;" S:%ZIS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" 26 ;I %IS["T"&(%IS["0") S (%H,%E)=0 G ^%ZIS1 27 I $D(IOP),IOP=$I!(IOP="HOME")!(0[IOP),$D(^XUTL("XQ",$J,"IO")) D HOME K %IS,%Y,%ZIS,%ZISB,%ZISV,IOP Q 28 ;Don't worry about HOME if %ZIS[0 29 D:%ZIS'[0 GETHOME G EXIT^%ZIS1:POP,^%ZIS1 ;Jump to next part 30 ; 31 GETHOME I $D(IO("HOME")),$P(IO("HOME"),"^",2)=IO(0) S (%E,%H)=+IO("HOME") Q 32 I $D(^XUTL("XQ",$J,"IOS")),$D(^("IO")),IO(0)=^("IO") S (%E,%H)=^("IOS") Q 33 ;CALL LINEPORT CODE HERE--- 34 S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q 35 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!",*7 37 S %H=%E S:'%H&(%IS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I 38 Q 39 VIRTUAL ;See if a Virtual Terminal (LAT, TELNET) 40 ;Change the MSM check for telnet to work with v4.4 41 I %ZISOS["MSM" X "I $P($ZV,""Version "",2)'<3 S %ZISVT=$ZDE(+%ZISVT) I %ZISVT?.E1""~""4.5N.E S %ZISVT=""TELNET""" 42 F %ZISI=$L(%ZISVT):-1:0 D:$D(^%ZIS(1,"C",%ZISVT)) Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) S %ZISVT=$E(%ZISVT,1,%ZISI) 43 .D VTLKUP Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) 44 .S %X=0 F %ZISX=%ZISV,"" Q:%X>0 S %X=0 F S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,%X)) S %X=%E Q:%E'>0 I $G(^%ZIS(1,+%E,"TYPE"))="VTRM" Q 45 Q 46 VTLKUP F %ZISX=%ZISV,"" S %E=+$O(^%ZIS(1,"G","SYS."_%ZISX_"."_%ZISVT,0)) Q:%E S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,0)) Q:%E 47 Q 48 ; 49 CURRENT N POP,%ZIS,%IS,%E,%H 50 S FF="#",SL=24,BS="*8",RM=80,(SUB,XY)="",%IS=0,%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")),POP=0 51 D GETHOME K %E,%IS,%ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX Q:POP 52 I $D(^%ZIS(1,%H,"SUBTYPE")) S SUB=+^("SUBTYPE") K %H 53 I $D(SUB),SUB,$D(^%ZIS(2,SUB,1)) S SUB=$S($D(^(0)):$P(^(0),"^"),1:""),FF=$P(^(1),"^",2),SL=$P(^(1),"^",3),BS=$P(^(1),"^",4),XY=$P(^(1),"^",5),RM=+^(1) 54 E S SUB="" 55 I $D(^%ZOSF("RM")) N X S X=RM X ^("RM") K %A 56 Q 57 HOME ;Entry point to establish IO* variables for home device. 58 D CLEAN ;(p363) 59 N X I '$D(^XUTL("XQ",$J,"IO")) S IOP="HOME" D ^%ZIS Q 60 D RESETVAR 61 I '$D(IO("C")),$G(IOM),IO=$I,$D(IO(1,IO)),$D(^%ZOSF("RM")) S X=+IOM X ^("RM") 62 Q 63 ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS. 64 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 67 S (IOPAR,IOUPAR)="" 68 Q 69 ; 70 RESETVAR ;Reset home IO* variables. 71 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 76 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,%)=@% 81 Q 82 ZISLPC Q ;No longer called in Kernel v8. 83 ; 84 HLP1 G EN1^%ZIS7 85 HLP2 N %E,%H,%X,%ZISV,X S %ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"") G EN2^%ZIS7 86 ; 87 REWIND(IO2,IOT,IOPAR) ;Rewind Device 88 N %,X,Y,$ES,$ET S $ET="D REWERR^%ZIS Q 0" 89 S %=$I 90 I '($D(IO2)#2)!'$D(IOT)!'$D(IOPAR) Q 0 91 I "MT^SDP^HFS"'[IOT Q 0 92 S @("Y=$$REW"_IOT_"^%ZIS4(IO2,IOPAR)") 93 U % 94 Q Y 95 REWERR ;Error encountered 96 S IO("ERROR")=$EC 97 S $EC="",$ET="Q:$ES>1 S $EC="""" Q 0" S $EC=",U1," 98 Q 0 99 ; 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 3 N %ZISOS,%ZISV 4 S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")) 5 ;Check SPOOLER special case first 6 INIT I $D(ZTQUEUED),$G(IOT)="SPL",$D(IO)#2,$D(IO(0))#2,IO]"",IO=IO(0),$D(IO(1,IO))#2,%ZISOS["VAX DSM"!(%ZISOS["M/VX"),$G(IOP)[ION!(IOP[IO) K %ZIS,%IS,IOP Q 7 ; 8 I '$D(%ZIS),$D(%IS) M %ZIS=%IS 9 S:'($D(%ZIS)#2) %ZIS="M" M %IS=%ZIS ;update %IS for now 10 ; 11 I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1 12 .I $D(ZTIO)#2,ZTIO="" S:%IS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" 13 I '$D(ZTQUEUED),%IS["T",$P($G(IOP),";")="Q" S POP=1 G EXIT^%ZIS1 14 N %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE 15 N %ZHFN,%ZISOLD,DTOUT,DUOUT 16 ;Save symbols to restore if don't open a device 17 D SYMBOL^%ZISUTL(0,$NA(%ZISOLD)) 18 A D CLEAN ;(p363) K IO("CLOSE"),IO("HFSIO") 19 K IO("P"),IO("Q"),IO("S"),IO("T") 20 K2 D K2^%ZIS1 21 S %ZISB=%ZIS'["N",(%E,%H,POP)=0,%Y="" S:'$D(IO(0)) IO(0)=$I 22 I %ZISOS["VAX DSM",$I["SYS$INPUT:.;" S:%ZIS'[0 %IS=%IS_"0",%ZIS=%ZIS_"0" 23 ;I %IS["T"&(%IS["0") S (%H,%E)=0 G ^%ZIS1 24 I $D(IOP),IOP=$I!(IOP="HOME")!(0[IOP),$D(^XUTL("XQ",$J,"IO")) D HOME K %IS,%Y,%ZIS,%ZISB,%ZISV,IOP Q 25 ;Don't worry about HOME if %ZIS[0 26 D:%ZIS'[0 GETHOME G EXIT^%ZIS1:POP,^%ZIS1 ;Jump to next part 27 ; 28 GETHOME I $D(IO("HOME")),$P(IO("HOME"),"^",2)=IO(0) S (%E,%H)=+IO("HOME") Q 29 I $D(^XUTL("XQ",$J,"IOS")),$D(^("IO")),IO(0)=^("IO") S (%E,%H)=^("IOS") Q 30 ;CALL LINEPORT CODE HERE--- 31 S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q 32 S %ZISVT=$I D VTLKUP I '%E S %ZISVT=$I D VIRTUAL 33 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 34 S %H=%E S:'%H&(%IS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I 35 Q 36 VIRTUAL ;See if a Virtual Terminal (LAT, TELNET) 37 ;Change the MSM check for telnet to work with v4.4 38 I %ZISOS["MSM" X "I $P($ZV,""Version "",2)'<3 S %ZISVT=$ZDE(+%ZISVT) I %ZISVT?.E1""~""4.5N.E S %ZISVT=""TELNET""" 39 F %ZISI=$L(%ZISVT):-1:0 D:$D(^%ZIS(1,"C",%ZISVT)) Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) S %ZISVT=$E(%ZISVT,1,%ZISI) 40 .D VTLKUP Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0) 41 .S %X=0 F %ZISX=%ZISV,"" Q:%X>0 S %X=0 F S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,%X)) S %X=%E Q:%E'>0 I $G(^%ZIS(1,+%E,"TYPE"))="VTRM" Q 42 Q 43 VTLKUP F %ZISX=%ZISV,"" S %E=+$O(^%ZIS(1,"G","SYS."_%ZISX_"."_%ZISVT,0)) Q:%E S %E=+$O(^%ZIS(1,"CPU",%ZISX_"."_%ZISVT,0)) Q:%E 44 Q 45 ; 46 CURRENT N POP,%ZIS,%IS,%E,%H 47 S FF="#",SL=24,BS="*8",RM=80,(SUB,XY)="",%IS=0,%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")),POP=0 48 D GETHOME K %E,%IS,%ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX Q:POP 49 I $D(^%ZIS(1,%H,"SUBTYPE")) S SUB=+^("SUBTYPE") K %H 50 I $D(SUB),SUB,$D(^%ZIS(2,SUB,1)) S SUB=$S($D(^(0)):$P(^(0),"^"),1:""),FF=$P(^(1),"^",2),SL=$P(^(1),"^",3),BS=$P(^(1),"^",4),XY=$P(^(1),"^",5),RM=+^(1) 51 E S SUB="" 52 I $D(^%ZOSF("RM")) N X S X=RM X ^("RM") K %A 53 Q 54 HOME ;Entry point to establish IO* variables for home device. 55 D CLEAN ;(p363) 56 N X I '$D(^XUTL("XQ",$J,"IO")) S IOP="HOME" D ^%ZIS Q 57 D RESETVAR 58 I '$D(IO("C")),$G(IOM),IO=$I,$D(IO(1,IO)),$D(^%ZOSF("RM")) S X=+IOM X ^("RM") 59 Q 60 ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS. 61 CLEAN ;Cleanup env. Called from %ZISC also. 62 K IO("DOC"),IO("HFSIO"),IO("SPOOL") ;(p366) 63 S (IOPAR,IOUPAR)="" 64 Q 65 ; 66 RESETVAR ;Reset home IO* variables. 67 I '$D(^XUTL("XQ",$J,"IO")) Q 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)="" 70 Q 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,%)=@% 73 Q 74 ZISLPC Q ;No longer called in Kernel v8. 75 ; 76 HLP1 G EN1^%ZIS7 77 HLP2 N %E,%H,%X,%ZISV,X S %ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"") G EN2^%ZIS7 78 ; 79 REWIND(IO2,IOT,IOPAR) ;Rewind Device 80 N %,X,Y,$ES,$ET S $ET="D REWERR^%ZIS Q 0" 81 S %=$I 82 I '($D(IO2)#2)!'$D(IOT)!'$D(IOPAR) Q 0 83 I "MT^SDP^HFS"'[IOT Q 0 84 S @("Y=$$REW"_IOT_"^%ZIS4(IO2,IOPAR)") 85 U % 86 Q Y 87 REWERR ;Error encountered 88 S IO("ERROR")=$EC 89 S $EC="",$ET="Q:$ES>1 S $EC="""" Q 0" S $EC=",U1," 90 Q 0 91 ;
Note:
See TracChangeset
for help on using the changeset viewer.
