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/_ZIS4.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/_ZIS4.m (modified) (6 diffs)

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/_ZIS4.m

@@ -1 @@
-%ZIS4 ;ISF/RWF,DW - DEVICE HANDLER SPECIFIC CODE (GT.M for Unix/VMS) ;1/24/08  16:08
- ;;8.0;KERNEL;**275,425,440**;Jul 10, 1995;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified
+%ZIS4 ;ISF/RWF,DW - DEVICE HANDLER SPECIFIC CODE (GT.M for Unix/VMS) ;03/07/2007
+ ;;8.0;KERNEL;**275,425**;Jul 10, 1995;Build 18
+ ;
 OPEN ;From %ZIS3 for TRM
  G OPN2:$D(IO(1,IO))
@@ -13 +13 @@
  Q
  ;Why no open paraneters???
-OP1 N $ET S $ET="G OPNERR^%ZIS4"
- I $D(%ZISLOCK) L +@%ZISLOCK:5 E  S POP=1 Q
- O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1
+OP1 N $ES,$ET S $ET="G OPNERR^%ZIS4"
+ L:$D(%ZISLOCK) +@%ZISLOCK:60
+ O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK
  Q
 OPNERR ;Open Error
- S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$$EC^%ZOSV,$EC=""
- Q
+ S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$$EC^%ZOSV,$EC="" Q
  ;
-O ;From %ZIS6 for all types.
+O ;From %ZIS6 for other types.
  D:%IS["L" ZIO
- I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer Port
+LCKGBL ;Lock Global
+ I %ZTYPE="CHAN" N % S %=$G(^%ZIS(1,+%E,"GBL")) I $L(%) L @("+^"_%_":0") S:'$T POP=1 I POP W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q
+ I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX
 OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR")
  I %ZTYPE="CHAN" D TCPIP Q:POP  G OXECUTE^%ZIS6
- S %A=%ZISOPAR_$S(%ZISOPAR["):":"",1:":"_%ZISTO)
+ S %A=%ZISOPAR_$S(%ZISOPAR["):":"",%ZTYPE["CHAN"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO)
  N % S %(IO)="",%=$P($P($NA(%(IO)),"(",2),")")
  S %A=%_$E(":",%A]"")_%A
@@ -39 +40 @@
  ;
 O1 N $ES,$ET S $ET="G OPNERR^%ZIS4"
- I $D(%ZISLOCK) L +@%ZISLOCK:5 E  S POP=1 Q
- O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)=""
+ L:$D(%ZISLOCK) +@%ZISLOCK:60
+ O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)="" L:$D(%ZISLOCK) -@%ZISLOCK
  S IO("ERROR")="" Q
  ;
@@ -53 +54 @@
  Q
  ;
-TCPIP ;For TCP/IP devices, should use ^%ZISTCP
+TCPIP ;For TCP/IP devices
  N %S
  S %ZISTO=$G(%ZISTO,3)
@@ -66 +67 @@
  I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N
  I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N
-R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0
- S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q"))
- G:'%ZISB OK I '$P(%ZY,"^",3),$L(%ZFN) O %ZFN:(append:nowrap):2 G DOC
+R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0 S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q"))
+ G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN]"" D SPL3 G N:%ZFN']"",DOC
  S %ZFN=IO_"SPOOL_no_"_%ZDA_".TMP" D SPL2 G:%ZFN']"" N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)=""
 DOC S IO=%ZFN,IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#"
@@ -74 +74 @@
 OK K %ZDA,%ZFN Q
 N K %ZDA,%ZFN,IO("DOC") S POP=1 Q
- ;
-SPL2 ;Open for write
- O %ZFN:(newversion:noreadonly:nowrap:exception="G SPL4"):2 G:$ZA<0 SPL4 S IO(1,%ZFN)="" Q
- ;
-SPL3 ;Open for Read
- O %ZFN:(readonly:exception="G SPL4"):2 S:'$T ZISPLQ=1 G:'$T SPL4 S IO(1,%ZFN)="" Q
+SPL2 O %ZFN:(NEWVERSION:WORLD=RWD) G:$ZA<0 SPL4 S IO(1,%ZFN)="" Q
+SPL3 N X S X="SPL4^%ZIS4",@^%ZOSF("TRAP")
+ O %ZFN:READONLY:1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q
 SPL4 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN="" Q
- ;
-CLOSE ;Close out the spool
- N %,%1,%Z1,%ZFN,%ZS,%ZDA,XS,%Y,%X
- I $L(IO) C IO K IO(1,IO)
- D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q
- S %ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN']""  S %ZCR=$C(13),%Y=""
- S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0
- U %ZFN F  R %X#255:5 Q:$ZEOF  S %2=%X D CL2 Q:%Z1<%
+CLOSE N %Z1 C:IO]"" IO K:IO]"" IO(1,IO) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q
+ S %ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN']""  U %ZFN S %ZCR=$C(13),%Y="",X="SPLEOF^%ZIS4",@^%ZOSF("TRAP")
+ S %Z1=+$G(^XTV(8989.3,1,"SPL"))
+ F %=0:0 R %X#255:5 Q:$ZA<0  S %2=%X D CL2 G:%Z1<% SPLEX
+SPLEOF I $ZE'["ENDO" Q  ;Send error up
 SPLEX C %ZFN:(DELETE) K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q
  ;