source: IHS-VA_UTILITIES-XB/trunk/ZIBFIND.m@ 1720

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

Modified directory structure; moved routines.

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.