Routine: ZIS4ONT

%ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (Cache) ;06/16/14  13:23

 ;;8.0;KERNEL;**34,59,69,191,278,293,440,499,524,546,543,584,638**;Jul 10, 1995;Build 15

 ;Per VA Directive 6402, this routine should not be modified.

OPEN ;Called for TRM devices

 G OPN2:$D(IO(1,IO))

 S POP=0 D OP1 G NOPEN:'$D(IO(1,IO))

OPN2 ;

 I $D(%ZISHP),'$D(IOP) W !,$C(7)_" Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"")

NOPEN ;

 I %ZIS'["D",$D(%ZISHP) S POP=1 Q

 I '$D(IOP) W $C(7)_"  [BUSY]" W "  ...  RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1

 S POP=1 Q

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

OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC=""

O ;Gets called for all devices

 N X,%A1

 D:%ZIS["L" ZIO

 I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port

OPAR I $D(IOP),%ZTYPE="HFS",$D(%ZIS("HFSIO")),$D(%ZIS("IOPAR")),%ZIS("HFSIO")]"" S IO=%ZIS("HFSIO"),%ZISOPAR=%ZIS("IOPAR")

 S %A=$S($L(%ZISOPAR):%ZISOPAR,%ZTYPE'["TRM":"",$E(%ZISIOST,1)="C":"("_+%Z91_":""C"")",$E(%ZISIOST,1,2)="PK":"("_+%Z91_":""P"")",1:+%Z91)

 S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A

 D O1 I POP W:'$D(IOP) !,?5,$C(7)_"[Device is BUSY]" Q

 U IO S $X=0,$Y=0

 I $L(%ZISUPAR) S %A1=""""_IO_""":"_%ZISUPAR U @%A1

 G OXECUTE^%ZIS6

O1 N $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)=""

 S IO("ERROR")=""

ZIO  ;Obtain Client IP and Node Name if available

 I $D(IO("IP")),$D(IO("ZIO")) Q  ;p499,p524

 N PROCESS

 S IO("ZIO")=$ZIO

 ;Get IP name or number

 I $$OS^%ZOSV="VMS",$G(IO("IP"))="" S IO("IP")=$P($ZF("TRNLNM","SYS$REM_NODE"),":") ;For SSH, p499

 I $$OS^%ZOSV="UNIX",$G(IO("IP"))="" S IO("IP")=$P($SYSTEM.Util.GetEnviron("SSH_CLIENT")," ") ;For SSH, p543

 S PROCESS=##class(%SYS.ProcessQuery).%OpenId($J)

 I ('$L($G(IO("IP"))))&(PROCESS'="") D

 . S IO("IP")=PROCESS.ClientIPAddress ; last resort, get IP address from current process

 . S IO("CLNM")=PROCESS.ClientNodeName

 I '$L($G(IO("ZIO"))) S IO("ZIO")=$G(IO("IP"))

SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file Num/Name.

 N %ZOS S %ZOS=$$OS^%ZOSV

 I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G NO

 I $D(ZISDA) W:'$D(IOP) !?5,$C(7)_"You may not Spool the printing of a Spool document" G NO

 I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G NO

 ;Get entry in Spool Doc file

R S %ZY=-1 D NEWDOC^ZISPL1:$D(DUZ)=11 G NO:%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 NO:%ZFN<0,DOC

 I %ZOS="NT" D  G:%ZFN>255 NO

 . F %ZFN=1:1:260 I '$D(^XMB(3.51,"C",%ZFN))!$D(^(%ZFN,%ZDA)) Q:%ZFN<256  W:'$D(IOP) $C(7)_"  DELETE SOME OTHER DOCUMENT!" Q

 . Q:%ZFN>255  D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)=""

 I %ZOS'="NT" D  G:%ZFN=-1 NO ;For VMS & UNIT p546

 . S %ZFN=IO_"SPOOL_no_"_%ZDA_".TMP" D SPL2 Q:%ZFN=-1  S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)="",IO=%ZFN

DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA

 I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS

OK K %ZDA,%ZFN Q

NO K %ZDA,%ZFN,IO("DOC") S POP=1 Q

SPL2 ;Open for output

 I %ZOS="NT" O IO:(%ZFN:0) S IO(1,IO)="",^SPOOL(0,IO("DOC"),%ZFN)="",^SPOOL(%ZFN,0)=IO("DOC")_"{"_$H Q

 ;VMS

 O %ZFN:("WNS"):2 G:'$T SPL4 S IO(1,%ZFN)="" Q

SPL3 ;Open to read

 I %ZOS="NT" G SPL4:'$D(^SPOOL(%ZFN,2147483647)) O IO:(%ZFN:$P(^(2147483647),"{",3)):1 S:'$T ZISPLQ=1 K ^(2147483647) S IO(1,IO)="" Q

 ;VMS

 N $ETRAP S $ETRAP="S $EC="""" G SPL4^%ZIS4"

 O %ZFN:"R":1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q

SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q

CLOSE ;Handle Close and copy to Global

 N %,%ZOS,%Z1,%ZCR,%2,%3,%X,%Y,ZTSK,%ZFN S %ZOS=$$OS^%ZOSV

 I %ZOS="NT",IO=2,$D(IO(1,IO)) K IO(1,IO) C IO

 I %ZOS="VMS",$L(IO),$D(IO(1,IO)) U IO S %ZFN=$ZIO C IO K IO(1,IO)

 I %ZOS="UNIX",$L(IO),$D(IO(1,IO)) C IO K IO(1,IO)

 ;See that ZTSK is set so we will move to the global now.

 S ZTSK=$G(ZTSK,1) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q

 G:%ZOS'="NT" CLVMS ;p546

 S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3)

 S %Z1=+$G(^XTV(8989.3,1,"SPL"))

 F %2=1:1:%3 Q:'$D(^SPOOL(%ZFN,%2))  S %X=^SPOOL(%ZFN,%2) D

 . I %Z1<% D LIMIT S %2=%3 Q

 . I %X[$C(13,12) D:$L($P(%X,$C(13))) ADD($P(%X,$C(13))) D ADD("|TOP|") Q

 . D ADD($P(%X,$C(13),1))

 K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1

ADD(L) S %=%+1,^XMBS(3.519,XS,2,%,0)=L

LIMIT D ADD("*** INCOMPLETE REPORT  -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***") S $P(^XMB(3.51,%ZDA,0),"^",11)=1

CLVMS ;Close for Cache VMS & Linux

 N $ES,$ET S $ET="D:$EC'[""ENDOF"" ^%ZTER,UNWIND^%ZTER S $EC="""" D SPLEX^%ZIS4,UNWIND^%ZTER"

 ;Check Cache version, if 2008 use $ZU, else use system object

 I '$G(XUOSVER) N XUOSVER S XUOSVER=$$VERSION^%ZOSV

 S %ZA=$S(XUOSVER<2010:$ZU(68,40,1),1:##class(%SYSTEM.Process).SetZEOF(1)) ;Handle EOF like DSM

 ;%ZFN Could be set at the top

 S %ZFN=$S($G(%ZFN)]"":%ZFN,1:$P(%ZS,"^",2)) D SPL3 Q:%ZFN']""  U %ZFN S %ZCR=$C(13),%Y=""

 S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0

 F  R %X#255:5 Q:$ZEOF<0  D  G:%Z1<% SPLEX

 . I %Z1<% D LIMIT Q

 . I %X[$C(12) D  Q

 . . S %Y=$P(%X,$C(12)) D:$L(%Y) ADD(%Y),ADD("|TOP|")

 . . S %Y=$P(%X,$C(12),2) D:$L(%Y) ADD(%Y)

 . . Q

 . D ADD(%X)

. Q

SPLEX C %ZFN:"D" K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q

HFS G HFS^%ZISF

REWMT(IO2,IOPAR) ;Rewind Magtape

 N $ETRAP S $ET="G REWERR^%ZIS4"

 U IO2 W *5

Q 1

REWSDP(IO2,IOPAR) ;Rewind SDP

 G REW1

REWHFS(IO2,IOPAR) ;Rewind Host File.

REW1 ;ZIS set % to the current $I so need to update % if = IO

 N NIO,OP,$ETRAP

 S $ET="G REWERR^%ZIS4"

 C IO2 ;You do a rewind to read the file.

 S OP=$S($ZV["VMS":"RV",1:"RS")

 O IO2:(OP):1 S IO(1,IO2)=""

Q 1

REWERR ;Error encountered

 S IO("ERROR")=$EC,$ECODE=""

Q 0

ZIS4ONT.m