Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIKCUTL2

DIKCUTL2.m

Go to the documentation of this file.
  1. DIKCUTL2 ;SFISC/MKO-UTILITY OPTION TO MODIFY INDEX ;17DEC2010
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ;========
  1. ; $$TYPE
  1. ;========
  1. ;Prompt for type xref (to reindex or modify)
  1. ;Returns:
  1. ; '1' for Traditional; or
  1. ; '2' for New
  1. ;
  1. TYPE() ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="SAM^1:TRADITIONAL;2:NEW"
  1. S DIR("A")="What type of cross-reference (Traditional or New)? "
  1. S DIR("B")="Traditional"
  1. S DIR("?",1)="Enter 'T' to select a Traditional cross-reference."
  1. S DIR("?",2)=" Traditional cross references are stored in the data"
  1. S DIR("?",3)=" dictionary under ^DD(file#,field#,1)."
  1. S DIR("?",4)=" "
  1. S DIR("?",5)="Enter 'N' to select a New-Style cross-reference."
  1. S DIR("?",6)=" New-Style cross references are stored in the Index file."
  1. S DIR("?",7)=" Compound indexes (indexes based on more than one field)"
  1. S DIR("?")=" are examples of New-Style cross-references."
  1. D ^DIR
  1. Q $S($D(DIRUT):"",1:Y)
  1. ;
  1. ;==========================
  1. ; GETXR(file#,.count,flag)
  1. ;==========================
  1. ;Loop through the "AC" index to get the list of Index file
  1. ;xrefs with root file FIL.
  1. ;In:
  1. ; FIL = Root file #
  1. ; FLG [ "M" : also get xrefs on subfiles of FIL
  1. ;Out:
  1. ; CNT = # xrefs^rootFile# (or null if FLG [ "M")
  1. ; CNT(xref#) = rootFile#^File#^xrefName^rootType^UI[if uniq index]
  1. ;
  1. GETXR(FIL,CNT,FLG) ;
  1. N F,SB,XR
  1. K CNT
  1. D:$G(FLG)["M" SUBFILES^DIKCU(FIL,.SB)
  1. S SB(FIL)=""
  1. ;
  1. S (CNT,F)=0 F S F=$O(SB(F)) Q:'F D
  1. . S XR=0 F S XR=$O(^DD("IX","AC",F,XR)) Q:'XR D
  1. .. I $G(^DD("IX",XR,0))?."^" K ^DD("IX","AC",F,XR) Q
  1. ..I $G(FLG)["x",$G(^("NOREINDEX")) Q ;167
  1. .. S CNT=CNT+1
  1. .. S CNT(XR)=F_U_$P($G(^DD("IX",XR,0)),U,1,2)_U_$P(^(0),U,8)
  1. .. S:$D(^DD("KEY","AU",XR)) $P(CNT(XR),U,5)="UI"
  1. ;
  1. S:$G(FLG)'["M" $P(CNT,U,2)=FIL
  1. Q
  1. ;
  1. ;============================
  1. ; LIST(.count,header,screen)
  1. ;============================
  1. ;List the xrefs in the CNT array
  1. ;In:
  1. ; CNT = Array of xrefs to print (obtained by GETXR call above)
  1. ; HDR = Text to print before listing
  1. ; (default is 'Current Indexes[ on [sub]file #xxx]:')
  1. ; SCR = Sets $T to screen out indexes (Y = index#)
  1. ;
  1. LIST(CNT,HDR,SCR) ;
  1. I '$G(CNT) W:$P(CNT,U,2) !,"There are no INDEX file cross-references defined on "_$$FSTR($P(CNT,U,2))_"." Q
  1. N FIL,I,ONEFIL,RFIL,TYP,TXT,UI,XR,Y
  1. ;
  1. S ONEFIL=$P(CNT,U,2)
  1. S:$G(HDR)="" HDR="Current Indexes"_$S(ONEFIL:" on "_$$FSTR(ONEFIL),1:"")_":"
  1. W !,HDR
  1. ;
  1. S XR=0 F S XR=$O(CNT(XR)) Q:'XR D
  1. . I $G(SCR)]"" K Y S Y=XR,Y(0)=CNT(XR) X SCR K Y E Q
  1. . S FIL=$P(CNT(XR),U,2),RFIL=$P(CNT(XR),U),TYP=$P(CNT(XR),U,4)
  1. . S UI=$S($P(CNT(XR),U,5)="UI":"uniqueness ",1:"")
  1. . S RFIL=$S('ONEFIL:" on "_$$FSTR(RFIL),1:"")
  1. . ;
  1. . S TXT=XR_" "_$J("",5-$L(XR))_"'"_$P(CNT(XR),U,3)_"' "_UI
  1. . I TYP'="W" S TXT=TXT_"index"_RFIL
  1. . E S TXT=TXT_"whole file index"_RFIL_" (resides on "_$$FSTR(FIL)_")"
  1. . ;
  1. . D WRAP^DIKCU2(.TXT,-11,-2)
  1. . W !," "_TXT F I=1:1 Q:$D(TXT(I))[0 W !?10,TXT(I)
  1. . K TXT
  1. Q
  1. ;
  1. ;================================
  1. ; $$CHOOSE(.count,prompt,screen)
  1. ;================================
  1. ;Prompt for a xref from the DIKCCNT array
  1. ;In:
  1. ; DIKCCNT = Array contain xref data (obtained by GETXR call above)
  1. ; DIKCPR = Action to include with the prompt
  1. ; DIKCSCR = Sets $T to screen out entries (Y=index#)
  1. ;Returns:
  1. ; Index ien (or 0, if none selected)
  1. ;
  1. CHOOSE(DIKCCNT,DIKCPR,DIKCSCR) ;
  1. Q:'$G(DIKCCNT) 0
  1. N I,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. ;
  1. S DIR(0)="SAO^"
  1. S I=0 F S I=$O(DIKCCNT(I)) Q:'I S DIR("C",I)=I_":"_$P(DIKCCNT(I),U,3)
  1. S DIR("A")="Which Index do you wish to "_DIKCPR_"? "
  1. S:+DIKCCNT=1 DIR("B")=$O(DIKCCNT(0))
  1. S DIR("?")="",DIR("??")="^D LIST^DIKCUTL2(.DIKCCNT)"
  1. W ! D ^DIR I 'Y!$D(DIRUT) Q 0
  1. Q Y
  1. ;
  1. ;====================
  1. ; $$FSTR(file#,flag)
  1. ;====================
  1. ;Return string 'file #xxx' or 'subfile #xxx'
  1. ;In:
  1. ; FIL = File #
  1. ; FLG [ U : Capitalize 'File' or 'Subfile'
  1. ;
  1. FSTR(FIL,FLG) ;
  1. ;Q $P($P("f;F^subf;Subf",U,$G(^DD(FIL,0,"UP"))>0+1),";",$G(FLG)["U"+1)_"ile #"_FIL
  1. Q $P($$EZBLD^DIALOG(8098),U,$G(^DD(FIL,0,"UP"))>0*2+1+($G(FLG)["U"))_" #"_FIL
  1. ;
  1. ;================
  1. ; PRTMSG(index#)
  1. ;================
  1. ;Print message that DIXR can't be deleted because it's the
  1. ;Uniqueness Index for a key.
  1. ;In:
  1. ; DIXR = index #
  1. ;
  1. PRTMSG(DIXR) ;
  1. N KEYID,I,INDID,MSG
  1. ;
  1. S KEYID=$O(^DD("KEY","AU",DIXR,0)) Q:'KEYID
  1. S KEYID=$G(^DD("KEY",KEYID,0)) Q:KEYID?."^"
  1. S KEYID="Key '"_$P(KEYID,U,2)_"' on File #"_$P(KEYID,U)
  1. ;
  1. S INDID="Index '"_$P($G(^DD("IX",DIXR,0)),U,2)_"'"
  1. S MSG(0)=INDID_" cannot be deleted. It is the uniqueness index for "_KEYID_"."
  1. D WRAP^DIKCU2(.MSG)
  1. ;
  1. W $C(7) F I=0:1 Q:'$D(MSG(I)) W !,MSG(I)
  1. Q
  1. ;
  1. ;================
  1. ; BLDLOG(index#)
  1. ;================
  1. ;Build and file the logic of the cross reference.
  1. ;In:
  1. ; DIXR = index #
  1. ;
  1. ;Called from EDIT^DIKCUTL after an Index is edited.
  1. ;The reason for this call is if the user deletes some Cross-Reference
  1. ;Values, and then Quits the form, the Set/Kill logic may not reflect
  1. ;the deleted Values.
  1. ;
  1. BLDLOG(DIXR) ;
  1. N CNT,CRV,CRV0,DIERR,FCNT,FDA,FILE,IX0,KILL,L,LDIF,MAXL,MSG
  1. N NAME,ORD,ROOT,RTYPE,RFILE,SBSC,SET,VAL,WKILL
  1. ;
  1. ;Get index data
  1. S IX0=$G(^DD("IX",DIXR,0)) Q:IX0?."^"
  1. I $P(IX0,U,4)="MU" D UPDEXEC(DIXR) Q
  1. S FILE=$P(IX0,U),NAME=$P(IX0,U,2),RTYPE=$P(IX0,U,8),RFILE=$P(IX0,U,9)
  1. ;
  1. ;Build root of index and the 'Kill Entire Index Code'
  1. I FILE'=RFILE Q:RTYPE'="W" S LDIF=$$FLEVDIFF^DIKCU(FILE,RFILE)
  1. E S LDIF=0
  1. S ROOT=$$FROOTDA^DIKCU(FILE,LDIF_"O")_""""_NAME_""""
  1. S WKILL="K "_ROOT_")"
  1. ;
  1. ;Loop through Cross-Reference Values multiple
  1. ;Build SBSC(subscript#)=order#^maxLength array
  1. S CRV=0 F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
  1. . S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:CRV0?."^"
  1. . S ORD=$P(CRV0,U) Q:'ORD
  1. . S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
  1. . S CNT=$G(CNT)+1
  1. . S SBSC=$P(CRV0,U,6) Q:'SBSC
  1. . S MAXL=$P(CRV0,U,5)
  1. . S SBSC(SBSC)=ORD_U_MAXL
  1. ;
  1. ;Loop through SBSC array and build the root w/ X(n) array
  1. S SBSC=0 F S SBSC=$O(SBSC(SBSC)) Q:'SBSC D
  1. . S ORD=$P(SBSC(SBSC),U),MAXL=$P(SBSC(SBSC),U,2)
  1. . I $G(CNT)=1 S VAL=$S(MAXL:"$E(X,1,"_MAXL_")",1:"X")
  1. . E S VAL=$S(MAXL:"$E(X("_ORD_"),1,"_MAXL_")",1:"X("_ORD_")")
  1. . S ROOT=ROOT_","_VAL
  1. ;
  1. ;Append DA(n) to root
  1. F L=LDIF:-1:1 S ROOT=ROOT_",DA("_L_")"
  1. S ROOT=ROOT_",DA)"
  1. ;
  1. ;Build and file the Set and Kill Logic and the Execution
  1. I '$O(SBSC(0)) S (SET,KILL)="Q",WKILL=""
  1. E S SET="S "_ROOT_"=""""",KILL="K "_ROOT
  1. K FDA
  1. S FDA(.11,DIXR_",",1.1)=SET
  1. S FDA(.11,DIXR_",",2.1)=KILL
  1. S FDA(.11,DIXR_",",2.5)=WKILL
  1. S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
  1. D FILE^DIE("","FDA","MSG")
  1. Q
  1. ;
  1. UPDEXEC(DIXR) ;Update Execution based on number of field-type xref values
  1. N CRV,CRV0,DIERR,FCNT,FDA,MSG
  1. S CRV(1)=DIXR,CRV=0
  1. F S CRV=$O(^DD("IX",DIXR,11.1,CRV)) Q:'CRV D
  1. . S CRV0=$G(^DD("IX",DIXR,11.1,CRV,0)) Q:'CRV0
  1. . S:$P(CRV0,U,2)="F" FCNT=$G(FCNT)+1
  1. S FDA(.11,DIXR_",",.4)=$S($G(FCNT)>1:"R",1:"F")
  1. D FILE^DIE("","FDA","MSG")
  1. Q