| 1 | DICATTDK ;SFISC/GFT-DELETE FIELD ;25MAY2007
|
|---|
| 2 | ;;22.0;VA FileMan;**8,118,151**;Mar 30, 1999;Build 10
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;FROM ^DICATTDE
|
|---|
| 5 | KILL N M,DI,DA,DQ,DICL,D0,DIU,DQI,S,Q,O,X,DICATT4M
|
|---|
| 6 | I $D(DDA) S DDA="D" ;'DELETE' flag for Auditing
|
|---|
| 7 | S S=";",Q=""""
|
|---|
| 8 | MAYBGONE S (A,DA(1))=DICATTA,(D0,DA)=DICATTF I '$D(^DD(A,DA)) Q
|
|---|
| 9 | D IJ^DIUTL(A) S DICL=$O(J(""),-1),DQ=""
|
|---|
| 10 | F S DQ=$O(^DD(0,.01,"DEL",DQ)) Q:DQ="" I $D(^(DQ,0)) X ^(0) I S DDSERROR=1,DDSBR=1 H 3 G Q ;Delete checks
|
|---|
| 11 | S O=^DD(A,D0,0),M=$P(O,U),X=0
|
|---|
| 12 | F S X=$O(^DD(A,DA,1,X)) Q:'X I +^(X,0)=DICATTB,$P(^(0),DICATTB,2)?1"^"1.A S DQI=$P(^(0),U,2) ;HMMMMM remember that this field cross-referenced top level
|
|---|
| 13 | MUL I $G(DICATT2) D ;Delete a multiple field
|
|---|
| 14 | .K ^DD(A,"GL",$P($P(O,U,4),";")) ;SO EN+4^DICATT4 KNOWS TO DELETE THE ENTRIES CORRECTLY
|
|---|
| 15 | .S DQ(+DICATT2)=0
|
|---|
| 16 | NEW .S DICATT4M(0)=$NA(^DD(A,D0)) ;from NEW^DICATTD4
|
|---|
| 17 | .S DICATT4M("SB")=$NA(^DD(A,"SB",+$P(O,U,2),D0))
|
|---|
| 18 | .S ^DD(A,D0,0)=O,^DD(A,"SB",+$P(O,U,2),D0)=""
|
|---|
| 19 | .D ^DICATT4
|
|---|
| 20 | .K @DICATT4M(0),@DICATT4M("SB")
|
|---|
| 21 | .D KDD^DICATT4 ;Kill the DD globals below
|
|---|
| 22 | ENTRIES E I $P(O,U,2)'["C"," "'[$P(O,U,4) S DICATT4M=1 D ^DICATT4
|
|---|
| 23 | D DELFLD(DICATTA,DICATTF)
|
|---|
| 24 | D N^DICATTDE
|
|---|
| 25 | Q Q
|
|---|
| 26 | ;
|
|---|
| 27 | DELFLD(DICATTA,DA) ;ALSO FROM ^DICATTD
|
|---|
| 28 | W $C(7),!,"FIELD DELETED!" S:$D(DDA) DDA=$E("D",DDA="")
|
|---|
| 29 | N A,D0,DIC,DIK,O,M S (DIC,DIK)="^DD(DICATTA,",DA(1)=DICATTA,DA=DICATTF
|
|---|
| 30 | AUD S:$D(DDA) ^UTILITY("DDA",$J,DICATTA,DA,0)=$G(^DD(DICATTA,DA,0))
|
|---|
| 31 | D ^DIK
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | ;
|
|---|
| 35 | ;
|
|---|
| 36 | ;
|
|---|
| 37 | POST9 ;POST-ACTION OF FIELD 99, 'ARE YOU SURE YOU WANT TO DELETE THE ENTIRE FIELD?'
|
|---|
| 38 | I 'X D Q ;IF THEY DON'T ANSWER "YES", REPAINT FIELD LABEL AND QUIT
|
|---|
| 39 | .S X=$P(^DD(DICATTA,DICATTF,0),U)
|
|---|
| 40 | .I $G(DICATT2) D PUT^DDSVALF(1,"DICATT MUL",10,X) Q
|
|---|
| 41 | .D PUT^DDSVALF(1,"DICATT",1,X)
|
|---|
| 42 | S DICATTDK=1,DDACT="EX" ;FORCE EXIT FROM SCREENMAN
|
|---|
| 43 | D REQ^DDSUTL(20,"DICATT",1,0)
|
|---|
| 44 | NOREQ ;(not sure anyone uses this entry point yet)
|
|---|
| 45 | D REQ^DDSUTL(67,"DICATT SCREEN",6,0)
|
|---|
| 46 | D REQ^DDSUTL(31,"DICATT2",2.2,0)
|
|---|
| 47 | D REQ^DDSUTL(32,"DICATT2",2.2,0)
|
|---|
| 48 | D REQ^DDSUTL(68,"DICATT4",2.4,0)
|
|---|
| 49 | D REQ^DDSUTL(69,"DICATT4",2.4,0)
|
|---|
| 50 | D REQ^DDSUTL(78,"DICATT6",2.6,0)
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
