DDUCHK4 ;SFISC/MKO-CHECK INDEXES ON FILE ;6:36 AM 28 Dec 2004
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
INDEX(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Index file entry
N DDUCIX
Q:'$G(DDUCFI) S DDUCFIX=$G(DDUCFIX)
;
;Loop through "B" index to find INDEXes that reside on this file
D WCHK
S DDUCIX=""
F S DDUCIX=$O(^DD("IX","B",DDUCFI,DDUCIX)) Q:DDUCIX="" D CHKIX
;
;Check "AC","BB", and "F" indexes
D CHKAC,CHKBB,CHKF
Q
;
CHKIX ;Check Index DDUCIX found in "B" index
;In:
; DDUCIX = index #
; DDUCFI = file #
; DDUCFIX = flag to fix
N DDUCIX0,DDUCIXID,DDUCNM,DDUCRF,DDUCRV
S DDUCIXID=$$IXID(DDUCIX,"")
;
;Check that Index exists
I '$D(^DD("IX",DDUCIX)) D Q
. D WNOIX
. D:DDUCFIX KILL($NA(^DD("IX","B",DDUCFI,DDUCIX)))
;
;Check that index has a FILE
S DDUCIX0=$G(^DD("IX",DDUCIX,0))
I $P(DDUCIX0,U)="" D
. D WMS("FILE (#.01) for "_DDUCIXID)
. D:DDUCFIX FFILE
;
;Get Name
S DDUCNM=$P(DDUCIX0,U,2)
I DDUCNM]"" S DDUCIXID=$$IXID(DDUCIX,DDUCNM)
E D WMS("NAME for "_DDUCIXID)
;
;Check Root File not null, and "AC" index exists
S DDUCRF=$P(DDUCIX0,U,9)
I 'DDUCRF D
. D WMS("ROOT FILE for "_DDUCIXID)
. D:DDUCFIX FRF
;
;Check Cross-Reference Values multiple
S DDUCRV=0
F S DDUCRV=$O(^DD("IX",DDUCIX,11.1,DDUCRV)) Q:'DDUCRV D CRV
;
;Reindex Index file entry
I DDUCFIX D
. N DIC,DIK,DA,X
. S DIK="^DD(""IX"",",DA=DDUCIX
. D IX^DIK
Q
;
CRV ;Check a Cross-Reference Value
;In:
; DDUCIX = Index #
; DDUCRV = CRV #
; DDUCFIX = Flag to fix
; DDUCRF = Root file #
; DDUCIXID = String that identifies Index
N DDUCFIL,DDUCFLD,DDUCGL,DDUCOID,DDUCORD,DDUCRV0
;
S DDUCRV0=$G(^DD("IX",DDUCIX,11.1,DDUCRV,0))
Q:$P(DDUCRV0,U,2)="C"
S DDUCORD=$P(DDUCRV0,U),DDUCFIL=$P(DDUCRV0,U,3),DDUCFLD=$P(DDUCRV0,U,4)
;
;Check .01 of CRV
I DDUCORD="" D
. D WMS("ORDER NUMBER of Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID)
. D:DDUCFIX FON
S DDUCOID=$$OID(DDUCORD,"","",DDUCIXID)
;
;Make sure FILE is not null
I 'DDUCFIL D
. D WMS("FILE for "_DDUCOID,1)
;
;If there's a File, make sure it is equal to Root File
;and that referenced field exists.
E D
. D:DDUCFIL'=DDUCRF WNE
. D:$D(^DD(DDUCFIL,DDUCFLD,0))[0 WFMS
. I $D(^DD("IX","F",DDUCFIL,DDUCFLD,DDUCIX,DDUCRV))[0 S DDUCGL=$NA(^(DDUCRV)) D
.. D WMS(DDUCGL)
.. D:DDUCFIX SET(DDUCGL)
Q
;
CHKAC ;Check "AC index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCGL,DDUCIX
S DDUCIX=0 F S DDUCIX=$O(^DD("IX","AC",DDUCFI,DDUCIX)) Q:'DDUCIX D
. I $P($G(^DD("IX",DDUCIX,0)),U,9)]"",$P(^(0),U,9)'=DDUCFI D
.. S DDUCGL=$NA(^DD("IX","AC",DDUCFI,DDUCIX))
.. D WEN(DDUCGL)
.. D:DDUCFIX KILL(DDUCGL)
Q
;
CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCGL,DDUCIX,DDUCIX0,DDUCIXID,DDUCNM,DDUCNML
S DDUCNM=""
F S DDUCNM=$O(^DD("IX","BB",DDUCFI,DDUCNM)) Q:DDUCNM="" D
. S DDUCIX=0
. F DDUCIX=$O(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX)) Q:'DDUCIX D
.. S DDUCIX0=$G(^DD("IX",DDUCIX,0))
.. I $D(^DD("IX",DDUCIX)),$P(DDUCIX0,U,2)="" S DDUCNML(DDUCIX,DDUCNM)=""
.. E I $P(DDUCIX0,U)'=DDUCFI!($P(DDUCIX0,U,2)'=DDUCNM) D
... S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
... D WEN(DDUCGL)
... D:DDUCFIX KILL(DDUCGL)
;
;If any of the Indexes have null Names, check whether a single name
;for it was found in the "BB" index.
I $D(DDUCNML) S DDUCIX=0 F S DDUCIX=$O(DDUCNML(DDUCIX)) Q:'DDUCIX D
. S DDUCNM=$O(DDUCNML(DDUCIX,""))
. I $O(DDUCNML(DDUCIX,DDUCNM))="" D
.. S DDUCIXID=$$IXID(DDUCIX,"")
.. D WNM
.. D:DDUCFIX FNM
. E F D S DDUCNM=$O(DDUCNML(DDUCIX,DDUCNM)) Q:DDUCNM=""
.. S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
.. D WEN(DDUCGL)
.. D:DDUCFIX KILL(DDUCGL)
Q
;
CHKF ;Check "F" index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCFLD,DDUCGL,DDUCIX,DDUCRV
S DDUCFLD=0
F S DDUCFLD=$O(^DD("IX","F",DDUCFI,DDUCFLD)) Q:'DDUCFLD D
. S DDUCIX=0
. F S DDUCIX=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX)) Q:'DDUCIX D
.. S DDUCRV=0
.. F S DDUCRV=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV)) Q:'DDUCRV D
... I $P($G(^DD("IX",DDUCIX,11.1,DDUCRV,0)),U,3)'=DDUCFI!($P($G(^(0)),U,4)'=DDUCFLD) D
.... S DDUCGL=$NA(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV))
.... D WEN(DDUCGL)
.... D:DDUCFIX KILL(DDUCGL)
Q
;
;---------------
FFILE ;Set the .01 of index to DDUCFI
S $P(^DD("IX",DDUCIX,0),U)=DDUCFI
D WRITE("FILE (#.01) for "_DDUCIXID_" set to "_DDUCFI_".",10)
Q
;
FRF ;Set Root File equal to File and Root Type to 'INDEX FILE'
S $P(^DD("IX",DDUCIX,0),U,8)="I"
S $P(^DD("IX",DDUCIX,0),U,9)=DDUCFI
S DDUCRF=DDUCFI
D WRITE("ROOT FILE for "_DDUCIXID_" set to "_DDUCFI_".",10)
D WRITE("ROOT TYPE for "_DDUCIXID_" set to 'INDEX FILE'.",10)
Q
;
FON ;Determine Order Number
N DDUCI,DDUCO
;
;Look for Order Number in "B" index
S DDUCORD=0
F S DDUCORD=$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD)) Q:'DDUCORD Q:$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD,0))=DDUCRV
;
;If not found, just pick an unused Order Number
I 'DDUCORD D
. S DDUCI=0
. F S DDUCI=$O(^DD("IX",DDUCIX,11.1,DDUCI)) Q:'DDUCI S:$P($G(^(DDUCI,0)),U)]"" DDUCO($P(^(0),U))=""
. S DDUCORD=$O(DDUCO(""),-1)
. S:'DDUCORD DDUCORD=1
;
S $P(^DD("IX",DDUCIX,11.1,DDUCRV,0),U)=DDUCORD
D WRITE("ORDER NUMBER for Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID_" set to "_DDUCORD_".",10)
Q
;
FNM ;Set the NAME for the Index
S $P(^DD("IX",DDUCIX,0),U,2)=DDUCNM
D WRITE("NAME for "_DDUCIXID_" set to '"_DDUCNM_"'.",10)
Q
;
KILL(GL) ;Kill a global and print a message
Q:'$D(@GL)
K @GL
W !?10,GL_" was killed."
Q
;
SET(GL,VAL) ;Set a global and print a message
Q:$D(@GL)
S VAL=$G(VAL),@GL=VAL
W !?10,GL_" was set"_$S(VAL]"":" to "_VAL,1:"")_"."
Q
;
;Write messages
WCHK Q ;D WRITE("Checking Indexes.",5) Q
WNOIX D WRITE(DDUCIXID_" does not exist.",7) Q
WMS(S,N) D WRITE("*"_S_" is missing."_$S($G(N):" ",1:""),7) Q
WNE D WRITE("*FILE does not equal ROOT FILE in "_DDUCOID_".",7) Q ;22*130
WFMS D WRITE("*File/Sub-file #"_$S($G(FIL)'="":FIL,1:DDUCFIL)_", Field #"_$S($G(FLD)'="":FLD,1:DDUCFLD)_" referenced in "_DDUCOID_" is missing.",7) Q ;22*130
WEN(GL) D WRITE("Erroneous node "_GL_" is set.",7) Q
WNM D WRITE("NAME for "_DDUCIXID_" looks like it should be '"_DDUCNM_"'.",7) Q
;
WRITE(TXT,TAB) ;Write text, wrap at word boundaries.
N I
D WRAP^DIKCU2(.TXT,-TAB-2,-TAB)
W !?TAB,$G(TXT,$G(TXT(0))) F I=1:1 Q:'$D(TXT(I)) W !?TAB+2,TXT(I)
Q
;
IXID(IX,NM) ;Return string that identifies an Index
S:'$D(NM) NM=$P($G(^DD("IX",IX,0)),U,2)
Q $S(NM]"":"'"_NM_"' Index (#"_IX_")",1:"Index #"_IX)
;
OID(ORD,IX,NM,IXID) ;Return string that identifies Cross-Reference Value
I '$D(IXID),$G(IX) S IXID=$S($D(NM)#2:$$IXID(IX,NM),1:$$IXID(IX))
Q "Order #"_ORD_" of "_$S($G(IXID)]"":IXID,1:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDUCHK4 7133 printed Nov 22, 2024@17:53:45 Page 2
DDUCHK4 ;SFISC/MKO-CHECK INDEXES ON FILE ;6:36 AM 28 Dec 2004
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
INDEX(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Index file entry
+1 NEW DDUCIX
+2 if '$GET(DDUCFI)
QUIT
SET DDUCFIX=$GET(DDUCFIX)
+3 ;
+4 ;Loop through "B" index to find INDEXes that reside on this file
+5 DO WCHK
+6 SET DDUCIX=""
+7 FOR
SET DDUCIX=$ORDER(^DD("IX","B",DDUCFI,DDUCIX))
if DDUCIX=""
QUIT
DO CHKIX
+8 ;
+9 ;Check "AC","BB", and "F" indexes
+10 DO CHKAC
DO CHKBB
DO CHKF
+11 QUIT
+12 ;
CHKIX ;Check Index DDUCIX found in "B" index
+1 ;In:
+2 ; DDUCIX = index #
+3 ; DDUCFI = file #
+4 ; DDUCFIX = flag to fix
+5 NEW DDUCIX0,DDUCIXID,DDUCNM,DDUCRF,DDUCRV
+6 SET DDUCIXID=$$IXID(DDUCIX,"")
+7 ;
+8 ;Check that Index exists
+9 IF '$DATA(^DD("IX",DDUCIX))
Begin DoDot:1
+10 DO WNOIX
+11 if DDUCFIX
DO KILL($NAME(^DD("IX","B",DDUCFI,DDUCIX)))
End DoDot:1
QUIT
+12 ;
+13 ;Check that index has a FILE
+14 SET DDUCIX0=$GET(^DD("IX",DDUCIX,0))
+15 IF $PIECE(DDUCIX0,U)=""
Begin DoDot:1
+16 DO WMS("FILE (#.01) for "_DDUCIXID)
+17 if DDUCFIX
DO FFILE
End DoDot:1
+18 ;
+19 ;Get Name
+20 SET DDUCNM=$PIECE(DDUCIX0,U,2)
+21 IF DDUCNM]""
SET DDUCIXID=$$IXID(DDUCIX,DDUCNM)
+22 IF '$TEST
DO WMS("NAME for "_DDUCIXID)
+23 ;
+24 ;Check Root File not null, and "AC" index exists
+25 SET DDUCRF=$PIECE(DDUCIX0,U,9)
+26 IF 'DDUCRF
Begin DoDot:1
+27 DO WMS("ROOT FILE for "_DDUCIXID)
+28 if DDUCFIX
DO FRF
End DoDot:1
+29 ;
+30 ;Check Cross-Reference Values multiple
+31 SET DDUCRV=0
+32 FOR
SET DDUCRV=$ORDER(^DD("IX",DDUCIX,11.1,DDUCRV))
if 'DDUCRV
QUIT
DO CRV
+33 ;
+34 ;Reindex Index file entry
+35 IF DDUCFIX
Begin DoDot:1
+36 NEW DIC,DIK,DA,X
+37 SET DIK="^DD(""IX"","
SET DA=DDUCIX
+38 DO IX^DIK
End DoDot:1
+39 QUIT
+40 ;
CRV ;Check a Cross-Reference Value
+1 ;In:
+2 ; DDUCIX = Index #
+3 ; DDUCRV = CRV #
+4 ; DDUCFIX = Flag to fix
+5 ; DDUCRF = Root file #
+6 ; DDUCIXID = String that identifies Index
+7 NEW DDUCFIL,DDUCFLD,DDUCGL,DDUCOID,DDUCORD,DDUCRV0
+8 ;
+9 SET DDUCRV0=$GET(^DD("IX",DDUCIX,11.1,DDUCRV,0))
+10 if $PIECE(DDUCRV0,U,2)="C"
QUIT
+11 SET DDUCORD=$PIECE(DDUCRV0,U)
SET DDUCFIL=$PIECE(DDUCRV0,U,3)
SET DDUCFLD=$PIECE(DDUCRV0,U,4)
+12 ;
+13 ;Check .01 of CRV
+14 IF DDUCORD=""
Begin DoDot:1
+15 DO WMS("ORDER NUMBER of Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID)
+16 if DDUCFIX
DO FON
End DoDot:1
+17 SET DDUCOID=$$OID(DDUCORD,"","",DDUCIXID)
+18 ;
+19 ;Make sure FILE is not null
+20 IF 'DDUCFIL
Begin DoDot:1
+21 DO WMS("FILE for "_DDUCOID,1)
End DoDot:1
+22 ;
+23 ;If there's a File, make sure it is equal to Root File
+24 ;and that referenced field exists.
+25 IF '$TEST
Begin DoDot:1
+26 if DDUCFIL'=DDUCRF
DO WNE
+27 if $DATA(^DD(DDUCFIL,DDUCFLD,0))[0
DO WFMS
+28 IF $DATA(^DD("IX","F",DDUCFIL,DDUCFLD,DDUCIX,DDUCRV))[0
SET DDUCGL=$NAME(^(DDUCRV))
Begin DoDot:2
+29 DO WMS(DDUCGL)
+30 if DDUCFIX
DO SET(DDUCGL)
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
CHKAC ;Check "AC index (In: DDUCFI = file; DDUCFIX = flag to fix)
+1 NEW DDUCGL,DDUCIX
+2 SET DDUCIX=0
FOR
SET DDUCIX=$ORDER(^DD("IX","AC",DDUCFI,DDUCIX))
if 'DDUCIX
QUIT
Begin DoDot:1
+3 IF $PIECE($GET(^DD("IX",DDUCIX,0)),U,9)]""
IF $PIECE(^(0),U,9)'=DDUCFI
Begin DoDot:2
+4 SET DDUCGL=$NAME(^DD("IX","AC",DDUCFI,DDUCIX))
+5 DO WEN(DDUCGL)
+6 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
+1 NEW DDUCGL,DDUCIX,DDUCIX0,DDUCIXID,DDUCNM,DDUCNML
+2 SET DDUCNM=""
+3 FOR
SET DDUCNM=$ORDER(^DD("IX","BB",DDUCFI,DDUCNM))
if DDUCNM=""
QUIT
Begin DoDot:1
+4 SET DDUCIX=0
+5 FOR DDUCIX=$ORDER(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
if 'DDUCIX
QUIT
Begin DoDot:2
+6 SET DDUCIX0=$GET(^DD("IX",DDUCIX,0))
+7 IF $DATA(^DD("IX",DDUCIX))
IF $PIECE(DDUCIX0,U,2)=""
SET DDUCNML(DDUCIX,DDUCNM)=""
+8 IF '$TEST
IF $PIECE(DDUCIX0,U)'=DDUCFI!($PIECE(DDUCIX0,U,2)'=DDUCNM)
Begin DoDot:3
+9 SET DDUCGL=$NAME(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
+10 DO WEN(DDUCGL)
+11 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:3
End DoDot:2
End DoDot:1
+12 ;
+13 ;If any of the Indexes have null Names, check whether a single name
+14 ;for it was found in the "BB" index.
+15 IF $DATA(DDUCNML)
SET DDUCIX=0
FOR
SET DDUCIX=$ORDER(DDUCNML(DDUCIX))
if 'DDUCIX
QUIT
Begin DoDot:1
+16 SET DDUCNM=$ORDER(DDUCNML(DDUCIX,""))
+17 IF $ORDER(DDUCNML(DDUCIX,DDUCNM))=""
Begin DoDot:2
+18 SET DDUCIXID=$$IXID(DDUCIX,"")
+19 DO WNM
+20 if DDUCFIX
DO FNM
End DoDot:2
+21 IF '$TEST
FOR
Begin DoDot:2
+22 SET DDUCGL=$NAME(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
+23 DO WEN(DDUCGL)
+24 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:2
SET DDUCNM=$ORDER(DDUCNML(DDUCIX,DDUCNM))
if DDUCNM=""
QUIT
End DoDot:1
+25 QUIT
+26 ;
CHKF ;Check "F" index (In: DDUCFI = file; DDUCFIX = flag to fix)
+1 NEW DDUCFLD,DDUCGL,DDUCIX,DDUCRV
+2 SET DDUCFLD=0
+3 FOR
SET DDUCFLD=$ORDER(^DD("IX","F",DDUCFI,DDUCFLD))
if 'DDUCFLD
QUIT
Begin DoDot:1
+4 SET DDUCIX=0
+5 FOR
SET DDUCIX=$ORDER(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX))
if 'DDUCIX
QUIT
Begin DoDot:2
+6 SET DDUCRV=0
+7 FOR
SET DDUCRV=$ORDER(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV))
if 'DDUCRV
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^DD("IX",DDUCIX,11.1,DDUCRV,0)),U,3)'=DDUCFI!($PIECE($GET(^(0)),U,4)'=DDUCFLD)
Begin DoDot:4
+9 SET DDUCGL=$NAME(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV))
+10 DO WEN(DDUCGL)
+11 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;---------------
FFILE ;Set the .01 of index to DDUCFI
+1 SET $PIECE(^DD("IX",DDUCIX,0),U)=DDUCFI
+2 DO WRITE("FILE (#.01) for "_DDUCIXID_" set to "_DDUCFI_".",10)
+3 QUIT
+4 ;
FRF ;Set Root File equal to File and Root Type to 'INDEX FILE'
+1 SET $PIECE(^DD("IX",DDUCIX,0),U,8)="I"
+2 SET $PIECE(^DD("IX",DDUCIX,0),U,9)=DDUCFI
+3 SET DDUCRF=DDUCFI
+4 DO WRITE("ROOT FILE for "_DDUCIXID_" set to "_DDUCFI_".",10)
+5 DO WRITE("ROOT TYPE for "_DDUCIXID_" set to 'INDEX FILE'.",10)
+6 QUIT
+7 ;
FON ;Determine Order Number
+1 NEW DDUCI,DDUCO
+2 ;
+3 ;Look for Order Number in "B" index
+4 SET DDUCORD=0
+5 FOR
SET DDUCORD=$ORDER(^DD("IX",DDUCIX,11.1,"B",DDUCORD))
if 'DDUCORD
QUIT
if $ORDER(^DD("IX",DDUCIX,11.1,"B",DDUCORD,0))=DDUCRV
QUIT
+6 ;
+7 ;If not found, just pick an unused Order Number
+8 IF 'DDUCORD
Begin DoDot:1
+9 SET DDUCI=0
+10 FOR
SET DDUCI=$ORDER(^DD("IX",DDUCIX,11.1,DDUCI))
if 'DDUCI
QUIT
if $PIECE($GET(^(DDUCI,0)),U)]""
SET DDUCO($PIECE(^(0),U))=""
+11 SET DDUCORD=$ORDER(DDUCO(""),-1)
+12 if 'DDUCORD
SET DDUCORD=1
End DoDot:1
+13 ;
+14 SET $PIECE(^DD("IX",DDUCIX,11.1,DDUCRV,0),U)=DDUCORD
+15 DO WRITE("ORDER NUMBER for Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID_" set to "_DDUCORD_".",10)
+16 QUIT
+17 ;
FNM ;Set the NAME for the Index
+1 SET $PIECE(^DD("IX",DDUCIX,0),U,2)=DDUCNM
+2 DO WRITE("NAME for "_DDUCIXID_" set to '"_DDUCNM_"'.",10)
+3 QUIT
+4 ;
KILL(GL) ;Kill a global and print a message
+1 if '$DATA(@GL)
QUIT
+2 KILL @GL
+3 WRITE !?10,GL_" was killed."
+4 QUIT
+5 ;
SET(GL,VAL) ;Set a global and print a message
+1 if $DATA(@GL)
QUIT
+2 SET VAL=$GET(VAL)
SET @GL=VAL
+3 WRITE !?10,GL_" was set"_$SELECT(VAL]"":" to "_VAL,1:"")_"."
+4 QUIT
+5 ;
+6 ;Write messages
WCHK ;D WRITE("Checking Indexes.",5) Q
QUIT
WNOIX DO WRITE(DDUCIXID_" does not exist.",7)
QUIT
WMS(S,N) DO WRITE("*"_S_" is missing."_$SELECT($GET(N):" ",1:""),7)
QUIT
WNE ;22*130
DO WRITE("*FILE does not equal ROOT FILE in "_DDUCOID_".",7)
QUIT
WFMS ;22*130
DO WRITE("*File/Sub-file #"_$SELECT($GET(FIL)'="":FIL,1:DDUCFIL)_", Field #"_$SELECT($GET(FLD)'="":FLD,1:DDUCFLD)_" referenced in "_DDUCOID_" is missing.",7)
QUIT
WEN(GL) DO WRITE("Erroneous node "_GL_" is set.",7)
QUIT
WNM DO WRITE("NAME for "_DDUCIXID_" looks like it should be '"_DDUCNM_"'.",7)
QUIT
+1 ;
WRITE(TXT,TAB) ;Write text, wrap at word boundaries.
+1 NEW I
+2 DO WRAP^DIKCU2(.TXT,-TAB-2,-TAB)
+3 WRITE !?TAB,$GET(TXT,$GET(TXT(0)))
FOR I=1:1
if '$DATA(TXT(I))
QUIT
WRITE !?TAB+2,TXT(I)
+4 QUIT
+5 ;
IXID(IX,NM) ;Return string that identifies an Index
+1 if '$DATA(NM)
SET NM=$PIECE($GET(^DD("IX",IX,0)),U,2)
+2 QUIT $SELECT(NM]"":"'"_NM_"' Index (#"_IX_")",1:"Index #"_IX)
+3 ;
OID(ORD,IX,NM,IXID) ;Return string that identifies Cross-Reference Value
+1 IF '$DATA(IXID)
IF $GET(IX)
SET IXID=$SELECT($DATA(NM)#2:$$IXID(IX,NM),1:$$IXID(IX))
+2 QUIT "Order #"_ORD_" of "_$SELECT($GET(IXID)]"":IXID,1:"")
