INHPCO2 ; JKB ; 29 Oct 97 08:58
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
;;
;
;
CONTROLS ; re-index GIS control files
N INFILE
W:$G(INVERBOS) !!,"Re-indexing GIS control files:"
F INFILE="^INRHD(","^INRHNS(","^INRHR(","^INRHS(","^INRHT(","^INTHERL(","^INTHL7F(","^INTHL7FT(","^INTHL7M(","^INTHL7S(","^INTHPC(","^INVD(4090.2," D:$G(INVERBOS) D REINDEX(INFILE)
.N X S X=@(INFILE_"0)")
.W !,$P(X,U)_" (#"_+$P(X,U,2)_") "_$P(X,U,4)_" entries started at "_$P($$CDATASC^%ZTFDT($H,2,3)," ",2)
Q
;
REINDEX(DIU,INDD) ; kill & re-index all xrefs for a file
; Input : DIU (req) = file global root in DIC format
; INDD (opt) = re-index the DD also (boolean)
; Output: void
; Note : derived from ^DIU1
N DA,DCNT,DH,DI,DIC,DIK,DV,DW,X,Y
K ^UTILITY("DIK",$J)
S DI=+$P(@(DIU_"0)"),U,2)
; get xref data and put in ^UTILITY
S X=0,DIK=DIU D DD^DIK
; loop thru xref data (DW=file#, DV=field#, DH=xref#)
S (X,DW)=0
F S DW=$O(^UTILITY("DIK",$J,DW)) Q:'DW S DV=0 D
.F S DV=$O(^UTILITY("DIK",$J,DW,DV)),DH=0 Q:'DV S DH=0 D
..F S DH=$O(^UTILITY("DIK",$J,DW,DV,DH)) Q:'DH D
...; the 6 node designates a non-'re-runnable' xref
...I $G(^DD(DW,DV,1,DH,6)) Q
...; move xref data into local X array, incrementing counter
...S Y=^UTILITY("DIK",$J,DW,DV,DH),X=X+1,X(X)=Y,X(X,0)=DW_U_DV
...; pick up triggers (they're stored differently by DD^DIK)
...I $P(Y,U,3)="",'Y,$D(^UTILITY("DIK",$J,DW,DV,DH,0)) S X(X)=^(0)
K ^UTILITY("DIK",$J)
; if no xrefs, just re-index the DD and quit
I 'X D:$G(INDD) DD(DI) Q
; loop thru xref info and kill 'regular' xrefs
F X=X:-1:1 S Y=$P(X(X),U,2,9) I Y]"",Y'[U,+X(X)=DI K @(DIK_"Y)"),X(X)
; set flag to not fire bulletins
S DIK(0)="B"
; execute delete logic for 'special' xrefs (or all xrefs?)
I $O(X(0)) S X=2,(DA,DCNT)=0 D DIXALL^DIK,CNT^DIK1
; re-index the file's DD and its data
K X D:$G(INDD) DD(DI) S DIK=DIU D IXALL^DIK
Q
DD(DI) ; clean re-index of the DD
; Input: DI = file number (do not pass by ref - it is modified)
N DDD S DDD=$O(^DIC(DI))
F D S DI=$O(^DD(DI)) I 'DI!(DI=DDD) Q
.S DIK="^DD(DI,",DA(1)=DI
.; kill the DD xrefs
.K ^DD(DI,"B"),^("GL"),^("IX"),^("RQ"),^("GR"),^("SB")
.; re-index the field definitions
.I $D(^DD(DI,0))#2 D IXALL^DIK
INHPCO2 ; JKB ; 29 Oct 97 08:58
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 ;;
+4 ;
+5 ;
CONTROLS ; re-index GIS control files
+1 NEW INFILE
+2 IF $GET(INVERBOS)
WRITE !!,"Re-indexing GIS control files:"
+3 FOR INFILE="^INRHD(","^INRHNS(","^INRHR(","^INRHS(","^INRHT(","^INTHERL(","^INTHL7F(","^INTHL7FT(","^INTHL7M(","^INTHL7S(","^INTHPC(","^INVD(4090.2,"
IF $GET(INVERBOS)
Begin DoDot:1
+4 NEW X
SET X=@(INFILE_"0)")
+5 WRITE !,$PIECE(X,U)_" (#"_+$PIECE(X,U,2)_") "_$PIECE(X,U,4)_" entries started at "_$PIECE($$CDATASC^%ZTFDT($HOROLOG,2,3)," ",2)
End DoDot:1
DO REINDEX(INFILE)
+6 QUIT
+7 ;
REINDEX(DIU,INDD) ; kill & re-index all xrefs for a file
+1 ; Input : DIU (req) = file global root in DIC format
+2 ; INDD (opt) = re-index the DD also (boolean)
+3 ; Output: void
+4 ; Note : derived from ^DIU1
+5 NEW DA,DCNT,DH,DI,DIC,DIK,DV,DW,X,Y
+6 KILL ^UTILITY("DIK",$JOB)
+7 SET DI=+$PIECE(@(DIU_"0)"),U,2)
+8 ; get xref data and put in ^UTILITY
+9 SET X=0
SET DIK=DIU
DO DD^DIK
+10 ; loop thru xref data (DW=file#, DV=field#, DH=xref#)
+11 SET (X,DW)=0
+12 FOR
SET DW=$ORDER(^UTILITY("DIK",$JOB,DW))
IF 'DW
QUIT
SET DV=0
Begin DoDot:1
+13 FOR
SET DV=$ORDER(^UTILITY("DIK",$JOB,DW,DV))
SET DH=0
IF 'DV
QUIT
SET DH=0
Begin DoDot:2
+14 FOR
SET DH=$ORDER(^UTILITY("DIK",$JOB,DW,DV,DH))
IF 'DH
QUIT
Begin DoDot:3
+15 ; the 6 node designates a non-'re-runnable' xref
+16 IF $GET(^DD(DW,DV,1,DH,6))
QUIT
+17 ; move xref data into local X array, incrementing counter
+18 SET Y=^UTILITY("DIK",$JOB,DW,DV,DH)
SET X=X+1
SET X(X)=Y
SET X(X,0)=DW_U_DV
+19 ; pick up triggers (they're stored differently by DD^DIK)
+20 IF $PIECE(Y,U,3)=""
IF 'Y
IF $DATA(^UTILITY("DIK",$JOB,DW,DV,DH,0))
SET X(X)=^(0)
End DoDot:3
End DoDot:2
End DoDot:1
+21 KILL ^UTILITY("DIK",$JOB)
+22 ; if no xrefs, just re-index the DD and quit
+23 IF 'X
IF $GET(INDD)
DO DD(DI)
QUIT
+24 ; loop thru xref info and kill 'regular' xrefs
+25 FOR X=X:-1:1
SET Y=$PIECE(X(X),U,2,9)
IF Y]""
IF Y'[U
IF +X(X)=DI
KILL @(DIK_"Y)"),X(X)
+26 ; set flag to not fire bulletins
+27 SET DIK(0)="B"
+28 ; execute delete logic for 'special' xrefs (or all xrefs?)
+29 IF $ORDER(X(0))
SET X=2
SET (DA,DCNT)=0
DO DIXALL^DIK
DO CNT^DIK1
+30 ; re-index the file's DD and its data
+31 KILL X
IF $GET(INDD)
DO DD(DI)
SET DIK=DIU
DO IXALL^DIK
+32 QUIT
DD(DI) ; clean re-index of the DD
+1 ; Input: DI = file number (do not pass by ref - it is modified)
+2 NEW DDD
SET DDD=$ORDER(^DIC(DI))
+3 FOR
Begin DoDot:1
+4 SET DIK="^DD(DI,"
SET DA(1)=DI
+5 ; kill the DD xrefs
+6 KILL ^DD(DI,"B"),^("GL"),^("IX"),^("RQ"),^("GR"),^("SB")
+7 ; re-index the field definitions
+8 IF $DATA(^DD(DI,0))#2
DO IXALL^DIK
End DoDot:1
SET DI=$ORDER(^DD(DI))
IF 'DI!(DI=DDD)
QUIT
