%ZIS4 ;SF/GFT,RWF,MVB - DEVICE HANDLER SPOOL SPECIFIC CODE(MSM) ;02/11/97 11:02 [ 04/02/2003 8:29 AM ]
;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003
;;8.0;KERNEL;**23,36,49,59**;JUL 03, 1995
;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/HQW/JLB 2/16/99
;
OPEN G OPN2:$D(IO(1,IO))
S POP=0 D OP1 S:'POP IO(1,IO)="" G NOPEN:'$D(IO(1,IO))
OPN2 I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"")
Q
NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q
I '$D(IOP) W *7," [BUSY]" W " ... RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1
S POP=1 Q
Q
OP1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
L:$D(%ZISLOCK) +@%ZISLOCK:60
O IO::%ZISTO S:'$T POP=1 L:$D(%ZISLOCK) -@%ZISLOCK Q
OPNERR S POP=1,IO("ERROR")=$ZE,IO("LASTERR")=$ZE Q
;
O I $P($ZV,"Version ",2)'<3 D:%IS["L" ZIO
;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8.
OPRTPORT 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")
S %A=$S(%ZISOPAR]"":%ZISOPAR,%ZTYPE["TRM":+%Z91,1:"")
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,*7,"[DEVICE IS BUSY]" Q
S IO(1,IO)=""
I %ZTYPE="HFS" D Q:POP
.N % S %=$I
.U IO S:$ZA<0 POP=1
.U:'$D(ZTQUEUED) % I POP C:IO]"" IO K:IO]"" IO(1,IO)
.I POP,'$D(IOP),'$D(ZTQUEUED) W !,?5,*7,"[FILE NOT FOUND]" Q
N DX,DY S (DX,DY)=0
U IO X:$D(^%ZOSF("XY"))&'(IO=IO(0)&'$D(ZTQUEUED)&'$D(IO("S"))) ^("XY")
I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1
U:%IS'[0 IO(0)
G OXECUTE^%ZIS6
;
O1 N X S X="OPNERR^%ZIS4",@^%ZOSF("TRAP")
L:$D(%ZISLOCK) +@%ZISLOCK:60
O @%A S:'$T&(%A?.E1":".N) POP=1 L:$D(%ZISLOCK) -@%ZISLOCK
S IO("ERROR")="" Q
;
ZIO N % S (IO("ZIO"),%)=$ZDEV($I),%=$S(%?1.3N1P.E:$TR(%,"~",":"),1:%)
S:(%?1.3N1P1.3N1P.E)&'$D(IO("IP")) IO("IP")=$TR(%,"~",":") S:(%?1A.ANP1"~"1.4N)&'$D(IO("CLNM")) IO("CLNM")=$TR($$LOW^%ZIS1(%),"~",":")
Q
;
SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name.
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
S ZOSFV=($P($ZV,"Version ",2)'<2)
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) I '%ZISB!$D(IO("Q")) S:'ZOSFV IO=51 G OK
I '$P(%ZY,"^",3),%ZFN D SPL3 G N:'%ZFN,DOC
S %ZFN=-1 D SPL2 G:%ZFN<0 N S $P(^XMB(3.51,%ZDA,0),U,2)=%ZFN,^XMB(3.51,"C",%ZFN,%ZDA)=""
DOC S IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#"
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
N K %ZDA,%ZFN,IO("DOC") S POP=1 Q
;
SPL2 O 2:1 G SPL5:$ZA<0,SPL5:$ZC S %ZFN=$ZA#256 S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q
;
SPL3 Q:$D(IO(1,2))#2 O 2:%ZFN+256 G:$ZA<0 SPL5:$ZA<0,SPL5:$ZC S IO(1,2)="",IO(1,2,"%ZFN")=%ZFN Q
SPL4 E G SPL5
;U IO S %ZA=$ZA U:%IS'[0 IO(0) I %ZA<0 G SPL5
Q
SPL5 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN=-1 Q
;
CLOSE N %Z1 S ZOSFV=($P($ZV,"Version ",2)'<2)
C 2 K IO(1,2)
D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q
S %Z1=+$G(^XTV(8989.3,1,"SPL"))
S IO=2,%ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN'>0 U IO S %ZCR=$C(13),%Y=""
G V2CL1^%ZOSV
Q ;Send error up
CL2 I %Z1<(%+1) S %=%+1,^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q
I %2[$C(12) S %=%+1,^XMBS(3.519,XMZ,2,%,0)="|TOP|"
S %=%+1,^XMBS(3.519,XMZ,2,%,0)=%2 Q
;
HFS G HFS^%ZISF
REWMT(IO,IOPAR) ;Rewind Magtape
S X="REWERR^%ZIS4",@^%ZOSF("TRAP")
U IO W *5
Q 1
REWSDP(IO,IOPAR) ;Rewind Sequential Block Processor
S X="REWERR^%ZIS4",@^%ZOSF("TRAP")
U IO:IOPAR
Q 1
REWHFS(IO,IOPAR) ;Rewind Host File.
REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP")
; IHS/HQW/JLB 2/16/99 As of MSM 4.4 the original line from VA works
;N FILENAME ;IHS/ANMC/FBD-2/19/97-ADDED LINE-SUPPORT FOR ADDITION 2 LINES BELOW IHS/HQW/JLB 2/16/99 uncomment for MSM 4.3 and below
U IO:(::0) ;IHS/ANMC/FBD-2/19/97-ORIGINAL LINE-COMMENTED OUT IHS/HQW/JLB 2/16/99 comment out for MSM 4.3 and below
;U IO I $$^%FINDFN(.FILENAME) C IO O IO:(FILENAME:"M") ;IHS/ANMC/FBD-2/ LINE-WORKAROUND TO MSM NO-REWIND PROBLEM IHS/HQW/JLB uncomment for MSM 4.3 and below
Q 1
REWERR ;Error encountered.
Q 0
%ZIS4 ;SF/GFT,RWF,MVB - DEVICE HANDLER SPOOL SPECIFIC CODE(MSM) ;02/11/97 11:02 [ 04/02/2003 8:29 AM ]
+1 ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003
+2 ;;8.0;KERNEL;**23,36,49,59**;JUL 03, 1995
+3 ;THIS ROUTINE CONTAINS AN IHS MODIFICATION BY IHS/HQW/JLB 2/16/99
+4 ;
OPEN IF $DATA(IO(1,IO))
GOTO OPN2
+1 SET POP=0
DO OP1
IF 'POP
SET IO(1,IO)=""
IF '$DATA(IO(1,IO))
GOTO NOPEN
OPN2 IF $DATA(%ZISHP)
IF '$DATA(IOP)
WRITE !,*7," Routing to device "_$PIECE(^%ZIS(1,%E,0),"^",1)_$SELECT($DATA(^(1)):" "_$PIECE(^(1),"^",1)_" ",1:"")
+1 QUIT
NOPEN IF %IS'["D"
IF $DATA(%ZISHP)!(%ZISHG]"")
SET POP=1
QUIT
+1 IF '$DATA(IOP)
WRITE *7," [BUSY]"
WRITE " ... RETRY"
SET %=2
SET U="^"
DO YN^%ZIS1
IF %=1
GOTO OPEN
+2 SET POP=1
QUIT
+3 QUIT
OP1 NEW X
SET X="OPNERR^%ZIS4"
SET @^%ZOSF("TRAP")
+1 IF $DATA(%ZISLOCK)
LOCK +@%ZISLOCK:60
+2 OPEN IO::%ZISTO
IF '$TEST
SET POP=1
IF $DATA(%ZISLOCK)
LOCK -@%ZISLOCK
QUIT
OPNERR SET POP=1
SET IO("ERROR")=$ZE
SET IO("LASTERR")=$ZE
QUIT
+1 ;
O IF $PIECE($ZV,"Version ",2)'<3
IF %IS["L"
DO ZIO
+1 ;D:$D(%ZISIOS) ZISLPC^%ZIS Q:'%ZISB ;No longer called in Kernel v8.
OPRTPORT IF $DATA(IO("S"))
IF $DATA(^%ZIS(2,IO("S"),10))
IF ^(10)]""
USE IO(0)
DO X10^ZISX
OPAR IF $DATA(IOP)
IF %ZTYPE="HFS"
IF $DATA(%IS("HFSIO"))
IF $DATA(%IS("IOPAR"))
IF %IS("HFSIO")]""
SET IO=%IS("HFSIO")
SET %ZISOPAR=%IS("IOPAR")
+1 SET %A=$SELECT(%ZISOPAR]"":%ZISOPAR,%ZTYPE["TRM":+%Z91,1:"")
+2 SET %A=%A_$SELECT(%A["):":"",%ZTYPE["OTH"&($PIECE(%ZTIME,"^",3)="n"):"",1:":"_%ZISTO)
SET %A=""""_IO_""""_$EXTRACT(":",%A]"")_%A
+3 DO O1
IF POP
IF '$DATA(IOP)
WRITE !,?5,*7,"[DEVICE IS BUSY]"
QUIT
+4 SET IO(1,IO)=""
+5 IF %ZTYPE="HFS"
Begin DoDot:1
+6 NEW %
SET %=$IO
+7 USE IO
IF $ZA<0
SET POP=1
+8 IF '$DATA(ZTQUEUED)
USE %
IF POP
IF IO]""
CLOSE IO
IF IO]""
KILL IO(1,IO)
+9 IF POP
IF '$DATA(IOP)
IF '$DATA(ZTQUEUED)
WRITE !,?5,*7,"[FILE NOT FOUND]"
QUIT
End DoDot:1
IF POP
QUIT
+10 NEW DX,DY
SET (DX,DY)=0
+11 USE IO
IF $DATA(^%ZOSF("XY"))&'(IO=IO(0)&'$DATA(ZTQUEUED)&'$DATA(IO("S")))
XECUTE ^("XY")
+12 IF %ZISUPAR]""
SET %A1=""""_IO_""":"_%ZISUPAR
USE @%A1
+13 IF %IS'[0
USE IO(0)
+14 GOTO OXECUTE^%ZIS6
+15 ;
O1 NEW X
SET X="OPNERR^%ZIS4"
SET @^%ZOSF("TRAP")
+1 IF $DATA(%ZISLOCK)
LOCK +@%ZISLOCK:60
+2 OPEN @%A
IF '$TEST&(%A?.E1"
SET POP=1
IF $DATA(%ZISLOCK)
LOCK -@%ZISLOCK
+3 SET IO("ERROR")=""
QUIT
+4 ;
ZIO NEW %
SET (IO("ZIO"),%)=$ZDEV($IO)
SET %=$SELECT(%?1.3N1P.E:$TRANSLATE(%,"~",":"),1:%)
+1 IF (%?1.3N1P1.3N1P.E)&'$DATA(IO("IP"))
SET IO("IP")=$TRANSLATE(%,"~",":")
IF (%?1A.ANP1"~"1.4N)&'$DATA(IO("CLNM"))
SET IO("CLNM")=$TRANSLATE($$LOW^%ZIS1(%),"~",":")
+2 QUIT
+3 ;
SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name.
+1 IF $DATA(ZISDA)
IF '$DATA(IOP)
WRITE !?5,*7,"You may not Spool the printing of a Spool document"
GOTO N
+2 IF $DATA(DUZ)[0
IF '$DATA(IOP)
WRITE !,"Must be a valid user."
GOTO N
+3 SET ZOSFV=($PIECE($ZV,"Version ",2)'<2)
R SET %ZY=-1
DO NEWDOC^ZISPL1
IF %ZY'>0
GOTO N
SET %ZDA=+%ZY
SET %ZFN=$PIECE(%ZY(0),U,2)
SET IO("DOC")=$PIECE(%ZY(0),U,1)
IF '%ZISB!$DATA(IO("Q"))
IF 'ZOSFV
SET IO=51
GOTO OK
+1 IF '$PIECE(%ZY,"^",3)
IF %ZFN
DO SPL3
IF '%ZFN
GOTO N
GOTO DOC
+2 SET %ZFN=-1
DO SPL2
IF %ZFN<0
GOTO N
SET $PIECE(^XMB(3.51,%ZDA,0),U,2)=%ZFN
SET ^XMB(3.51,"C",%ZFN,%ZDA)=""
DOC SET IO("SPOOL")=%ZDA
SET ^XUTL("XQ",$JOB,"SPOOL")=%ZDA
SET IOF="#"
+1 IF $DATA(^%ZIS(1,%ZISIOS,1))
IF $PIECE(^(1),"^",8)
IF $ORDER(^("SPL",0))
SET ^XUTL("XQ",$JOB,"ADSPL")=%ZISIOS
SET ZISPLAD=%ZISIOS
OK KILL %ZDA,%ZFN
QUIT
N KILL %ZDA,%ZFN,IO("DOC")
SET POP=1
QUIT
+1 ;
SPL2 OPEN 2:1
IF $ZA<0
GOTO SPL5
IF $ZC
GOTO SPL5
SET %ZFN=$ZA#256
SET IO(1,2)=""
SET IO(1,2,"%ZFN")=%ZFN
QUIT
+1 ;
SPL3 IF $DATA(IO(1,2))#2
QUIT
OPEN 2:%ZFN+256
IF $ZA<0
IF $ZA<0
GOTO SPL5
IF $ZC
GOTO SPL5
SET IO(1,2)=""
SET IO(1,2,"%ZFN")=%ZFN
QUIT
SPL4 IF '$TEST
GOTO SPL5
+1 ;U IO S %ZA=$ZA U:%IS'[0 IO(0) I %ZA<0 G SPL5
+2 QUIT
SPL5 IF '$DATA(IOP)&'$DATA(ZTQUEUED)
WRITE !?5,*7,"Couldn't open the spool file."
SET %ZFN=-1
QUIT
+1 ;
CLOSE NEW %Z1
SET ZOSFV=($PIECE($ZV,"Version ",2)'<2)
+1 CLOSE 2
KILL IO(1,2)
+2 DO FILE^ZISPL1
IF %ZDA'>0
KILL ZISPLAD
QUIT
+3 SET %Z1=+$GET(^XTV(8989.3,1,"SPL"))
+4 SET IO=2
SET %ZFN=$PIECE(%ZS,"^",2)
DO SPL3
IF %ZFN'>0
QUIT
USE IO
SET %ZCR=$CHAR(13)
SET %Y=""
+5 GOTO V2CL1^%ZOSV
+6 ;Send error up
QUIT
CL2 IF %Z1<(%+1)
SET %=%+1
SET ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***"
SET $PIECE(^XMB(3.51,%ZDA,0),"^",11)=1
QUIT
+1 IF %2[$CHAR(12)
SET %=%+1
SET ^XMBS(3.519,XMZ,2,%,0)="|TOP|"
+2 SET %=%+1
SET ^XMBS(3.519,XMZ,2,%,0)=%2
QUIT
+3 ;
HFS GOTO HFS^%ZISF
REWMT(IO,IOPAR) ;Rewind Magtape
+1 SET X="REWERR^%ZIS4"
SET @^%ZOSF("TRAP")
+2 USE IO
WRITE *5
+3 QUIT 1
REWSDP(IO,IOPAR) ;Rewind Sequential Block Processor
+1 SET X="REWERR^%ZIS4"
SET @^%ZOSF("TRAP")
+2 USE IO:IOPAR
+3 QUIT 1
REWHFS(IO,IOPAR) ;Rewind Host File.
REW1 SET X="REWERR^%ZIS4"
SET @^%ZOSF("TRAP")
+1 ; IHS/HQW/JLB 2/16/99 As of MSM 4.4 the original line from VA works
+2 ;N FILENAME ;IHS/ANMC/FBD-2/19/97-ADDED LINE-SUPPORT FOR ADDITION 2 LINES BELOW IHS/HQW/JLB 2/16/99 uncomment for MSM 4.3 and below
+3 ;IHS/ANMC/FBD-2/19/97-ORIGINAL LINE-COMMENTED OUT IHS/HQW/JLB 2/16/99 comment out for MSM 4.3 and below
USE IO:(::0)
+4 ;U IO I $$^%FINDFN(.FILENAME) C IO O IO:(FILENAME:"M") ;IHS/ANMC/FBD-2/ LINE-WORKAROUND TO MSM NO-REWIND PROBLEM IHS/HQW/JLB uncomment for MSM 4.3 and below
+5 QUIT 1
REWERR ;Error encountered.
+1 QUIT 0
