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

ZISHMNT.m

Go to the documentation of this file. 
  1. %ZISH ;IHS\PR,SFISC/AC - Host File Control for MSM ;05/21/98  11:17 [ 05/01/2003  12:51 PM ]
  1.  ;;8.0;KERNEL;**1005,1006,1007,1008**;APR 1, 2003 
  1.  ;;8.0;KERNEL;**24,36,49,65,84**;JUL 10, 1995
  1.  ;THIS ROUTINE CONTAINS IHS MODIFICATIONS BY IHS/ANMC/LJF 6/1/98; IHS/HQW/JLB 2/16/99; IHS/OKCAO/POC 1/22/99; IHS/AAO/RPL 4/14/99; IHS/ANMC/LJF 2/19/97; IHS/MFD; IHS/OKCAO/POC 1/25/99; IHS/OIRM/DSD/AEF/02/19/03
  1.  ;THIS IS ROUTINE ZISHMNT
  1.  ;
  1. OPEN(X1,X2,X3,X4,X5)    ;SR. Open Host File
  1.  I '$D(X4) Q $$OPEN^ZISHMSMD(X1,X2,X3); IHS/ANMC/LJF 6/1/98
  1.  ;X1=handle name
  1.  ;X2=directory name \dir\
  1.  ;X3=file name
  1.  ;X4=file access mode e.g.: W for write, R for read, A for append, B for block.
  1.  ;X5=Max record size for a new file
  1.  N %,%1,%2,%I,%P1,%P2,%P6,%T,%ZA,%ZISHIO
  1.  S %I=$I,%T=0,POP=0,X2=$$DEFDIR($G(X2)),%Q=$C(34) M %ZISHIO=IO
  1.  S %P2=$S(X4["RW":"RW",X4["W":"W",X4["N":"W",X4["A":"A",1:"R")
  1.  S %P1=X2_X3,%P6=$S(X4["B":%Q_%Q,1:$C(13,10))
  1.  F %2=51:1:54 I '$D(IO(1,%2)) O %2:(%P1:%P2::::%P6):0 I $T S %T=%2 Q
  1.  I '%T S POP=1 Q
  1.  ;S %1=$$MODE^%ZISF(X2_X3,X4)
  1.  U %2 S %ZA=$ZA
  1.  I %ZA=-1 U:%I]"" %I C %2 S POP=1 Q
  1.  S IO=%2,IO(1,IO)="",IOT="HFS",POP=0
  1.  I $G(X1)]"" D SAVDEV^%ZISUTL(X1)
  1.  Q
  1.  ;
  1. CLOSE(X) ;SR. Close HFS device not opened by %ZIS.
  1.  ;X=HANDLE NAME, IO=Device
  1.  N %
  1.  I $G(IO)]"" C IO K IO(1,IO)
  1.  I $G(X)]"" D RMDEV^%ZISUTL(X)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. OPENERR ;
  1.  Q 0
  1.  ;
  1. DEL(%ZX1,%ZX2) ;ef,SR. Del fl(s)
  1.  ;S Y=$$DEL^ZOSHMSM("\dir\","fl")
  1.  ;                         ,.array)
  1.  ;----- BEGIN IHS MODIFICATION - XU*8.0*1007
  1.  ;LINE ADDED TO REDIRECT TO DEL^ZISHMSMD AS CODE BELOW DOES NOT WORK
  1.  ;ORIGINAL MODIFICATION BY IHS/OIRM/DSD/AEF/02/19/03
  1.  Q $$DEL^ZISHMSMD(%ZX1,%ZX2)
  1.  ;----- END IHS MODIFICATION
  1.  ;Changed %ZX2 to a $NAME string
  1.  N %,%ZH,ZOSHDA,ZOSHF,ZOSHX,ZOSHQ,ZOSHDF,ZOSHC
  1.  S %ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""
  1.  ;Get fls to act on
  1.  ;No '*' allowed
  1.  S %ZH="" F  S %ZH=$O(@%ZX2@(%ZH)) Q:'%ZH  I %ZH["*" S ZOSHQ=1 Q
  1.  Q:$D(ZOSHQ) 0
  1.  S %ZH="" F   S %ZH=$O(@%ZX2@(%ZH)) Q:%ZH=""  D
  1.  .;S ZOSHC="rm "_X1_%
  1.  .S ZOSHC=$ZOS(2,%ZX1_%ZH) ;Use system function to delete file
  1.  Q 1
  1.  ;
  1. LIST(%ZX1,%ZX2,%ZX3) ;ef,SR. Create a local array holding fl names
  1.  ;S Y=$$LIST^ZOSHDOS("\dir\","fl",".return array")
  1.  ;                           "fl*",
  1.  ;                           .array,
  1.  ;IHS/HQW/JLB 2/16/99 Enables NT to read directory of files
  1.  ;IHS/OKCAO/POC 1/22/99
  1.  D LIST1
  1.  Q VAR
  1. LIST1 ;
  1.  S VAR=1 ;VAR=1 MEANS NO FILES OR A PROBLEM
  1.  I $G(%ZX1)']""!($G(%ZX2)']"") Q   ;PROBLEM
  1.  D DF(.%ZX1); IHS/AAO/RPL 4/21/99
  1.  S X=$ZOS(12,%ZX1_%ZX2,0) Q:$P(X,"^")=""  S %ZX3(1)=$P(X,"^",1); IHS/AAO/RPL 4/14/99 changed %ZX3(0) to %ZX3(1) to start counting with 1 not 0
  1.  F I=2:1 S X=$ZOS(13,X) Q:$P(X,"^",1)=""  S %ZX3(I)=$P(X,"^",1); IHS/AAO/RPL changed F I=1:1 to F I=2:1
  1.  I $P(X,"^")'="" S X=$ZOS(16,X)
  1.  S VAR='$D(%ZX3)
  1.  Q 
  1.  ;
  1.  ;Change X2 = $NAME OF CLOSE ROOT
  1.  ;Change X3 = $NAME OF CLOSE ROOT
  1.  ;
  1.  N %ZISH,%ZISHN,%ZX,%ZISHY
  1.  S %ZISHN=0,%ZX1=$$DEFDIR($G(%ZX1)) S:$D(@%ZX2)=1 @%ZX2(@%ZX2)=""
  1.  ;Get fls to act on
  1.  S %ZISH="" F  S %ZISH=$O(@%ZX2@(%ZISH)) Q:%ZISH=""  D
  1.  .S %ZX=%ZX1_%ZISH
  1.  .F %ZISHN=1:1 D  Q:$P(%ZISHY,"^")=""!(%ZISHY<0)  S @%ZX3@($P(%ZISHY,"^"))="" ;S @%ZX3@(%ZISHN)=$P(%ZISHY,"^")
  1.  ..I %ZISHN>1 S %ZISHY=$ZOS(13,%ZISHY)
  1.  ..E  S %ZISHY=$ZOS(12,%ZX,0)
  1.  Q $O(@%ZX3@(""))]""
  1.  ;
  1. MV(X1,X2,Y1,Y2) ;ef,SR. Rename a fl
  1.  ;S Y=$$MV^ZOSHDOS("\dir\","fl","\dir\","fl")
  1.  ;
  1.  ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
  1.  ;This subroutine is rewritten to make sure the correct path is used
  1.  ;when renaming or moving a file.  IHS/ITSC/AEF/04/28/03
  1.  N X,Y,%ZISHMVC
  1.  S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
  1.  S X=X1_X2,Y=Y1_Y2
  1.  S %ZISHMVC=$S($ZV["UNIX":"mv",1:"move")
  1.  Q $$JOBWAIT^%HOSTCMD(%ZISHMVC_" "_X_" "_Y)
  1.  ;----- END IHS MODIFICATION - XU*8.0*1008
  1.  N %ZB,%ZC,%ZISHDV1,%ZISHDV2,%ZISHFN1,%ZISHFN2,%ZISHPCT,%ZISHSIZ,%ZISHX,X,Y
  1.  S X1=$$DEFDIR($G(X1)),Y1=$$DEFDIR($G(Y1))
  1.  I X1=Y1 Q $ZOS(3,X2,Y2)'<0
  1.  S X=X1_X2,Y=Y1_Y2
  1.  ;
  1.  S %ZISHDV1=51,%ZISHDV2=52,%ZISHFN1=X,%ZISHFN2=Y
  1.  O %ZISHDV1:(%ZISHFN1)
  1.  O %ZISHDV2:(%ZISHFN2:"W")
  1.  U %ZISHDV1:(::0:2) S %ZISHSIZ=$ZB U %ZISHDV1:(::0:0) S (%ZISHPCT,%ZB,%ZC)=0
  1.  D SLOWCOPY S %ZISHX(X2)="" S Y=$$DEL^%ZISH(X1,$NA(%ZISHX))
  1.  Q 1
  1.  ;
  1. SLOWCOPY ; Copy without view buffer
  1.  N X,Y
  1.  O %ZISHDV1:(%ZISHFN1:"R"::::""),%ZISHDV2:(%ZISHFN2:"W"::::"")
  1.  FOR  DO  Q:%ZC!(%ZB=%ZISHSIZ)
  1.  . U %ZISHDV1 R X#1024 Q:$L(X)=0
  1.  . U %ZISHDV2 W X S %ZB=$ZB,%ZC=$ZC Q:%ZC
  1.  . I %ZB=%ZISHSIZ C %ZISHDV2 S %ZC=($ZA=-1)
  1.  . S X=%ZB/%ZISHSIZ*100\1 ; %done
  1.  . Q:X=%ZISHPCT  S %ZISHPCT=X
  1.  . Q  ;U 0 W $J(%ZISHPCT,3),*13
  1.  Q
  1.  ;
  1. PWD(X) ;ef,SR. Print working directory
  1.  Q $$PWD^ZISHMSMD(.X) ; IHS/ANMC/LJF 2/19/97 
  1.  N Y
  1.  S Y=$$DEFDIR("") I $L(Y) Q Y
  1.  S Y=$ZOS(11,$ZOS(14))
  1.  Q:Y<0 ""
  1.  S Y=Y_$S($E(Y,$L(Y))'="\":"\",1:"")
  1.  Q $ZOS(14)_":"_Y
  1.  ;
  1. JW ;Call dos $ZOS
  1.  S ZOSHX=$ZOS(ZOSHNUM,ZOSHC)
  1.  Q
  1. DF(X) ;Dir frmt  ; IHS/MFD added subroutine and edited for NT/DOS
  1.  Q:X=""
  1.  S X=$TR(X,"/","\")
  1.  I $E(X,$L(X))'="\" S X=X_"\"
  1.  Q
  1. DEFDIR(DF) ;ef. Default Dir and frmt
  1.  Q:DF="." "" ;Special way to get current dir.
  1.  S:DF="" DF=$G(^XTV(8989.3,1,"DEV")) S DF=$TR(DF,"/","\")
  1.  I $E(DF,$L(DF))'="\" S DF=DF_"\"
  1.  Q DF
  1. FL(X) ;Fl len
  1.  N ZOSHP1,ZOSHP2
  1.  S ZOSHP1=$P(X,"."),ZOSHP2=$P(X,".",2)
  1.  ;DONT CARE IF LESS THAN 3 OR GREATER THAN 8 ON NT BOX IHS/OKCAO/POC 1/25/99
  1.  ;I $L(ZOSHP1)>8 S X=4 Q
  1.  ;I $L(ZOSHP2)>3 S X=4 Q
  1.  Q
  1. READNXT(REC) ;Read any sized record into array.
  1.  N T,I,X,LB
  1.  U IO S LB=$ZB R REC#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC,%ZL=%ZA Q:$$EOF(%ZC)
  1.  Q:%ZA<255
  1.  F I=1:1 S LB=LB+%ZA Q:LB<%ZB  R X#255 S %ZA=$ZA,%ZB=$ZB,%ZC=$ZC Q:$$EOF(%ZC)!('$L(X))  S REC(I)=X
  1.  Q
  1. STATUS() ;ef,SR. Return EOF status
  1.  U $I
  1.  Q $$EOF($ZC)
  1.  ;
  1. EOF(X) ;Eof flag, pass in $ZC
  1.  Q (X=-1)
  1.  ;
  1. READREC(X) ;Read record from host file.
  1.  N Y
  1.  U IO R X S Y=$ZC
  1.  U $P
  1.  Q Y
  1. MAKEREF(HF,IX,OVF) ;Internal call to rebuild global ref.
  1.  ;Return %ZISHF,%ZISHO,%ZISHI,%ZISUB
  1.  N I,F,MX
  1.  S OVF=$G(OVF,"%ZISHOF")
  1.  S %ZISHI=$QS(HF,IX),MX=$QL(HF) ;
  1.  S F=$NA(@HF,IX-1) ;Get first part
  1.  I IX=1 S %ZISHF=F_"(%ZISHI" ;Build root, IX=1
  1.  I IX>1 S %ZISHF=$E(F,1,$L(F)-1)_",%ZISHI" ;Build root
  1.  S %ZISHO=%ZISHF_","_OVF_",%OVFCNT)" ;Make overflow
  1.  F I=IX+1:1:MX S %ZISHF=%ZISHF_",%ZISUB("_I_")",%ZISUB(I)=$QS(HF,I)
  1.  S %ZISHF=%ZISHF_")"
  1.  Q
  1. FTG(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;ef,SR. Unload contents of host file into global
  1.  ;p1=host file directory 
  1.  ;p2=host file name
  1.  ;p3= $NAME REFERENCE INCLUDING STARTING SUBSCRIPT
  1.  ;p4=INCREMENT SUBSCRIPT
  1.  ;p5=Overflow subscript, defaults to "OVF"
  1.  N %ZA,%ZB,%ZC,%ZL,%OVFCNT,%CONT,%XX
  1.  N I,%ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHOF,%ZISHOX,%ZISHS,%ZX,%ZISHY,POP,%ZISUB
  1.  S %ZX1=$$DEFDIR($G(%ZX1)),%ZISHOF=$G(%ZX5,"OVF")
  1.  D MAKEREF(%ZX3,%ZX4,"%ZISHOF")
  1.  D OPEN^%ZISH(,%ZX1,%ZX2,"R")
  1.  I POP Q 0
  1.  S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
  1.  U IO F  K %XX D READNXT(.%XX) D  Q:$$EOF(%ZC)
  1.  . S I=('$$EOF(%ZC))!($$EOF(%ZC)&$L(%XX)) Q:'I
  1.  . S @%ZISHF=%XX
  1.  . I $D(%XX)>2 F %OVFCNT=1:1 Q:'$D(%XX(%OVFCNT))  S @%ZISHO=%XX(%OVFCNT)
  1.  . S %ZISHI=%ZISHI+1
  1.  . Q
  1.  D CLOSE() ;Normal exit
  1.  Q 1
  1.  ;
  1. ERREOF D CLOSE() ;Error close and exit
  1.  Q 0
  1.  ;
  1. GTF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Load contents of global to host file.
  1.  ;Previously name LOAD
  1.  ;p1=$NAME of global reference
  1.  ;p2=incrementing subscript
  1.  ;p3=host file directory, p4=host file name
  1.  N %ZISHY,%ZISHOX
  1.  S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"W")
  1.  Q %ZISHY
  1.  ;
  1. GATF(%ZX1,%ZX2,%ZX3,%ZX4) ;ef,SR. Append to host file.
  1.  ;
  1.  ;p1=$NAME of global reference
  1.  ;p2=incrementing subscript
  1.  ;p3=host file directory
  1.  ;p4=host file name
  1.  N %ZISHY
  1.  S %ZISHY=$$MGTF(%ZX1,%ZX2,$G(%ZX3),%ZX4,"A")
  1.  Q %ZISHY
  1. MGTF(%ZX1,%ZX2,%ZX3,%ZX4,%ZX5) ;
  1.  ;p1=$NAME of global reference
  1.  ;p2=incrementing subscript
  1.  ;p3=host file directory
  1.  ;p4=host file name
  1.  N %ZISH,%ZISH1,%ZISHI,%ZISHL,%ZISHS,%ZISHOX,IO,%ZX,Y
  1.  D MAKEREF(%ZX1,%ZX2)
  1.  D OPEN^%ZISH(,%ZX3,%ZX4,%ZX5) ;Default dir set in open
  1.  I POP Q 0
  1.  N X
  1.  S X="ERREOF^%ZISH",@^%ZOSF("TRAP")
  1.  F  Q:'($D(@%ZISHF)#2)  S %ZX=@%ZISHF,%ZISHI=%ZISHI+1 U IO W %ZX,!
  1.  D CLOSE()
  1.  Q 1
  1.  ;
  1.  ;----- BEGIN IHS MODIFICATION - XU*8.0*1007
  1. SEND(ZISH1,ZISH2,ZISH3)      ;SEND FILE
  1.  ;
  1.  ;THIS IS A PLACE HOLDER WAITING FOR NT SCRIPT - THIS IS HERE TO
  1.  ;PREVENT A <NOPGM> ERROR ON NT SYSTEMS - IHS/ITSC/AEF/02/12/03
  1.  ;
  1.  Q
  1. SENDTO1(ZISH1,ZISH2)         ;
  1.  ;
  1.  Q
  1.  ;----- END IHS MODIFICATION