Return to %urimp.m CVS log

Up to [Coherent Logic Development] / freem / contrib

Annotation of freem/contrib/%urimp.m, revision 1.1

1.1     ! snw         1: %urimp ; Routine Import Utility - version 0.5.0.1
        !             2:  ; Jon Diamond - 1999-03-31
        !             3:  ;
        !             4:  w !,$t(+1),"  ",$$^%uxdat()
        !             5:  ;
        !             6:  n error,select,device,header,comment,yes,cnt,sel
        !             7:  s error=$$init^%uxxxx(),device=""
        !             8:  ;
        !             9:  k @%uwork
        !            10:  ;
        !            11: %device i device'="" s error=$$close^%ufxxx(device) i err<0 g %exit1
        !            12:  s error=$$select^%ufxxx(.device,"in") 
        !            13:  i error<0 g %exit1
        !            14:  ;
        !            15:  s error=$$%header i error<0 s a=$$writep^%uxxxx("Header error on input file") g %exit
        !            16:  s error=$$writep^%uxxxx("Header - "_header) i error<0 g %exit
        !            17:  s error=$$writep^%uxxxx("Description - "_comment) i error<0 g %exit
        !            18:  ;
        !            19: %cont s yes=1
        !            20:  s error=$$readyn^%uxxxx("Continue? ",.yes)
        !            21:  i error<0 g %device
        !            22:  i 'yes g %exit
        !            23:  ;
        !            24: %all s all=1
        !            25:  s error=$$readyn^%uxxxx("Restore all routines? ",.all) 
        !            26:  i error<0 g %cont
        !            27:  ;
        !            28: %go s error=$$go(device,all) i error<0 s a=$$error^%uxxxx(error) g %exit
        !            29:  s cnt=+error
        !            30:  s error=$$writep^%uxxxx("Finished")
        !            31:  s error=$$writep^%uxxxx("Routines restored - "_cnt)
        !            32:  ;
        !            33: %exit i device'="" s error=$$close^%ufxxx(device) i error<0 ; ??? if error
        !            34: %exit1 k @%uwork
        !            35:  q
        !            36:  ;
        !            37: %header()
        !            38:  s (header,comment)=""
        !            39:  s error=$$read^%ufxxx(device,"",.header) i error<0 q error
        !            40:  s error=$$read^%ufxxx(device,"",.comment) i error<0 q error
        !            41:  q "0,%header^%urimp"
        !            42:  ;
        !            43:  ; Executable entry point
        !            44:  ; Needs modifying to allow a selection mask (major changes!)
        !            45: go(device,all)
        !            46:  n name,d,error,cnt,this,replace,line
        !            47:  s cnt=0,all=$g(all,1)
        !            48: %go1 s name=""
        !            49:  s error=$$read^%ufxxx(device,"",.name) i error<0 q error
        !            50:  i name="" g %go1
        !            51:  i name'?1"%".30an,name'?1a.30an g %go2
        !            52:  s replace=name,this=1
        !            53:  i all s error=$$writep^%uxxxx("Processing - "_name) g %go1b
        !            54: %go1a s error=$$readn^%uxxxx("Restore as ",.replace) i error<0 q error
        !            55:  i this,replace="*" s all=1,replace=name
        !            56:  i this,replace="-" s this=0
        !            57:  i this,replace'?1a.30an,replace'?1"%".30an s error=$$rerror^%uxxxx("Invalid routine name") g %go1a
        !            58: %go1b k line 
        !            59:  f d=1:1 s line="",error=$$read^%ufxxx(device,"",.line) q:error<0!(line="")  s line(d)=line i d=1,$p(line," ")=name s $p(line(d)," ",1)=replace
        !            60:  i this s error=$$save^%urxxx(replace,.line) q:error<0 error  s cnt=cnt+1
        !            61:  g %go1
        !            62:  ;
        !            63: %go2 i name?1"****".e1"****" q cnt_",go^%urimp"
        !            64:  s error=$$error^%uxxxx("Invalid routine name - "_name) 
        !            65:  g %go1
        !            66:  ;
        !            67:  ;
        !            68:  ; Alternative entry point with Open/Close included
        !            69: import(device,all)
        !            70:  n error
        !            71:  s error=$$open^%ufxxx(device,"in") q:error<0
        !            72:  s error=$$go(device,all) q:error<0
        !            73:  s error=$$close^%ufxxx(device)
        !            74:  q
        !            75: