Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

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

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