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

DIKD.m

Go to the documentation of this file. 
  1. DIKD ;SFISC/MKO-DELETE A CROSS REFERENCE ;9:14 AM  19 Dec 2001 [ 12/09/2003  4:44 PM ]
  1.  ;;22.0;VA FileMan;**12,68,95,1002**;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. DELIX(DIFIL,DIFLD,DIXR,DIFLG,DIKDOUT,DIKDMSG) ;Delete traditional xref
  1. DELIXX ;Come here from DELIX^DDMOD
  1.  N %,DIC,X,Y,DIF,DIFINFO,DIQUIT
  1.  ;
  1.  ;Init
  1.  I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1.  S DIFLG=$G(DIFLG)
  1.  S DIF=$E("D",DIFLG'["d")
  1.  I DIFLG'["c" D CHK G:$G(DIQUIT) END
  1.  D FINFO^DIKCU1(DIFIL,.DIFINFO)
  1.  ;
  1.  ;Delete data in index
  1.  D:DIFLG["K" KILL^DIKD1(DIFIL,DIFLD,DIXR,$E("W",DIFLG["W")_DIF_"c")
  1.  ;
  1.  ;Audit, delete xref, recompile
  1.  D:$G(^DD(+DIFINFO(0),0,"DDA"))["Y" AUDIT
  1.  D DELDEF(DIFIL,DIFLD,DIXR,DIFLG)
  1.  D DIEZ(DIFIL,DIFLD,DIFLG,$G(DIKDOUT))
  1.  D DIKZ(+DIFINFO(0),DIFLG,$G(DIKDOUT))
  1.  ;
  1. END ;Move error message if necessary and quit
  1.  D:$G(DIKDMSG)]"" CALLOUT^DIEFU(DIKDMSG)
  1.  Q
  1.  ;
  1. DELDEF(DIFIL,DIFLD,DIXR,DIFLG) ;Delete index definition
  1.  N DIK,DA,DITYP
  1.  S DITYP=$P($G(^DD(DIFIL,DIFLD,1,DIXR,0)),U,3)
  1.  K:DITYP="SOUNDEX" ^DD(DIFIL,0,"LOOK"),^("QUES")
  1.  ;
  1.  W:$G(DIFLG)["W" !,"Deleting cross-reference definition ..."
  1.  S ^DD(DIFIL,DIFLD,1,0)="^.1"
  1.  S DIK="^DD("_DIFIL_","_DIFLD_",1,"
  1.  S DA(2)=DIFIL,DA(1)=DIFLD,DA=DIXR
  1.  D ^DIK
  1.  Q
  1.  ;
  1. DIEZ(DIFIL,DIFLD,DIFLG,DIKDOUT,DIKTEML) ;Recompile input templates containing field
  1.  N DIERR,DITEM,DIMAX,DIRNM
  1.  S DIMAX=$$ROUSIZE^DILF
  1.  S DITEM=0 F  S DITEM=$O(^DIE("AF",DIFIL,DIFLD,DITEM)) Q:'DITEM  D
  1.  . N DIERR,DIEZMSG
  1.  . Q:$D(DIKTEML(DITEM))#2  S DIKTEML(DITEM)=""
  1.  . K ^DIE("AF",DIFIL,DIFLD,DITEM),^DIE(DITEM,"ROU")
  1.  . S DIRNM=$G(^DIE(DITEM,"ROUOLD")) Q:DIRNM=""
  1.  . D EN2^DIEZ(DITEM,$E("T",$G(DIFLG)["W"),DIRNM,"","DIEZMSG")
  1.  . I '$G(DIERR),$G(DIKDOUT)]"" D
  1.  .. S @DIKDOUT@("DIEZ",DITEM)=$P(^DIE(DITEM,0),U)_U_$P(^(0),U,4)_U_DIRNM
  1.  Q
  1.  ;
  1. DIKZ(Y,DIFLG,DIKDOUT) ;Recompile xrefs
  1.  Q:'$G(Y)
  1.  N DIERR,DIKZMSG,DMAX,DIRNM
  1.  S DIRNM=$G(^DD(Y,0,"DIK")) Q:DIRNM=""
  1.  S DMAX=$$ROUSIZE^DILF
  1.  D EN2^DIKZ(Y,$E("T",$G(DIFLG)["W"),DIRNM,"","DIKZMSG")
  1.  I '$G(DIERR),$G(DIKDOUT)]"" S @DIKDOUT@("DIKZ")=DIRNM
  1.  Q
  1.  ;
  1. AUDIT ;Audit DD change
  1.  N %,%D,%T,A0,A1,A2,B0,B1,B2,B3,DA,DDA,DL,DQ,J,N
  1.  S DDA="D",N=DIFINFO,J(0)=+DIFINFO(0),J(N)=DIFIL,DL=DIFLD,DQ=DIXR
  1.  D XA^DICATTA
  1.  S:$G(DIKDOUT)]"" @DIKDOUT@("DDAUD")=1
  1.  Q
  1.  ;
  1. CHK ;Check input parameters
  1.  I '$G(DIFIL) D:DIF["D" ERR^DIKCU2(202,"","","","FILE") D QUIT
  1.  I '$G(DIFLD) D:DIF["D" ERR^DIKCU2(202,"","","","FIELD") D QUIT
  1.  I '$G(DIQUIT),'$$VFNUM^DIKCU1(DIFIL,DIF) D QUIT
  1.  I '$G(DIQUIT),'$$VFLD^DIKCU1($G(DIFIL),$G(DIFLD),DIF) D QUIT
  1.  ;
  1.  I $G(DIXR)="" D
  1.  . D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
  1.  E  I '$G(DIQUIT) D
  1.  . I DIXR=+DIXR D
  1.  .. I $D(^DD(DIFIL,DIFLD,1,DIXR,0))[0 D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
  1.  . E  D
  1.  .. N I,XR
  1.  .. S I=0 F  S I=$O(^DD(DIFIL,DIFLD,1,I)) Q:'I  S:$P($G(^(I,0)),U,2)=DIXR XR=$G(XR)+1,XR(XR)=I
  1.  .. I $G(XR)=1 S DIXR=XR(XR)
  1.  .. E  D:DIF["D" ERR^DIKCU2(202,"","","","CROSS-REFERENCE") D QUIT
  1.  ;
  1.  D:'$$VFLAG^DIKCU1(DIFLG,"KWcd",DIF) QUIT
  1.  Q
  1.  ;
  1. QUIT ;Set flag to quit
  1.  S DIQUIT=1
  1.  Q