source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGUTOS1.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1RGUTOS ;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
5VER() Q +$P($T(RGUTOS+1),";",3)
6 ; Set right margin
7RM(X) X ^%ZOSF("RM")
8 Q
9 ; Test for routine/tag
10TEST(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
15RAISE(X) ZT $G(X)
16 ; Return code to set error trap
17TRAP(X) Q $$SUBST^RGUT(^%ZOSF("TRAP"),"X",""""_X_"""")
18 ; Check for $ET capability
19ETRAP() Q $$NEWERR^%ZTER
20 ; Open a file (extrinsic)
21OPENX(X1,X2) ;
22 D OPEN(.X1,.X2)
23 Q X1
24 ; Open a file
25OPEN(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
32CLOSE(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
38CLOSEALL 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
43PARSE(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
48READ(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
55DELETE(X) ;
56 N Z
57 D PARSE(.X,.Z)
58 S Z(X)="",Z=$$DEL^%ZISH(Z,"Z")
59 Q
60 ; Rename a file
61RENAME(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
67DIR(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
75EOF I $$STATUS^%ZISH ZT "EOF"
76 Q
77 ; Returns true if current error is EOF
78EOFERR() Q $$EC^%ZOSV["EOF"
79 ; URL format filename-->HFS format
80CVTFN(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
88DIRDLM() N X
89 S X=$$PWD^%ZISH
90 Q $S(X["[":"[.]",X["\":"\\\",1:"///")
91 ; FTP file transfer
92FTP(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
96ERR(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
102ERRMSM 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
106ERRDSM S X1=$P($P(X,", ",2),"-",3),X2=$P($P(X,", "),":"),X3=$$TRIM^RGUT($P(X,", ",$S(X1="ZTRAP":4,1:3)))
107 Q
Note: See TracBrowser for help on using the repository browser.