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

DICATT4.m

Go to the documentation of this file.
  1. DICATT4 ;SFISC/XAK - DELETE A FIELD ;12NOV2015
  1. ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
  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. DIEZ S DI=A,DA=D0 D DIPZ^DIU0
  1. K ^DD(A,0,"ID",D0),^DD(A,0,"SP",D0)
  1. EN I $O(@(I(0)_"0)"))>0 D
  1. .N X,T,Y,Z,MUL
  1. .S MUL=+$P(O,U,2)
  1. .S %=1,Y=$P(O,U,4),X=$P(Y,";"),Y=$P(Y,";",2),Z=$S(+X=X:X,1:""""_X_"""")_")",E="^("_Z
  1. .I $O(^DD(A,"GL",X,""))="" S T="K ^(M,"_Z G F
  1. .I Y S T="U_$P("_E_",U,"_(Y+1)_",999) K:"_E_"?.""^"" "_E S:Y>1 T="$P("_E_",U,1,"_(Y-1)_")_U_"_T
  1. .E S X=+$E(Y,2,4),Y=+$P(Y,",",2) Q:'X!'Y S T="$E("_E_",1,"_(X-1)_")_$J("""","_(Y-X+1)_")_$E("_E_","_(Y+1)_",999)"
  1. .S T="I $D(^(M,"_Z_")#2 S "_E_"="_T
  1. F .I '$D(DIU(0)) W $C(7),!,"OK TO DELETE '",$P(M,U),"' FIELDS IN THE EXISTING ENTRIES" D YN^DICN I %-1 D:'$D(DIU) DELXRF(A,D0) Q
  1. KILLIX .I $D(DICATT4M) D S M="" F S M=$O(^DD(J(0),0,"IX",M)) Q:M="" I $O(^(M,MUL,0)) K @(I(0)_""""_M_""")")
  1. ..D INDEX^DIKC(J(0),"","","","KiRW"_MUL)
  1. .E D:'$D(DIU) DELXRF(A,D0,1,J(0))
  1. .S M="",X=DICL,Y=I(0) I $D(DQI) K @(I(0)_""""_DQI_""")")
  1. L .S O="M" S:X O=O_"("_X_")" S Y=Y_O,M=M_"F "_O_"=0:0 S "_O_"=$O("_Y_")) Q:"_O_"'>0 "
  1. .S X=X-1 I X+1 S Y=Y_","_I(DICL-X)_"," G L
  1. .S M=M_"X T"_$P(" W "".""",U,$S('$D(DIU(0)):1,DIU(0)["E":1,1:0))
  1. .X M ;HERE'S THE LOOP WHERE WE KILL THE VALUES!
  1. N Q:$D(DIU)!$D(DICATT4M) G N^DICATT
  1. ;
  1. NEW ;Delete the data in the multiple
  1. S DICATT4M=$NA(^DD(A,D0))
  1. S DICATT4M("SB")=$NA(^DD(A,"SB",+$P(O,U,2),D0))
  1. S ^DD(A,D0,0)=O,^DD(A,"SB",+$P(O,U,2),D0)=""
  1. D DICATT4
  1. K @DICATT4M,@DICATT4M("SB"),DICATT4M
  1. ;
  1. ;Kill the DD globals and go back to N^DICATT
  1. D KDD G N^DICATT
  1. ;
  1. VP ; VARIABLE POINTER
  1. S DA(2)=DA(1),DA(1)=DA,DICATT=DA I $D(DICS) S DICSS=DICS K DICS
  1. V S DA(2)=A,DA(1)=DICATT,DIC="^DD("_A_","_DICATT_",""V"",",DIC("P")=".12P",DIC(0)="QEAMLI",DIC("W")="W:$S($D(^DIC(+^(0),0)):$P(^(0),U)'=$P(^DD(DA(2),DA(1),""V"",+Y,0),U,2),1:0) ?30,$P(^(0),U,2)" D ^DIC S DIE=DIC K DIC
  1. I Y>0 S DA=+Y,Z="P",DR=".01:.04;"_$S($P($G(^DD(+$P(Y,U,2),0,"DI")),U,2)["Y":".06///n",1:".06T")_";S:DUZ(0)'=""@"" Y=0;.05;I ""n""[X K ^DD(DA(2),DA(1),""V"",DA,1),^(2) S Y=0;S DIE(""NO^"")=""BACK"";1;2;" S:$P(Y,U,3) DIE("NO^")=""
  1. I Y>0 D ^DIE K DIE W ! S:$D(DTOUT) DA=DICATT G CHECK^DICATT:$D(DTOUT),V
  1. S Z="V^",DIZ=Z,C="Q",L=18,DA=DICATT,DA(1)=A S:$D(DICSS) DICS=DICSS K DICSS,DR,DIE,DA(2),DICATT G CHECK^DICATT:$D(DTOUT)!(X=U),^DICATT1
  1. Q
  1. HELP ;
  1. W !?5,"Enter a MUMPS statement that sets DIC(""S"") to code that sets $T."
  1. W !?5,"Those entries for which $T=1 will be selectable."
  1. I Z?1"P".E D Q
  1. . W !?5,"The naked reference will be at the zeroeth node of the pointed to"
  1. . W !?5,"file, e.g., ^DIZ(9999,Entry Number,0). The internal entry number"
  1. . W !?5,"of the entry that is being processed in the pointed to file will be"
  1. . W !?5,"in the variable Y."
  1. W !?5,"The variable Y will be equal to the internally-stored code of the item"
  1. W !?5,"in the set which is being processed."
  1. Q
  1. KDD ;
  1. I '$D(DIANC) S X=A F S DIANC(X)="" Q:$D(^DD(X,0,"UP"))[0 S X=^("UP")
  1. S DQ=$O(DQ(0)),X=0 I DQ="" S DQ=-1 K DIANC Q
  1. D KIX(.DIANC,DQ)
  1. F S X=$O(^DD(DQ,"SB",X)) Q:'X S DQ(X)=0
  1. N DIFLD S DIFLD=0 F S DIFLD=$O(^DD(DQ,DIFLD)) Q:'DIFLD D
  1. . I $D(^DD(DQ,DIFLD,9.01)) S X=^(9.01),Y=DIFLD D KACOMP
  1. . D KTRB(.DIANC,DQ,DIFLD)
  1. . S X=$P($G(^DD(DQ,DIFLD,0)),U,2) I X["t" D AFDEFDEL^DIETLIB(DQ,DIFLD) Q ;DELETE EXTENDED DATA TYPE CROSS-REFERENCE
  1. . I X["P" S X=+$P(X,"P",2) K:X ^DD(X,0,"PT",DQ,DIFLD) Q
  1. . F %=0:0 S %=$O(^DD(DQ,DIFLD,"V",%)) Q:'% S X=+$G(^(%,0)) K:X ^DD(X,0,"PT",DQ,DIFLD)
  1. . Q
  1. K DQ(DQ),^DD(DQ),^DD("ACOMP",DQ),^DDA(DQ)
  1. S Y=0 F S Y=$O(DIANC(Y)) Q:'Y K ^DD(Y,"TRB",DQ)
  1. D DELXR(DQ)
  1. S Y=0 F S Y=$O(^DIE("AF",DQ,Y)) Q:Y="" S %=0 F S %=$O(^DIE("AF",DQ,Y,0)) Q:%="" K ^(%),^DIE(%,"ROU")
  1. S Y=0 F S Y=$O(^DIPT("AF",DQ,Y)) G KDD:Y="" S %=0 F S %=$O(^DIPT("AF",DQ,Y,0)) Q:%="" K ^(%),^DIPT(%,"ROU")
  1. ;
  1. KIX(DIANC,DIFIL) ;
  1. N F,NM
  1. S F=0 F S F=$O(DIANC(F)) Q:'F D
  1. . S NM="" F S NM=$O(^DD(F,0,"IX",NM)) Q:NM="" K:$D(^(NM,DIFIL)) ^(DIFIL)
  1. Q
  1. KACOMP N DA,I,% S DA(1)=DQ,DA=Y X ^DD(0,9.01,1,1,2) Q
  1. ;
  1. KTRB(DIANC,DIFIL,DIFLD) ;Kill 5 node of triggered field
  1. ;Also kill "TRB" nodes here if triggered field is in another file
  1. N %,F,DITFLD,DITFIL,DIXR,DIXR0
  1. S DIXR=0
  1. F S DIXR=$O(^DD(DIFIL,DIFLD,1,DIXR)) Q:'DIXR S DIXR0=$G(^(DIXR,0)) D:$P(DIXR0,U,3)="TRIGGER"
  1. . S DITFIL=$P(DIXR0,U,4),DITFLD=$P(DIXR0,U,5) Q:'DITFIL!'DITFLD
  1. . S %=0
  1. . F S %=$O(^DD(DITFIL,DITFLD,5,%)) Q:'% I $P($G(^(%,0)),U,1,3)=(DIFIL_U_DIFLD_U_DIXR) D Q
  1. .. K ^DD(DITFIL,DITFLD,5,%) Q:DITFIL=DIFIL!$D(DIANC(DITFIL))
  1. .. S F=DITFIL
  1. .. F K ^DD(F,"TRB",DIFIL) S F=$G(^DD(F,0,"UP")) Q:'F!$D(DIANC(+F))
  1. Q
  1. DELXR(DIFIL) ;Delete the Key and Index file entries for file DIFIL
  1. Q:'$G(DIFIL)
  1. N DA,DIK
  1. ;
  1. ;Kill keys on file DIFIL
  1. S DIK="^DD(""KEY"","
  1. S DA=0 F S DA=$O(^DD("KEY","B",DIFIL,DA)) Q:'DA D ^DIK
  1. ;
  1. ;Kill indexes on file DIFIL
  1. S DIK="^DD(""IX"","
  1. S DA=0 F S DA=$O(^DD("IX","AC",DIFIL,DA)) Q:'DA D ^DIK
  1. Q
  1. ;
  1. DELXRF(DIFIL,DIFLD,DIFLG,DITOPFIL) ;Delete Keys and Indexes on field
  1. ;If DIFLG=1, also delete the Indexes from the data global.
  1. Q:'$G(DIFIL)!'$G(DIFLD)
  1. N DA,DIK
  1. ;
  1. ;Execute the kill logic for all indexes defined on the field
  1. ;for all entries in the file.
  1. I $G(DIFLG) D
  1. . S:$G(DITOPFIL)="" DITOPFIL=$$FNO^DILIBF(DIFIL)
  1. . D:DITOPFIL INDEX^DIKC(DITOPFIL,"",DIFLD,"","RKW"_DIFIL)
  1. ;
  1. ;Kill keys on file/field
  1. S DIK="^DD(""KEY"","
  1. S DA=0 F S DA=$O(^DD("KEY","F",DIFIL,DIFLD,DA)) Q:'DA D ^DIK
  1. ;
  1. ;Kill indexes on file/field
  1. S DIK="^DD(""IX"","
  1. S DA=0 F S DA=$O(^DD("IX","F",DIFIL,DIFLD,DA)) Q:'DA D ^DIK
  1. Q