- %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;11/08/2011
- ;;8.0;KERNEL;**24,36,49,69,199,216,275,409,440,585**;JUL 10, 1995;Build 22
- ;Per VHA Directive 2004-038, this routine should not be modified
- C0 ;
- N %,%E,%H,%ZISI,%ZISOS,%ZISX,%ZISV
- ;Clear IO var we will use for reporting
- K IO("ERROR"),IO("LASTERR"),IO("CLOSE")
- ;Protect ourself from calls with incomplete setup.
- S:$D(IO)[0 IO=$I S:'$D(IO(0)) IO(0)=$P
- S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL"))
- ;S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO)
- S %=$S($L($G(ION)):ION,1:IO) ;p409
- I (%="")!(IO="") G SETIO:IO(0)]"",END
- I $G(IOT)="RES" D RES G SETIO ;Handle a resource device
- ;
- ;Define subtype info if not already defined.
- D SUBTYPE
- ;
- ;perform close execute
- I $G(IOST(0))>0 D
- . I $G(^%ZIS(2,+IOST(0),3))]"",$D(IO(1,IO)) D
- . . U IO S:$X $X=1 D X3^ZISX:'$D(IO("T"))
- ;
- ;Incase the Close execute changed IO, Open IO("HOME") or NULL.
- I '$L($G(IO)) D Q
- . S IOP=$S($L($G(IO("HOME"))):"`"_(+IO("HOME")),1:"NULL") D ^%ZIS
- . Q
- ;
- ;Perform the following if the device is open.
- I $D(IO(1,IO)) D
- . I $G(IO("P"))["B" D ;Return to normal intensity
- . . S %=$P($G(^%ZIS(2,+IOST(0),7)),"^",3) I %]"" W @%
- . I $G(IO("P"))["P" D ;Return to default pitch
- . . S %=$G(^%ZIS(2,+IOST(0),12.11)) I %]"" W @%
- . ;
- . W:$$FF @IOF ;Issue form feed at close
- . I $$CLOSPP D X11^ZISX:'$D(IO("T")) K IO("S") ;Close printer port
- . Q
- ;
- ;Don't use IOCPU as we now use IO(1,IO)
- I (IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D
- . U:$S($D(ZTQUEUED):0,'$L($G(IO(0))):0,$D(IO(1,IO(0)))#2:1,1:0) IO(0)
- . C IO K IO(1,IO) S IO("CLOSE")=IO ;close device`
- ;Unlock global used to control access.
- S %=$G(^XUTL("XQ",$J,"lock",+$G(IOS))) I $L(%) L -@% K ^XUTL("XQ",$J,"lock",IOS)
- ;
- ;**P585 START CJM
- I $G(IOT)="PQ" D CLOSE^ZISPQ(IO)
- ;**P585 END CJM
- ;
- I $D(IO("SPOOL")) D CLOSE^%ZIS4 ;Special close for spool device
- ;
- SETIO ;
- ;See if old device has PCX code
- I $G(IOS),$G(^%ZIS(1,+IOS,"PCX"))]"" S %ZISPCX=^("PCX")
- ;Setup the IO(0) device, should be the home device
- S IO=IO(0),(IOPAR,IOUPAR)="" K IO("T") D CIOS(IO(0))
- I 'IOS S IOT="TRM" G END
- S ION=$P(^%ZIS(1,IOS,0),"^",1),IOT=$G(^("TYPE")),IOST(0)=$S(IOT["TRM"&($D(^XUTL("XQ",$J,"IOST(0)"))):^("IOST(0)"),1:$G(^%ZIS(1,IOS,"SUBTYPE")))
- I IOT["TRM",$D(^XUTL("XQ",$J,"IO")) D HOME^%ZIS G END
- S %="Y"
- I IOST(0),$D(^%ZIS(2,IOST(0),1)) S %=^(1),IOM=+%,IOF=$P(%,"^",2),IOSL=$P(%,"^",3),IOBS=$P(%,"^",4)
- I $D(^%ZIS(1,IOS,91)) S %=^%ZIS(1,IOS,91) S:+% IOM=+% S:$P(%,"^",3) IOSL=$P(%,"^",3)
- ;Don't know the subtype so set some defaults
- I %="Y" S IOM=80,IOSL=24,IOF="#",IOST="C-OTHER",IOBS="$C(8)"
- S1 S:IOST(0) IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^"),IOXY=$G(^("XY"))
- I '$D(ZTQUEUED),'$D(IO("C")),IOT["TRM" D RM:$D(IO(1,IO))
- ;With home device set, Do Post-close execute code of Device closed.
- END I '$D(IO("T")),$G(%ZISPCX)]"" S %Y=%ZISPCX D %Y^ZISX
- ;See that any extra IO variables are cleaned up
- K IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF
- ;IOCPU should not be changed.
- Q
- ;
- SUBTYPE ;Find a subtype
- N %S
- S IOST=$G(IOST),IOST(0)=+$G(IOST(0))
- I $L(IOST)&$L(IOST(0)) Q ;Have a subtype
- S %S=$G(^%ZIS(2,+IOST(0),0)) I $L(%S) S IOST=$P(%S,U) Q
- I $L(IOST) S %S=$O(^%ZIS(2,"B",$G(IOST,"X"),0)) I %S>0 S IOST(0)=+%S Q
- S IOST="",IOST(0)=0 D CIOS($I) Q:IOS'>0
- S IOST(0)=$G(^%ZIS(1,+IOS,"SUBTYPE")),IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^")
- Q
- ;
- CIOS(%I) ;Find a value for IOS (IEN into device file)
- N %ZISVT
- I $D(^XUTL("XQ",$J,"IOS")) S IOS=+^("IOS") Q
- I $D(%ZISV) S %ZISVT=%I D VTLKUP^%ZIS S IOS=+%E
- E S IOS=+$O(^%ZIS(1,"C",%I,0))
- Q:$G(IOS)>0
- S %ZISVT=%I D VIRTUAL^%ZIS
- I $D(%ZISVT) S %H=%E I %ZISVT]"",%H>0,$D(^%ZIS(1,%H,0)),$D(^("TYPE")),^("TYPE")="VTRM" S IOS=%H
- Q
- ;
- RM N X S X=+IOM X ^%ZOSF("RM")
- Q
- ;
- RES ;Close resource device.
- Q:'$D(IO(1,IO))&'$D(^%ZISL(3.54,"AJ",$J))
- N %ZISJOB,%X,%Y,%ZISD0,%ZISD1,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO
- S %ZISJOB=$J
- ;
- RES1 G RQ:'$D(IOS),RQ:'$D(^%ZIS(1,+IOS,1)) S %ZISRL=+$P(^(1),"^",10),%ZISRL=$S(%ZISRL:%ZISRL,1:1)
- S %X=$O(^%ZISL(3.54,"B",IO,0)) G RQ:'%X
- G RQ:'$D(^%ZISL(3.54,+%X,0)) S %ZISD0=+%X,%ZISY0=^(0)
- S %X=$O(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0)) S %ZISD1=%X G RQ:'%X
- S %Y=$G(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0)) G RQ:$P(%Y,"^",3)'=%ZISJOB
- D KILLRES(+%ZISD0,+%ZISD1)
- RQ K IO(1,IO)
- Q
- ;
- KILLRES(D0,D1) ;Kill one resource use
- Q:(D0'>0)!(D1'>0)
- N %X,%Y,%J,%ZISRL
- L +^%ZISL(3.54,D0,0)
- S %Y=$G(^%ZISL(3.54,D0,0)) G KRX:%Y=""
- S %X=$G(^%ZISL(3.54,D0,1,D1,0)),%J=$P(%X,"^",3) S:%J="" %J=" "
- K ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1)
- S %X=$P(%Y,"^",2)+1,$P(^%ZISL(3.54,D0,0),"^",2)=%X
- ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ
- S %Y=$G(^%ZISL(3.54,D0,1,0)),%X=$P(%Y,"^",4),$P(^%ZISL(3.54,D0,1,0),"^",3,4)="^"_$S(%X>0:(%X-1),1:0)
- KRX L -^%ZISL(3.54,D0,0)
- Q
- ;
- DQCRES ;Tasked entry point to close resource device.
- S IO=%ZISRES G RES1
- ;
- FF() ;Issue form feed
- I $E(IOST,1,2)'["C-",$D(IO(1,IO)),$G(IOT)="TRM"!($G(IOT)="SPL"),'$D(IO("T"))&$Y&'$D(IONOFF)&'$D(IO(1,IO,"NOFF")) Q 1
- Q 0
- ;
- CLOSPP() ;Close printer port
- I $D(IO("S")),$D(^%ZIS(2,+IO("S"),11))&$D(IO(1,IO)) Q 1
- Q 0
- ;
- ;
- ;
- ;
- ;
- ;
- ;
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZISC 5275 printed Jan 18, 2025@03:15:47 Page 2
- %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;11/08/2011
- +1 ;;8.0;KERNEL;**24,36,49,69,199,216,275,409,440,585**;JUL 10, 1995;Build 22
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- C0 ;
- +1 NEW %,%E,%H,%ZISI,%ZISOS,%ZISX,%ZISV
- +2 ;Clear IO var we will use for reporting
- +3 KILL IO("ERROR"),IO("LASTERR"),IO("CLOSE")
- +4 ;Protect ourself from calls with incomplete setup.
- +5 if $DATA(IO)[0
- SET IO=$IO
- if '$DATA(IO(0))
- SET IO(0)=$PRINCIPAL
- +6 SET U="^"
- SET %ZISOS=$GET(^%ZOSF("OS"))
- SET %ZISV=$GET(^("VOL"))
- +7 ;S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO)
- +8 ;p409
- SET %=$SELECT($LENGTH($GET(ION)):ION,1:IO)
- +9 IF (%="")!(IO="")
- if IO(0)]""
- GOTO SETIO
- GOTO END
- +10 ;Handle a resource device
- IF $GET(IOT)="RES"
- DO RES
- GOTO SETIO
- +11 ;
- +12 ;Define subtype info if not already defined.
- +13 DO SUBTYPE
- +14 ;
- +15 ;perform close execute
- +16 IF $GET(IOST(0))>0
- Begin DoDot:1
- +17 IF $GET(^%ZIS(2,+IOST(0),3))]""
- IF $DATA(IO(1,IO))
- Begin DoDot:2
- +18 USE IO
- if $X
- SET $X=1
- if '$DATA(IO("T"))
- DO X3^ZISX
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 ;Incase the Close execute changed IO, Open IO("HOME") or NULL.
- +21 IF '$LENGTH($GET(IO))
- Begin DoDot:1
- +22 SET IOP=$SELECT($LENGTH($GET(IO("HOME"))):"`"_(+IO("HOME")),1:"NULL")
- DO ^%ZIS
- +23 QUIT
- End DoDot:1
- QUIT
- +24 ;
- +25 ;Perform the following if the device is open.
- +26 IF $DATA(IO(1,IO))
- Begin DoDot:1
- +27 ;Return to normal intensity
- IF $GET(IO("P"))["B"
- Begin DoDot:2
- +28 SET %=$PIECE($GET(^%ZIS(2,+IOST(0),7)),"^",3)
- IF %]""
- WRITE @%
- End DoDot:2
- +29 ;Return to default pitch
- IF $GET(IO("P"))["P"
- Begin DoDot:2
- +30 SET %=$GET(^%ZIS(2,+IOST(0),12.11))
- IF %]""
- WRITE @%
- End DoDot:2
- +31 ;
- +32 ;Issue form feed at close
- if $$FF
- WRITE @IOF
- +33 ;Close printer port
- IF $$CLOSPP
- if '$DATA(IO("T"))
- DO X11^ZISX
- KILL IO("S")
- +34 QUIT
- End DoDot:1
- +35 ;
- +36 ;Don't use IOCPU as we now use IO(1,IO)
- +37 IF (IO'=IO(0)!$DATA(IO("C")))
- IF $DATA(IO(1,IO))
- Begin DoDot:1
- +38 if $SELECT($DATA(ZTQUEUED)
- USE IO(0)
- +39 ;close device`
- CLOSE IO
- KILL IO(1,IO)
- SET IO("CLOSE")=IO
- End DoDot:1
- +40 ;Unlock global used to control access.
- +41 SET %=$GET(^XUTL("XQ",$JOB,"lock",+$GET(IOS)))
- IF $LENGTH(%)
- LOCK -@%
- KILL ^XUTL("XQ",$JOB,"lock",IOS)
- +42 ;
- +43 ;**P585 START CJM
- +44 IF $GET(IOT)="PQ"
- DO CLOSE^ZISPQ(IO)
- +45 ;**P585 END CJM
- +46 ;
- +47 ;Special close for spool device
- IF $DATA(IO("SPOOL"))
- DO CLOSE^%ZIS4
- +48 ;
- SETIO ;
- +1 ;See if old device has PCX code
- +2 IF $GET(IOS)
- IF $GET(^%ZIS(1,+IOS,"PCX"))]""
- SET %ZISPCX=^("PCX")
- +3 ;Setup the IO(0) device, should be the home device
- +4 SET IO=IO(0)
- SET (IOPAR,IOUPAR)=""
- KILL IO("T")
- DO CIOS(IO(0))
- +5 IF 'IOS
- SET IOT="TRM"
- GOTO END
- +6 SET ION=$PIECE(^%ZIS(1,IOS,0),"^",1)
- SET IOT=$GET(^("TYPE"))
- SET IOST(0)=$SELECT(IOT["TRM"&($DATA(^XUTL("XQ",$JOB,"IOST(0)"))):^("IOST(0)"),1:$GET(^%ZIS(1,IOS,"SUBTYPE")))
- +7 IF IOT["TRM"
- IF $DATA(^XUTL("XQ",$JOB,"IO"))
- DO HOME^%ZIS
- GOTO END
- +8 SET %="Y"
- +9 IF IOST(0)
- IF $DATA(^%ZIS(2,IOST(0),1))
- SET %=^(1)
- SET IOM=+%
- SET IOF=$PIECE(%,"^",2)
- SET IOSL=$PIECE(%,"^",3)
- SET IOBS=$PIECE(%,"^",4)
- +10 IF $DATA(^%ZIS(1,IOS,91))
- SET %=^%ZIS(1,IOS,91)
- if +%
- SET IOM=+%
- if $PIECE(%,"^",3)
- SET IOSL=$PIECE(%,"^",3)
- +11 ;Don't know the subtype so set some defaults
- +12 IF %="Y"
- SET IOM=80
- SET IOSL=24
- SET IOF="#"
- SET IOST="C-OTHER"
- SET IOBS="$C(8)"
- S1 if IOST(0)
- SET IOST=$PIECE($GET(^%ZIS(2,+IOST(0),0)),"^")
- SET IOXY=$GET(^("XY"))
- +1 IF '$DATA(ZTQUEUED)
- IF '$DATA(IO("C"))
- IF IOT["TRM"
- if $DATA(IO(1,IO))
- DO RM
- +2 ;With home device set, Do Post-close execute code of Device closed.
- END IF '$DATA(IO("T"))
- IF $GET(%ZISPCX)]""
- SET %Y=%ZISPCX
- DO %Y^ZISX
- +1 ;See that any extra IO variables are cleaned up
- +2 KILL IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF
- +3 ;IOCPU should not be changed.
- +4 QUIT
- +5 ;
- SUBTYPE ;Find a subtype
- +1 NEW %S
- +2 SET IOST=$GET(IOST)
- SET IOST(0)=+$GET(IOST(0))
- +3 ;Have a subtype
- IF $LENGTH(IOST)&$LENGTH(IOST(0))
- QUIT
- +4 SET %S=$GET(^%ZIS(2,+IOST(0),0))
- IF $LENGTH(%S)
- SET IOST=$PIECE(%S,U)
- QUIT
- +5 IF $LENGTH(IOST)
- SET %S=$ORDER(^%ZIS(2,"B",$GET(IOST,"X"),0))
- IF %S>0
- SET IOST(0)=+%S
- QUIT
- +6 SET IOST=""
- SET IOST(0)=0
- DO CIOS($IO)
- if IOS'>0
- QUIT
- +7 SET IOST(0)=$GET(^%ZIS(1,+IOS,"SUBTYPE"))
- SET IOST=$PIECE($GET(^%ZIS(2,+IOST(0),0)),"^")
- +8 QUIT
- +9 ;
- CIOS(%I) ;Find a value for IOS (IEN into device file)
- +1 NEW %ZISVT
- +2 IF $DATA(^XUTL("XQ",$JOB,"IOS"))
- SET IOS=+^("IOS")
- QUIT
- +3 IF $DATA(%ZISV)
- SET %ZISVT=%I
- DO VTLKUP^%ZIS
- SET IOS=+%E
- +4 IF '$TEST
- SET IOS=+$ORDER(^%ZIS(1,"C",%I,0))
- +5 if $GET(IOS)>0
- QUIT
- +6 SET %ZISVT=%I
- DO VIRTUAL^%ZIS
- +7 IF $DATA(%ZISVT)
- SET %H=%E
- IF %ZISVT]""
- IF %H>0
- IF $DATA(^%ZIS(1,%H,0))
- IF $DATA(^("TYPE"))
- IF ^("TYPE")="VTRM"
- SET IOS=%H
- +8 QUIT
- +9 ;
- RM NEW X
- SET X=+IOM
- XECUTE ^%ZOSF("RM")
- +1 QUIT
- +2 ;
- RES ;Close resource device.
- +1 if '$DATA(IO(1,IO))&'$DATA(^%ZISL(3.54,"AJ",$JOB))
- QUIT
- +2 NEW %ZISJOB,%X,%Y,%ZISD0,%ZISD1,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO
- +3 SET %ZISJOB=$JOB
- +4 ;
- RES1 if '$DATA(IOS)
- GOTO RQ
- if '$DATA(^%ZIS(1,+IOS,1))
- GOTO RQ
- SET %ZISRL=+$PIECE(^(1),"^",10)
- SET %ZISRL=$SELECT(%ZISRL:%ZISRL,1:1)
- +1 SET %X=$ORDER(^%ZISL(3.54,"B",IO,0))
- if '%X
- GOTO RQ
- +2 if '$DATA(^%ZISL(3.54,+%X,0))
- GOTO RQ
- SET %ZISD0=+%X
- SET %ZISY0=^(0)
- +3 SET %X=$ORDER(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0))
- SET %ZISD1=%X
- if '%X
- GOTO RQ
- +4 SET %Y=$GET(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0))
- if $PIECE(%Y,"^",3)'=%ZISJOB
- GOTO RQ
- +5 DO KILLRES(+%ZISD0,+%ZISD1)
- RQ KILL IO(1,IO)
- +1 QUIT
- +2 ;
- KILLRES(D0,D1) ;Kill one resource use
- +1 if (D0'>0)!(D1'>0)
- QUIT
- +2 NEW %X,%Y,%J,%ZISRL
- +3 LOCK +^%ZISL(3.54,D0,0)
- +4 SET %Y=$GET(^%ZISL(3.54,D0,0))
- if %Y=""
- GOTO KRX
- +5 SET %X=$GET(^%ZISL(3.54,D0,1,D1,0))
- SET %J=$PIECE(%X,"^",3)
- if %J=""
- SET %J=" "
- +6 KILL ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1)
- +7 SET %X=$PIECE(%Y,"^",2)+1
- SET $PIECE(^%ZISL(3.54,D0,0),"^",2)=%X
- +8 ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ
- +9 SET %Y=$GET(^%ZISL(3.54,D0,1,0))
- SET %X=$PIECE(%Y,"^",4)
- SET $PIECE(^%ZISL(3.54,D0,1,0),"^",3,4)="^"_$SELECT(%X>0:(%X-1),1:0)
- KRX LOCK -^%ZISL(3.54,D0,0)
- +1 QUIT
- +2 ;
- DQCRES ;Tasked entry point to close resource device.
- +1 SET IO=%ZISRES
- GOTO RES1
- +2 ;
- FF() ;Issue form feed
- +1 IF $EXTRACT(IOST,1,2)'["C-"
- IF $DATA(IO(1,IO))
- IF $GET(IOT)="TRM"!($GET(IOT)="SPL")
- IF '$DATA(IO("T"))&$Y&'$DATA(IONOFF)&'$DATA(IO(1,IO,"NOFF"))
- QUIT 1
- +2 QUIT 0
- +3 ;
- CLOSPP() ;Close printer port
- +1 IF $DATA(IO("S"))
- IF $DATA(^%ZIS(2,+IO("S"),11))&$DATA(IO(1,IO))
- QUIT 1
- +2 QUIT 0
- +3 ;
- +4 ;
- +5 ;
- +6 ;
- +7 ;
- +8 ;
- +9 ;
- +10 ;