CIAUIN16.m

CIAUIN16 ;MSC/IND/DKM - Inits for VMS;04-May-2006 08:19;DKM

 ;;1.2;CIA UTILITIES;;Mar 20, 2007

 ;;Copyright 2000-2006, Medsphere Systems Corporation

 ;=================================================================

 ; Open a host file

OPEN(X1,X2) ;EP

 N Z

 S Z="X1"_$S("Rr"[$G(X2):":READONLY:0","Ww"[X2:":(NEWVERSION,RECORDSIZE=65535)","Bb"[X2:":(READONLY,BLOCKSIZE=0)",1:"")

 O @Z

 U X1

 S ^TMP("CIAUHFS",$J,X1)=""

 Q

 ; Close a host file

CLOSE(X) ;EP

 C X

 K ^TMP("CIAUHFS",$J,X)

 Q

 ; Close all open host files

CLOSEALL ;EP

 N Z

 S Z=""

 F  S Z=$O(^TMP("CIAUHFS",$J,Z)) Q:Z=""  C Z

 K ^TMP("CIAUHFS",$J)

 Q

EOF U $I:TRAP

 Q

EOFERR() Q $ZE["ENDOFILE"

 ; Read a line of data

READ(X,Y) ;EP

 U $G(Y,$I):NOTRAP

 R X:5

 Q $S($T:$ZA=-1,1:1)

 ; Delete a host file

DELETE(X) ;EP

 O X::0

 C X:DELETE

 Q

 ; Rename a host file

RENAME(X1,X2) ;EP

 O X1:READONLY:0

 C X1:RENAME=X2

 Q

 ; Return directory of files

DIR(X1,X2,X3) ;EP

 N Z,Z1

 S $ZT="DIRX^CIAUOS",X3=$G(X3,"^UTILITY(""DIR"",$J)")

 K @X3

 S:'$G(X2) X2=9999999999

 F Z=1:1:X2 S Z1=$ZSEARCH(X1),X1="" Q:Z1=""  S @X3@($P(Z1,"]",2))=""

DIRX Q

 ; Return default working directory

DEFDIR(X) ;EP

 Q $G(X,$P($G(^XTV(8989.3,1,"DEV")),U))

 ; Return path delimiters

DIRDLM() ;EP

 Q "[.]"

 ; Parse current error

ERR(X1,X2,X3) ;EP

 S X1=$P($P($ZE,", ",2),"-",3),X2=$P($P($ZE,", "),":"),X3=$P($ZE,", ",$S(X1="ZTRAP":4,1:3))

 Q

 ; Raise an exception

RAISE(X) ;EP

 ZT $G(X)

 ; Set error trap

TRAP(X) ;EP

 Q $S($D(X):"$ZT="""_X_"""",1:"$ZT")

 ; Return size of a file

SIZE(X) ;EP

 Q $ZC(%GETFILE,X,"BLS")*$ZC(%GETFILE,X,"EOF")

 ; Return free disk space

FREE(X) ;EP

 Q $ZC(%GETDVI,X,"FREEBLOCKS")/2048

 ; Return host ip address

HOSTIP() ;EP

 Q ""

 ; Return host name

HOSTNAME() ;EP

 Q ""

 ; Return client ip address

CLIENTIP() ;EP

 N IP,$ET

 S $ET="S $EC=""""",IP=$&%UCXGETPEER

 Q $A(IP,1)_"."_$A(IP,2)_"."_$A(IP,3)_"."_$A(IP,4)

CIAUIN16  ;MSC/IND/DKM - Inits for VMS;04-May-2006 08:19;DKM

 +1       ;;1.2;CIA UTILITIES;;Mar 20, 2007

 +2       ;;Copyright 2000-2006, Medsphere Systems Corporation

 +3       ;=================================================================

 +4       ; Open a host file

OPEN(X1,X2) ;EP

 +1        NEW Z

 +2        SET Z="X1"_$SELECT("Rr"[$GET(X2):":READONLY:0","Ww"[X2:":(NEWVERSION,RECORDSIZE=65535)","Bb"[X2:":(READONLY,BLOCKSIZE=0)",1:"")

 +3        OPEN @Z

 +4        USE X1

 +5        SET ^TMP("CIAUHFS",$JOB,X1)=""

 +6        QUIT 

 +7       ; Close a host file

CLOSE(X)  ;EP

 +1        CLOSE X

 +2        KILL ^TMP("CIAUHFS",$JOB,X)

 +3        QUIT 

 +4       ; Close all open host files

CLOSEALL  ;EP

 +1        NEW Z

 +2        SET Z=""

 +3        FOR 

               SET Z=$ORDER(^TMP("CIAUHFS",$JOB,Z))

               IF Z=""

                   QUIT 

               CLOSE Z

 +4        KILL ^TMP("CIAUHFS",$JOB)

 +5        QUIT 

EOF        USE $IO:TRAP

 +1        QUIT 

EOFERR()   QUIT $ZE["ENDOFILE"

 +1       ; Read a line of data

READ(X,Y) ;EP

 +1        USE $GET(Y,$IO):NOTRAP

 +2        READ X:5

 +3        QUIT $SELECT($TEST:$ZA=-1,1:1)

 +4       ; Delete a host file

DELETE(X) ;EP

 +1        OPEN X::0

 +2        CLOSE X:DELETE

 +3        QUIT 

 +4       ; Rename a host file

RENAME(X1,X2) ;EP

 +1        OPEN X1:READONLY:0

 +2        CLOSE X1:RENAME=X2

 +3        QUIT 

 +4       ; Return directory of files

DIR(X1,X2,X3) ;EP

 +1        NEW Z,Z1

 +2        SET $ZT="DIRX^CIAUOS"

           SET X3=$GET(X3,"^UTILITY(""DIR"",$J)")

 +3        KILL @X3

 +4        IF '$GET(X2)

               SET X2=9999999999

 +5        FOR Z=1:1:X2

               SET Z1=$ZSEARCH(X1)

               SET X1=""

               IF Z1=""

                   QUIT 

               SET @X3@($PIECE(Z1,"]",2))=""

DIRX       QUIT 

 +1       ; Return default working directory

DEFDIR(X) ;EP

 +1        QUIT $GET(X,$PIECE($GET(^XTV(8989.3,1,"DEV")),U))

 +2       ; Return path delimiters

DIRDLM()  ;EP

 +1        QUIT "[.]"

 +2       ; Parse current error

ERR(X1,X2,X3) ;EP

 +1        SET X1=$PIECE($PIECE($ZE,", ",2),"-",3)

           SET X2=$PIECE($PIECE($ZE,", "),":")

           SET X3=$PIECE($ZE,", ",$SELECT(X1="ZTRAP":4,1:3))

 +2        QUIT 

 +3       ; Raise an exception

RAISE(X)  ;EP

 +1 

*** ERROR ***

 +2       ; Set error trap

TRAP(X)   ;EP

 +1        QUIT $SELECT($DATA(X):"$ZT="""_X_"""",1:"$ZT")

 +2       ; Return size of a file

SIZE(X)   ;EP

 +1        QUIT $ZC(%GETFILE,X,"BLS")*$ZC(%GETFILE,X,"EOF")

 +2       ; Return free disk space

FREE(X)   ;EP

 +1        QUIT $ZC(%GETDVI,X,"FREEBLOCKS")/2048

 +2       ; Return host ip address

HOSTIP()  ;EP

 +1        QUIT ""

 +2       ; Return host name

HOSTNAME() ;EP

 +1        QUIT ""

 +2       ; Return client ip address

CLIENTIP() ;EP

 +1        NEW IP,$ETRAP

 +2        SET $ETRAP="S $EC="""""

           SET IP=$&%UCXGETPEER

 +3        QUIT $ASCII(IP,1)_"."_$ASCII(IP,2)_"."_$ASCII(IP,3)_"."_$ASCII(IP,4)