fis-gtm/sr_port/ri.mpt

64 lines
2.3 KiB
Plaintext

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; Copyright 1985, 2007 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. ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
%RI ;service@greystone.com %RI;19920722 07:40;routine input
;Converts mumps routines from a standard routine output (RO)
;file to individual *.m files.
;possible enhancements:
;selection and/or exclusion by list, range and/or wildcard
;optional confirmation by routine name
;callable entry point
;
w !,"Routine Input Utility - Converts RO file to *.m files.",!
i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%RI" u $p:(ctrap=$c(3):exc="zg "_$zl_":EXIT^%RI")
n d,dir,ff,l,r,x,y,%ZD,ff
r !,"Formfeed delimited <No>? ",x
s ff=$s($e($tr(x,"u","U"))="Y":$c(13,12),1:"")
f d q:$l(%ZD)
. r !,"Input device: <terminal>: ",%ZD,!
. i '$l(%ZD) s %ZD=$p q
. i %ZD="^" q
. i %ZD="?" d q
. . w !!,"Select the device you want for input"
. . w !,"If you wish to exit enter a carat (^)",!
. . s %ZD=""
. i $zparse(%ZD)="" w " no such device" s %ZD="" q
. o %ZD:(readonly: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="^"
u %ZD:(exception="zg "_$zl_":eof":ctrap=$C(3,$s($zver["VMS":26,1:4)))
if %ZD'=$P r x,y u $p w !,x,!,y,!!
r !,"Output directory : ",dir,!!
i dir="^" c:%ZD'=$p %ZD u $p:(ctrap="":exc="") q
s (l,r)=0
f u %ZD w:$P=%ZD !,"Routine: " r x q:'$l(x) s x=$p(x,"^") i $l(x),$e(x)?1a!($e(x)="%"),$e(x,2,99)?.an d
. w:$P=%ZD !,"Enter routine "
. ;warning - loop terminated by exception
. u $p w:$x>70 ! w x,?$x\10+1*10
. s x=dir_$tr($e(x),"%","_")_$e(x,2,9999)_".m",r=r+1 ;convert % to _
. o x:(newversion:noreadonly:blocksize=2048:recordsize=2044)
. f u %ZD w:$P=%ZD ! r y q:y=ff s l=l+1 u x w $s(y="":" ",1:y),!
. c x
eof u $p
i $l(x) c x
w !!!,"Restored ",l," line",$s(l=1:"",1:"s")
w " in ",r," routine",$s(r=1:".",1:"s.")
c:%ZD'=$p %ZD u $p:(ctrap="":exc="")
q
;
ERR u $p w !,$p($zs,",",2,99),!
s $ec=""
; Warning - Fall-though
EXIT i $d(%ZD),%ZD'=$p c %ZD
u $p:(ctrap="":exc="")
q