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

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 2.0 KB
Line 
1ZIBFIND ; IHS/ADC/GTH - FIND MSM BLOCKS WITH CONTAIN SPECIFIC GLOBAL ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Thanks to Ross Leatham, AAO, and Mark Delaney, DSM, for the
5 ; original routine.
6 ;
7 ; MSM-specific utility for finding blocks which contain a
8 ; specific GBL.
9 ;
10 ; ZIBCC=common count, ZIBUC=unique count
11 ; ZIBCHAR=string of characters
12 ;
13 ;S X="ERR^ZIBFIND",@^%ZOSF("TRAP") K X
14 ;
15 I '(^%ZOSF("OS")["MSM") D OSNO^XB Q ; IHS/SET/GTH XB*3*9 10/29/2002
16 S ZIBOSET=-1
17GETINFO ;
18 KILL ZIBVN,ZIBGREF,ZIBTYPE
19 D GETVOL^%VGUTIL
20 S:VGVOL=1 ZIBVN=0
21 I VGVOL>1 R !,"What Volume Number are you looking in? ",ZIBVN:30
22 G END:"^"[ZIBVN
23 S ZIBLBLK=$P(VGVOL(ZIBVN),"^",4)
24ASK1 ;
25 S ZIBN=1
26 F R !,"Enter GLOBAL to search for: ^",ZIBGREF:30 Q:"^"[ZIBGREF S ZIBGREF(ZIBN)=ZIBGREF,ZIBN=ZIBN+1
27 G END:ZIBGREF="^"
28 S ZIBTYPE="234"
29 O 63::0
30 I '$T W !,"VIEW BUFFER IN USE- SORRY" Q
31 KILL ^TMP("ZIBFIND",$J)
32 V 0:"DB/"_ZIBVN ;get the actual block number at start of volume
33 S ZIBBBLK=$V(1016,0,4),ZIBEBLK=ZIBBBLK+ZIBLBLK-1
34ASK2 ;
35 W !,"Enter beginning actual block to search from <",ZIBBBLK,"> "
36 R X:30
37 G ASK2:X'?.N,END:X["^"!(X>ZIBLBLK)
38 S:X]"" ZIBBBLK=X
39 S ZIBOSET=ZIBBBLK-1
40ASK3 ;
41 W !,"Enter last actual block to search to <",ZIBEBLK,"> "
42 R X:30
43 G ASK3:X'?.N,END:X["^"!(X<ZIBBBLK)
44 S:X]"" ZIBEBLK=X
45 W !,"Start Block=",ZIBBBLK," End Block=",ZIBEBLK,!
46 W !!,"This could take a while, hold on... ",!
47 F ZIBI=ZIBBBLK:1:ZIBEBLK V ZIBI S ZIBCC=$V(0,0,1),ZIBUC=$V(1,0,1),ZIBCHAR=$V(2,0,ZIBUC,1),ZIBBTYPE=$V(1020,0,1),ZIBOSET=ZIBOSET+1 I ZIBCHAR]"",ZIBTYPE[ZIBBTYPE D LOOP
48 C 63
49 W !,"DONE!",*7,$S($D(^TMP("ZIBFIND",$J)):" The blocks are listed in ^TMP(""ZIBFIND"","_$J_"), in this UCI",1:" no blocks were found with this data")
50 Q
51 ;
52LOOP ;
53 S ZIBN=0
54 F S ZIBN=$O(ZIBGREF(ZIBN)) Q:ZIBN="" I ZIBCHAR[ZIBGREF(ZIBN) S ^TMP("ZIBFIND",$J,ZIBGREF(ZIBN),ZIBI)=ZIBVN_":"_ZIBOSET W *13,ZIBI
55 Q
56 ;
57END ;
58 C 63
59 KILL ZIBBBLK,ZIBBTYPE,ZIBCC,ZIBCHAR,ZIBEBLK,ZIBLBLK,ZIBN,ZIBOSET,ZIBUC,ZIBZR
60 Q
61 ;
62ERR ;
63 C 63
64 S ZIBZR=$ZR
65 D @^%ZOSF("ERRTN")
66 Q
67 ;
Note: See TracBrowser for help on using the repository browser.