- 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 ;
