- ZIBFR ; IHS/ADC/GTH - LIST UCI'S FOR A GIVEN ROUTINE ; [ 10/29/2002 7:42 AM ]
- ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
- ; 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
- ;
- ZIBFR ; IHS/ADC/GTH - LIST UCI'S FOR A GIVEN ROUTINE ; [ 10/29/2002 7:42 AM ]
- +1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
- +2 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
- +3 ;
- +4 ; Given a routine name, this routine searches all UCIs and
- +5 ; reports the first line of the selected routine to the user.
- +6 ;
- EN ;
- +1 ;Q:'($ZV?1"MSM".E!($ZV?1"DSM".E)) ; Only works for MSM or DSM.;IHS/SET/GTH XB*3*9 10/29/2002
- +2 ;IHS/SET/GTH XB*3*9 10/29/2002
- SET %=$$VERSION^%ZOSV(1)
- IF '(%["Cache")
- IF '(%["MSM")
- QUIT
- +3 READ !,"Please enter full routine name to locate: ",%ZIB("RTN NAME"):$GET(DTIME,300),!
- +4 ; G:"^"[%ZIB("RTN NAME") EX ;IHS/SET/GTH XB*3*9 10/29/2002
- +5 ;IHS/SET/GTH XB*3*9 10/29/2002
- IF "^"[%ZIB("RTN NAME")
- GOTO EXIT
- +6 ;IHS/SET/GTH XB*3*9 10/29/2002
- IF %ZIB("RTN NAME")["^"
- SET %ZIB("RTN NAME")=$PIECE(%ZIB("RTN NAME"),"^",2)
- +7 ; Set operating system.
- SET %ZIB("OP SYS")=$ZV
- +8 ;IHS/SET/GTH XB*3*9 10/29/2002
- IF %ZIB("OP SYS")["Cache"
- GOTO CACHE
- +9 ; Save current UCI nbr.
- SET %ZIB("CURR UCI NBR")=$PIECE($ZU($PIECE($ZU(0),","),$PIECE($ZU(0),",",2)),",")
- +10 ; Save current VOL nbr.
- SET %ZIB("CURR VOL NBR")=$PIECE($ZU($PIECE($ZU(0),","),$PIECE($ZU(0),",",2)),",",2)
- +11 ; S:%ZIB("RTN NAME")["^" %ZIB("RTN NAME")=$P(%ZIB("RTN NAME"),"^",2) ;IHS/SET/GTH XB*3*9 10/29/2002
- +12 ; Loop until last UCI of last VOLUME SET.
- Begin DoDot:1
- +13 ; Set error trap for DSM <NOSYS>.
- SET $ZT="ZT"
- +14 FOR %ZIB("VOL NBR")=0:1
- IF $ZU(1,%ZIB("VOL NBR"))!($ZU(1,%ZIB("VOL NBR"))="")
- QUIT
- Begin DoDot:2
- +15 ; Set error trap for DSM <NOUCI>.
- SET $ZT="ZT"
- +16 FOR %ZIB("UCI NBR")=1:1
- IF $ZU(%ZIB("UCI NBR"),%ZIB("VOL NBR"))!($ZU(%ZIB("UCI NBR"),%ZIB("VOL NBR"))="")
- QUIT
- Begin DoDot:3
- +17 ; MGR routine.
- IF $EXTRACT(%ZIB("RTN NAME"))="%"&(%ZIB("UCI NBR")'=1)
- QUIT
- +18 IF %ZIB("OP SYS")?1"MSM".E
- Begin DoDot:4
- +19 ; MSM switch to next UCI.
- VIEW 2:$JOB:%ZIB("VOL NBR")*32+%ZIB("UCI NBR"):2
- End DoDot:4
- +20 ; DSM switch to next UCI.
- IF '$TEST
- VIEW 148:$JOB:$VIEW(148,$JOB)#256+(%ZIB("VOL NBR")*32+%ZIB("UCI NBR"))*256
- +21 SET X=%ZIB("RTN NAME")
- +22 XECUTE ^%ZOSF("TEST")
- +23 IF $TEST
- Begin DoDot:4
- +24 XECUTE "ZL @%ZIB(""RTN NAME"") S %ZIB(""RTN FIRST LINE"")=$T(+1)"
- +25 WRITE !!,$ZU(0),?10,"Routine - ",%ZIB("RTN NAME")," - was last saved on ",$PIECE($PIECE(%ZIB("RTN FIRST LINE"),"[",2),"]")
- +26 ; Display first line of routine.
- WRITE !,%ZIB("RTN FIRST LINE")
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +27 ; Return to current UCI MSM.
- IF %ZIB("OP SYS")?1"MSM".E
- VIEW 2:$JOB:%ZIB("CURR VOL NBR")*32+%ZIB("CURR UCI NBR"):2
- +28 ; Return to current UCI DSM.
- IF '$TEST
- VIEW 148:$JOB:$VIEW(148,$JOB)#256+(%ZIB("CURR VOL NBR")*32+%ZIB("CURR UCI NBR"))*256)
- EXIT ;IHS/SET/GTH XB*3*9 10/29/2002 Label EX changed to EXIT.
- +1 KILL %ZIB
- ENQ ;
- +1 QUIT
- +2 ;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
- CACHE ;
- +1 SET $ZT="BACK^%ETN"
- +2 SET %ZIB("CURR NSP")=$ZU(5)
- +3 FOR I=1:1:$ZU(90,0)
- SET ZIBLIST($ZU(90,2,0,I))=""
- +4 SET ZIBFUCI=""
- FOR
- SET ZIBFUCI=$ORDER(ZIBLIST(ZIBFUCI))
- IF ZIBFUCI=""
- QUIT
- Begin DoDot:1
- +5 IF $ZU(5,ZIBFUCI)
- +6 SET X=%ZIB("RTN NAME")
- +7 XECUTE "I X?1(1""%"",1A).7AN,$D(^$R(X))"
- +8 IF $TEST
- Begin DoDot:2
- +9 XECUTE "ZL @%ZIB(""RTN NAME"") S %ZIB(""RTN FIRST LINE"")=$T(+1),%ZIB(""RTN SECOND LINE"")=$T(+2)"
- +10 WRITE !!,$ZU(5),?10,"Routine - ",%ZIB("RTN NAME")," - was last compiled on ",$$CDATE(%ZIB("RTN NAME"))
- +11 ; Display first line of routine.
- WRITE !,%ZIB("RTN FIRST LINE")
- +12 ; Display second line
- WRITE !,%ZIB("RTN SECOND LINE"),!
- End DoDot:2
- End DoDot:1
- +13 ; Go back to original Namespace
- IF $ZU(5,%ZIB("CURR NSP"))
- +14 DO EN^XBVK("ZIB")
- +15 KILL I,X
- +16 GOTO EXIT
- +17 ;
- CDATE(%ZIBRTN) ; retrieve date of last edit on Cache only
- +1 QUIT $$DATE^%R(%ZIBRTN_".INT",1)
- +2 ;
- +3 ;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
- ZT ; ERROR TRAP
- +1 IF $ZE["<NOSYS"!($ZE["<NOUCI")
- QUIT
- ZTQ ;
- +1
- *** ERROR ***
- +2 ;
