ZIBFIND.m

ZIBFIND ; IHS/ADC/GTH - FIND MSM BLOCKS WITH CONTAIN SPECIFIC GLOBAL ; [ 10/29/2002   7:42 AM ]

 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 ;

 ; Thanks to Ross Leatham, AAO, and Mark Delaney, DSM, for the

 ; original routine.

 ;

 ; MSM-specific utility for finding blocks which contain a

 ; specific GBL.

 ;

 ;  ZIBCC=common count, ZIBUC=unique count

 ;  ZIBCHAR=string of characters

 ;

 ;S X="ERR^ZIBFIND",@^%ZOSF("TRAP") K X

 ;

 I '(^%ZOSF("OS")["MSM") D OSNO^XB Q  ; IHS/SET/GTH XB*3*9 10/29/2002

 S ZIBOSET=-1

GETINFO ;

 KILL ZIBVN,ZIBGREF,ZIBTYPE

 D GETVOL^%VGUTIL

 S:VGVOL=1 ZIBVN=0

 I VGVOL>1 R !,"What Volume Number are you looking in? ",ZIBVN:30

 G END:"^"[ZIBVN

 S ZIBLBLK=$P(VGVOL(ZIBVN),"^",4)

ASK1 ;

 S ZIBN=1

 F  R !,"Enter GLOBAL to search for: ^",ZIBGREF:30 Q:"^"[ZIBGREF  S ZIBGREF(ZIBN)=ZIBGREF,ZIBN=ZIBN+1

 G END:ZIBGREF="^"

 S ZIBTYPE="234"

 O 63::0

 I '$T W !,"VIEW BUFFER IN USE- SORRY" Q

 KILL ^TMP("ZIBFIND",$J)

 V 0:"DB/"_ZIBVN ;get the actual block number at start of volume

 S ZIBBBLK=$V(1016,0,4),ZIBEBLK=ZIBBBLK+ZIBLBLK-1

ASK2 ;

 W !,"Enter beginning actual block to search from <",ZIBBBLK,"> "

 R X:30

 G ASK2:X'?.N,END:X["^"!(X>ZIBLBLK)

 S:X]"" ZIBBBLK=X

 S ZIBOSET=ZIBBBLK-1

ASK3 ;

 W !,"Enter last actual block to search to <",ZIBEBLK,"> "

 R X:30

 G ASK3:X'?.N,END:X["^"!(X<ZIBBBLK)

 S:X]"" ZIBEBLK=X

 W !,"Start Block=",ZIBBBLK,"     End Block=",ZIBEBLK,!

 W !!,"This could take a while, hold on... ",!

 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

 C 63

 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")

 Q

 ;

