Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ZIS4GTM

ZIS4GTM.m

Go to the documentation of this file.
  1. %ZIS4 ;ISF/RWF,DW - DEVICE HANDLER SPECIFIC CODE (GT.M for Unix/VMS) ;05/29/2008
  1.  ;;8.0;KERNEL;**275,425,440,499**;Jul 10, 1995;Build 24
  1.  ;Per VHA Directive 2004-038, this routine should not be modified
  1. OPEN ;From %ZIS3 for TRM
  1.  G OPN2:$D(IO(1,IO))
  1.  S POP=0 D OP1 G NOPEN:'$D(IO(1,IO))
  1. OPN2 ;
  1.  I $D(%ZISHP),'$D(IOP) W !,*7," Routing to device "_$P(^%ZIS(1,%E,0),"^",1)_$S($D(^(1)):" "_$P(^(1),"^",1)_" ",1:"")
  1.  Q
  1. NOPEN I %IS'["D",$D(%ZISHP)!(%ZISHG]"") S POP=1 Q
  1.  I '$D(IOP) W *7,"  [BUSY]" W "  ...  RETRY" S %=2,U="^" D YN^%ZIS1 G OPEN:%=1
  1.  S POP=1 Q
  1.  Q
  1.  ;Why no open paraneters???
  1. OP1 N $ET S $ET="G OPNERR^%ZIS4"
  1.  I $D(%ZISLOCK) L +@%ZISLOCK:5 E  S POP=1 Q
  1.  O IO::%ZISTO S:$T IO(1,IO)="" S:'$T POP=1
  1.  Q
  1. OPNERR ;Open Error
  1.  S POP=1,IO("LASTERR")=$G(IO("ERROR")),IO("ERROR")=$$EC^%ZOSV,$EC=""
  1.  Q
  1.  ;
  1. O ;From %ZIS6 for all types.
  1.  D:%IS["L" ZIO
  1.  I $D(IO("S")),$D(^%ZIS(2,IO("S"),10)),^(10)]"" U IO(0) D X10^ZISX ;Open Printer Port
  1. OPAR I $D(IOP),%ZTYPE="HFS",$D(%IS("HFSIO")),$D(%IS("IOPAR")),%IS("HFSIO")]"" S IO=%IS("HFSIO"),%ZISOPAR=%IS("IOPAR")
  1.  I %ZTYPE="CHAN" D TCPIP Q:POP  G OXECUTE^%ZIS6
  1.  S %A=%ZISOPAR_$S(%ZISOPAR["):":"",1:":"_%ZISTO)
  1.  N % S %(IO)="",%=$P($P($NA(%(IO)),"(",2),")")
  1.  S %A=%_$E(":",%A]"")_%A
  1.  D O1 I POP D  Q
  1.  .I %ZTYPE="HFS",'$D(IOP),$G(IO("ERROR"))["file not found" W !,?5,*7,"[File Not Found]" Q
  1.  .W:'$D(IOP) !,?5,*7,"[DEVICE IS BUSY]" Q
  1.  ;S IO(1,IO)="" U IO S:'(IO=IO(0)&'$D(IO("S"))&'$D(ZTQUEUED)) $X=0,$Y=0 I %ZTYPE["TRM" U IO:(WIDTH=+%Z91)
  1.  U IO S $X=0,$Y=0 I %ZTYPE["TRM" U IO:(WIDTH=+%Z91)
  1.  I %ZISUPAR]"" S %A1=""""_IO_""":"_%ZISUPAR U @%A1
  1.  ;U:%IS'[0 IO(0)
  1.  G OXECUTE^%ZIS6
  1.  ;
  1. O1 N $ES,$ET S $ET="G OPNERR^%ZIS4"
  1.  I $D(%ZISLOCK) L +@%ZISLOCK:5 E  S POP=1 Q
  1.  O @%A S:'$T&(%A?.E1":".N) POP=1 S:'POP IO(1,IO)=""
  1.  S IO("ERROR")="" Q
  1.  ;
  1.  ;Need to find out how to get IP address
  1. ZIO N %,%1 S (%,%1)=$ZIO
  1.  I $ZV["VMS",%["_TNA" D
  1.  . S (%,%1)=$ZGETDVI($I,"TT_ACCPORNAM")
  1.  . S %=$S(%["Host:":$P($P(%,"Host: ",2)," ")_":"_$P(%,"Port: ",2),1:%) S:%[" " %=$TR(%," ")
  1.  I $ZV'["VMS" D
  1.  . S (%,%1)=$ZTRNLNM("REMOTEHOST") S:$L(%) %1="Host:"_% S:'$L(%) %=$ZIO
  1.  . S:%1'["Host" %1=$ZTRNLNM("SSH_CLIENT") S:$L(%1) %1="Host:"_$P(%1," ")
  1.  S IO("ZIO")=% S:(%1["Host:")&'$D(IO("IP")) IO("IP")=$P(%1,":",2)
  1.  Q
  1.  ;
  1. TCPIP ;For TCP/IP devices, should use ^%ZISTCP
  1.  N %S
  1.  S %ZISTO=$G(%ZISTO,3)
  1.  S %A="IO:"_$S($E(%ZISOPAR)="(":"",1:"(")_%ZISOPAR_$S($E(%ZISOPAR,$L(%ZISOPAR))=")":"",1:")")_":%ZISTO:""SOCKET"""
  1.  ;U $P W !,"%A=",%A
  1.  O @%A I '$T S POP=1 Q  ;D O1 ;Do the open.
  1.  U IO:(WIDTH=512:NOWRAP:EXCEPT="G OPNERR^%ZIS4") S %S=$KEY
  1.  U $P ;W !,"$KEY=",%S
  1.  Q
  1.  ;
  1. SPOOL ;%ZDA=pointer to ^XMB(3.51, %ZFN=spool file name.
  1.  I $D(ZISDA) W:'$D(IOP) !?5,*7,"You may not Spool the printing of a Spool document" G N
  1.  I $D(DUZ)[0 W:'$D(IOP) !,"Must be a valid user." G N
  1. R S %ZY=-1 D NEWDOC^ZISPL1 G N:%ZY'>0
  1.  S %ZDA=+%ZY,%ZFN=$P(%ZY(0),U,2),IO("DOC")=$P(%ZY(0),U,1) G OK:$D(IO("Q"))
  1.  G:'%ZISB OK I '$P(%ZY,"^",3),$L(%ZFN) O %ZFN:(append:nowrap):2 G DOC
  1.  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)=""
  1. DOC S IO=%ZFN,IO("SPOOL")=%ZDA,^XUTL("XQ",$J,"SPOOL")=%ZDA,IOF="#"
  1.  I $D(^%ZIS(1,%ZISIOS,1)),$P(^(1),"^",8),$O(^("SPL",0)) S ^XUTL("XQ",$J,"ADSPL")=%ZISIOS,ZISPLAD=%ZISIOS
  1. OK K %ZDA,%ZFN Q
  1. N K %ZDA,%ZFN,IO("DOC") S POP=1 Q
  1.  ;
  1. SPL2 ;Open for write
  1.  O %ZFN:(newversion:noreadonly:nowrap:exception="G SPL4"):2 G:$ZA<0 SPL4 S IO(1,%ZFN)="" Q
  1.  ;
  1. SPL3 ;Open for Read
  1.  O %ZFN:(readonly:exception="G SPL4"):2 S:'$T ZISPLQ=1 G:'$T SPL4 S IO(1,%ZFN)="" Q
  1. SPL4 W:'$D(IOP)&'$D(ZTQUEUED) !?5,*7,"Couldn't open the spool file." S %ZFN="" Q
  1.  ;
  1. CLOSE ;Close out the spool
  1.  N %,%1,%Z1,%ZFN,%ZS,%ZDA,XS,%Y,%X
  1.  I $L(IO) C IO K IO(1,IO)
  1.  D FILE^ZISPL1 I %ZDA'>0 K ZISPLAD Q
  1.  S %ZFN=$P(%ZS,"^",2) D SPL3 Q:%ZFN']""  S %ZCR=$C(13),%Y=""
  1.  S %Z1=+$G(^XTV(8989.3,1,"SPL")),%=0
  1.  U %ZFN F  R %X#255:5 Q:$ZEOF  S %2=%X D CL2 Q:%Z1<%
  1. SPLEX C %ZFN:(DELETE) K:%ZFN]"" IO(1,%ZFN) D CLOSE^ZISPL1 K %Y,%X,%1,%ZFN Q
  1.  ;
  1. CL2 S %=%+1 I %Z1<% S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT  -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q
  1.  I %2[$C(12) S ^XMBS(3.519,XS,2,%,0)="|TOP|" Q
  1.  S ^XMBS(3.519,XS,2,%,0)=%2 Q
  1.  ;
  1. HFS G HFS^%ZISF
  1. REWMT(IO,IOPAR) ;Rewind Magtape
  1.  S X="REWERR^%ZIS4",@^%ZOSF("TRAP")
  1.  U IO W *5
  1.  Q 1
  1. REWSDP(IO,IOPAR) ;Rewind SDP
  1.  G REW1
  1. REWHFS(IO,IOPAR) ;Rewind Host File.
  1. REW1 S X="REWERR^%ZIS4",@^%ZOSF("TRAP")
  1.  U IO:(REWIND)
  1.  Q 1
  1. REWERR ;Error encountered
  1.  Q 0