Return to %urxxx.m CVS log

Up to [Coherent Logic Development] / freem / contrib

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

1.1     ! snw         1: %urxxx ; FreeM Routines Utilities Common Subroutines  - version 0.5.0.1
        !             2:  ; Jon Diamond - 1999-03-19
        !             3:  q
        !             4:  ; 
        !             5:  ; Select a set of Routines in @%uwork
        !             6:  ; Needs much more work on the selection masks
        !             7: rsel(work)
        !             8:  n a,b,c,entries,error,result
        !             9:  s entries=0
        !            10:  i $g(work)="" d
        !            11:  . s work=$g(%uwork) i work="" s work="^uwork("_$j_")"
        !            12:  . k @work
        !            13: %rselr s result="",error=$$readn^%uxxxx("Routine ",.result) 
        !            14:  i error<0 k @work q error
        !            15:  i result="" q entries_",rsel^%urxxx"
        !            16:  i result="?" d rseldisp(work) g %rselr
        !            17:  i result="?^" s error=$$list^%urdir(1) g %rselr
        !            18:  ; 
        !            19:  s entries=entries+1,@work@(entries)=result
        !            20:  f  s a=$p(result,";") q:a=""  s result=$p(result,";",2,$l(result,";")) d
        !            21:  . i a'?.1"-"1A.30AN.1"*",a'?.1"-"1"%".31AN.1"*" s error=$$writep^%uxxxx("Invalid routine specification - "_a) q
        !            22:  . i a?1"-"1.e d
        !            23:  . . i $e(a,$l(a))="*" s b=$e(a,2,$l(a)-1) d %all q
        !            24:  . . s c=$e(a,2,$l(a)) d %all1
        !            25:  . e  d
        !            26:  . . i $e(a,$l(a))="*" s b=$e(a,1,$l(a)-1) d %all q
        !            27:  . . i $t(@("+1^"_a))="" s error=$$writep^%uxxxx("Routine does not exist - "_a) q
        !            28:  . . s c=a d %all1
        !            29:  g %rselr
        !            30:  ; 
        !            31: %all s c=b d %all1
        !            32:  f  s c=$o(^$routine(c)) q:$e(c,1,$l(b))'=b  d %all1
        !            33:  q
        !            34: %all1 i $e(a)="-" k @work@(c) q
        !            35:  i $t(@("+1^"_c))'="" s @work@(c)=c
        !            36:  q
        !            37:  ; 
        !            38: rseldisp(work)
        !            39:  s a=99999
        !            40:  s error=$$writep^%uxxxx("Selected routines"),error=$$writen^%uxxxx("") q:error<0
        !            41:  f  s a=$o(@work@(a)) q:a=""  s error=$$write^%uxxxx(a_"  ")
        !            42:  q "0,rseldisp^%urxxx"
        !            43:  ; 
        !            44:  ; Delete single routine
        !            45:  ; 
        !            46: delete(rtn) n path,exec
        !            47:  S path=$S($E(rtn)="%":$V(8),1:$V(4))
        !            48:  I $L(path)>0,($E(path,$L(path))'="/") S path=path_"/"
        !            49:  I path="" S path="./"
        !            50:  S exec="!rm "_path_rtn_$V(98)
        !            51:  X exec
        !            52:  i $t(@("+1^"_rtn))'="" q "-102,delete^%urxxx"
        !            53:  q "0,delete^%urxxx"
        !            54:  ; 
        !            55:  ; Save single routine
        !            56:  ; 
        !            57: save(rtn,code)
        !            58:  ; Unsure code here works for FreeM - OK for Cache
        !            59:  n a
        !            60:  s a=""
        !            61:  x "ZR  f  s a=$o(code(a)) ZI:a'="""" code(a) i a="""" ZS @rtn ZL %urxxx q"
        !            62:  q "0,save^%urxxx"
        !            63: