source: 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/ZIS4ONT.m@ 1427

Last change on this file since 1427 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1%ZIS4 ;SFISC/RWF,AC - DEVICE HANDLER SPOOL SPECIFIC CODE (Cache) ;1/24/08 16:08
2 ;;8.0;KERNEL;**34,59,69,191,278,293,440**;Jul 10, 1995;Build 13
3 ;Per VHA Directive 2004-038, this routine should not be modified
4OPEN ;Called for TRM devices
5 G OPN2:$D(IO(1,IO))
6 S POP=0 D OP1 G NOPEN:'$D(IO(1,IO))
7OPN2 ;
8 I $D(%ZISHP),'$D(IOP) W !,$C(7)_" Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"")
9 Q
10NOPEN ;
11 I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q
12 I '$D(IOP) W $C(7)_" [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1
13 S POP=1 Q
14 Q
15OP1 N $ET S $ET="G OPNERR^%ZIS4"
16 I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q
17 O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1
18 Q
19OPNERR S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$ZE,$EC=""
20 Q
21 ;
22O ;Gets called for all devices
23 N X,%A1
24 D:%ZIS["L" ZIO
25 I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer port
26OPAR I $D(IOP),%ZTYPE="HFS",$D(%ZIS("HFSIO")),$D(%ZIS("IOPAR")),%ZIS("HFSIO")]"" S IO=%ZIS("HFSIO"),%ZISOPAR=%ZIS("IOPAR")
27 S %A=$S($L(%ZISOPAR):%ZISOPAR,%ZTYPE'["TRM":"",$E(%ZISIOST,1)="C":"("_+%Z91_":""C"")",$E(%ZISIOST,1,2)="PK":"("_+%Z91_":""P"")",1:+%Z91)
28 S %A=%A_$S(%A["):":"",%ZTYPE["OTH"&($P(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO),%A=""""_IO_""""_$E(":",%A]"")_%A
29 D O1 I POP W:'$D(IOP) !,?5,$C(7)_"[Device is BUSY]" Q
30 ;I %ZTYPE="HFS" U IO S X=IO,IO=IO_";"_$P($ZIO,";",2),IO(1,IO)="" K IO(1,X)
31 U IO S $X=0,$Y=0
32 I $L(%ZISUPAR) S %A1=""""_IO_""":"_%ZISUPAR U @%A1
33 ;U:%IS'[0 IO(0)
34 G OXECUTE^%ZIS6
35 ;
36O1 N $ET S $ET="G OPNERR^%ZIS4"
37 I $D(%ZISLOCK) L +@%ZISLOCK:5 E S POP=1 Q
38 O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)=""
39 S IO("ERROR")=""
40 Q
41 ;Version 3 used ip/port, Version 4 has ip:port|xx
42ZIO N %,%1 S %=$ZIO,%1=$$VERSION^%ZOSV
43 S IO("ZIO")=$S(%1<4:$I,1:$ZIO),%1=$S(%["/":"/",1:":")
44 ;Drop prefix
45 S:%["|TNT|" %=$E(%,6,999) S:%["|TNA|" %=$E(%,6,999)
46 ;Get IP name or number
47 I '$D(IO("IP")) D
48 . S:$P(%,%1)["." IO("IP")=$P(%,%1)
49 Q
50 ;
51SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file Num/Name.
52 N %ZOS S %ZOS=$$OS^%ZOSV
53 I '$D(^XMB(3.51,0)) W:'$D(IOP) !?5,"The spooler files are not setup in this account." G NO
54 I $D(ZISDA) W:'$D(IOP) !?5,$C(7)_"You may not Spool the printing of a Spool document" G NO
55 I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G NO
56 ;Get entry in Spool Doc file
57R 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"))
58 G:'%ZISB OK I '$P(%ZY,"^",3),%ZFN]"" D SPL3 G NO:%ZFN<0,DOC
59 I %ZOS="NT" D G:%ZFN>255 NO
60 . 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
61 . Q:%ZFN>255 D SPL2 S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)=""
62 I %ZOS="VMS" D G:%ZFN=-1 NO
63 . 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
64DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA
65 I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS
66OK K %ZDA,%ZFN Q
67NO K %ZDA,%ZFN,IO("DOC") S POP=1 Q
68 ;
69SPL2 I %ZOS="NT" O IO:(%ZFN:0) S IO(1,IO)="",^SPOOL(0,IO("DOC"),%ZFN)="",^SPOOL(%ZFN,0)=IO("DOC")_"{"_$H Q
70 ;VMS
71 O %ZFN:("WNS"):2 G:'$T SPL4 S IO(1,%ZFN)="" Q
72 ;
73SPL3 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
74 ;VMS
75 N $ETRAP S $ETRAP="S $EC="""" G SPL4^%ZIS4"
76 O %ZFN:"RV":1 S:'$T ZISPLQ=1 G:$ZA<0!('$T) SPL4 S IO(1,%ZFN)="" Q
77 ;
78SPL4 W:'$D(IOP) !,"Spool file already open" S %ZFN=-1 Q
79 ;
80CLOSE N %ZOS,%Z1,%ZCR,%2,%3,%X,%Y,ZTSK,%ZFN S %ZOS=$$OS^%ZOSV
81 I %ZOS="NT",IO=2,$D(IO(1,IO)) K IO(1,IO) C IO
82 I %ZOS="VMS",IO]"",$D(IO(1,IO)) U IO S %ZFN=$ZIO C IO K IO(1,IO)
83 ;See that ZTSK is set so we will move to the global now.
84 S ZTSK=$G(ZTSK,1) D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q
85 G:%ZOS="VMS" CLVMS
86 S %ZFN=$P(%ZS,"^",2),%ZCR=$C(13),%Y="",%=0,%3=$P(^SPOOL(%ZFN,2147483647),"{",3)
87 S %Z1=+$G(^XTV(8989.3,1,"SPL"))
88 F %2=1:1:%3 Q:'$D(^SPOOL(%ZFN,%2)) S %X=^SPOOL(%ZFN,%2) D
89 . I %Z1<% D LIMIT S %2=%3 Q
90 . I %X[$C(13,12) D:$L($P(%X,$C(13))) ADD($P(%X,$C(13))) D ADD("|TOP|") Q
91 . D ADD($P(%X,$C(13),1))
92 K ^SPOOL(%ZFN),^SPOOL(0,$P(%ZS,U,1)),%Y,%X,%1,%2,%3 D CLOSE^ZISPL1
93 Q
94ADD(L) S %=%+1,^XMBS(3.519,XS,2,%,0)=L Q
95LIMIT D ADD("*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***") S $P(^XMB(3.51,%ZDA,0),"^",11)=1
96 Q
97CLVMS ;Close for Cache VMS
98 N $ES,$ET S $ET="D:$EC'[""ENDOF"" ^%ZTER,UNWIND^%ZTER S $EC="""" D SPLEX^%ZIS4,UNWIND^%ZTER"
99 S %ZA=$ZU(68,40,1) ;Work like DSM
100 ;%ZFN Could be set at the top
101 S %ZFN=$S($G(%ZFN)]"":%ZFN,1:$P(%ZS,"^",2)) D SPL3 Q:%ZFN']"" U %ZFN S %ZCR=$C(13),%Y=""
102 S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0
103 F R %X#255:5 Q:$ZEOF<0 D G:%Z1<% SPLEX
104 . I %Z1<% D LIMIT Q
105 . I %X[$C(12) D Q
106 . . S %Y=$P(%X,$C(12)) D:$L(%Y) ADD(%Y),ADD("|TOP|")
107 . . S %Y=$P(%X,$C(12),2) D:$L(%Y) ADD(%Y)
108 . . Q
109 . D ADD(%X)
110 . Q
111SPLEX C %ZFN:"D" K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q
112 ;
113 ;
114HFS G HFS^%ZISF
115REWMT(IO2,IOPAR) ;Rewind Magtape
116 N $ETRAP S $ET="G REWERR^%ZIS4"
117 U IO2 W *5
118 Q 1
119REWSDP(IO2,IOPAR) ;Rewind SDP
120 G REW1
121REWHFS(IO2,IOPAR) ;Rewind Host File.
122REW1 ;ZIS set % to the current $I so need to update % if = IO
123 N NIO,OP,$ETRAP
124 S $ET="G REWERR^%ZIS4"
125 C IO2 ;You do a rewind to read the file.
126 S OP=$S($ZV["VMS":"RV",1:"RS")
127 O IO2:(OP):1 S IO(1,IO2)=""
128 Q 1
129REWERR ;Error encountered
130 S IO("ERROR")=$EC,$ECODE=""
131 Q 0
Note: See TracBrowser for help on using the repository browser.