RGUTIN8 ;CAIRO/DKM - Inits for MSM;04-Sep-1998 11:26;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
OPEN(X1,X2) ;
N Z
S X2=$G(X2,"R")
F Z=51:1:55 I '$D(^TMP("HFS",$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("HFS",$J,Z)=X1,X1=Z
Q
CLOSE(X) N Z
S Z=X,X=$G(^TMP("HFS",$J,X))
K ^(Z)
C Z
Q
CLOSEALL N Z
F Z=0:0 S Z=$O(^TMP("HFS",$J,Z)) Q:'Z C Z
K ^TMP("HFS",$J)
Q
EOF ZT:$ZC "EOF"
Q
EOFERR() Q $ZE["ZEOF"
READ(X,Y) ;
U:$G(Y)'="" Y
R X
Q $ZC&'$L(X)
DELETE(X) ;
S X=$ZOS(2,X)
Q
RENAME(X1,X2) ;
N Z
S Z=$ZOS(3,X1,X2)
Q
DIR(X1,X2,X3) ;
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
DEFDIR(X) ;
S X=$G(X,$P($G(^XTV(8989.3,1,"DEV")),U))
S:$E(X,$L(X))'="\" X=X_"\"
Q X
DIRDLM() Q "\\\"
FREE(X) S X=$ZOS(9,$E(X))
Q X*$P(X,"^",2)*$P(X,"^",3)/1048576
ERR(X1,X2,X3) ;
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
FTP(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) 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTIN8 1333 printed Dec 13, 2024@02:37:20 Page 2
RGUTIN8 ;CAIRO/DKM - Inits for MSM;04-Sep-1998 11:26;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
OPEN(X1,X2) ;
+1 NEW Z
+2 SET X2=$GET(X2,"R")
+3 FOR Z=51:1:55
IF '$DATA(^TMP("HFS",$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("HFS",$JOB,Z)=X1
SET X1=Z
End DoDot:1
QUIT
+9 QUIT
CLOSE(X) NEW Z
+1 SET Z=X
SET X=$GET(^TMP("HFS",$JOB,X))
+2 KILL ^(Z)
+3 CLOSE Z
+4 QUIT
CLOSEALL NEW Z
+1 FOR Z=0:0
SET Z=$ORDER(^TMP("HFS",$JOB,Z))
if 'Z
QUIT
CLOSE Z
+2 KILL ^TMP("HFS",$JOB)
+3 QUIT
EOF
*** ERROR ***
+1 QUIT
EOFERR() QUIT $ZE["ZEOF"
READ(X,Y) ;
+1 if $GET(Y)'=""
USE Y
+2 READ X
+3 QUIT $ZC&'$LENGTH(X)
DELETE(X) ;
+1 SET X=$ZOS(2,X)
+2 QUIT
RENAME(X1,X2) ;
+1 NEW Z
+2 SET Z=$ZOS(3,X1,X2)
+3 QUIT
DIR(X1,X2,X3) ;
+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
DEFDIR(X) ;
+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
DIRDLM() QUIT "\\\"
FREE(X) SET X=$ZOS(9,$EXTRACT(X))
+1 QUIT X*$PIECE(X,"^",2)*$PIECE(X,"^",3)/1048576
ERR(X1,X2,X3) ;
+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
FTP(X1,X2,X3,X4,X5,X6,X7) ;
+1 QUIT
RAISE(X)
*** ERROR ***
TRAP(X) QUIT $SELECT($DATA(X):"$ZT="""_X_"""",1:"$ZT")
SIZE(X) NEW I,Y,Z
+1 SET Z=$ZOS(12,X,0)
SET Z=$PIECE(Z,"^",2,999)
SET Y=0
+2 IF Z'=""
FOR I=30:-1:27
SET Y=Y*256+$ASCII(Z,I)
+3 QUIT Y