| [613] | 1 | DIKCUTL2 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;12:15 PM 1 Nov 2001
|
|---|
| 2 | ;;22.0;VA FileMan;**68**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;========
|
|---|
| 6 | ; $$TYPE
|
|---|
| 7 | ;========
|
|---|
| 8 | ;Prompt for type xref (to reindex or modify)
|
|---|
| 9 | ;Returns:
|
|---|
| 10 | ; '1' for Traditional; or
|
|---|
| 11 | ; '2' for New
|
|---|
| 12 | ;
|
|---|
| 13 | TYPE() ;
|
|---|
| 14 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 15 | S DIR(0)="SAM^1:TRADITIONAL;2:NEW"
|
|---|
| 16 | S DIR("A")="What type of cross-reference (Traditional or New)? "
|
|---|
| 17 | S DIR("B")="Traditional"
|
|---|
| 18 | S DIR("?",1)="Enter 'T' to select a Traditional cross-reference."
|
|---|
| 19 | S DIR("?",2)=" Traditional cross references are stored in the data"
|
|---|
| 20 | S DIR("?",3)=" dictionary under ^DD(file#,field#,1)."
|
|---|
| 21 | S DIR("?",4)=" "
|
|---|
| 22 | S DIR("?",5)="Enter 'N' to select a New-Style cross-reference."
|
|---|
| 23 | S DIR("?",6)=" New-Style cross references are stored in the Index file."
|
|---|
| 24 | S DIR("?",7)=" Compound indexes (indexes based on more than one field)"
|
|---|
| 25 | S DIR("?")=" are examples of New-Style cross-references."
|
|---|
| 26 | D ^DIR
|
|---|
| 27 | Q $S($D(DIRUT):"",1:Y)
|
|---|
| 28 | ;
|
|---|
| 29 | ;==========================
|
|---|
| 30 | ; GETXR(file#,.count,flag)
|
|---|
| 31 | ;==========================
|
|---|
| 32 | ;Loop through the "AC" index to get the list of Index file
|
|---|
| 33 | ;xrefs with root file FIL.
|
|---|
| 34 | ;In:
|
|---|
| 35 | ; FIL = Root file #
|
|---|
| 36 | ; FLG [ "M" : also get xrefs on subfiles of FIL
|
|---|
| 37 | ;Out:
|
|---|
| 38 | ; CNT = # xrefs^rootFile# (or null if FLG [ "M")
|
|---|
| 39 | ; CNT(xref#) = rootFile#^File#^xrefName^rootType^UI[if uniq index]
|
|---|
| 40 | ;
|
|---|
| 41 | GETXR(FIL,CNT,FLG) ;
|
|---|
| 42 | N F,SB,XR
|
|---|
| 43 | K CNT
|
|---|
| 44 | D:$G(FLG)["M" SUBFILES^DIKCU(FIL,.SB)
|
|---|
| 45 | S SB(FIL)=""
|
|---|
| 46 | ;
|
|---|
| 47 | S (CNT,F)=0 F S F=$O(SB(F)) Q:'F D
|
|---|
| 48 | . S XR=0 F S XR=$O(^DD("IX","AC",F,XR)) Q:'XR D
|
|---|
| 49 | .. I $G(^DD("IX",XR,0))?."^" K ^DD("IX","AC",F,XR) Q
|
|---|
| 50 | .. S CNT=CNT+1
|
|---|
| 51 | .. S CNT(XR)=F_U_$P($G(^DD("IX",XR,0)),U,1,2)_U_$P(^(0),U,8)
|
|---|
| 52 | .. S:$D(^DD("KEY","AU",XR)) $P(CNT(XR),U,5)="UI"
|
|---|
| 53 | ;
|
|---|
| 54 | S:$G(FLG)'["M" $P(CNT,U,2)=FIL
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;============================
|
|---|
| 58 | ; LIST(.count,header,screen)
|
|---|
| 59 | ;============================
|
|---|
| 60 | ;List the xrefs in the CNT array
|
|---|
| 61 | ;In:
|
|---|
| 62 | ; CNT = Array of xrefs to print (obtained by GETXR call above)
|
|---|
| 63 | ; HDR = Text to print before listing
|
|---|
| 64 | ; (default is 'Current Indexes[ on [sub]file #xxx]:')
|
|---|
| 65 | ; SCR = Sets $T to screen out indexes (Y = index#)
|
|---|
| 66 | ;
|
|---|
| 67 | LIST(CNT,HDR,SCR) ;
|
|---|
| 68 | I '$G(CNT) W:$P(CNT,U,2) !,"There are no INDEX file cross-references defined on "_$$FSTR($P(CNT,U,2))_"." Q
|
|---|
| 69 | N FIL,I,ONEFIL,RFIL,TYP,TXT,UI,XR,Y
|
|---|
| 70 | ;
|
|---|
| 71 | S ONEFIL=$P(CNT,U,2)
|
|---|
| 72 | S:$G(HDR)="" HDR="Current Indexes"_$S(ONEFIL:" on "_$$FSTR(ONEFIL),1:"")_":"
|
|---|
| 73 | W !,HDR
|
|---|
| 74 | ;
|
|---|
| 75 | S XR=0 F S XR=$O(CNT(XR)) Q:'XR D
|
|---|
| 76 | . I $G(SCR)]"" K Y S Y=XR,Y(0)=CNT(XR) X SCR K Y E Q
|
|---|
| 77 | . S FIL=$P(CNT(XR),U,2),RFIL=$P(CNT(XR),U),TYP=$P(CNT(XR),U,4)
|
|---|
| 78 | . S UI=$S($P(CNT(XR),U,5)="UI":"uniqueness ",1:"")
|
|---|
| 79 | . S RFIL=$S('ONEFIL:" on "_$$FSTR(RFIL),1:"")
|
|---|
| 80 | . ;
|
|---|
| 81 | . S TXT=XR_" "_$J("",5-$L(XR))_"'"_$P(CNT(XR),U,3)_"' "_UI
|
|---|
| 82 | . I TYP'="W" S TXT=TXT_"index"_RFIL
|
|---|
| 83 | . E S TXT=TXT_"whole file index"_RFIL_" (resides on "_$$FSTR(FIL)_")"
|
|---|
| 84 | . ;
|
|---|
| 85 | . D WRAP^DIKCU2(.TXT,-11,-2)
|
|---|
| 86 | . W !," "_TXT F I=1:1 Q:$D(TXT(I))[0 W !?10,TXT(I)
|
|---|
| 87 | . K TXT
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
| 90 | ;================================
|
|---|
| 91 | ; $$CHOOSE(.count,prompt,screen)
|
|---|
| 92 | ;================================
|
|---|
| 93 | ;Prompt for a xref from the DIKCCNT array
|
|---|
| 94 | ;In:
|
|---|
| 95 | ; DIKCCNT = Array contain xref data (obtained by GETXR call above)
|
|---|
| 96 | ; DIKCPR = Action to include with the prompt
|
|---|
| 97 | ; DIKCSCR = Sets $T to screen out entries (Y=index#)
|
|---|
| 98 | ;Returns:
|
|---|
| 99 | ; Index ien (or 0, if none selected)
|
|---|
| 100 | ;
|
|---|
| 101 | CHOOSE(DIKCCNT,DIKCPR,DIKCSCR) ;
|
|---|
| 102 | Q:'$G(DIKCCNT) 0
|
|---|
| 103 | N I,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
|---|
| 104 | ;
|
|---|
| 105 | S DIR(0)="SAO^"
|
|---|
| 106 | S I=0 F S I=$O(DIKCCNT(I)) Q:'I S DIR("C",I)=I_":"_$P(DIKCCNT(I),U,3)
|
|---|
| 107 | S DIR("A")="Which Index do you wish to "_DIKCPR_"? "
|
|---|
| 108 | S:+DIKCCNT=1 DIR("B")=$O(DIKCCNT(0))
|
|---|
| 109 | S DIR("?")="",DIR("??")="^D LIST^DIKCUTL2(.DIKCCNT)"
|
|---|
| 110 | W ! D ^DIR I 'Y!$D(DIRUT) Q 0
|
|---|
| 111 | Q Y
|
|---|
| 112 | ;
|
|---|
| 113 | ;====================
|
|---|
| 114 | ; $$FSTR(file#,flag)
|
|---|
| 115 | ;====================
|
|---|
| 116 | ;Return string 'file #xxx' or 'subfile #xxx'
|
|---|
| 117 | ;In:
|
|---|
| 118 | ; FIL = File #
|
|---|
| 119 | ; FLG [ U : Capitalize 'File' or 'Subfile'
|
|---|
| 120 | ;
|
|---|
| 121 | FSTR(FIL,FLG) ;
|
|---|
| 122 | ;Q $P($P("f;F^subf;Subf",U,$G(^DD(FIL,0,"UP"))>0+1),";",$G(FLG)["U"+1)_"ile #"_FIL
|
|---|
| 123 | Q $P($$EZBLD^DIALOG(8098),U,$G(^DD(FIL,0,"UP"))>0*2+1+($G(FLG)["U"))_" #"_FIL
|
|---|
| 124 | ;
|
|---|
| 125 | ;================
|
|---|
| 126 | ; PRTMSG(index#)
|
|---|
| 127 | ;================
|
|---|
| 128 | ;Print message that DIXR can't be deleted because it's the
|
|---|
| 129 | ;Uniqueness Index for a key.
|
|---|
| 130 | ;In:
|
|---|
| 131 | ; DIXR = index #
|
|---|
| 132 | ;
|
|---|
| 133 | PRTMSG(DIXR) ;
|
|---|
| 134 | N KEYID,I,INDID,MSG
|
|---|
| 135 | ;
|
|---|
| 136 | S KEYID=$O(^DD("KEY","AU",DIXR,0)) Q:'KEYID
|
|---|
| 137 | S KEYID=$G(^DD("KEY",KEYID,0)) Q:KEYID?."^"
|
|---|
| 138 | S KEYID="Key '"_$P(KEYID,U,2)_"' on File #"_$P(KEYID,U)
|
|---|
| 139 | ;
|
|---|
| 140 | S INDID="Index '"_$P($G(^DD("IX",DIXR,0)),U,2)_"'"
|
|---|
| 141 | S MSG(0)=INDID_" cannot be deleted. It is the uniqueness index for "_KEYID_"."
|
|---|
| 142 | D WRAP^DIKCU2(.MSG)
|
|---|
| 143 | ;
|
|---|
| 144 | W $C(7) F I=0:1 Q:'$D(MSG(I)) W !,MSG(I)
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
| 147 | ;================
|
|---|
| 148 | ; BLDLOG(index#)
|
|---|
| 149 | ;================
|
|---|
| 150 | ;Build and file the logic of the cross reference.
|
|---|
| 151 | ;In:
|
|---|
| 152 | ; DIXR = index #
|
|---|
| 153 | ;
|
|---|
| 154 | ;Called from EDIT^DIKCUTL after an Index is edited.
|
|---|
| 155 | ;The reason for this call is if the user deletes some Cross-Reference
|
|---|
| 156 | ;Values, and then Quits the form, the Set/Kill logic may not reflect
|
|---|
| 157 | ;the deleted Values.
|
|---|
| 158 | ;
|
|---|
| 159 | BLDLOG(DIXR) ;
|
|---|
| 160 | N CNT,CRV,CRV0,DIERR,FCNT,FDA,FILE,IX0,KILL,L,LDIF,MAXL,MSG
|
|---|
| 161 | N NAME,ORD,ROOT,RTYPE,RFILE,SBSC,SET,VAL,WKILL
|
|---|
| 162 | ;
|
|---|
| 163 | ;Get index data
|
|---|
| 164 | S IX0=$G(^DD("IX",DIXR,0)) Q:IX0?."^"
|
|---|
| 165 | I $P(IX0,U,4)="MU" D UPDEXEC(DIXR) Q
|
|---|
| 166 | S FILE=$P(IX0,U),NAME=$P(IX0,U,2),RTYPE=$P(IX0,U,8),RFILE=$P(IX0,U,9)
|
|---|
| 167 | ;
|
|---|
| 168 | ;Build root of index and the 'Kill Entire Index Code'
|
|---|
| 169 | I FILE'=RFILE Q:RTYPE'="W" S LDIF=$$FLEVDIFF^DIKCU(FILE,RFILE)
|
|---|
| 170 | E S LDIF=0
|
|---|
| 171 | S ROOT=$$FROOTDA^DIKCU(FILE,LDIF_"O")_""""_NAME_""""
|
|---|
| 172 | S WKILL="K "_ROOT_")"
|
|---|
| 173 | ;
|
|---|
| 174 | ;Loop through Cross-Reference Values multiple
|
|---|
| 175 | ;Build SBSC(subscript#)=order#^maxLength array
|
|---|
| 176 | S CRV=0 F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
|
|---|
| 177 | . S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:CRV0?."^"
|
|---|
| 178 | . S ORD=$P(CRV0,U) Q:'ORD
|
|---|
| 179 | . S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
|
|---|
| 180 | . S CNT=$G(CNT)+1
|
|---|
| 181 | . S SBSC=$P(CRV0,U,6) Q:'SBSC
|
|---|
| 182 | . S MAXL=$P(CRV0,U,5)
|
|---|
| 183 | . S SBSC(SBSC)=ORD_U_MAXL
|
|---|
| 184 | ;
|
|---|
| 185 | ;Loop through SBSC array and build the root w/ X(n) array
|
|---|
| 186 | S SBSC=0 F S SBSC=$O(SBSC(SBSC)) Q:'SBSC D
|
|---|
| 187 | . S ORD=$P(SBSC(SBSC),U),MAXL=$P(SBSC(SBSC),U,2)
|
|---|
| 188 | . I $G(CNT)=1 S VAL=$S(MAXL:"$E(X,1,"_MAXL_")",1:"X")
|
|---|
| 189 | . E S VAL=$S(MAXL:"$E(X("_ORD_"),1,"_MAXL_")",1:"X("_ORD_")")
|
|---|
| 190 | . S ROOT=ROOT_","_VAL
|
|---|
| 191 | ;
|
|---|
| 192 | ;Append DA(n) to root
|
|---|
| 193 | F L=LDIF:-1:1 S ROOT=ROOT_",DA("_L_")"
|
|---|
| 194 | S ROOT=ROOT_",DA)"
|
|---|
| 195 | ;
|
|---|
| 196 | ;Build and file the Set and Kill Logic and the Execution
|
|---|
| 197 | I '$O(SBSC(0)) S (SET,KILL)="Q",WKILL=""
|
|---|
| 198 | E S SET="S "_ROOT_"=""""",KILL="K "_ROOT
|
|---|
| 199 | K FDA
|
|---|
| 200 | S FDA(.11,DIXR_",",1.1)=SET
|
|---|
| 201 | S FDA(.11,DIXR_",",2.1)=KILL
|
|---|
| 202 | S FDA(.11,DIXR_",",2.5)=WKILL
|
|---|
| 203 | S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
|
|---|
| 204 | D FILE^DIE("","FDA","MSG")
|
|---|
| 205 | Q
|
|---|
| 206 | ;
|
|---|
| 207 | UPDEXEC(DIXR) ;Update Execution based on number of field-type xref values
|
|---|
| 208 | N CRV,CRV0,DIERR,FCNT,FDA,MSG
|
|---|
| 209 | S CRV(1)=DIXR,CRV=0
|
|---|
| 210 | F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
|
|---|
| 211 | . S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:'CRV0
|
|---|
| 212 | . S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
|
|---|
| 213 | S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
|
|---|
| 214 | D FILE^DIE("","FDA","MSG")
|
|---|
| 215 | Q
|
|---|
