/usr/lib/x86_64-linux-gnu/fis-gtm/V6.3-000A_x86_64/_ro.m is in fis-gtm-6.3-000a 6.3-000A-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 1987, 2011 Fidelity Information Services, Inc ;
; ;
; This source code contains the intellectual property ;
; of its copyright holder(s), and is made available ;
; under a license. If you do not know the terms of ;
; the license, please stop and do not read further. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
%RO ;routine output
;last modified by R. Partridge
;invoke ^%RO to get interaction
;invoke CALL^%RO with %ZR - routine array,
;%ZC - strip comments, %ZD - device, %ZH - header label
;
w !,"Routine Output - Save selected routines into RO file.",!
n ctrap,exc,d,k
d dev
i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RO")
n ename,fl,l,lc,out,r,rn,rf,src,x,y,t1,%ZC,%ZD,%ZH,%ZR,%ZRSET
s (fl,lc,r)=0,out=1
d main
q
;
CALL n ctrap,exc,d,k
d dev
n ename,fl,l,lc,out,r,rn,rf,src,x,y,t1,%ZRSET
n:'$d(%ZC) %ZC n:'$d(%ZD) %ZD n:'$d(%ZH) %ZH
s %ZC=$g(%ZC,1),%ZD=$g(%ZD,$p),%ZH=$g(%ZH),(fl,lc,r,out)=0
o %ZD:(newversion:block=2048:record=2044):0 e q
i $d(%ZR)<10 d CALL^%RSEL q:$d(%ZR)<10
d work
q
;
FL w !,"First Line Lister",!
n ctrap,exc,d,k
d dev
i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RO" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RO")
n ename,fl,l,lc,out,r,rf,rn,src,x,y,t1,%ZC,%ZD,%ZH,%ZR,%ZRSET
s (lc,r)=0,(%ZC,fl,out)=1,%ZH="Routine First Line Lister Utility"
d main
u $p:(ctrap=ctrap:exc=exc)
q
;
main
s %ZR="" d CALL^%RSEL
i %ZR=0 w !,"No routines selected" q
f d q:$l(%ZD)
. r !,"Output device: <terminal>: ",%ZD,!
. i '$l(%ZD) s %ZD=$p q
. i %ZD="^" q
. i %ZD="?" d q
. . w !!,"Select the device you want for output"
. . w !,"If you wish to exit enter a carat (^)",!
. . s %ZD=""
. i $zparse(%ZD)="" w " no such device" s %ZD="" q
. o %ZD:(newversion:block=2048:record=2044:exception="g noopen"):0
. i '$t w !,%ZD," is not available" s %ZD="" q
. q
noopen . w !,$p($ZS,",",2,999),! c %ZD s %ZD=""
q:%ZD="^"
i 'fl d
. r !,"Header Label: ",%ZH
. r !,"Strip comments <No>?: ",%ZC
. i $l(%ZC),"\YES"[("\"_$tr(%ZC,"yes","YES")) s %ZC=0
. e s %ZC=1
w !
d work
q
;
work i '$l(%ZH) s %ZH="%RO Routine Output Utility"
u %ZD w %ZH,!,"GT.M ",$zd($h,"DD-MON-YEAR 24:60:SS"),! u $p
s %ZR=""
f s %ZR=$o(%ZR(%ZR)) q:'$l(%ZR) d out
i 'fl u %ZD w !!
u $p
i out d
. w !!,"Total of ",lc," line",$s(lc=1:"",1:"s")
. w " in ",r," routine",$s(r=1:".",1:"s."),!!
c:%ZD'=$p %ZD u $p:(ctrap=ctrap:exc=exc)
q
;
out s rf=%ZR(%ZR)_$tr($e(%ZR),"%","_")_$e(%ZR,2,9999)_".m"
o rf:(readonly:rewind:exception="g rnoopen")
u rf:exception="g reof" r x s rn=$p($p($p(x,$c(9))," "),"(") d frmt
i $tr(rn,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")'=%ZR s rn=%ZR
i %ZD'=$p u $p w:$x>70 ! w %ZR,?$x\10+1*10
s r=r+1,lc=lc+1 s:x="" x=rn
u %ZD w rn,!,x,!
; warning - loop terminated by an execption
i 'fl f u rf r x d frmt i $l(x) u %ZD w x,! s lc=lc+1
f u rf r x d frmt q:x'?.E1";"1.E u %ZD w x,! s lc=lc+1
u %ZD w ! c rf
q
;
reof u %ZD w ! c rf
rnoopen i $zs'["EOF" w !,$p($zs,",",2,999),!
q
frmt new stripped set stripped=0
if '%ZC set t1=0 do ;strip comments
. for set t1=$find(x,";",t1) quit:'t1 if $length($extract(x,1,t1-1),"""")#2 do quit
. . if $extract(x,t1)'=";" set x=$extract(x,1,t1-2) if '$length($translate(x," "_$char(9))) set x="",stripped=1
if '$length(x),stripped quit
;kill stripped
if '$length(x) set x=" " quit
if $extract(x)=";" set x=" "_x ;if lonely comment, provide ls
set t1=0
for set t1=$find(x,$char(9),t1) quit:'t1 do ;convert <TAB>s to spaces
. set x=$extract(x,1,t1-2)_$justify("",8-(t1-2#8))_$extract(x,t1,9999)
quit
;
ERR u $p w !,$p($zs,",",2,99),!
s $ec=""
; Warning - Fall-though
EXIT i $d(%ZD),%ZD'=$p c %ZD
i $d(rf) c rf
u $p:(ctrap=ctrap:exc=exc)
q
dev ; save device parameters EXC, and CTRAP
zsh "d":d
s d=""
f s d=$o(d("D",d)) q:d="" i $p=$p(d("D",d)," ") s d=d("D",d),ctrap=$p($p(d,"CTRA=",2)," "),exc=$p(d,"EXCE=",2) q
e s (ctrap,exc)="" ; should never happen
s k=$l(exc,"""")
s k=$l(exc) i $e(exc,1,1)="""",$e(exc,k,k)="""" s exc=$e(exc,2,k-1)
if ctrap'="" s exc="s ctrap="_ctrap x exc
k d
q
|