LOOP ;

 S ZIBN=0

 F  S ZIBN=$O(ZIBGREF(ZIBN)) Q:ZIBN=""  I ZIBCHAR[ZIBGREF(ZIBN) S ^TMP("ZIBFIND",$J,ZIBGREF(ZIBN),ZIBI)=ZIBVN_":"_ZIBOSET W *13,ZIBI

 Q

 ;

END ;

 C 63

 KILL ZIBBBLK,ZIBBTYPE,ZIBCC,ZIBCHAR,ZIBEBLK,ZIBLBLK,ZIBN,ZIBOSET,ZIBUC,ZIBZR

 Q

 ;

ERR ;

 C 63

 S ZIBZR=$ZR

 D @^%ZOSF("ERRTN")

 Q

 ;

ZIBFIND   ; IHS/ADC/GTH - FIND MSM BLOCKS WITH CONTAIN SPECIFIC GLOBAL ; [ 10/29/2002   7:42 AM ]

 +1       ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997

 +2       ;

 +3       ; Thanks to Ross Leatham, AAO, and Mark Delaney, DSM, for the

 +4       ; original routine.

 +5       ;

 +6       ; MSM-specific utility for finding blocks which contain a

 +7       ; specific GBL.

 +8       ;

 +9       ;  ZIBCC=common count, ZIBUC=unique count

 +10      ;  ZIBCHAR=string of characters

 +11      ;

 +12      ;S X="ERR^ZIBFIND",@^%ZOSF("TRAP") K X

 +13      ;

 +14      ; IHS/SET/GTH XB*3*9 10/29/2002

           IF '(^%ZOSF("OS")["MSM")

               DO OSNO^XB

               QUIT 

 +15       SET ZIBOSET=-1

GETINFO   ;

 +1        KILL ZIBVN,ZIBGREF,ZIBTYPE

 +2        DO GETVOL^%VGUTIL

 +3        IF VGVOL=1

               SET ZIBVN=0

 +4        IF VGVOL>1

               READ !,"What Volume Number are you looking in? ",ZIBVN:30

 +5        IF "^"[ZIBVN

               GOTO END

 +6        SET ZIBLBLK=$PIECE(VGVOL(ZIBVN),"^",4)

ASK1      ;

 +1        SET ZIBN=1

 +2        FOR 

               READ !,"Enter GLOBAL to search for: ^",ZIBGREF:30

               IF "^"[ZIBGREF

                   QUIT 

               SET ZIBGREF(ZIBN)=ZIBGREF

               SET ZIBN=ZIBN+1

 +3        IF ZIBGREF="^"

               GOTO END

 +4        SET ZIBTYPE="234"

 +5        OPEN 63::0

 +6        IF '$TEST

               WRITE !,"VIEW BUFFER IN USE- SORRY"

               QUIT 

 +7        KILL ^TMP("ZIBFIND",$JOB)

 +8       ;get the actual block number at start of volume

           VIEW 0:"DB/"_ZIBVN

 +9        SET ZIBBBLK=$VIEW(1016,0,4)

           SET ZIBEBLK=ZIBBBLK+ZIBLBLK-1

ASK2      ;

 +1        WRITE !,"Enter beginning actual block to search from <",ZIBBBLK,"> "

 +2        READ X:30

 +3        IF X'?.N

               GOTO ASK2

           IF X["^"!(X>ZIBLBLK)

               GOTO END

 +4        IF X]""

               SET ZIBBBLK=X

 +5        SET ZIBOSET=ZIBBBLK-1

ASK3      ;

 +1        WRITE !,"Enter last actual block to search to <",ZIBEBLK,"> "

 +2        READ X:30

 +3        IF X'?.N

               GOTO ASK3

           IF X["^"!(X<ZIBBBLK)

               GOTO END

 +4        IF X]""

               SET ZIBEBLK=X

 +5        WRITE !,"Start Block=",ZIBBBLK,"     End Block=",ZIBEBLK,!

 +6        WRITE !!,"This could take a while, hold on... ",!

 +7        FOR ZIBI=ZIBBBLK:1:ZIBEBLK

               VIEW ZIBI

               SET ZIBCC=$VIEW(0,0,1)

               SET ZIBUC=$VIEW(1,0,1)

               SET ZIBCHAR=$VIEW(2,0,ZIBUC,1)

               SET ZIBBTYPE=$VIEW(1020,0,1)

               SET ZIBOSET=ZIBOSET+1

               IF ZIBCHAR]""

                   IF ZIBTYPE[ZIBBTYPE

                       DO LOOP

 +8        CLOSE 63

 +9        WRITE !,"DONE!",*7,$SELECT($DATA(^TMP("ZIBFIND",$JOB)):" The blocks are listed in ^TMP(""ZIBFIND"","_$JOB_"), in this UCI",1:" no blocks were found with this data")

 +10       QUIT 

 +11      ;

LOOP      ;

 +1        SET ZIBN=0

 +2        FOR 

               SET ZIBN=$ORDER(ZIBGREF(ZIBN))

               IF ZIBN=""

                   QUIT 

               IF ZIBCHAR[ZIBGREF(ZIBN)

                   SET ^TMP("ZIBFIND",$JOB,ZIBGREF(ZIBN),ZIBI)=ZIBVN_":"_ZIBOSET

                   WRITE *13,ZIBI

 +3        QUIT 

 +4       ;

END       ;

 +1        CLOSE 63

 +2        KILL ZIBBBLK,ZIBBTYPE,ZIBCC,ZIBCHAR,ZIBEBLK,ZIBLBLK,ZIBN,ZIBOSET,ZIBUC,ZIBZR

 +3        QUIT 

 +4       ;

ERR       ;

 +1        CLOSE 63

 +2        SET ZIBZR=$ZR

 +3        DO @^%ZOSF("ERRTN")

 +4        QUIT 

 +5       ;