source: IHS-VA_UTILITIES-XB/trunk/XBPATSE.m@ 1320

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

Modified directory structure; moved routines.
File size: 6.0 KB
Line 
1XBPATSE ; IHS/ADC/GTH - SEARCH ROUTINES FOR PATCHES ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; Search Routines for Patch Versions.
6 ;
7 ; Thanks to Ray A. Willie for the original routine.
8 ;
9MAIN ;
10 NEW XB,DUZ,IO,IOF,IOM,IOSL,IOBS,IOXY,IOST,DT,DTIME,POP,U,X,Y
11 D INIT
12 D:'$D(ZTQUEUED)
13 . D RSEL
14 . D:'XB("END") DEVICE
15 .Q
16 D:'XB("END") SRCH
17 D:'XB("END") PRT
18 D EXIT
19 Q
20 ;
21INIT ;
22 S (XB("END"),XB("VER"),XB("PNBR"),XB("Q"))=0,XB("NAM")=""
23 KILL ^TMP($J)
24 D:'$D(ZTQUEUED) ^XBKVAR,DT^DICRW,HOME^%ZIS
25 D NOW^%DTC
26 S Y=%
27 X ^DD("DD")
28 S XB("DT")=Y
29 X ^%ZOSF("UCI")
30 S XB("UCI")=$P(Y,","),XB("VOL")=$P(Y,",",2)
31 S XB("HD1")="R.P.M.S. PATCH SEARCH UTILITY Version: "_$P($T(+2),";",3)
32 S XB("HD2")="UCI: "_XB("UCI")_" CPU: "_XB("VOL")_" "_XB("DT")
33 Q
34 ;
35RSEL ;
36 D SCHDR
37 X ^%ZOSF("RSEL")
38 S XB("END")='$D(^UTILITY($J))
39 Q
40 ;
41DEVICE ;
42 NEW %ZIS
43 S %ZIS="NMQ"
44 D ^%ZIS
45 S XB("END")=POP
46 Q:XB("END")
47 S XB("IOP")=ION_";"_IOST_$S($D(IO("DOC")):";"_IO("DOC"),1:";"_IOM_";"_IOSL)
48 D:$D(IO("Q")) QUE
49 Q
50 ;
51QUE ;
52 NEW ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
53 D:IO=IO(0)&($E(IOST,1,2)="C-")&($D(IO("Q"))#2)
54 . W !,"Cannot Queue to HOME or CHARACTER Device",!
55 . S XB("END")=1
56 .Q
57 Q:XB("END")
58 S ZTRTN="^"_$TR($P($T(+1),";")," ",""),ZTIO=XB("IOP"),ZTDESC=$P($T(+1),";",2)
59 F Q:$E(ZTDESC)'=" " S ZTDESC=$E(ZTDESC,2,99)
60 S ZTSAVE("^UTILITY($J,")=""
61 D ^%ZTLOAD
62 I '$D(ZTSK) W !,"TASK not Queued with Task Manager",! S XB("END")=1
63 Q:XB("END")
64 S %H=ZTSK("D")
65 D YX^%DTC
66 W !,"TASK Queued with Task Manager: JOB # ",ZTSK," at ",Y,!
67 D HOME^%ZIS
68 S XB("END")=1
69 Q
70 ;
71SRCH ;
72 NEW XCNP,DIF
73 D:'$D(ZTQUEUED) SCHDR
74 S XB("NSP")=""
75 F S XB("NSP")=$O(^DIC(9.4,"C",XB("NSP"))) Q:XB("NSP")="" D
76 . S XB("EIN")=0,XB("EIN")=$O(^DIC(9.4,"C",XB("NSP"),XB("EIN")))
77 . S XB("NAM")=$P($G(^DIC(9.4,XB("EIN"),0)),U)
78 . S XB("VER")=$G(^DIC(9.4,XB("EIN"),"VERSION"),0)
79 . S XB("ROU")=XB("NSP")
80 . S:$D(^UTILITY($J,XB("ROU"))) XB("ROU")=$O(^UTILITY($J,XB("ROU")),-1)
81 . F XB("RKT")=0:1 S XB("ROU")=$O(^UTILITY($J,XB("ROU"))) Q:$E(XB("ROU"),1,$L(XB("NSP")))'=XB("NSP") D SRCH1
82 . D:XB("RKT")>0 SRCH2
83 .Q
84 ;S XB("NSP")="~~",XB("ROU")="";IHS/SET/GTH XB*3*9 10/29/2002
85 S XB("NSP")="~~",XB("ROU")=0 ;IHS/SET/GTH XB*3*9 10/29/2002
86 F XB("RKT")=0:1 S XB("ROU")=$O(^UTILITY($J,XB("ROU"))) Q:XB("ROU")="" D
87 . S XB("NAM")="",XB("VER")=0
88 . D SRCH1
89 .Q
90 S XB("NAM")="%",XB("VER")=0
91 D:XB("RKT")>0 SRCH2
92 Q
93 ;
94SRCH1 ;
95 D:'$D(ZTQUEUED)
96 . W:'(XB("RKT")#8) !
97 . W XB("ROU"),$J("",9-$L(XB("ROU")))
98 .Q
99 S XCNP=0,DIF="^TMP("_$J_",""R"","""_XB("ROU")_""",",X=XB("ROU")
100 X ^%ZOSF("TEST")
101 Q:'$T
102 X ^%ZOSF("LOAD")
103 S XB("PPC")=$TR($P($G(^TMP($J,"R",XB("ROU"),2,0)),";",5),"*","")
104 D:XB("PPC")]""&(XB("PPC")'=0)
105 . S:XB("NAM")="" XB("NAM")=$P($G(^TMP($J,"R",XB("ROU"),2,0)),";",4)
106 . S:XB("VER")=0 XB("VER")=$P($G(^TMP($J,"R",XB("ROU"),2,0)),";",3)
107 . S XB("DESC")=$S($P($P($G(^TMP($J,"R",XB("ROU"),1,0)),";",2),"-",2,3)'="":$P($P($G(^TMP($J,"R",XB("ROU"),1,0)),";",2),"-",2,3),1:$P($G(^TMP($J,"R",XB("ROU"),1,0)),";",3))
108 . F Q:$E(XB("DESC"))'=" " S XB("DESC")=$E(XB("DESC"),2,99)
109 . D:XB("VER")]""&(XB("NAM")]"")
110 .. F XB("J")=1:1 S XB("PNR")=$P(XB("PPC"),",",XB("J")) Q:XB("PNR")="" D:XB("PNR")?1.4N
111 ... S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNR"),XB("ROU"))=XB("DESC")
112 ... S ^TMP($J,"P","P",XB("PNR"))=""
113 ... S ^TMP($J,"P","R",XB("ROU"))=""
114 KILL ^TMP($J,"R",XB("ROU")),^UTILITY($J,XB("ROU"))
115 Q
116 ;
117SRCH2 ;
118 W:'$D(ZTQUEUED) !!?5,XB("RKT")," Routines Processed",!!
119 S (XB("PNR"),XB("ROU"))=""
120 F XB("PKT")=0:1 S XB("PNR")=$O(^TMP($J,"P","P",XB("PNR"))) Q:XB("PNR")=""
121 F XB("PRK")=0:1 S XB("ROU")=$O(^TMP($J,"P","R",XB("ROU"))) Q:XB("ROU")=""
122 KILL ^TMP($J,"P","P"),^TMP($J,"P","R")
123 S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)=XB("RKT")
124 S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)=XB("PKT")
125 S ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)=XB("PRK")
126 Q
127 ;
128SCHDR ;
129 W !,?IOM-$L(XB("HD1"))\2,XB("HD1"),!,?IOM-$L(XB("HD2"))\2,XB("HD2"),!
130 Q
131 ;
132PRT ;
133 S XB("PAGE")=0,XB("NSP")=""
134 D:'$D(ZTQUEUED)
135 . S IOP=XB("IOP")
136 . D ^%ZIS
137 .Q
138 U IO
139 D HDR
140 F S XB("NSP")=$O(^TMP($J,"P",XB("NSP"))) Q:XB("NSP")=""!(XB("END")) D
141 . S XB("NAM")=""
142 . F S XB("NAM")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"))) Q:XB("NAM")=""!(XB("END")) D
143 .. D:XB("NAM")="%"
144 ... W !!,"****",?5,"ROUTINES THAT ARE NOT IN PACKAGE FILE NAME-SPACE"
145 ... W !?5,^TMP($J,"P",XB("NSP"),"%",0,.01)," TOTAL ROUTINE(s): "
146 ... W ^TMP($J,"P",XB("NSP"),"%",0,.02)," PATCHE(s) in "
147 ... W ^TMP($J,"P",XB("NSP"),"%",0,.03)," ROUTINE(s)",!
148 ... S XB("NAM")=$O(^TMP($J,"P",XB("NSP"),XB("NAM")))
149 .. S XB("END")=(XB("NAM")="")
150 .. Q:XB("END")
151 .. S XB("VER")=.5
152 .. F S XB("VER")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"))) Q:XB("VER")=""!(XB("END")) D
153 ... D:$Y+5>IOSL HDR
154 ... Q:XB("END")
155 ... W !!,XB("NSP"),?5,XB("NAM")," -- Version: ",XB("VER")
156 ... D:XB("NSP")'="~~"
157 .... W !?5,^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.01)," TOTAL ROUTINE(s): "
158 .... W ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.02)," PATCHE(s) in "
159 .... W ^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),.03)," ROUTINE(s)",!
160 ... S XB("PNBR")=.5
161 ... F S XB("PNBR")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"))) Q:XB("PNBR")=""!(XB("END")) D
162 .... S XB("ROU")=""
163 .... F S XB("ROU")=$O(^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU"))) Q:XB("ROU")=""!(XB("END")) D
164 ..... D:$Y+5>IOSL HDR
165 ..... Q:XB("END")
166 ..... W !,$J(XB("PNBR"),4),?5,XB("ROU"),?14,^TMP($J,"P",XB("NSP"),XB("NAM"),XB("VER"),XB("PNBR"),XB("ROU"))
167 Q
168 ;
169HDR ;
170 NEW DIRUT,DUOUT
171 D:XB("PAGE")&($E(IOST,1,2)="C-")&(IO=IO(0))
172 . S Y=$$DIR^XBDIR("E")
173 . S:$D(DIRUT)!($D(DUOUT)) XB("END")=1
174 .Q
175 Q:XB("END")
176HDR1 ;
177 D:$D(IO("S"))&('XB("PAGE"))
178 . S (DX,DY)=0
179 . X ^%ZOSF("XY")
180 .Q
181 W:$E(IOST,1,2)="C-"!(($E(IOST,1,2)'="C-")&(XB("PAGE"))) @IOF
182HDR2 ;
183 S XB("PAGE")=XB("PAGE")+1
184 W !,?IOM-$L(XB("HD1"))\2,XB("HD1"),?(IOM-15),"PAGE: ",$J(XB("PAGE"),3)
185 W !,?IOM-$L(XB("HD2"))\2,XB("HD2")
186 W !,"PATCH"
187 W !,"NMBR",?5,"ROUTINE",?14,"ROUTINE DESCRIPTION"
188 W !,"==== ======== ",$$REPEAT^XLFSTR("=",IOM-19)
189 Q
190 ;
191EXIT ;
192 D ^%ZISC
193 KILL ^UTILITY($J),^TMP($J)
194 Q
195 ;
Note: See TracBrowser for help on using the repository browser.