Return to DICD.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICD	;SFISC/XAK-DISP,SELECT,DELETE,EDIT XREF ;03:49 PM  1 Feb 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	K DICD S (DA,DL)=+Y D CHIX I 'DQ D ^DICE G Q
    5: 	D RD G:$D(DIRUT) Q I Y["C" D ^DICE G Q
    6: 	I Y["E" D EDT^DICE G Q
    7: 	D DEL G Q
    8: 	;
    9: DEL	I DH(DQ,4) D R Q:'$D(DICD)  S DQ=DICD
   10: 	I $D(DH(DQ,3)) W !?5,*7,"This cross-reference cannot be deleted.",! Q
   11: ASK	S %=2 W !,"Are you sure that you want to delete the CROSS-REFERENCE " D YN^DICN Q:(%<0)!(%=2)
   12: 	I %=0 W !?7,"Answer YES if you want to delete the Cross-Reference." G ASK
   13: 	W !,"  ...OK",! K:I["SOUNDEX" ^DD(DI,0,"LOOK"),^("QUES") D DIEZ^DIU0
   14: 	S ^DD(J(N),DL,1,0)="^.1",X=^(DQ,2),Y=$P(I,U,2) I Y?1A.E,+I=J(0),I'["MNEM",I'["MUM" K @(I(0)_"Y)") G DDD
   15: 	G DDD:X="Q"!$F(I,"BUL") I I'["MUM",I'["TRIG" D DD G DDD
   16: 	S %=1 W "DO YOU WANT THE INDIVIDUAL CROSS-REFERENCE VALUES DELETED" D YN^DICN Q:%<1
   17: 	D DD:%=1
   18: DDD	I $D(DDA) S DDA="D" D XA^DICATTA
   19: 	S DIK="^DD(J(N),DL,1,",DA(1)=DL,DA(2)=J(N),DA=DQ D ^DIK
   20: D	I $D(^DD(J(0),0,"DIK")) S X=^("DIK"),Y=J(0),DMAX=^DD("ROU") D EN^DIKZ
   21: 	Q
   22: 	;
   23: CHIX	;
   24: 	K DH S DQ=0,X="CURRENT CROSS-REFERENCE"
   25: 	F Y=0:1 S DQ=$O(^DD(DI,DA,1,DQ)) Q:DQ'>0  S DH(DQ)=^(DQ,0),DH(DQ,4)=Y S:$D(^(3)) DH(DQ,3)=^(3)
   26: 	W !! I 'Y S DQ=0 W "NO ",X Q
   27: 	I Y=1 W X_" IS " S DQ=$O(DH(0)) D L Q:'$D(DICD)  S %=2 W !,"WANT TO "_DICD_" IT" D YN^DICN S:%=-1 DICDF=1 S:%=1 DICD=DQ Q
   28: 	D M Q:'$D(DICD)  S %=2 W !,"WANT TO "_DICD_" ONE OF THEM" D YN^DICN Q:%-1
   29: R	R !,"WHICH NUMBER: ",X:DTIME Q:U[X  I X\1'=X!'$D(DH(X)) D M G R
   30: 	S DICD=X,I=DH(X) Q
   31: M	W !,"CURRENT CROSS-REFERENCES:" F J=0:0 S J=$O(DH(J)) Q:J'>0  W !?8,J,?14 S DQ=J D L
   32: 	Q
   33: 	;
   34: L	S I=DH(DQ),X=$P(I,U,3) S:X="" X="REGULAR" W X
   35: 	G E:X["BULL" I X["TRIGGER" S %=+$P(I,U,4),(%F,Y)=+$P(I,U,5) W " OF " D WR^DIDH:$D(^DD(%,Y,0)),N Q
   36: 	W " '",$P(I,U,2),"' INDEX OF " I +I=J(0) W "FILE"
   37: 	W:'$T $P(^DD(+I,0),U)
   38: N	W:$D(DH(DQ,3)) !?14,"("_DH(DQ,3)_")" Q
   39: 	;
   40: E	F %="CREA","DELE" S %=%_"TE VALUE" I $D(^DD(DI,DA,1,DQ,%)),^(%)'="NO EFFECT" W "  ("_^(%)_")"
   41: 	D N Q
   42: 	;
   43: DD	;
   44: 	N DIKJ,DA,DV,DH,Y,DCNT,DIK S DIKJ=$J
   45: 	K ^UTILITY("DIK",$J) S J=J(N),^($J)=$H,^($J,J,DL,1)=X,Y=$P(^DD(DI,DL,0),U,4),^UTILITY("DIK",$J,J,DL)=$P(Y,";",1),Y=$P(Y,";",2),^(DL,0)="S X=$"_$S(Y:"P(^(X),U,"_Y_")",1:"E(^(X),"_+$E(Y,2,9)_","_$P(Y,",",2)_")")
   46: 	I $D(^DD(J,DL,1,DQ,"DIK")) S ^UTILITY("DIK",$J,J,DL,1)="D RCR",^(1,0)=X
   47: 	K Y,DA,DV,DH S DH(1)=J(0) F Y=1:1:N S DV(J(Y-1),1)=I(Y),DV(J(Y-1),1,0)=J(Y)
   48: 	D WAIT S DIK=DIU,DA=0,DCNT=0 G CNT^DIK1
   49: 	;
   50: KOLD	K DIR S DIR(0)="Y",DIR("A")="DO YOU WANT TO EXECUTE THE OLD KILL LOGIC NOW",DIR("?",1)="Enter 'YES' to execute the original kill logic now.",DIR("?")="Otherwise, enter 'NO'."
   51: 	D ^DIR K DIR I 'Y!$D(DIRUT) K DTOUT,DUOUT,DIRUT,DIROUT Q
   52: 	N DA W !!,"Executing old kill logic...",! S X=A1(2) D DD Q
   53: WAIT	;
   54: 	W !,"..."
   55: 	W $P("HMMM^EXCUSE ME^SORRY","^",$R(3)+1),", ",$P("THIS MAY TAKE A FEW MOMENTS^LET ME PUT YOU ON 'HOLD' FOR A SECOND^HOLD ON^JUST A MOMENT PLEASE^I'M WORKING AS FAST AS I CAN^LET ME THINK ABOUT THAT A MOMENT","^",$R(6)+1)_"..."
   56: 	Q
   57: 	;
   58: RD	;
   59: 	N DQ,DH W ! S DIR(0)="SAO^E:EDIT;D:DELETE;C:CREATE",DIR("A")="Choose E (Edit)/D (Delete)/C (Create): "
   60: 	S DIR("?",1)="Enter 'E' to edit an existing X-reference",DIR("?",2)="      'D' to delete it",DIR("?")="      'C' to create a new X-reference."
   61: 	D ^DIR K DIR Q
   62: 	;
   63: Q	D Q^DICE K DICD,DDA Q