- %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;05/22/12 12:31
- ;;8.0;KERNEL;**18,23,69,112,199,191,275,363,440,499,524,546,599**;JUL 10, 1995;Build 8
- ;Per VHA Directive 2004-038, this routine should not be modified
- ; ZEXCEPT: %IS,%ZIS,%ZISVT,DTIME,ION,IOP,IOT,POP,ZTIO,ZTQUEUED
- N %ZISOS,%ZISV
- S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^%ZOSF("VOL")),POP=0 ;p524
- ;Check SPOOLER special case first
- INIT ;
- I $G(ZTQUEUED),$G(IOT)="SPL",$D(IOP),$L($G(IO)),IO=$G(IO(0)),$D(IO(1,IO))#2,(IOP[$G(ION)!(IOP[IO)) K %ZIS,%IS,IOP Q ;p524
- ;p524 Line above for HD141181.
- I '$D(%ZIS),$D(%IS) M %ZIS=%IS
- S:'($D(%ZIS)#2) %ZIS="M" M %IS=%ZIS ;update %IS for now
- I '$D(^XUTL("XQ",$J,"MIXED OS")) S ^XUTL("XQ",$J,"MIXED OS")=$$PRI^%ZOSV
- S %ZIS("PRI")=$G(^XUTL("XQ",$J,"MIXED OS"),1)
- ;
- I $D(ZTQUEUED) D I '$D(IOP) S POP=1 G EXIT^%ZIS1
- .I $G(ZTIO)="" S:%ZIS'[0 %ZIS=%ZIS_"0",%IS=%ZIS
- I '$D(ZTQUEUED),%ZIS["T",$P($G(IOP),";")="Q" S POP=1 G EXIT^%ZIS1
- N %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z2,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE
- N %ZHFN,%ZISOLD,%ZTOUT,%ZISDTIM,DTOUT,DUOUT
- S %ZISDTIM=$G(DTIME,300)
- ;Save symbols to restore if don't open a device
- D SYMBOL^%ZISUTL(0,$NA(%ZISOLD))
- A D CLEAN ;p363
- K IO("P"),IO("Q"),IO("S"),IO("T")
- K2 D K2^%ZIS1
- S %ZISB=%ZIS'["N",(%E,%H)=0,%Y="" S:'$D(IO(0)) IO(0)=$I
- I $D(IOP),IOP=$I!(IOP="HOME")!(0[IOP),$D(^XUTL("XQ",$J,"IO")) D HOME K %IS,%Y,%ZIS,%ZISB,%ZISV,IOP Q
- ;Don't worry about HOME if %ZIS[0
- D:%ZIS'[0 GETHOME G EXIT^%ZIS1:POP,^%ZIS1 ;Jump to next part
- GETHOME I $D(IO("HOME")),$P(IO("HOME"),"^",2)=IO(0) S (%E,%H)=+IO("HOME") Q
- I $D(^XUTL("XQ",$J,"IOS")),$D(^("IO")),IO(0)=^("IO") S (%E,%H)=^("IOS") Q
- ;CALL LINEPORT CODE HERE---
- S %=$$LINEPORT^%ZISUTL I % S (%E,%H)=% Q
- S %ZISVT=$I D VTLKUP I '%E S %ZISVT=$I D VIRTUAL
- I %ZISVT=""!(%E'>0) I %ZIS'[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
- S %H=%E S:'%H&(%ZIS'[0) POP=1 S:(%H>0)&('$D(IO("HOME"))) IO("HOME")=%H_"^"_$I
- Q
- VIRTUAL ;See if a Virtual Terminal (LAT, TELNET)
- ; ZEXCEPT: %ZISI,%ZISVT
- F %ZISI=$L(%ZISVT):-1:1 D:$D(^%ZIS(1,"C",%ZISVT)) Q:$S('%E:0,$G(^%ZIS(1,%E,"TYPE"))="VTRM":1,1:0) S %ZISVT=$E(%ZISVT,1,%ZISI)
- .D VTLKUP Q ;Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0)
- Q
- VTLKUP ;
- ; ZEXCEPT: %E,%ZISV,%ZISVT,%ZISX
- F %ZISX=%ZISV,"" S %E=+$O(^%ZIS(1,"G","SYS."_%ZISX_"."_%ZISVT,0)) Q:%E
- Q
- CURRENT ;Old, Not in current doc's.
- ; ZEXCEPT: %ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX,BS,FF,RM,SL,SUB,XY
- N %ZIS,%IS,%E,%H,%A,%,POP,X
- S FF="#",SL=24,BS="*8",RM=80,(SUB,XY)="",%ZIS=0,%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")),POP=0
- D GETHOME K %ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX Q:POP
- I $D(^%ZIS(1,%H,"SUBTYPE")) S SUB=+^("SUBTYPE")
- 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)
- E S SUB=""
- I $D(^%ZOSF("RM")) S X=RM X ^("RM")
- Q
- HOME ;Entry point to establish IO* variables for home device.
- ; ZEXCEPT: IOM,IOP
- D CLEAN ;(p363)
- N X I '$D(^XUTL("XQ",$J,"IO")) S IOP="HOME" D ^%ZIS Q
- D RESETVAR
- I $L($G(IO)),$P($G(IO("HOME")),"^",2)=IO,$D(IO(1,IO)) U IO ;p524
- I '$D(IO("C")),$G(IOM),IO=$I,$D(IO(1,IO)),$D(^%ZOSF("RM")) S X=+IOM X ^("RM")
- S X=$$ENDOFILE^%ZISUTL ;p599 Set end-of-file handling for Cache
- Q
- ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS.
- CLEAN ;Cleanup env. Called from %ZISC also.
- ; ZEXCEPT: IOPAR,IOT,IOUPAR
- I $G(IOT)'="SPL" K IO("DOC"),IO("SPOOL") ;(p440)
- I $G(IOT)'="HFS" K IO("HFSIO") ;p440
- S (IOPAR,IOUPAR)=""
- Q
- RESETVAR ;Reset home IO* variables.
- ; ZEXCEPT: POP
- I '$D(^XUTL("XQ",$J,"IO")) Q
- N %
- F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%)
- F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(^XUTL("XQ",$J,%))#2 S @%=^(%)
- S POP=0,IO(0)=IO
- Q
- SAVEVAR ;Save home IO* variables, called from XUS1,%ZTMS3
- N %
- F %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR" I $D(@%) S ^XUTL("XQ",$J,%)=@%
- F %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")" I $D(@%) S ^XUTL("XQ",$J,%)=@%
- Q
- ZISLPC Q ;No longer called in Kernel v8.
- HLP1 G EN1^%ZIS7
- HLP2 ;
- ; ZEXCEPT: DTIME
- N %E,%H,%X,%ZISV,X,%ZISDTIM
- S %ZISDTIM=$G(DTIME,60),%ZISV=$S($D(^%ZOSF("VOL")):^("VOL"),1:"") G EN2^%ZIS7
- REWIND(IO2,IOT,IOPAR) ;Rewind Device
- N %,X,Y,$ES,$ET S $ET="D REWERR^%ZIS Q 0"
- S %=$I
- I '($D(IO2)#2)!'$D(IOT)!'$D(IOPAR) Q 0
- I "MT^SDP^HFS"'[IOT Q 0
- S @("Y=$$REW"_IOT_"^%ZIS4(IO2,IOPAR)")
- U %
- Q Y
- REWERR ;Error encountered
- S IO("ERROR")=$EC
- S $EC="",$ET="Q:$ES>1 S $EC="""" Q 0" S $EC=",U1,"
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZIS 4844 printed Jan 18, 2025@03:15:31 Page 2
- %ZIS ;SFISC/AC,RWF -- DEVICE HANDLER ;05/22/12 12:31
- +1 ;;8.0;KERNEL;**18,23,69,112,199,191,275,363,440,499,524,546,599**;JUL 10, 1995;Build 8
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- +3 ; ZEXCEPT: %IS,%ZIS,%ZISVT,DTIME,ION,IOP,IOT,POP,ZTIO,ZTQUEUED
- +4 NEW %ZISOS,%ZISV
- +5 ;p524
- SET U="^"
- SET %ZISOS=$GET(^%ZOSF("OS"))
- SET %ZISV=$GET(^%ZOSF("VOL"))
- SET POP=0
- +6 ;Check SPOOLER special case first
- INIT ;
- +1 ;p524
- IF $GET(ZTQUEUED)
- IF $GET(IOT)="SPL"
- IF $DATA(IOP)
- IF $LENGTH($GET(IO))
- IF IO=$GET(IO(0))
- IF $DATA(IO(1,IO))#2
- IF (IOP[$GET(ION)!(IOP[IO))
- KILL %ZIS,%IS,IOP
- QUIT
- +2 ;p524 Line above for HD141181.
- +3 IF '$DATA(%ZIS)
- IF $DATA(%IS)
- MERGE %ZIS=%IS
- +4 ;update %IS for now
- if '($DATA(%ZIS)#2)
- SET %ZIS="M"
- MERGE %IS=%ZIS
- +5 IF '$DATA(^XUTL("XQ",$JOB,"MIXED OS"))
- SET ^XUTL("XQ",$JOB,"MIXED OS")=$$PRI^%ZOSV
- +6 SET %ZIS("PRI")=$GET(^XUTL("XQ",$JOB,"MIXED OS"),1)
- +7 ;
- +8 IF $DATA(ZTQUEUED)
- Begin DoDot:1
- +9 IF $GET(ZTIO)=""
- if %ZIS'[0
- SET %ZIS=%ZIS_"0"
- SET %IS=%ZIS
- End DoDot:1
- IF '$DATA(IOP)
- SET POP=1
- GOTO EXIT^%ZIS1
- +10 IF '$DATA(ZTQUEUED)
- IF %ZIS["T"
- IF $PIECE($GET(IOP),";")="Q"
- SET POP=1
- GOTO EXIT^%ZIS1
- +11 NEW %,%A,%E,%H,%I,%X,%XX,%Y,%Z,%Z1,%Z2,%Z9,%Z90,%Z91,%Z95,%ZISB,%ZTIME,%ZTYPE
- +12 NEW %ZHFN,%ZISOLD,%ZTOUT,%ZISDTIM,DTOUT,DUOUT
- +13 SET %ZISDTIM=$GET(DTIME,300)
- +14 ;Save symbols to restore if don't open a device
- +15 DO SYMBOL^%ZISUTL(0,$NAME(%ZISOLD))
- A ;p363
- DO CLEAN
- +1 KILL IO("P"),IO("Q"),IO("S"),IO("T")
- K2 DO K2^%ZIS1
- +1 SET %ZISB=%ZIS'["N"
- SET (%E,%H)=0
- SET %Y=""
- if '$DATA(IO(0))
- SET IO(0)=$IO
- +2 IF $DATA(IOP)
- IF IOP=$IO!(IOP="HOME")!(0[IOP)
- IF $DATA(^XUTL("XQ",$JOB,"IO"))
- DO HOME
- KILL %IS,%Y,%ZIS,%ZISB,%ZISV,IOP
- QUIT
- +3 ;Don't worry about HOME if %ZIS[0
- +4 ;Jump to next part
- if %ZIS'[0
- DO GETHOME
- if POP
- GOTO EXIT^%ZIS1
- GOTO ^%ZIS1
- GETHOME IF $DATA(IO("HOME"))
- IF $PIECE(IO("HOME"),"^",2)=IO(0)
- SET (%E,%H)=+IO("HOME")
- QUIT
- +1 IF $DATA(^XUTL("XQ",$JOB,"IOS"))
- IF $DATA(^("IO"))
- IF IO(0)=^("IO")
- SET (%E,%H)=^("IOS")
- QUIT
- +2 ;CALL LINEPORT CODE HERE---
- +3 SET %=$$LINEPORT^%ZISUTL
- IF %
- SET (%E,%H)=%
- QUIT
- +4 SET %ZISVT=$IO
- DO VTLKUP
- IF '%E
- SET %ZISVT=$IO
- DO VIRTUAL
- +5 IF %ZISVT=""!(%E'>0)
- IF %ZIS'[0
- OPEN IO(0)::0
- IF $TEST
- USE IO(0)
- WRITE !,"HOME DEVICE ("_$IO_") DOES NOT EXIST IN THE DEVICE FILE",!,"PLEASE CONTACT YOUR SYSTEM MANAGER!",*7
- +6 SET %H=%E
- if '%H&(%ZIS'[0)
- SET POP=1
- if (%H>0)&('$DATA(IO("HOME")))
- SET IO("HOME")=%H_"^"_$IO
- +7 QUIT
- VIRTUAL ;See if a Virtual Terminal (LAT, TELNET)
- +1 ; ZEXCEPT: %ZISI,%ZISVT
- +2 FOR %ZISI=$LENGTH(%ZISVT):-1:1
- if $DATA(^%ZIS(1,"C",%ZISVT))
- Begin DoDot:1
- +3 ;Q:$S('%E:0,'$D(^%ZIS(1,%E,"TYPE")):0,^("TYPE")="VTRM":1,1:0)
- DO VTLKUP
- QUIT
- End DoDot:1
- if $SELECT('%E
- QUIT
- SET %ZISVT=$EXTRACT(%ZISVT,1,%ZISI)
- +4 QUIT
- VTLKUP ;
- +1 ; ZEXCEPT: %E,%ZISV,%ZISVT,%ZISX
- +2 FOR %ZISX=%ZISV,""
- SET %E=+$ORDER(^%ZIS(1,"G","SYS."_%ZISX_"."_%ZISVT,0))
- if %E
- QUIT
- +3 QUIT
- CURRENT ;Old, Not in current doc's.
- +1 ; ZEXCEPT: %ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX,BS,FF,RM,SL,SUB,XY
- +2 NEW %ZIS,%IS,%E,%H,%A,%,POP,X
- +3 SET FF="#"
- SET SL=24
- SET BS="*8"
- SET RM=80
- SET (SUB,XY)=""
- SET %ZIS=0
- SET %ZISOS=$GET(^%ZOSF("OS"))
- SET %ZISV=$GET(^("VOL"))
- SET POP=0
- +4 DO GETHOME
- KILL %ZISI,%ZISOS,%ZISV,%ZISVT,%ZISX
- if POP
- QUIT
- +5 IF $DATA(^%ZIS(1,%H,"SUBTYPE"))
- SET SUB=+^("SUBTYPE")
- +6 IF $DATA(SUB)
- IF SUB
- IF $DATA(^%ZIS(2,SUB,1))
- SET SUB=$SELECT($DATA(^(0)):$PIECE(^(0),"^"),1:"")
- SET FF=$PIECE(^(1),"^",2)
- SET SL=$PIECE(^(1),"^",3)
- SET BS=$PIECE(^(1),"^",4)
- SET XY=$PIECE(^(1),"^",5)
- SET RM=+^(1)
- +7 IF '$TEST
- SET SUB=""
- +8 IF $DATA(^%ZOSF("RM"))
- SET X=RM
- XECUTE ^("RM")
- +9 QUIT
- HOME ;Entry point to establish IO* variables for home device.
- +1 ; ZEXCEPT: IOM,IOP
- +2 ;(p363)
- DO CLEAN
- +3 NEW X
- IF '$DATA(^XUTL("XQ",$JOB,"IO"))
- SET IOP="HOME"
- DO ^%ZIS
- QUIT
- +4 DO RESETVAR
- +5 ;p524
- IF $LENGTH($GET(IO))
- IF $PIECE($GET(IO("HOME")),"^",2)=IO
- IF $DATA(IO(1,IO))
- USE IO
- +6 IF '$DATA(IO("C"))
- IF $GET(IOM)
- IF IO=$IO
- IF $DATA(IO(1,IO))
- IF $DATA(^%ZOSF("RM"))
- SET X=+IOM
- XECUTE ^("RM")
- +7 ;p599 Set end-of-file handling for Cache
- SET X=$$ENDOFILE^%ZISUTL
- +8 QUIT
- +9 ;IO("Q") is checked by many routines after a call to ^%ZISC, so only clean on call to %ZIS.
- CLEAN ;Cleanup env. Called from %ZISC also.
- +1 ; ZEXCEPT: IOPAR,IOT,IOUPAR
- +2 ;(p440)
- IF $GET(IOT)'="SPL"
- KILL IO("DOC"),IO("SPOOL")
- +3 ;p440
- IF $GET(IOT)'="HFS"
- KILL IO("HFSIO")
- +4 SET (IOPAR,IOUPAR)=""
- +5 QUIT
- RESETVAR ;Reset home IO* variables.
- +1 ; ZEXCEPT: POP
- +2 IF '$DATA(^XUTL("XQ",$JOB,"IO"))
- QUIT
- +3 NEW %
- +4 FOR %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR"
- IF $DATA(^XUTL("XQ",$JOB,%))#2
- SET @%=^(%)
- +5 FOR %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")"
- IF $DATA(^XUTL("XQ",$JOB,%))#2
- SET @%=^(%)
- +6 SET POP=0
- SET IO(0)=IO
- +7 QUIT
- SAVEVAR ;Save home IO* variables, called from XUS1,%ZTMS3
- +1 NEW %
- +2 FOR %="IO","IOBS","IOF","IOM","ION","IOS","IOSL","IOST","IOST(0)","IOT","IOXY","IOPAR","IOUPAR"
- IF $DATA(@%)
- SET ^XUTL("XQ",$JOB,%)=@%
- +3 FOR %="IO(""IP"")","IO(""CLNM"")","IO(""DOC"")","IO(""HFSIO"")","IO(""SPOOL"")"
- IF $DATA(@%)
- SET ^XUTL("XQ",$JOB,%)=@%
- +4 QUIT
- ZISLPC ;No longer called in Kernel v8.
- QUIT
- HLP1 GOTO EN1^%ZIS7
- HLP2 ;
- +1 ; ZEXCEPT: DTIME
- +2 NEW %E,%H,%X,%ZISV,X,%ZISDTIM
- +3 SET %ZISDTIM=$GET(DTIME,60)
- SET %ZISV=$SELECT($DATA(^%ZOSF("VOL")):^("VOL"),1:"")
- GOTO EN2^%ZIS7
- REWIND(IO2,IOT,IOPAR) ;Rewind Device
- +1 NEW %,X,Y,$ESTACK,$ETRAP
- SET $ETRAP="D REWERR^%ZIS Q 0"
- +2 SET %=$IO
- +3 IF '($DATA(IO2)#2)!'$DATA(IOT)!'$DATA(IOPAR)
- QUIT 0
- +4 IF "MT^SDP^HFS"'[IOT
- QUIT 0
- +5 SET @("Y=$$REW"_IOT_"^%ZIS4(IO2,IOPAR)")
- +6 USE %
- +7 QUIT Y
- REWERR ;Error encountered
- +1 SET IO("ERROR")=$ECODE
- +2 SET $ECODE=""
- SET $ETRAP="Q:$ES>1 S $EC="""" Q 0"
- SET $ECODE=",U1,"
- +3 QUIT 0