CIAUIN8.m

CIAUIN8 ;MSC/IND/DKM - Inits for MSM;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 X2=$G(X2,"R")

 F Z=51:1:55 I '$D(^TMP("CIAUHFS",$J,Z)) D  Q

 .ZT:Z=55 "TMOF"

 .O Z:(X1:$S("RrWw"[X2:X2,1:"R")::::$S("Bb"[X2:"",1:$C(13,10)))

 .U Z

 .ZT:$ZA "OPEN"

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

 Q

 ; Close a host file

CLOSE(X) ;EP

 N Z

 S Z=X,X=$G(^TMP("CIAUHFS",$J,X))

 K ^(Z)

 C Z

 Q

 ; Close all open host files

CLOSEALL ;EP

 N Z

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

 K ^TMP("CIAUHFS",$J)

 Q

EOF ZT:$ZC "EOF"

 Q

EOFERR() Q $ZE["ZEOF"

 ; Read a line of data

READ(X,Y) ;EP

 U:$G(Y)'="" Y

 R X:5

 Q $S($T:$ZC&'$L(X),1:1)

 ; Delete a host file

DELETE(X) ;EP

 S X=$ZOS(2,X)

 Q

 ; Rename a host file

RENAME(X1,X2) ;EP

 N Z

 S Z=$ZOS(3,X1,X2)

 Q

 ; Generate a directory listing

DIR(X1,X2,X3) ;EP

 N Z

 S X1=$ZOS(12,X1,0),X2=+$G(X2),X3=$G(X3,"^UTILITY(""DIR"",$J)")

 K @X3

 F Z=1:1 Q:(X2&(Z>X2))!($P(X1,"^")="")  S @X3@($P(X1,"^"))="",X1=$ZOS(13,X1)

 Q

 ; Return default working directory

DEFDIR(X) ;EP

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

 S:$E(X,$L(X))'="\" X=X_"\"

 Q X

 ; Return path delimiters

DIRDLM() ;EP

 Q "\\\"

 ; Return free disk space

FREE(X) ;EP

 S X=$ZOS(9,$E(X))

 Q X*$P(X,"^",2)*$P(X,"^",3)/1048576

 ; Parse current error

ERR(X1,X2,X3) ;EP

 S X1=$E($P($ZE,">"),2,99),X2=$P($P($ZE,">",2),":"),X3=X1

 S:X2["*" X2=""

 S:$E(X1)="Z" X3=$E(X1,2,99),X1="ZTRAP"

 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

 N I,Y,Z

 S Z=$ZOS(12,X,0),Z=$P(Z,"^",2,999),Y=0

 I Z'="" F I=30:-1:27 S Y=Y*256+$A(Z,I)

 Q Y

 ; Return host ip address

HOSTIP() ;EP

 Q ""

 ; Return host name

HOSTNAME() ;EP

 Q ""

 ; Return client ip address

CLIENTIP() ;EP

 Q ""

CIAUIN8   ;MSC/IND/DKM - Inits for MSM;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 X2=$GET(X2,"R")

 +3        FOR Z=51:1:55

               IF '$DATA(^TMP("CIAUHFS",$JOB,Z))

                   Begin DoDot:1

 +4 

*** ERROR ***

 +5                    OPEN Z:(X1:$SELECT("RrWw"[X2:X2,1:"R")::::$SELECT("Bb"[X2:"",1:$CHAR(13,10)))

 +6                    USE Z

 +7 

*** ERROR ***

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

                       SET X1=Z

                   End DoDot:1

                   QUIT 

 +9        QUIT 

 +10      ; Close a host file

CLOSE(X)  ;EP

 +1        NEW Z

 +2        SET Z=X

           SET X=$GET(^TMP("CIAUHFS",$JOB,X))

 +3        KILL ^(Z)

 +4        CLOSE Z

 +5        QUIT 

 +6       ; Close all open host files

CLOSEALL  ;EP

 +1        NEW Z

 +2        FOR Z=0:0

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

               IF 'Z

                   QUIT 

               CLOSE Z

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

 +4        QUIT 

EOF 

*** ERROR ***

 +1        QUIT 

EOFERR()   QUIT $ZE["ZEOF"

 +1       ; Read a line of data

READ(X,Y) ;EP

 +1        IF $GET(Y)'=""

               USE Y

 +2        READ X:5

 +3        QUIT $SELECT($TEST:$ZC&'$LENGTH(X),1:1)

 +4       ; Delete a host file

DELETE(X) ;EP

 +1        SET X=$ZOS(2,X)

 +2        QUIT 

 +3       ; Rename a host file

RENAME(X1,X2) ;EP

 +1        NEW Z

 +2        SET Z=$ZOS(3,X1,X2)

 +3        QUIT 

 +4       ; Generate a directory listing

DIR(X1,X2,X3) ;EP

 +1        NEW Z

 +2        SET X1=$ZOS(12,X1,0)

           SET X2=+$GET(X2)

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

 +3        KILL @X3

 +4        FOR Z=1:1

               IF (X2&(Z>X2))!($PIECE(X1,"^")="")

                   QUIT 

               SET @X3@($PIECE(X1,"^"))=""

               SET X1=$ZOS(13,X1)

 +5        QUIT 

 +6       ; Return default working directory

DEFDIR(X) ;EP

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

 +2        IF $EXTRACT(X,$LENGTH(X))'="\"

               SET X=X_"\"

 +3        QUIT X

 +4       ; Return path delimiters

DIRDLM()  ;EP

 +1        QUIT "\\\"

 +2       ; Return free disk space

FREE(X)   ;EP

 +1        SET X=$ZOS(9,$EXTRACT(X))

 +2        QUIT X*$PIECE(X,"^",2)*$PIECE(X,"^",3)/1048576

 +3       ; Parse current error

ERR(X1,X2,X3) ;EP

 +1        SET X1=$EXTRACT($PIECE($ZE,">"),2,99)

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

           SET X3=X1

 +2        IF X2["*"

               SET X2=""

 +3        IF $EXTRACT(X1)="Z"

               SET X3=$EXTRACT(X1,2,99)

               SET X1="ZTRAP"

 +4        QUIT 

 +5       ; 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        NEW I,Y,Z

 +2        SET Z=$ZOS(12,X,0)

           SET Z=$PIECE(Z,"^",2,999)

           SET Y=0

 +3        IF Z'=""

               FOR I=30:-1:27

                   SET Y=Y*256+$ASCII(Z,I)

 +4        QUIT Y

 +5       ; Return host ip address

HOSTIP()  ;EP

 +1        QUIT ""

 +2       ; Return host name

HOSTNAME() ;EP

 +1        QUIT ""

 +2       ; Return client ip address

CLIENTIP() ;EP

 +1        QUIT ""