[613] | 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
|
---|