RGUTIN16 ;CAIRO/DKM - Inits for VMS;04-Sep-1998 11:26;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
OPEN(X1,X2) ;
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("HFS",$J,X1)=""
Q
CLOSE(X) C X
K ^TMP("HFS",$J,X)
Q
CLOSEALL N Z
S Z=""
F S Z=$O(^TMP("HFS",$J,Z)) Q:Z="" C Z
K ^TMP("HFS",$J)
Q
EOF U $I:TRAP
Q
EOFERR() Q $ZE["ENDOFILE"
READ(X,Y) ;
U $G(Y,$I):NOTRAP
R X
Q $ZA=-1
DELETE(X) ;
O X::0
C X:DELETE
Q
RENAME(X1,X2) ;
O X1:READONLY:0
C X1:RENAME=X2
Q
DIR(X1,X2,X3) ;
N Z,Z1
S $ZT="DIRX^RGUTOS",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
DEFDIR(X) Q $G(X,$P($G(^XTV(8989.3,1,"DEV")),U))
DIRDLM() Q "[.]"
ERR(X1,X2,X3) ;
S X1=$P($P($ZE,", ",2),"-",3),X2=$P($P($ZE,", "),":"),X3=$P($ZE,", ",$S(X1="ZTRAP":4,1:3))
Q
FTP(X1,X2,X3,X4,X5,X6,X7) ;
D VMS^RGUTFTP(.X1,.X2,.X3,.X4,.X5,.X6,.X7)
Q
RAISE(X) ZT $G(X)
TRAP(X) Q $S($D(X):"$ZT="""_X_"""",1:"$ZT")
SIZE(X) Q $ZC(%GETFILE,X,"BLS")*$ZC(%GETFILE,X,"EOF")
FREE(X) Q $ZC(%GETDVI,X,"FREEBLOCKS")/2048
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTIN16 1217 printed Dec 13, 2024@02:37:18 Page 2
RGUTIN16 ;CAIRO/DKM - Inits for VMS;04-Sep-1998 11:26;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
OPEN(X1,X2) ;
+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("HFS",$JOB,X1)=""
+6 QUIT
CLOSE(X) CLOSE X
+1 KILL ^TMP("HFS",$JOB,X)
+2 QUIT
CLOSEALL NEW Z
+1 SET Z=""
+2 FOR
SET Z=$ORDER(^TMP("HFS",$JOB,Z))
if Z=""
QUIT
CLOSE Z
+3 KILL ^TMP("HFS",$JOB)
+4 QUIT
EOF USE $IO:TRAP
+1 QUIT
EOFERR() QUIT $ZE["ENDOFILE"
READ(X,Y) ;
+1 USE $GET(Y,$IO):NOTRAP
+2 READ X
+3 QUIT $ZA=-1
DELETE(X) ;
+1 OPEN X::0
+2 CLOSE X:DELETE
+3 QUIT
RENAME(X1,X2) ;
+1 OPEN X1:READONLY:0
+2 CLOSE X1:RENAME=X2
+3 QUIT
DIR(X1,X2,X3) ;
+1 NEW Z,Z1
+2 SET $ZT="DIRX^RGUTOS"
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
DEFDIR(X) QUIT $GET(X,$PIECE($GET(^XTV(8989.3,1,"DEV")),U))
DIRDLM() QUIT "[.]"
ERR(X1,X2,X3) ;
+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
FTP(X1,X2,X3,X4,X5,X6,X7) ;
+1 DO VMS^RGUTFTP(.X1,.X2,.X3,.X4,.X5,.X6,.X7)
+2 QUIT
RAISE(X)
*** ERROR ***
TRAP(X) QUIT $SELECT($DATA(X):"$ZT="""_X_"""",1:"$ZT")
SIZE(X) QUIT $ZC(%GETFILE,X,"BLS")*$ZC(%GETFILE,X,"EOF")
FREE(X) QUIT $ZC(%GETDVI,X,"FREEBLOCKS")/2048
