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/ZISC.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/ZISC.m
r613 r623 1 %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;1/24/08 16:09 2 ;;8.0;KERNEL;**24,36,49,69,199,216,275,409,440**;JUL 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified 4 C0 ; 5 N %,%E,%H,%ZISI,%ZISOS,%ZISX,%ZISV 6 ;Clear IO var we will use for reporting 7 K IO("ERROR"),IO("LASTERR"),IO("CLOSE") 8 ;Protect ourself from calls with incomplete setup. 9 S:$D(IO)[0 IO=$I S:'$D(IO(0)) IO(0)=$P 10 S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")) 11 ;S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO) 12 S %=$S($L($G(ION)):ION,1:IO) ;p409 13 I (%="")!(IO="") G SETIO:IO(0)]"",END 14 I $G(IOT)="RES" D RES G SETIO ;Handle a resource device 15 ; 16 ;Define subtype info if not already defined. 17 D SUBTYPE 18 ; 19 ;perform close execute 20 I $G(IOST(0))>0 D 21 . I $G(^%ZIS(2,+IOST(0),3))]"",$D(IO(1,IO)) D 22 . . U IO S:$X $X=1 D X3^ZISX:'$D(IO("T")) 23 ; 24 ;Incase the Close execute changed IO, Open IO("HOME") or NULL. 25 I '$L($G(IO)) D Q 26 . S IOP=$S($L($G(IO("HOME"))):"`"_(+IO("HOME")),1:"NULL") D ^%ZIS 27 . Q 28 ; 29 ;Perform the following if the device is open. 30 I $D(IO(1,IO)) D 31 . I $G(IO("P"))["B" D ;Return to normal intensity 32 . . S %=$P($G(^%ZIS(2,+IOST(0),7)),"^",3) I %]"" W @% 33 . I $G(IO("P"))["P" D ;Return to default pitch 34 . . S %=$G(^%ZIS(2,+IOST(0),12.11)) I %]"" W @% 35 . ; 36 . W:$$FF @IOF ;Issue form feed at close 37 . I $$CLOSPP D X11^ZISX:'$D(IO("T")) K IO("S") ;Close printer port 38 . Q 39 ; 40 ;Don't use IOCPU as we now use IO(1,IO) 41 I (IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D 42 . U:$S($D(ZTQUEUED):0,'$L($G(IO(0))):0,$D(IO(1,IO(0)))#2:1,1:0) IO(0) 43 . C IO K IO(1,IO) S IO("CLOSE")=IO ;close device 44 ;Unlock global used to control access. 45 S %=$G(^XUTL("XQ",$J,"lock",+$G(IOS))) I $L(%) L -@% K ^XUTL("XQ",$J,"lock",IOS) 46 ; 47 I $D(IO("SPOOL")) D CLOSE^%ZIS4 ;Special close for spool device 48 ; 49 SETIO ; 50 ;See if old device has PCX code 51 I $G(IOS),$G(^%ZIS(1,+IOS,"PCX"))]"" S %ZISPCX=^("PCX") 52 ;Setup the IO(0) device, should be the home device 53 S IO=IO(0),(IOPAR,IOUPAR)="" K IO("T") D CIOS(IO(0)) 54 I 'IOS S IOT="TRM" G END 55 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"))) 56 I IOT["TRM",$D(^XUTL("XQ",$J,"IO")) D HOME^%ZIS G END 57 S %="Y" 58 I IOST(0),$D(^%ZIS(2,IOST(0),1)) S %=^(1),IOM=+%,IOF=$P(%,"^",2),IOSL=$P(%,"^",3),IOBS=$P(%,"^",4) 59 I $D(^%ZIS(1,IOS,91)) S %=^%ZIS(1,IOS,91) S:+% IOM=+% S:$P(%,"^",3) IOSL=$P(%,"^",3) 60 ;Don't know the subtype so set some defaults 61 I %="Y" S IOM=80,IOSL=24,IOF="#",IOST="C-OTHER",IOBS="$C(8)" 62 S1 S:IOST(0) IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^"),IOXY=$G(^("XY")) 63 I '$D(ZTQUEUED),'$D(IO("C")),IOT["TRM" D RM:$D(IO(1,IO)) 64 ;With home device set, Do Post-close execute code of Device closed. 65 END I '$D(IO("T")),$G(%ZISPCX)]"" S %Y=%ZISPCX D %Y^ZISX 66 ;See that any extra IO variables are cleaned up 67 K IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF 68 ;IOCPU should not be changed. 69 Q 70 ; 71 SUBTYPE ;Find a subtype 72 N %S 73 S IOST=$G(IOST),IOST(0)=+$G(IOST(0)) 74 I $L(IOST)&$L(IOST(0)) Q ;Have a subtype 75 S %S=$G(^%ZIS(2,+IOST(0),0)) I $L(%S) S IOST=$P(%S,U) Q 76 I $L(IOST) S %S=$O(^%ZIS(2,"B",$G(IOST,"X"),0)) I %S>0 S IOST(0)=+%S Q 77 S IOST="",IOST(0)=0 D CIOS($I) Q:IOS'>0 78 S IOST(0)=$G(^%ZIS(1,+IOS,"SUBTYPE")),IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^") 79 Q 80 ; 81 CIOS(%I) ;Find a value for IOS (IEN into device file) 82 N %ZISVT 83 I $D(^XUTL("XQ",$J,"IOS")) S IOS=+^("IOS") Q 84 I $D(%ZISV) S %ZISVT=%I D VTLKUP^%ZIS S IOS=+%E 85 E S IOS=+$O(^%ZIS(1,"C",%I,0)) 86 Q:$G(IOS)>0 87 S %ZISVT=%I D VIRTUAL^%ZIS 88 I $D(%ZISVT) S %H=%E I %ZISVT]"",%H>0,$D(^%ZIS(1,%H,0)),$D(^("TYPE")),^("TYPE")="VTRM" S IOS=%H 89 Q 90 ; 91 RM N X S X=+IOM X ^%ZOSF("RM") 92 Q 93 ; 94 RES ;Close resource device. 95 Q:'$D(IO(1,IO))&'$D(^%ZISL(3.54,"AJ",$J)) 96 N %ZISJOB,%X,%Y,%ZISD0,%ZISD1,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO 97 S %ZISJOB=$J 98 ; 99 RES1 G RQ:'$D(IOS),RQ:'$D(^%ZIS(1,+IOS,1)) S %ZISRL=+$P(^(1),"^",10),%ZISRL=$S(%ZISRL:%ZISRL,1:1) 100 S %X=$O(^%ZISL(3.54,"B",IO,0)) G RQ:'%X 101 G RQ:'$D(^%ZISL(3.54,+%X,0)) S %ZISD0=+%X,%ZISY0=^(0) 102 S %X=$O(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0)) S %ZISD1=%X G RQ:'%X 103 S %Y=$G(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0)) G RQ:$P(%Y,"^",3)'=%ZISJOB 104 D KILLRES(+%ZISD0,+%ZISD1) 105 RQ K IO(1,IO) 106 Q 107 ; 108 KILLRES(D0,D1) ;Kill one resource use 109 Q:(D0'>0)!(D1'>0) 110 N %X,%Y,%J,%ZISRL 111 L +^%ZISL(3.54,D0,0) 112 S %Y=$G(^%ZISL(3.54,D0,0)) G KRX:%Y="" 113 S %X=$G(^%ZISL(3.54,D0,1,D1,0)),%J=$P(%X,"^",3) S:%J="" %J=" " 114 K ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1) 115 S %X=$P(%Y,"^",2)+1,$P(^%ZISL(3.54,D0,0),"^",2)=%X 116 ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ 117 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) 118 KRX L -^%ZISL(3.54,D0,0) 119 Q 120 ; 121 DQCRES ;Tasked entry point to close resource device. 122 S IO=%ZISRES G RES1 123 ; 124 FF() ;Issue form feed 125 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 126 Q 0 127 ; 128 CLOSPP() ;Close printer port 129 I $D(IO("S")),$D(^%ZIS(2,+IO("S"),11))&$D(IO(1,IO)) Q 1 130 Q 0 1 %ZISC ;SFISC/GFT,AC,MUS - CLOSE LOGIC FOR DEVICES ;01/14/2002 09:06 2 ;;8.0;KERNEL;**24,36,49,69,199,216,275,409**;JUL 10, 1995;Build 3 3 C0 ; 4 N %,%E,%H,%ZISI,%ZISOS,%ZISX,%ZISV 5 ;Clear IO var we will use for reporting 6 K IO("ERROR"),IO("LASTERR"),IO("CLOSE") 7 ;Protect ourself from calls with incomplete setup. 8 S:$D(IO)[0 IO=$I S:'$D(IO(0)) IO(0)=$P 9 S U="^",%ZISOS=$G(^%ZOSF("OS")),%ZISV=$G(^("VOL")) 10 ;S %=$S(+$G(IOS):IOS,$L($G(ION)):ION,1:IO) 11 S %=$S($L($G(ION)):ION,1:IO) ;p409 12 I (%="")!(IO="") G SETIO:IO(0)]"",END 13 I $G(IOT)="RES" D RES G SETIO ;Handle a resource device 14 ; 15 ;Define subtype info if not already defined. 16 D SUBTYPE 17 ; 18 ;perform close execute 19 I $G(IOST(0))>0 D 20 . I $G(^%ZIS(2,+IOST(0),3))]"",$D(IO(1,IO)) D 21 . . U IO S:$X $X=1 D X3^ZISX:'$D(IO("T")) 22 ; 23 ;Incase the Close execute changed IO, Open IO("HOME") or NULL. 24 I '$L($G(IO)) D Q 25 . S IOP=$S($L($G(IO("HOME"))):"`"_(+IO("HOME")),1:"NULL") D ^%ZIS 26 . Q 27 ; 28 ;Perform the following if the device is open. 29 I $D(IO(1,IO)) D 30 . I $G(IO("P"))["B" D ;Return to normal intensity 31 . . S %=$P($G(^%ZIS(2,+IOST(0),7)),"^",3) I %]"" W @% 32 . I $G(IO("P"))["P" D ;Return to default pitch 33 . . S %=$G(^%ZIS(2,+IOST(0),12.11)) I %]"" W @% 34 . ; 35 . W:$$FF @IOF ;Issue form feed at close 36 . I $$CLOSPP D X11^ZISX:'$D(IO("T")) K IO("S") ;Close printer port 37 . Q 38 ; 39 ;Don't use IOCPU as we now use IO(1,IO) 40 I (IO'=IO(0)!$D(IO("C"))),$D(IO(1,IO)) D 41 . U:$S($D(ZTQUEUED):0,'$L($G(IO(0))):0,$D(IO(1,IO(0)))#2:1,1:0) IO(0) 42 . C IO K IO(1,IO) S IO("CLOSE")=IO ;close device 43 ; 44 ; 45 I $D(IOT),IOT="CHAN",$D(IOS) D 46 .S %=$G(^%ZIS(1,+IOS,"GBL")) 47 .I %]"" L @("-^"_%) ;unlock global used to control access to network channels. 48 I $D(IO("SPOOL")) D CLOSE^%ZIS4 ;Special close for spool device 49 ; 50 SETIO ; 51 ;See if old device has PCX code 52 I $G(IOS),$G(^%ZIS(1,+IOS,"PCX"))]"" S %ZISPCX=^("PCX") 53 ;Setup the IO(0) device, should be the home device 54 S IO=IO(0),(IOPAR,IOUPAR)="" K IO("T") D CIOS(IO(0)) 55 I 'IOS S IOT="TRM" G END 56 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"))) 57 I IOT["TRM",$D(^XUTL("XQ",$J,"IO")) D HOME^%ZIS G END 58 S %="Y" 59 I IOST(0),$D(^%ZIS(2,IOST(0),1)) S %=^(1),IOM=+%,IOF=$P(%,"^",2),IOSL=$P(%,"^",3),IOBS=$P(%,"^",4) 60 I $D(^%ZIS(1,IOS,91)) S %=^%ZIS(1,IOS,91) S:+% IOM=+% S:$P(%,"^",3) IOSL=$P(%,"^",3) 61 ;Don't know the subtype so set some defaults 62 I %="Y" S IOM=80,IOSL=24,IOF="#",IOST="C-OTHER",IOBS="$C(8)" 63 S1 S:IOST(0) IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^"),IOXY=$G(^("XY")) 64 I '$D(ZTQUEUED),'$D(IO("C")),IOT["TRM" D RM:$D(IO(1,IO)) 65 ;With home device set, Do Post-close execute code of Device closed. 66 END I '$D(IO("T")),$G(%ZISPCX)]"" S %Y=%ZISPCX D %Y^ZISX 67 ;See that any extra IO variables are cleaned up 68 K IO("P"),IO("DOC"),IO("HFSIO"),IO("SPOOL"),IOC,IONOFF 69 ;IOCPU should not be changed. 70 Q 71 ; 72 SUBTYPE ;Find a subtype 73 N %S 74 S IOST=$G(IOST),IOST(0)=+$G(IOST(0)) 75 I $L(IOST)&$L(IOST(0)) Q ;Have a subtype 76 S %S=$G(^%ZIS(2,+IOST(0),0)) I $L(%S) S IOST=$P(%S,U) Q 77 I $L(IOST) S %S=$O(^%ZIS(2,"B",$G(IOST,"X"),0)) I %S>0 S IOST(0)=+%S Q 78 S IOST="",IOST(0)=0 D CIOS($I) Q:IOS'>0 79 S IOST(0)=$G(^%ZIS(1,+IOS,"SUBTYPE")),IOST=$P($G(^%ZIS(2,+IOST(0),0)),"^") 80 Q 81 ; 82 CIOS(%I) ;Find a value for IOS (IEN into device file) 83 N %ZISVT 84 I $D(^XUTL("XQ",$J,"IOS")) S IOS=+^("IOS") Q 85 I $D(%ZISV) S %ZISVT=%I D VTLKUP^%ZIS S IOS=+%E 86 E S IOS=+$O(^%ZIS(1,"C",%I,0)) 87 Q:$G(IOS)>0 88 S %ZISVT=%I D VIRTUAL^%ZIS 89 I $D(%ZISVT) S %H=%E I %ZISVT]"",%H>0,$D(^%ZIS(1,%H,0)),$D(^("TYPE")),^("TYPE")="VTRM" S IOS=%H 90 Q 91 ; 92 RM N X S X=+IOM X ^%ZOSF("RM") 93 Q 94 ; 95 RES ;Close resource device. 96 Q:'$D(IO(1,IO))&'$D(^%ZISL(3.54,"AJ",$J)) 97 N %ZISJOB,%X,%Y,%ZISD0,%ZISD1,%ZISRES,%ZISRL,%ZISY0,%ZTRTN,ZTSAVE,ZTIO 98 S %ZISJOB=$J 99 ; 100 RES1 G RQ:'$D(IOS),RQ:'$D(^%ZIS(1,+IOS,1)) S %ZISRL=+$P(^(1),"^",10),%ZISRL=$S(%ZISRL:%ZISRL,1:1) 101 S %X=$O(^%ZISL(3.54,"B",IO,0)) G RQ:'%X 102 G RQ:'$D(^%ZISL(3.54,+%X,0)) S %ZISD0=+%X,%ZISY0=^(0) 103 S %X=$O(^%ZISL(3.54,"AJ",%ZISJOB,%ZISD0,0)) S %ZISD1=%X G RQ:'%X 104 S %Y=$G(^%ZISL(3.54,%ZISD0,1,+%ZISD1,0)) G RQ:$P(%Y,"^",3)'=%ZISJOB 105 D KILLRES(+%ZISD0,+%ZISD1) 106 RQ K IO(1,IO) 107 Q 108 ; 109 KILLRES(D0,D1) ;Kill one resource use 110 Q:(D0'>0)!(D1'>0) 111 N %X,%Y,%J,%ZISRL 112 L +^%ZISL(3.54,D0,0) 113 S %Y=$G(^%ZISL(3.54,D0,0)) G KRX:%Y="" 114 S %X=$G(^%ZISL(3.54,D0,1,D1,0)),%J=$P(%X,"^",3) S:%J="" %J=" " 115 K ^%ZISL(3.54,D0,1,D1,0),^%ZISL(3.54,D0,1,"B",D1,D1),^%ZISL(3.54,"AJ",%J,D0,D1) 116 S %X=$P(%Y,"^",2)+1,$P(^%ZISL(3.54,D0,0),"^",2)=%X 117 ;I '$D(^%ZISL(3.54,%ZISD0,1,0)) S ^(0)="^3.542A^^" G RQ 118 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) 119 KRX L -^%ZISL(3.54,D0,0) 120 Q 121 ; 122 DQCRES ;Tasked entry point to close resource device. 123 S IO=%ZISRES G RES1 124 ; 125 FF() ;Issue form feed 126 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 127 Q 0 128 ; 129 CLOSPP() ;Close printer port 130 I $D(IO("S")),$D(^%ZIS(2,+IO("S"),11))&$D(IO(1,IO)) Q 1 131 Q 0
Note:
See TracChangeset
for help on using the changeset viewer.