Return to %ugxxx.m CVS log

Up to [Coherent Logic Development] / freem / contrib

FreeM

    1: %ugxxx ; FreeM Global Utilities Common Subroutines - version 0.5.0.1
    2:  ; Jon Diamond - 1999-03-31
    3:  q
    4:  ; 
    5:  ; Select a set of Globals in @%uwork
    6:  ; Needs much more work on the selection masks
    7: gsel(work)
    8:  n a,b,c,error,result,entries
    9:  s entries=0
   10:  i $g(work)="" d
   11:  . s work=$g(%uwork) i work="" s work="^uwork("_$j_")"
   12:  . k @work
   13: %gselr s result="",error=$$readn^%uxxxx("Global ",.result) i error<0 k @work q error
   14:  i result="" q entries_",gsel^%ugxxx"
   15:  i result="?" s error=$$gseldisp(work) g %gselr
   16:  i result="?^" s error=$$list^%ugdir g %gselr
   17:  ; 
   18:  s entries=entries+1,@work@(entries)=result
   19:  f  s a=$p(result,";") q:a=""  s result=$p(result,";",2,$l(result,";")) d
   20:  . i a'?.1"-"1A.30AN.1"*",a'?.1"-"1"%".31AN.1"*" s error=$$writep^%uxxxx("Invalid global specification - "_a) q
   21:  . i a?1"-"1.e d
   22:  . . i $e(a,$l(a))="*" s b=$e(a,2,$l(a)-1) d %all q
   23:  . . s c=$e(a,2,$l(a)) d %all1
   24:  . e  d
   25:  . . i $e(a,$l(a))="*" s b=$e(a,1,$l(a)-1) d %all q
   26:  . . i '$d(@("^"_a)) s error=$$writep^%uxxxx("Global does not exist - "_a) q
   27:  . . s c=a d %all1
   28:  g %gselr
   29:  ; 
   30: %all s c=b d %all1
   31:  f  s c=$o(^$global(c)) q:$e(c,1,$l(b))'=b  d %all1
   32:  q
   33: %all1 i $e(a)="-" k @work@(c) q
   34:  i $d(@("^"_c)) s @work@(c)=c
   35:  q
   36:  ; 
   37: gseldisp(work)
   38:  s a=99999
   39:  s error=$$writep^%uxxxx("Selected globals") q:error<0
   40:  f  s a=$o(@work@(a)) q:a=""  s error=$$writen^%uxxxx("^"_a)
   41:  q "0,gseldisp^%ugxxx"
   42: