DDUCHK5 ;SFISC/MKO-CHECK KEYS ON FILE ;8/8/03 06:26
;;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.
;
KEY(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Key file entry
N DDUCKEY
Q:'$G(DDUCFI) S DDUCFIX=$G(DDUCFIX)
;
;Loop through "B" index to find KEYs that reside on this file
D WCHK
S DDUCKEY=""
F S DDUCKEY=$O(^DD("KEY","B",DDUCFI,DDUCKEY)) Q:DDUCKEY="" D CHKKEY
;
;Check "AP","BB", and "F" indexes
D CHKAP,CHKBB,CHKF
Q
;
CHKKEY ;Check Key DDUCKEY found in "B" index
;In:
; DDUCKEY = Key #
; DDUCFI = File #
; DDUCFIX = Flag to fix
N DDUCIEN,DDUCKEY0,DDUCKID,DDUCNM,DDUCUI
S DDUCKID=$$KEYID(DDUCKEY,"")
;
;Check that Key exists
I '$D(^DD("KEY",DDUCKEY)) D Q
. D WNOKEY
. D:DDUCFIX KILL($NA(^DD("KEY","B",DDUCFI,DDUCKEY)))
;
;Check that Key has a FILE
S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
I $P(DDUCKEY0,U)="" D
. D WMS("FILE (#.01) for "_DDUCKID)
. D:DDUCFIX FFILE
;
;Get Name
S DDUCNM=$P(DDUCKEY0,U,2)
I DDUCNM]"" S DDUCKID=$$KEYID(DDUCKEY,DDUCNM)
E D WMS("NAME for "_DDUCKID)
;
;Check Priority
S DDUCPRI=$P(DDUCKEY0,U,3)
D:DDUCPRI="" WMS("PRIORITY for "_DDUCKID)
;
;Check Uniqueness Index
S DDUCUI=$P(DDUCKEY0,U,4)
I 'DDUCUI D
. D WMS("Uniqueness Index for "_DDUCKID,1)
E D
. I '$D(^DD("IX",DDUCUI,0)) D Q
.. D WMS("Dangling pointer. Uniqueness Index #"_DDUCUI_" pointed to by "_DDUCKID,1)
. D GETFLD^DIKKUTL2(DDUCKEY,DDUCUI,.DDUCKFLD,.DDUCUFLD)
. D:'$$GCMP^DIKCU2("DDUCKFLD","DDUCUFLD") WNE
;
;Check Field multiple
S DDUCIEN=0
F S DDUCIEN=$O(^DD("KEY",DDUCKEY,2,DDUCIEN)) Q:'DDUCIEN D FLD
;
;Reindex Key file entry
I DDUCFIX D
. N DIC,DIK,DA,X
. S DIK="^DD(""KEY"",",DA=DDUCKEY
. D IX^DIK
Q
;
FLD ;Check a Cross-Reference Value
;In:
; DDUCKEY = Key #
; DDUCIEN = IEN in FIELD multiple
; DDUCFIX = Flag to fix
; DDUCKID = String that identifies Key
; DDUCUI = Uniqueness index #
N DDUCFIL,DDUCFLD,DDUCFLD0,DDUCKFLD,DDUCSEQ,DDUCUFLD
;
S DDUCFLD0=$G(^DD("KEY",DDUCKEY,2,DDUCIEN,0))
S DDUCFLD=$P(DDUCFLD0,U),DDUCFIL=$P(DDUCFLD0,U,2)
S DDUCSEQ=$P(DDUCFLD0,U,3)
;
;Check that field, file, and sequence are filled in
D:'DDUCFLD!'DDUCFIL!'DDUCSEQ WINC
;
;Make sure file/field exists and is in the "F" index
I DDUCFLD,DDUCFIL D
. D:$D(^DD(DDUCFIL,DDUCFLD,0))[0 WFMS
. I $D(^DD("KEY","F",DDUCFIL,DDUCFLD,DDUCKEY,DDUCIEN))[0 S DDUCGL=$NA(^(DDUCIEN)) D
.. D WMS(DDUCGL)
.. D:DDUCFIX SET(DDUCGL)
Q
;
CHKAP ;Check "AP" index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCGL,DDUCKEY,DDUCKEY0,DDUCPRI,DDUCPRIL
;
S DDUCPRI=""
F S DDUCPRI=$O(^DD("KEY","AP",DDUCFI,DDUCPRI)) Q:DDUCPRI="" D
. S DDUCKEY=0
. F S DDUCKEY=$O(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY)) Q:'DDUCKEY D
.. S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
.. I $D(^DD("KEY",DDUCKEY)),$P(DDUCKEY0,U,3)="" S DDUCPRIL(DDUCKEY,DDUCPRI)=""
.. E I $P(DDUCKEY0,U)'=DDUCFI!($P(DDUCKEY0,U,3)'=DDUCPRI) D
... S DDUCGL=$NA(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
... D WEN(DDUCGL)
... D:DDUCFIX KILL(DDUCGL)
;
;If any of the Keys have null Priorities, check whether a single
;priority for it was found in the "AP" index.
I $D(DDUCPRIL) S DDUCKEY=0 F S DDUCKEY=$O(DDUCPRIL(DDUCKEY)) Q:'DDUCKEY D
. S DDUCPRI=$O(DDUCPRIL(DDUCKEY,""))
. I $O(DDUCPRIL(DDUCKEY,DDUCPRI))="" D
.. S DDUCKID=$$KEYID(DDUCKEY)
.. D WPRI
.. D:DDUCFIX FPRI
. E F D S DDUCPRI=$O(DDUCPRIL(DDUCKEY,DDUCPRI)) Q:DDUCPRI=""
.. S DDUCGL=$NA(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
.. D WEN(DDUCGL)
.. D:DDUCFIX KILL(DDUCGL)
Q
;
CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCGL,DDUCKEY,DDUCKEY0,DDUCKID,DDUCNM,DDUCNML
S DDUCNM=""
F S DDUCNM=$O(^DD("KEY","BB",DDUCFI,DDUCNM)) Q:DDUCNM="" D
. S DDUCKEY=0
. F DDUCKEY=$O(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY)) Q:'DDUCKEY D
.. S DDUCKEY0=$G(^DD("KEY",DDUCKEY,0))
.. I $D(^DD("KEY",DDUCKEY)),$P(DDUCKEY0,U,2)="" S DDUCNML(DDUCKEY,DDUCNM)=""
.. E I $P(DDUCKEY0,U)'=DDUCFI!($P(DDUCKEY0,U,2)'=DDUCNM) D
... S DDUCGL=$NA(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
... D WEN(DDUCGL)
... D:DDUCFIX KILL(DDUCGL)
;
;If any of the Keys have null Names, check whether a single name
;for it was found in the "BB" index.
I $D(DDUCNML) S DDUCKEY=0 F S DDUCKEY=$O(DDUCNML(DDUCKEY)) Q:'DDUCKEY D
. S DDUCNM=$O(DDUCNML(DDUCKEY,""))
. I $O(DDUCNML(DDUCKEY,DDUCNM))="" D
.. S DDUCKID=$$KEYID(DDUCKEY,"")
.. D WNM
.. D:DDUCFIX FNM
. E F D S DDUCNM=$O(DDUCNML(DDUCKEY,DDUCNM)) Q:DDUCNM=""
.. S DDUCGL=$NA(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
.. D WEN(DDUCGL)
.. D:DDUCFIX KILL(DDUCGL)
Q
;
CHKF ;Check "F" index (In: DDUCFI = file; DDUCFIX = flag to fix)
N DDUCFLD,DDUCGL,DDUCKEY,DDUCIEN
S DDUCFLD=0
F S DDUCFLD=$O(^DD("KEY","F",DDUCFI,DDUCFLD)) Q:'DDUCFLD D
. S DDUCKEY=0
. F S DDUCKEY=$O(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY)) Q:'DDUCKEY D
.. S DDUCIEN=0
.. F S DDUCIEN=$O(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN)) Q:'DDUCIEN D
... I $P($G(^DD("KEY",DDUCKEY,2,DDUCIEN,0)),U,2)'=DDUCFI!($P($G(^(0)),U)'=DDUCFLD) D
.... S DDUCGL=$NA(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN))
.... D WEN(DDUCGL)
.... D:DDUCFIX KILL(DDUCGL)
Q
;
;---------------
FFILE ;Set the .01 of Key to DDUCFI
S $P(^DD("KEY",DDUCKEY,0),U)=DDUCFI
D WRITE("FILE (#.01) for "_DDUCKID_" set to "_DDUCFI_".",10)
Q
;
FNM ;Set the NAME for the Key
S $P(^DD("KEY",DDUCKEY,0),U,2)=DDUCNM
D WRITE("NAME for "_DDUCKID_" set to '"_DDUCNM_"'.",10)
Q
;
FPRI ;Set the PRIORITY for the Key
S $P(^DD("KEY",DDUCKEY,0),U,3)=DDUCPRI
D WRITE("PRIORITY for "_DDUCKID_" set to '"_DDUCPRI_"'.",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 Keys.",5) Q
WNOKEY D WRITE(DDUCKID_" does not exist.",7) Q
WMS(S,N) D WRITE(S_" is missing."_$S($G(N):" Nothing done.",1:""),7) Q
WINC D WRITE("Field information in "_DDUCKEY_" is incomplete. Nothing done.",7) Q
WFMS D WRITE("*File #"_DDUCFIL_", Field #"_DDUCFLD_" referenced in "_DDUCKEY_" is missing.",7) Q ;22*130
WNE D WRITE("*Fields in "_DDUCKID_" don't match fields in Uniqueness Index.",7) Q ;22*130
WEN(GL) D WRITE("Erroneous node "_GL_" is set.",7) Q
WNM D WRITE("NAME for "_DDUCKID_" looks like it should be '"_DDUCNM_"'.",7) Q
WPRI D WRITE("PRIORITY for "_DDUCKID_" looks like it should be '"_DDUCPRI_"'.",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
;
KEYID(KEY,NM) ;Return string that identifies a Key
S:'$D(NM) NM=$P($G(^DD("KEY",KEY,0)),U,2)
Q $S(NM]"":"Key '"_NM_"' (#"_KEY_")",1:"Key #"_KEY)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDUCHK5 7195 printed Sep 23, 2025@20:19:55 Page 2
DDUCHK5 ;SFISC/MKO-CHECK KEYS ON FILE ;8/8/03 06:26
+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 ;
KEY(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Key file entry
+1 NEW DDUCKEY
+2 if '$GET(DDUCFI)
QUIT
SET DDUCFIX=$GET(DDUCFIX)
+3 ;
+4 ;Loop through "B" index to find KEYs that reside on this file
+5 DO WCHK
+6 SET DDUCKEY=""
+7 FOR
SET DDUCKEY=$ORDER(^DD("KEY","B",DDUCFI,DDUCKEY))
if DDUCKEY=""
QUIT
DO CHKKEY
+8 ;
+9 ;Check "AP","BB", and "F" indexes
+10 DO CHKAP
DO CHKBB
DO CHKF
+11 QUIT
+12 ;
CHKKEY ;Check Key DDUCKEY found in "B" index
+1 ;In:
+2 ; DDUCKEY = Key #
+3 ; DDUCFI = File #
+4 ; DDUCFIX = Flag to fix
+5 NEW DDUCIEN,DDUCKEY0,DDUCKID,DDUCNM,DDUCUI
+6 SET DDUCKID=$$KEYID(DDUCKEY,"")
+7 ;
+8 ;Check that Key exists
+9 IF '$DATA(^DD("KEY",DDUCKEY))
Begin DoDot:1
+10 DO WNOKEY
+11 if DDUCFIX
DO KILL($NAME(^DD("KEY","B",DDUCFI,DDUCKEY)))
End DoDot:1
QUIT
+12 ;
+13 ;Check that Key has a FILE
+14 SET DDUCKEY0=$GET(^DD("KEY",DDUCKEY,0))
+15 IF $PIECE(DDUCKEY0,U)=""
Begin DoDot:1
+16 DO WMS("FILE (#.01) for "_DDUCKID)
+17 if DDUCFIX
DO FFILE
End DoDot:1
+18 ;
+19 ;Get Name
+20 SET DDUCNM=$PIECE(DDUCKEY0,U,2)
+21 IF DDUCNM]""
SET DDUCKID=$$KEYID(DDUCKEY,DDUCNM)
+22 IF '$TEST
DO WMS("NAME for "_DDUCKID)
+23 ;
+24 ;Check Priority
+25 SET DDUCPRI=$PIECE(DDUCKEY0,U,3)
+26 if DDUCPRI=""
DO WMS("PRIORITY for "_DDUCKID)
+27 ;
+28 ;Check Uniqueness Index
+29 SET DDUCUI=$PIECE(DDUCKEY0,U,4)
+30 IF 'DDUCUI
Begin DoDot:1
+31 DO WMS("Uniqueness Index for "_DDUCKID,1)
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 IF '$DATA(^DD("IX",DDUCUI,0))
Begin DoDot:2
+34 DO WMS("Dangling pointer. Uniqueness Index #"_DDUCUI_" pointed to by "_DDUCKID,1)
End DoDot:2
QUIT
+35 DO GETFLD^DIKKUTL2(DDUCKEY,DDUCUI,.DDUCKFLD,.DDUCUFLD)
+36 if '$$GCMP^DIKCU2("DDUCKFLD","DDUCUFLD")
DO WNE
End DoDot:1
+37 ;
+38 ;Check Field multiple
+39 SET DDUCIEN=0
+40 FOR
SET DDUCIEN=$ORDER(^DD("KEY",DDUCKEY,2,DDUCIEN))
if 'DDUCIEN
QUIT
DO FLD
+41 ;
+42 ;Reindex Key file entry
+43 IF DDUCFIX
Begin DoDot:1
+44 NEW DIC,DIK,DA,X
+45 SET DIK="^DD(""KEY"","
SET DA=DDUCKEY
+46 DO IX^DIK
End DoDot:1
+47 QUIT
+48 ;
FLD ;Check a Cross-Reference Value
+1 ;In:
+2 ; DDUCKEY = Key #
+3 ; DDUCIEN = IEN in FIELD multiple
+4 ; DDUCFIX = Flag to fix
+5 ; DDUCKID = String that identifies Key
+6 ; DDUCUI = Uniqueness index #
+7 NEW DDUCFIL,DDUCFLD,DDUCFLD0,DDUCKFLD,DDUCSEQ,DDUCUFLD
+8 ;
+9 SET DDUCFLD0=$GET(^DD("KEY",DDUCKEY,2,DDUCIEN,0))
+10 SET DDUCFLD=$PIECE(DDUCFLD0,U)
SET DDUCFIL=$PIECE(DDUCFLD0,U,2)
+11 SET DDUCSEQ=$PIECE(DDUCFLD0,U,3)
+12 ;
+13 ;Check that field, file, and sequence are filled in
+14 if 'DDUCFLD!'DDUCFIL!'DDUCSEQ
DO WINC
+15 ;
+16 ;Make sure file/field exists and is in the "F" index
+17 IF DDUCFLD
IF DDUCFIL
Begin DoDot:1
+18 if $DATA(^DD(DDUCFIL,DDUCFLD,0))[0
DO WFMS
+19 IF $DATA(^DD("KEY","F",DDUCFIL,DDUCFLD,DDUCKEY,DDUCIEN))[0
SET DDUCGL=$NAME(^(DDUCIEN))
Begin DoDot:2
+20 DO WMS(DDUCGL)
+21 if DDUCFIX
DO SET(DDUCGL)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
CHKAP ;Check "AP" index (In: DDUCFI = file; DDUCFIX = flag to fix)
+1 NEW DDUCGL,DDUCKEY,DDUCKEY0,DDUCPRI,DDUCPRIL
+2 ;
+3 SET DDUCPRI=""
+4 FOR
SET DDUCPRI=$ORDER(^DD("KEY","AP",DDUCFI,DDUCPRI))
if DDUCPRI=""
QUIT
Begin DoDot:1
+5 SET DDUCKEY=0
+6 FOR
SET DDUCKEY=$ORDER(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
if 'DDUCKEY
QUIT
Begin DoDot:2
+7 SET DDUCKEY0=$GET(^DD("KEY",DDUCKEY,0))
+8 IF $DATA(^DD("KEY",DDUCKEY))
IF $PIECE(DDUCKEY0,U,3)=""
SET DDUCPRIL(DDUCKEY,DDUCPRI)=""
+9 IF '$TEST
IF $PIECE(DDUCKEY0,U)'=DDUCFI!($PIECE(DDUCKEY0,U,3)'=DDUCPRI)
Begin DoDot:3
+10 SET DDUCGL=$NAME(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
+11 DO WEN(DDUCGL)
+12 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 ;If any of the Keys have null Priorities, check whether a single
+15 ;priority for it was found in the "AP" index.
+16 IF $DATA(DDUCPRIL)
SET DDUCKEY=0
FOR
SET DDUCKEY=$ORDER(DDUCPRIL(DDUCKEY))
if 'DDUCKEY
QUIT
Begin DoDot:1
+17 SET DDUCPRI=$ORDER(DDUCPRIL(DDUCKEY,""))
+18 IF $ORDER(DDUCPRIL(DDUCKEY,DDUCPRI))=""
Begin DoDot:2
+19 SET DDUCKID=$$KEYID(DDUCKEY)
+20 DO WPRI
+21 if DDUCFIX
DO FPRI
End DoDot:2
+22 IF '$TEST
FOR
Begin DoDot:2
+23 SET DDUCGL=$NAME(^DD("KEY","AP",DDUCFI,DDUCPRI,DDUCKEY))
+24 DO WEN(DDUCGL)
+25 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:2
SET DDUCPRI=$ORDER(DDUCPRIL(DDUCKEY,DDUCPRI))
if DDUCPRI=""
QUIT
End DoDot:1
+26 QUIT
+27 ;
CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
+1 NEW DDUCGL,DDUCKEY,DDUCKEY0,DDUCKID,DDUCNM,DDUCNML
+2 SET DDUCNM=""
+3 FOR
SET DDUCNM=$ORDER(^DD("KEY","BB",DDUCFI,DDUCNM))
if DDUCNM=""
QUIT
Begin DoDot:1
+4 SET DDUCKEY=0
+5 FOR DDUCKEY=$ORDER(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
if 'DDUCKEY
QUIT
Begin DoDot:2
+6 SET DDUCKEY0=$GET(^DD("KEY",DDUCKEY,0))
+7 IF $DATA(^DD("KEY",DDUCKEY))
IF $PIECE(DDUCKEY0,U,2)=""
SET DDUCNML(DDUCKEY,DDUCNM)=""
+8 IF '$TEST
IF $PIECE(DDUCKEY0,U)'=DDUCFI!($PIECE(DDUCKEY0,U,2)'=DDUCNM)
Begin DoDot:3
+9 SET DDUCGL=$NAME(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
+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 Keys have null Names, check whether a single name
+14 ;for it was found in the "BB" index.
+15 IF $DATA(DDUCNML)
SET DDUCKEY=0
FOR
SET DDUCKEY=$ORDER(DDUCNML(DDUCKEY))
if 'DDUCKEY
QUIT
Begin DoDot:1
+16 SET DDUCNM=$ORDER(DDUCNML(DDUCKEY,""))
+17 IF $ORDER(DDUCNML(DDUCKEY,DDUCNM))=""
Begin DoDot:2
+18 SET DDUCKID=$$KEYID(DDUCKEY,"")
+19 DO WNM
+20 if DDUCFIX
DO FNM
End DoDot:2
+21 IF '$TEST
FOR
Begin DoDot:2
+22 SET DDUCGL=$NAME(^DD("KEY","BB",DDUCFI,DDUCNM,DDUCKEY))
+23 DO WEN(DDUCGL)
+24 if DDUCFIX
DO KILL(DDUCGL)
End DoDot:2
SET DDUCNM=$ORDER(DDUCNML(DDUCKEY,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,DDUCKEY,DDUCIEN
+2 SET DDUCFLD=0
+3 FOR
SET DDUCFLD=$ORDER(^DD("KEY","F",DDUCFI,DDUCFLD))
if 'DDUCFLD
QUIT
Begin DoDot:1
+4 SET DDUCKEY=0
+5 FOR
SET DDUCKEY=$ORDER(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY))
if 'DDUCKEY
QUIT
Begin DoDot:2
+6 SET DDUCIEN=0
+7 FOR
SET DDUCIEN=$ORDER(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN))
if 'DDUCIEN
QUIT
Begin DoDot:3
+8 IF $PIECE($GET(^DD("KEY",DDUCKEY,2,DDUCIEN,0)),U,2)'=DDUCFI!($PIECE($GET(^(0)),U)'=DDUCFLD)
Begin DoDot:4
+9 SET DDUCGL=$NAME(^DD("KEY","F",DDUCFI,DDUCFLD,DDUCKEY,DDUCIEN))
+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 Key to DDUCFI
+1 SET $PIECE(^DD("KEY",DDUCKEY,0),U)=DDUCFI
+2 DO WRITE("FILE (#.01) for "_DDUCKID_" set to "_DDUCFI_".",10)
+3 QUIT
+4 ;
FNM ;Set the NAME for the Key
+1 SET $PIECE(^DD("KEY",DDUCKEY,0),U,2)=DDUCNM
+2 DO WRITE("NAME for "_DDUCKID_" set to '"_DDUCNM_"'.",10)
+3 QUIT
+4 ;
FPRI ;Set the PRIORITY for the Key
+1 SET $PIECE(^DD("KEY",DDUCKEY,0),U,3)=DDUCPRI
+2 DO WRITE("PRIORITY for "_DDUCKID_" set to '"_DDUCPRI_"'.",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 Keys.",5) Q
QUIT
WNOKEY DO WRITE(DDUCKID_" does not exist.",7)
QUIT
WMS(S,N) DO WRITE(S_" is missing."_$SELECT($GET(N):" Nothing done.",1:""),7)
QUIT
WINC DO WRITE("Field information in "_DDUCKEY_" is incomplete. Nothing done.",7)
QUIT
WFMS ;22*130
DO WRITE("*File #"_DDUCFIL_", Field #"_DDUCFLD_" referenced in "_DDUCKEY_" is missing.",7)
QUIT
WNE ;22*130
DO WRITE("*Fields in "_DDUCKID_" don't match fields in Uniqueness Index.",7)
QUIT
WEN(GL) DO WRITE("Erroneous node "_GL_" is set.",7)
QUIT
WNM DO WRITE("NAME for "_DDUCKID_" looks like it should be '"_DDUCNM_"'.",7)
QUIT
WPRI DO WRITE("PRIORITY for "_DDUCKID_" looks like it should be '"_DDUCPRI_"'.",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 ;
KEYID(KEY,NM) ;Return string that identifies a Key
+1 if '$DATA(NM)
SET NM=$PIECE($GET(^DD("KEY",KEY,0)),U,2)
+2 QUIT $SELECT(NM]"":"Key '"_NM_"' (#"_KEY_")",1:"Key #"_KEY)
