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

CIAUOS.m

Go to the documentation of this file. 
  1. CIAUOS ;MSC/IND/DKM - Platform-dependent operations;04-May-2006 08:19;DKM
  1.  ;;1.2;CIA UTILITIES;;Mar 20, 2007
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Return version #
  1. VER() Q $P($T(+2),";",3)
  1. CVTFN(CIAFIL,CIAROOT) ;
  1.  N CIAZ,CIAZ1,CIAD
  1.  S CIAD=$$DIRDLM,CIAROOT=$G(CIAROOT)
  1.  S:$E(CIAROOT,$L(CIAROOT))=$E(CIAD,3) CIAROOT=$E(CIAROOT,1,$L(CIAROOT)-1)
  1.  S CIAZ=$L(CIAFIL,"/"),CIAZ1=$P(CIAFIL,"/",1,CIAZ-1),CIAFIL=$P(CIAFIL,"/",CIAZ)
  1.  S:$L(CIAZ1) CIAROOT=CIAROOT_$E(CIAD,$S($L(CIAROOT):2,1:1))_$TR(CIAZ1,"/.-",$E(CIAD,2))
  1.  Q CIAROOT_$S($L(CIAROOT):$E(CIAD,3),1:"")_CIAFIL
  1.  ; Set right margin
  1. RM(X) ;EP
  1.  X ^%ZOSF("RM")
  1.  Q
  1.  ; Test for tag/routine
  1. TEST(X) ;EP
  1.  N Z
  1.  S:X[U Z=$P(X,U),X=$P(X,U,2)
  1.  Q:'$L(X)!(X'?.1"%"1.AN) 0
  1.  X ^%ZOSF("TEST")
  1.  Q $S('$T:0,$G(Z)="":1,Z'?.1"%"1.AN:0,1:$T(@Z^@X)'="")
  1. ETRAP() Q $$NEWERR^%ZTER
  1.  ; Open a host file
  1. OPENX(X1,X2) ;EP
  1.  D OPEN(.X1,.X2)
  1.  Q X1
  1.  ;;Copyright 2000-2006, Medsphere Systems Corporation
  1.  ;=================================================================
  1.  ; Open a host file
  1. OPEN(X1,X2) ;EP
  1.  O X1:$S("Rr"[$G(X2):"RS","Ww"[X2:"WNS","Bb"[X2:"RF",1:""):0
  1.  E  ZT "NOPEN"
  1.  U X1
  1.  S ^TMP("CIAUHFS",$J,X1)=""
  1.  Q
  1.  ; Close a host file
  1. CLOSE(X) ;EP
  1.  C X
  1.  K ^TMP("CIAUHFS",$J,X)
  1.  Q
  1.  ; Close all host files
  1. CLOSEALL ;EP
  1.  N Z
  1.  S Z=""
  1.  F  S Z=$O(^TMP("CIAUHFS",$J,Z)) Q:Z=""  C Z
  1.  K ^TMP("CIAUHFS",$J)
  1.  Q
  1. EOF ZT:$ZA=-1 "ENDOFFILE"
  1.  Q
  1. EOFERR() Q:$ZE["ENDOFFILE"
  1.  ; Read line of data
  1. READ(X,Y) ;EP
  1.  N $ET
  1.  S $ET="",$ZT="READX^CIAUOS"
  1.  U $G(Y,$I)
  1.  Q:$ZEOF 1
  1.  R X:5
  1.  Q:$T 0
  1. READX Q 1
  1.  ; Delete a host file
  1. DELETE(X) ;EP
  1.  S X=$ZF(-1,"del """_X_"""")
  1.  Q
  1.  ; Rename a host file
  1. RENAME(X1,X2) ;EP
  1.  S X1=$ZF(-1,"ren """_X1_""" """_X2_"""")
  1.  Q
  1.  ; Return directory of files
  1. DIR(X1,X2,X3) ;EP
  1.  N Z,Z1,FDLM
  1.  S FDLM=$E($$DIRDLM,1)
  1.  S X3=$G(X3,$NA(^UTILITY("DIR",$J)))
  1.  K @X3
  1.  S:'$G(X2) X2=9999999999
  1.  F Z=1:1:X2 S Z1=$ZSEARCH(X1),X1="" Q:Z1=""  D
  1.  .S Z1=$P(Z1,FDLM,$L(Z1,FDLM))
  1.  .S:$TR(Z1,".")'="" @X3@(Z1)=""
  1.  Q
  1.  ; Return path delimiters
  1. DIRDLM() ;EP
  1.  Q "\\\"
  1.  ; Return default working directory
  1. DEFDIR(X) ;EP
  1.  N FDLM
  1.  S FDLM=$E($$DIRDLM,1)
  1.  S X=$G(X,$P($G(^XTV(8989.3,1,"DEV")),U))
  1.  S:$E(X,$L(X))'=FDLM X=X_FDLM
  1.  Q X
  1.  ; Parse current error
  1. ERR(X1,X2,X3) ;EP
  1.  S X1=$E($P($ZE,">"),2,99),X2=$P($P($ZE,">",2),":"),X3=X1
  1.  S:X2["*" X2=""
  1.  S:$E(X1)="Z" X3=$E(X1,2,99),X1="ZTRAP"
  1.  Q
  1.  ; Raise an exception
  1. RAISE(X) ;EP
  1.  ZT $G(X)
  1.  ; Set error trap
  1. TRAP(X) ;EP
  1.  Q $S($D(X):"$ZT="""_X_"""",1:"$ZT")
  1.  ; Return size of file
  1. SIZE(X) ;EP
  1.  Q 0
  1.  ; Return free disk space
  1. FREE(X) ;EP
  1.  Q 0
  1.  ; Return host ip address
  1. HOSTIP() ;EP
  1.  Q $P($P($ZU(131,1),","),":",2)
  1.  ; Return host name
  1. HOSTNAME() ;EP
  1.  Q $P($P($ZU(131,1),","),":")
  1.  ; Return client ip address
  1. CLIENTIP() ;EP
  1.  N IP,$ET
  1.  S $ET="S $EC=""""",IP=$ZU(111,0)
  1.  Q $A(IP,1)_"."_$A(IP,2)_"."_$A(IP,3)_"."_$A(IP,4)