source: IHS-VA_UTILITIES-XB/XBPATSE.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
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.