176 lines
4.4 KiB
Mathematica
176 lines
4.4 KiB
Mathematica
|
ZIBCKPKG ; IHS/ADC/GTH - CHECK UCI FOR PACKAGE CONTENT ; [ 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 Change MSM systax to use $ROUTINE.
|
||
|
|
D INIT
|
||
|
|
S XBQUEST=1 D ASKIT G:XBQ=U EXIT S XBINPR=XBQ
|
||
|
|
S XBQUEST=2 D ASKIT G:XBQ=U EXIT S XBLC=XBQ
|
||
|
|
S XBQUEST=3 D ASKIT G:XBQ=U EXIT S XBLNPR=XBQ
|
||
|
|
;
|
||
|
|
ZIS ; SELECT DEVICE
|
||
|
|
KILL ZTSK,IOP,%ZIS
|
||
|
|
S %ZIS="PQM"
|
||
|
|
D ^%ZIS
|
||
|
|
G:POP EXIT
|
||
|
|
G:$D(IO("Q")) QUE
|
||
|
|
NOQUE ;
|
||
|
|
U IO
|
||
|
|
D EN
|
||
|
|
D ^%ZISC
|
||
|
|
G EXIT
|
||
|
|
;
|
||
|
|
QUE ;
|
||
|
|
KILL ZTSAVE
|
||
|
|
F %="XBINPR","XBLNPR","XBLC" S ZTSAVE(%)=""
|
||
|
|
S ZTRTN="EN^ZIBCKPKG",ZTDESC="SCAN UCI FOR PACKAGES",ZTIO=IO,ZTDTH=0
|
||
|
|
D ^%ZTLOAD
|
||
|
|
KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
||
|
|
EXIT ;
|
||
|
|
D KILLS
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EN1 ; ENTRY FOR SILENT OPERATION
|
||
|
|
D INIT
|
||
|
|
S (XBINPR,XBLC)=1
|
||
|
|
G EN
|
||
|
|
;
|
||
|
|
INIT ; INITIALIZATION
|
||
|
|
S U="^"
|
||
|
|
S:'$D(DTIME) DTIME=300
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EN ; COMMON INTERNAL ENTRY
|
||
|
|
S XBQUIT=0
|
||
|
|
KILL ^UTILITY($J,"ZIBCKPKG")
|
||
|
|
D SCAN
|
||
|
|
Q:XBQUIT
|
||
|
|
D:XBLNPR SHOWNPR
|
||
|
|
D:XBLC SHOWLC
|
||
|
|
I $D(IOST),$D(IOF),$E(IOST,1,2)="P-" W @IOF
|
||
|
|
SET:$D(ZTQUEUED) ZTREQ="@"
|
||
|
|
KILLS ;
|
||
|
|
KILL XBINPR,XBRNPR,XBLNPR,XBLC,XBQUIT,XBR,XBR2,XBPF,XBI,XBJ,XBP,XBQ,XBCNT,XBQUEST
|
||
|
|
KILL ^UTILITY($J,"ZIBCKPKG"),ZTSK
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SCAN ;
|
||
|
|
X ^%ZOSF("UCI")
|
||
|
|
W "- - - PACKAGE SCAN OF UCI ",Y,$S($D(^DD("SITE")):" ON "_^("SITE"),1:"")," - - -",!!
|
||
|
|
; S XBR=$O(^ ("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S XBR=$O(^$R("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
F Q:XBR="" Q:XBR?1L.E D CHKPKG Q:XBQUIT
|
||
|
|
Q:XBQUIT
|
||
|
|
F Q:XBR="" D GETNXT
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CHKPKG ; CHECK FOR PACKAGE
|
||
|
|
S XBPF=$E(XBR,1,4)
|
||
|
|
F XBI=$L(XBPF):-1:0 S XBPF=$E(XBPF,1,XBI) Q:XBPF="" S XBP=$O(^DIC(9.4,"C",XBPF,0)) Q:XBP
|
||
|
|
I XBPF="" D NOTPKG Q
|
||
|
|
W XBPF,?4," - ",$P(^DIC(9.4,XBP,0),U,1)
|
||
|
|
S XBRNPR=0
|
||
|
|
D SKIP
|
||
|
|
W " (",XBCNT,")",!
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
NOTPKG ;
|
||
|
|
I XBINPR S ^UTILITY($J,"ZIBCKPKG",2,XBR)="" S XBPF="" D GETNXT Q
|
||
|
|
F W XBR R " -- Package prefix? ",XBPF:DTIME S:'$T XBPF=U Q:XBPF[U D GETPKG Q:XBPF'="-"
|
||
|
|
I XBPF[U S XBQUIT=1 Q
|
||
|
|
W !
|
||
|
|
I XBPF="" D GETNXT Q
|
||
|
|
S XBI=$L(XBPF),XBRNPR=1
|
||
|
|
D SKIP
|
||
|
|
W " ",XBCNT," ROUTINES SKIPPED.",!
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETPKG ;
|
||
|
|
I XBPF?1."?" S XBQUEST=4 D DSPHLP W ! S XBPF="-" Q
|
||
|
|
I XBPF?1."?"1.E D DSPLY S XBPF="-" Q
|
||
|
|
Q:XBPF'?.E1CL.E&($L(XBPF)<5)
|
||
|
|
W " -- Package id must be upper case, length 1-4",!
|
||
|
|
S XBPF="-"
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SKIP ;
|
||
|
|
F XBCNT=1:1 S:XBRNPR ^UTILITY($J,"ZIBCKPKG",2,XBR)="" D GETNXT Q:$E(XBR,1,XBI)'=XBPF
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETNXT ;
|
||
|
|
S:XBR?.E1L.E ^UTILITY($J,"ZIBCKPKG",1,XBR)=""
|
||
|
|
; S XBR=$O(^ (XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
S XBR=$O(^$R(XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
DSPLY ;
|
||
|
|
S (XBPF,XBR2)=$E(XBPF,2,$L(XBPF))
|
||
|
|
W !
|
||
|
|
S XBJ=0
|
||
|
|
S X=XBR2
|
||
|
|
X ^%ZOSF("TEST")
|
||
|
|
I S XBJ=1 W !,XBR2
|
||
|
|
; F XBJ=XBJ:1 S XBR2=$O(^ (XBR2)) Q:$E(XBR2,1,$L(XBPF))'=XBPF W:XBJ#8=0 ! W ?XBJ#8*10,XBR2 ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
F XBJ=XBJ:1 S XBR2=$O(^$R(XBR2)) Q:$E(XBR2,1,$L(XBPF))'=XBPF W:XBJ#8=0 ! W ?XBJ#8*10,XBR2 ;IHS/SET/GTH XB*3*9 10/29/2002
|
||
|
|
W:$X !
|
||
|
|
W !
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SHOWNPR ;
|
||
|
|
Q:'$D(^UTILITY($J,"ZIBCKPKG",2))
|
||
|
|
W !!,"Non-package routines:",!
|
||
|
|
S XBR2=""
|
||
|
|
F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",2,XBR2)) Q:XBR2="" W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
|
||
|
|
W !
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SHOWLC ;
|
||
|
|
Q:'$D(^UTILITY($J,"ZIBCKPKG",1))
|
||
|
|
W !!,"Routine names containing lower case letters:",!
|
||
|
|
S XBR2=""
|
||
|
|
F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",1,XBR2)) Q:XBR2="" W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
|
||
|
|
W !
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ASKIT ; ASK A YES/NO QUESTION
|
||
|
|
KILL XBQ
|
||
|
|
S %=$T(@XBQUEST),XBQ("Q")=$P(%,";;",2),XBQ("D")=$P(%,";;",3)
|
||
|
|
ASKIT2 ;
|
||
|
|
W !,XBQ("Q")," ",XBQ("D"),"// "
|
||
|
|
R XBQ:DTIME
|
||
|
|
S:'$T XBQ=U
|
||
|
|
I XBQ="" S XBQ=XBQ("D") W XBQ
|
||
|
|
S XBQ("R")=XBQ,XBQ=""
|
||
|
|
I XBQ("R")[U S XBQ=U
|
||
|
|
I $P("YES",XBQ("R"))="" S XBQ=1
|
||
|
|
I $P("yes",XBQ("R"))="" S XBQ=1
|
||
|
|
I $P("NO",XBQ("R"))="" S XBQ=0
|
||
|
|
I $P("no",XBQ("R"))="" S XBQ=0
|
||
|
|
I XBQ]"" W ! Q
|
||
|
|
W !,"-- Please answer YES or NO"
|
||
|
|
D DSPHLP
|
||
|
|
G ASKIT
|
||
|
|
;
|
||
|
|
DSPHLP ;
|
||
|
|
F XBI=1:1 S %=$T(@XBQUEST+XBI) Q:%="" Q:$P(%," ")]"" W !,"-- ",$P(%,";;",2)
|
||
|
|
W !
|
||
|
|
KILL %
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
QUEST ;
|
||
|
|
;
|
||
|
|
1 ;;Ignore non-package routines?;;YES
|
||
|
|
;;Responding NO will cause you to be asked if a routine for which
|
||
|
|
;;a namespace cannot be identified in the package file can be
|
||
|
|
;;considered part of a "psuedo-package" with which a namespace can
|
||
|
|
;;be associated.
|
||
|
|
2 ;;Display routine names containing lower case letters?;;YES
|
||
|
|
;;Responding YES will cause a tabular listing to be produced
|
||
|
|
;;displaying all routine names which contain a lower case letter.
|
||
|
|
3 ;;Display names of non-package routines?;;YES
|
||
|
|
;;Responding YES will cause a tabular listing to be produced
|
||
|
|
;;displaying the names of all routines which were not found
|
||
|
|
;;to be part of a package.
|
||
|
|
4 ;;
|
||
|
|
;;If you enter a namespace, routines will be processed as though a
|
||
|
|
;;formal package association was made.
|