source: IHS-VA_UTILITIES-XB/trunk/ZIBCKPKG.m@ 1119

Last change on this file since 1119 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 4.4 KB
RevLine 
[641]1ZIBCKPKG ; IHS/ADC/GTH - CHECK UCI FOR PACKAGE CONTENT ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ;XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Change MSM systax to use $ROUTINE.
5 D INIT
6 S XBQUEST=1 D ASKIT G:XBQ=U EXIT S XBINPR=XBQ
7 S XBQUEST=2 D ASKIT G:XBQ=U EXIT S XBLC=XBQ
8 S XBQUEST=3 D ASKIT G:XBQ=U EXIT S XBLNPR=XBQ
9 ;
10ZIS ; SELECT DEVICE
11 KILL ZTSK,IOP,%ZIS
12 S %ZIS="PQM"
13 D ^%ZIS
14 G:POP EXIT
15 G:$D(IO("Q")) QUE
16NOQUE ;
17 U IO
18 D EN
19 D ^%ZISC
20 G EXIT
21 ;
22QUE ;
23 KILL ZTSAVE
24 F %="XBINPR","XBLNPR","XBLC" S ZTSAVE(%)=""
25 S ZTRTN="EN^ZIBCKPKG",ZTDESC="SCAN UCI FOR PACKAGES",ZTIO=IO,ZTDTH=0
26 D ^%ZTLOAD
27 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
28EXIT ;
29 D KILLS
30 Q
31 ;
32EN1 ; ENTRY FOR SILENT OPERATION
33 D INIT
34 S (XBINPR,XBLC)=1
35 G EN
36 ;
37INIT ; INITIALIZATION
38 S U="^"
39 S:'$D(DTIME) DTIME=300
40 Q
41 ;
42EN ; COMMON INTERNAL ENTRY
43 S XBQUIT=0
44 KILL ^UTILITY($J,"ZIBCKPKG")
45 D SCAN
46 Q:XBQUIT
47 D:XBLNPR SHOWNPR
48 D:XBLC SHOWLC
49 I $D(IOST),$D(IOF),$E(IOST,1,2)="P-" W @IOF
50 SET:$D(ZTQUEUED) ZTREQ="@"
51KILLS ;
52 KILL XBINPR,XBRNPR,XBLNPR,XBLC,XBQUIT,XBR,XBR2,XBPF,XBI,XBJ,XBP,XBQ,XBCNT,XBQUEST
53 KILL ^UTILITY($J,"ZIBCKPKG"),ZTSK
54 Q
55 ;
56SCAN ;
57 X ^%ZOSF("UCI")
58 W "- - - PACKAGE SCAN OF UCI ",Y,$S($D(^DD("SITE")):" ON "_^("SITE"),1:"")," - - -",!!
59 ; S XBR=$O(^ ("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
60 S XBR=$O(^$R("%zzzzzzz")) ;IHS/SET/GTH XB*3*9 10/29/2002
61 F Q:XBR="" Q:XBR?1L.E D CHKPKG Q:XBQUIT
62 Q:XBQUIT
63 F Q:XBR="" D GETNXT
64 Q
65 ;
66CHKPKG ; CHECK FOR PACKAGE
67 S XBPF=$E(XBR,1,4)
68 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
69 I XBPF="" D NOTPKG Q
70 W XBPF,?4," - ",$P(^DIC(9.4,XBP,0),U,1)
71 S XBRNPR=0
72 D SKIP
73 W " (",XBCNT,")",!
74 Q
75 ;
76NOTPKG ;
77 I XBINPR S ^UTILITY($J,"ZIBCKPKG",2,XBR)="" S XBPF="" D GETNXT Q
78 F W XBR R " -- Package prefix? ",XBPF:DTIME S:'$T XBPF=U Q:XBPF[U D GETPKG Q:XBPF'="-"
79 I XBPF[U S XBQUIT=1 Q
80 W !
81 I XBPF="" D GETNXT Q
82 S XBI=$L(XBPF),XBRNPR=1
83 D SKIP
84 W " ",XBCNT," ROUTINES SKIPPED.",!
85 Q
86 ;
87GETPKG ;
88 I XBPF?1."?" S XBQUEST=4 D DSPHLP W ! S XBPF="-" Q
89 I XBPF?1."?"1.E D DSPLY S XBPF="-" Q
90 Q:XBPF'?.E1CL.E&($L(XBPF)<5)
91 W " -- Package id must be upper case, length 1-4",!
92 S XBPF="-"
93 Q
94 ;
95SKIP ;
96 F XBCNT=1:1 S:XBRNPR ^UTILITY($J,"ZIBCKPKG",2,XBR)="" D GETNXT Q:$E(XBR,1,XBI)'=XBPF
97 Q
98 ;
99GETNXT ;
100 S:XBR?.E1L.E ^UTILITY($J,"ZIBCKPKG",1,XBR)=""
101 ; S XBR=$O(^ (XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
102 S XBR=$O(^$R(XBR)) ;IHS/SET/GTH XB*3*9 10/29/2002
103 Q
104 ;
105DSPLY ;
106 S (XBPF,XBR2)=$E(XBPF,2,$L(XBPF))
107 W !
108 S XBJ=0
109 S X=XBR2
110 X ^%ZOSF("TEST")
111 I S XBJ=1 W !,XBR2
112 ; 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
113 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
114 W:$X !
115 W !
116 Q
117 ;
118SHOWNPR ;
119 Q:'$D(^UTILITY($J,"ZIBCKPKG",2))
120 W !!,"Non-package routines:",!
121 S XBR2=""
122 F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",2,XBR2)) Q:XBR2="" W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
123 W !
124 Q
125 ;
126SHOWLC ;
127 Q:'$D(^UTILITY($J,"ZIBCKPKG",1))
128 W !!,"Routine names containing lower case letters:",!
129 S XBR2=""
130 F XBJ=0:1 S XBR2=$O(^UTILITY($J,"ZIBCKPKG",1,XBR2)) Q:XBR2="" W:XBJ#8=0 ! W ?XBJ#8*10,XBR2
131 W !
132 Q
133 ;
134ASKIT ; ASK A YES/NO QUESTION
135 KILL XBQ
136 S %=$T(@XBQUEST),XBQ("Q")=$P(%,";;",2),XBQ("D")=$P(%,";;",3)
137ASKIT2 ;
138 W !,XBQ("Q")," ",XBQ("D"),"// "
139 R XBQ:DTIME
140 S:'$T XBQ=U
141 I XBQ="" S XBQ=XBQ("D") W XBQ
142 S XBQ("R")=XBQ,XBQ=""
143 I XBQ("R")[U S XBQ=U
144 I $P("YES",XBQ("R"))="" S XBQ=1
145 I $P("yes",XBQ("R"))="" S XBQ=1
146 I $P("NO",XBQ("R"))="" S XBQ=0
147 I $P("no",XBQ("R"))="" S XBQ=0
148 I XBQ]"" W ! Q
149 W !,"-- Please answer YES or NO"
150 D DSPHLP
151 G ASKIT
152 ;
153DSPHLP ;
154 F XBI=1:1 S %=$T(@XBQUEST+XBI) Q:%="" Q:$P(%," ")]"" W !,"-- ",$P(%,";;",2)
155 W !
156 KILL %
157 Q
158 ;
159QUEST ;
160 ;
1611 ;;Ignore non-package routines?;;YES
162 ;;Responding NO will cause you to be asked if a routine for which
163 ;;a namespace cannot be identified in the package file can be
164 ;;considered part of a "psuedo-package" with which a namespace can
165 ;;be associated.
1662 ;;Display routine names containing lower case letters?;;YES
167 ;;Responding YES will cause a tabular listing to be produced
168 ;;displaying all routine names which contain a lower case letter.
1693 ;;Display names of non-package routines?;;YES
170 ;;Responding YES will cause a tabular listing to be produced
171 ;;displaying the names of all routines which were not found
172 ;;to be part of a package.
1734 ;;
174 ;;If you enter a namespace, routines will be processed as though a
175 ;;formal package association was made.
Note: See TracBrowser for help on using the repository browser.