69 lines
3.2 KiB
Mathematica
69 lines
3.2 KiB
Mathematica
|
ZIBFR ; IHS/ADC/GTH - LIST UCI'S FOR A GIVEN ROUTINE ; [ 10/29/2002 7:42 AM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
|
||
|
|
;
|
||
|
|
; Given a routine name, this routine searches all UCIs and
|
||
|
|
; reports the first line of the selected routine to the user.
|
||
|
|
;
|
||
|
|
EN ;
|
||
|
|
;Q:'($ZV?1"MSM".E!($ZV?1"DSM".E)) ; Only works for MSM or DSM.;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S %=$$VERSION^%ZOSV(1) I '(%["Cache"),'(%["MSM") Q ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
R !,"Please enter full routine name to locate: ",%ZIB("RTN NAME"):$G(DTIME,300),!
|
||
|
|
; G:"^"[%ZIB("RTN NAME") EX ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
G:"^"[%ZIB("RTN NAME") EXIT ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S:%ZIB("RTN NAME")["^" %ZIB("RTN NAME")=$P(%ZIB("RTN NAME"),"^",2) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S %ZIB("OP SYS")=$ZV ; Set operating system.
|
||
|
|
I %ZIB("OP SYS")["Cache" G CACHE ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S %ZIB("CURR UCI NBR")=$P($ZU($P($ZU(0),","),$P($ZU(0),",",2)),",") ; Save current UCI nbr.
|
||
|
|
S %ZIB("CURR VOL NBR")=$P($ZU($P($ZU(0),","),$P($ZU(0),",",2)),",",2) ; Save current VOL nbr.
|
||
|
|
; S:%ZIB("RTN NAME")["^" %ZIB("RTN NAME")=$P(%ZIB("RTN NAME"),"^",2) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
D ; Loop until last UCI of last VOLUME SET.
|
||
|
|
. S $ZT="ZT" ; Set error trap for DSM <NOSYS>.
|
||
|
|
. F %ZIB("VOL NBR")=0:1 Q:$ZU(1,%ZIB("VOL NBR"))!($ZU(1,%ZIB("VOL NBR"))="") D
|
||
|
|
.. S $ZT="ZT" ; Set error trap for DSM <NOUCI>.
|
||
|
|
.. F %ZIB("UCI NBR")=1:1 Q:$ZU(%ZIB("UCI NBR"),%ZIB("VOL NBR"))!($ZU(%ZIB("UCI NBR"),%ZIB("VOL NBR"))="") D
|
||
|
|
... Q:$E(%ZIB("RTN NAME"))="%"&(%ZIB("UCI NBR")'=1) ; MGR routine.
|
||
|
|
... I %ZIB("OP SYS")?1"MSM".E D
|
||
|
|
.... V 2:$J:%ZIB("VOL NBR")*32+%ZIB("UCI NBR"):2 ; MSM switch to next UCI.
|
||
|
|
... E V 148:$J:$V(148,$J)#256+(%ZIB("VOL NBR")*32+%ZIB("UCI NBR"))*256 ; DSM switch to next UCI.
|
||
|
|
... S X=%ZIB("RTN NAME")
|
||
|
|
... X ^%ZOSF("TEST")
|
||
|
|
... I D
|
||
|
|
.... X "ZL @%ZIB(""RTN NAME"") S %ZIB(""RTN FIRST LINE"")=$T(+1)"
|
||
|
|
.... W !!,$ZU(0),?10,"Routine - ",%ZIB("RTN NAME")," - was last saved on ",$P($P(%ZIB("RTN FIRST LINE"),"[",2),"]")
|
||
|
|
.... W !,%ZIB("RTN FIRST LINE") ; Display first line of routine.
|
||
|
|
I %ZIB("OP SYS")?1"MSM".E V 2:$J:%ZIB("CURR VOL NBR")*32+%ZIB("CURR UCI NBR"):2 ; Return to current UCI MSM.
|
||
|
|
E V 148:$J:$V(148,$J)#256+(%ZIB("CURR VOL NBR")*32+%ZIB("CURR UCI NBR"))*256) ; Return to current UCI DSM.
|
||
|
|
EXIT ;IHS/SET/GTH XB*3*9 10/29/2002 Label EX changed to EXIT.
|
||
|
|
KILL %ZIB
|
||
|
|
ENQ ;
|
||
|
|
Q
|
||
|
|
;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
CACHE ;
|
||
|
|
S $ZT="BACK^%ETN"
|
||
|
|
S %ZIB("CURR NSP")=$ZU(5)
|
||
|
|
F I=1:1:$ZU(90,0) S ZIBLIST($ZU(90,2,0,I))=""
|
||
|
|
S ZIBFUCI="" F S ZIBFUCI=$O(ZIBLIST(ZIBFUCI)) Q:ZIBFUCI="" D
|
||
|
|
.I $ZU(5,ZIBFUCI)
|
||
|
|
.S X=%ZIB("RTN NAME")
|
||
|
|
.X "I X?1(1""%"",1A).7AN,$D(^$R(X))"
|
||
|
|
.I D
|
||
|
|
..X "ZL @%ZIB(""RTN NAME"") S %ZIB(""RTN FIRST LINE"")=$T(+1),%ZIB(""RTN SECOND LINE"")=$T(+2)"
|
||
|
|
..W !!,$ZU(5),?10,"Routine - ",%ZIB("RTN NAME")," - was last compiled on ",$$CDATE(%ZIB("RTN NAME"))
|
||
|
|
..W !,%ZIB("RTN FIRST LINE") ; Display first line of routine.
|
||
|
|
..W !,%ZIB("RTN SECOND LINE"),! ; Display second line
|
||
|
|
I $ZU(5,%ZIB("CURR NSP")) ; Go back to original Namespace
|
||
|
|
D EN^XBVK("ZIB")
|
||
|
|
KILL I,X
|
||
|
|
G EXIT
|
||
|
|
;
|
||
|
|
CDATE(%ZIBRTN) ; retrieve date of last edit on Cache only
|
||
|
|
Q $$DATE^%R(%ZIBRTN_".INT",1)
|
||
|
|
;
|
||
|
|
;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
ZT ; ERROR TRAP
|
||
|
|
Q:$ZE["<NOSYS"!($ZE["<NOUCI")
|
||
|
|
ZTQ ;
|
||
|
|
ZQ
|
||
|
|
;
|