1 | RGUTOS ;CAIRO/DKM - Platform-dependent operations;12-Oct-1998 16:40;DKM
|
---|
2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
---|
3 | ;=================================================================
|
---|
4 | ; Return version # of RTL
|
---|
5 | VER() Q +$P($T(RGUTOS+1),";",3)
|
---|
6 | ; Set right margin
|
---|
7 | RM(X) X ^%ZOSF("RM")
|
---|
8 | Q
|
---|
9 | ; Test for routine/tag
|
---|
10 | TEST(X) N Z
|
---|
11 | S:X[U Z=$P(X,U),X=$P(X,U,2)
|
---|
12 | X ^%ZOSF("TEST")
|
---|
13 | Q $S('$T:0,$G(Z)="":1,Z'?.1"%"1.AN:0,1:$T(@Z^@X)'="")
|
---|
14 | ; Raise an exception
|
---|
15 | RAISE(X) ZT $G(X)
|
---|
16 | ; Return code to set error trap
|
---|
17 | TRAP(X) Q $$SUBST^RGUT(^%ZOSF("TRAP"),"X",""""_X_"""")
|
---|
18 | ; Check for $ET capability
|
---|
19 | ETRAP() Q $$NEWERR^%ZTER
|
---|
20 | ; Open a file (extrinsic)
|
---|
21 | OPENX(X1,X2) ;
|
---|
22 | D OPEN(.X1,.X2)
|
---|
23 | Q X1
|
---|
24 | ; Open a file
|
---|
25 | OPEN(X1,X2) ;
|
---|
26 | N IO,POP,X3
|
---|
27 | D PARSE(.X1,.X3),OPEN^%ZISH(X3_X1,X3,X1,$G(X2,"R"),32767)
|
---|
28 | I POP ZT "OPEN"
|
---|
29 | S ^XTMP("RGHFS",$J,IO)=X3_X1,X1=IO
|
---|
30 | Q
|
---|
31 | ; Close a file
|
---|
32 | CLOSE(X) N Y
|
---|
33 | S Y=$G(^XTMP("RGHFS",$J,X)),IO=X
|
---|
34 | K ^(X)
|
---|
35 | D CLOSE^%ZISH(Y)
|
---|
36 | Q
|
---|
37 | ; Close all open HFS
|
---|
38 | CLOSEALL N Z
|
---|
39 | S Z=""
|
---|
40 | F S Z=$O(^XTMP("RGHFS",$J,Z)) Q:Z="" D CLOSE(Z)
|
---|
41 | Q
|
---|
42 | ; Parse out directory from filename
|
---|
43 | PARSE(X,Y) ;
|
---|
44 | N D,Z
|
---|
45 | S D=$E($$DIRDLM,3),Z=$L(X,D),Y=$P(X,D,1,Z-1)_$S(Z>1:D,1:""),X=$P(X,D,Z)
|
---|
46 | Q
|
---|
47 | ; Read a line
|
---|
48 | READ(X,Y) ;
|
---|
49 | N IO,%ZA,%ZB,%ZC,%ZL
|
---|
50 | S IO=$G(Y,$I)
|
---|
51 | D READNXT^%ZISH(.X)
|
---|
52 | U IO
|
---|
53 | Q $$STATUS^%ZISH&'$L(X)
|
---|
54 | ; Delete a file
|
---|
55 | DELETE(X) ;
|
---|
56 | N Z
|
---|
57 | D PARSE(.X,.Z)
|
---|
58 | S Z(X)="",Z=$$DEL^%ZISH(Z,"Z")
|
---|
59 | Q
|
---|
60 | ; Rename a file
|
---|
61 | RENAME(X1,X2) ;
|
---|
62 | N X3,X4
|
---|
63 | D PARSE(.X1,.X3),PARSE(.X2,.X4)
|
---|
64 | I $$MV^%ZISH(X3,X1,X4,X2)
|
---|
65 | Q
|
---|
66 | ; List files
|
---|
67 | DIR(X1,X2,X3) ;
|
---|
68 | N Z
|
---|
69 | D PARSE(.X1,.Z)
|
---|
70 | S Z(X1)="",X3=$G(X3,"^UTILITY(""DIR"",$J)")
|
---|
71 | K @X3
|
---|
72 | I $$LIST^%ZISH(Z,"Z",X3)
|
---|
73 | Q
|
---|
74 | ; Force error if at EOF
|
---|
75 | EOF I $$STATUS^%ZISH ZT "EOF"
|
---|
76 | Q
|
---|
77 | ; Returns true if current error is EOF
|
---|
78 | EOFERR() Q $$EC^%ZOSV["EOF"
|
---|
79 | ; URL format filename-->HFS format
|
---|
80 | CVTFN(RGFIL,RGROOT) ;
|
---|
81 | N RGZ,RGZ1,RGD
|
---|
82 | S RGD=$$DIRDLM,RGROOT=$G(RGROOT)
|
---|
83 | S:$E(RGROOT,$L(RGROOT))=$E(RGD,3) RGROOT=$E(RGROOT,1,$L(RGROOT)-1)
|
---|
84 | S RGZ=$L(RGFIL,"/"),RGZ1=$P(RGFIL,"/",1,RGZ-1),RGFIL=$P(RGFIL,"/",RGZ)
|
---|
85 | S:$L(RGZ1) RGROOT=RGROOT_$E(RGD,$S($L(RGROOT):2,1:1))_$TR(RGZ1,"/.-",$E(RGD,2))
|
---|
86 | Q RGROOT_$S($L(RGROOT):$E(RGD,3),1:"")_RGFIL
|
---|
87 | ; Return directory delimiters
|
---|
88 | DIRDLM() N X
|
---|
89 | S X=$$PWD^%ZISH
|
---|
90 | Q $S(X["[":"[.]",X["\":"\\\",1:"///")
|
---|
91 | ; FTP file transfer
|
---|
92 | FTP(X1,X2,X3,X4,X5,X6,X7) ;
|
---|
93 | D:$$VERSION^%ZOSV(1)["DSM" VMS^RGUTFTP(.X1,.X2,.X3,.X4,.X5,.X6,.X7)
|
---|
94 | Q
|
---|
95 | ; Parse error data
|
---|
96 | ERR(X1,X2,X3) ;
|
---|
97 | N X
|
---|
98 | S X=$$EC^%ZOSV,X1=$$VERSION^%ZOSV(1)
|
---|
99 | G ERRMSM:X1["MSM",ERRDSM:X1["DSM"
|
---|
100 | S (X1,X2,X3)=""
|
---|
101 | Q
|
---|
102 | ERRMSM S X1=$E($P(X,">"),2,99),X2=$P($P(X,">",2),":"),X3=X1
|
---|
103 | S:X2["*" X2=""
|
---|
104 | S:$E(X1)="Z" X3=$E(X1,2,99),X1="ZTRAP"
|
---|
105 | Q
|
---|
106 | ERRDSM S X1=$P($P(X,", ",2),"-",3),X2=$P($P(X,", "),":"),X3=$$TRIM^RGUT($P(X,", ",$S(X1="ZTRAP":4,1:3)))
|
---|
107 | Q
|
---|