65 lines
2.3 KiB
Plaintext
65 lines
2.3 KiB
Plaintext
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
; ;
|
||
|
|
; Copyright 1987, 2009 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. ;
|
||
|
|
; ;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
%G ;GT.M %G utility - global lister
|
||
|
|
;
|
||
|
|
n %in,%ZL,%ZD
|
||
|
|
i '$d(%zdebug) n $et s $et="zg "_$zl_":ERR^%G" u $p:(ctrap=$c(3):exc="zg "_$zl_":LOOP^%G")
|
||
|
|
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="^"
|
||
|
|
d base
|
||
|
|
q
|
||
|
|
base f r !,"List ^",%in,! q:%in="" d
|
||
|
|
. i $e(%in)="?",$l(%in)=1 d help q
|
||
|
|
. i (%in="?D")!(%in="?d") d ^%GD u $p:(ctrap=$c(3):exc="zg "_($zl-2)_":LOOP^%G") q
|
||
|
|
. s:%in="*" %in="?.E(*)"
|
||
|
|
. s:$p(%in,"(")="*" $p(%in,"(")="?.E"
|
||
|
|
. s:$e(%in)'="^" %in="^"_%in
|
||
|
|
. n $et s $et="ZG "_$ZL_":badzwr"
|
||
|
|
. u %ZD zwr @%in u $p
|
||
|
|
. q
|
||
|
|
badzwr . u $p w !,$p($zs,",",3,99),!
|
||
|
|
. s $ec=""
|
||
|
|
d EXIT
|
||
|
|
q
|
||
|
|
help w !,"VALID INPUT",!!
|
||
|
|
w !,?3,"<RET>",?16,"to leave the %G utility ",!
|
||
|
|
w !,?4,"?D",?16,"to display existing globals in your directory ",!
|
||
|
|
w !,"[global name]",?16,"the MUMPS name for the global e.g. ABC, or"
|
||
|
|
w !?16,"a MUMPS pattern to match selected globals e.g. ?1""A"".E, or"
|
||
|
|
w !?16,"""*"" as a wildcard for all globals"
|
||
|
|
w !?16,"the global name may be followed by: "
|
||
|
|
w !?16,"subscript(s) in parentheses"
|
||
|
|
w !?16,"a subscript is a MUMPS expression e.g. ""joe"",10,$e(a,1),"
|
||
|
|
w !?16,"a ""*"" as a subscript causes all descendents to be included,"
|
||
|
|
w !?16,"or by a range of subscripts in parentheses"
|
||
|
|
w !?16,"expressed as [expr]:[expr] e.g 1:10 ""a"":""d""",!
|
||
|
|
q
|
||
|
|
ERR u $p w !,$p($zs,",",2,99),!
|
||
|
|
s $ecode=""
|
||
|
|
; Warning - Fall-through
|
||
|
|
EXIT i $d(%ZD),%ZD'=$p c %ZD
|
||
|
|
u $p:(ctrap="":exc="")
|
||
|
|
q
|
||
|
|
LOOP if 1'=$zeof d base
|
||
|
|
q
|