| [613] | 1 | DICN0 ;SFISC/GFT,XAK,SEA/TOAD/TKW-ADD NEW ENTRY ;10:39 AM 3 Apr 2006
|
|---|
| 2 | ;;22.0;VA FileMan;**31,48,56,147**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NEW ; try to add a new record to the file
|
|---|
| 6 | ; called from FILE, ^DICN
|
|---|
| 7 | ;
|
|---|
| 8 | N %,I,DDH,DI,DIE,DIK,DQ,DR,%H,%T,%DT,C,DIG,DIH,DIU,DIV,DISYS
|
|---|
| 9 | ;M %=DA N DA M DA=%
|
|---|
| 10 | K % M %=X N X M X=% S %=+$G(D0) N D0 S:% D0=% K %
|
|---|
| 11 | I '$G(DIFILEI)!($G(DINDEX("#"))="") N DINDEX,DIFILEI,DIENS D
|
|---|
| 12 | . S DINDEX("#")=1,(DINDEX,DINDEX("START"))="B"
|
|---|
| 13 | . D GETFILE^DIC0(.DIC,.DIFILEI,.DIENS) Q
|
|---|
| 14 | G:DIFILEI="" OUT
|
|---|
| 15 | I '$D(@(DIC_"0)")),'$D(DIC("P")),$E(DIC,1,6)'="^DOPT(" S DIC("P")=$$GETP^DIC0(DIFILEI)
|
|---|
| 16 | D:'$D(DO) GETFA^DIC1(.DIC,.DO) I DO="0^-1" G OUT
|
|---|
| 17 | S X=$G(X) I X="",DINDEX("#")>1 S X=$G(X(1))
|
|---|
| 18 | I X="",(DIC(0)'["E"!(DINDEX("#")'>1)) G OUT
|
|---|
| 19 | N DINO01 S DINO01=$S(X="":1,1:0) N DIX,DIY
|
|---|
| 20 | ;
|
|---|
| 21 | N1 ; if LAYGO nodes are present, XECUTE them and verify they don't object
|
|---|
| 22 | ;
|
|---|
| 23 | S Y=1 F DIX=0:0 D Q:DIX'>0 Q:'Y
|
|---|
| 24 | . S DIX=$O(^DD(+DO(2),.01,"LAYGO",DIX)) Q:DIX'>0
|
|---|
| 25 | . I $D(^DD(+DO(2),.01,"LAYGO",DIX,0)) X ^(0) S Y=$T
|
|---|
| 26 | I 'Y G OUT
|
|---|
| 27 | ;
|
|---|
| 28 | ; if the file is in the middle of archiving, keep out
|
|---|
| 29 | ;
|
|---|
| 30 | I $P($G(^DD($$FNO^DILIBF(+DO(2)),0,"DI")),U,2)["Y" D I Y G OUT
|
|---|
| 31 | . S Y='$D(DIOVRD)&'$G(DIFROM)
|
|---|
| 32 | ;
|
|---|
| 33 | N2 ; process DINUM
|
|---|
| 34 | ;
|
|---|
| 35 | S DIX=X
|
|---|
| 36 | I $D(DINUM) D
|
|---|
| 37 | . S X=DINUM D I '$D(X) S Y=0,X=DIX Q
|
|---|
| 38 | . . N DIX D N^DICN1 Q
|
|---|
| 39 | . D LOCK(DIC,X,.Y)
|
|---|
| 40 | ;
|
|---|
| 41 | ; or process DIENTRY (numeric input that might be IEN LAYGO)
|
|---|
| 42 | ;
|
|---|
| 43 | E I $D(DIENTRY) D
|
|---|
| 44 | . S X=DIENTRY D I 'Y S X=DIX Q
|
|---|
| 45 | . . N DIX D ASKP001^DICN1 Q
|
|---|
| 46 | . D LOCK(DIC,X,.Y)
|
|---|
| 47 | ;
|
|---|
| 48 | ; or get a record number the usual way
|
|---|
| 49 | ;
|
|---|
| 50 | E S X=$P(DO,U,3) D INCR N DIFAUD S %=+$P(DO,U,2),DIFAUD=$S($D(^DIA(%,"B")):%,1:0) F D Q:Y'="TRY NEXT"
|
|---|
| 51 | . F S X=X\DIY*DIY+DIY Q:'$D(@(DIC_"X)"))&$S('DIFAUD:1,1:+$O(^DIA(DIFAUD,"B",X_","))-X&'$D(^(X)))
|
|---|
| 52 | . I $G(DUZ(0))="@"!$P(DO,U,2) N DIX D ASKP001^DICN1 Q:'Y
|
|---|
| 53 | . D LOCK(DIC,X,.Y) Q:Y S Y="TRY NEXT"
|
|---|
| 54 | ;
|
|---|
| 55 | I 'Y S Y=-1 D BAD^DIC1 Q
|
|---|
| 56 | ;
|
|---|
| 57 | N3 ; add the new record at the IEN selected
|
|---|
| 58 | ;
|
|---|
| 59 | S @(DIC_"X,0)")=DIX
|
|---|
| 60 | L @("-"_DIC_"X)")
|
|---|
| 61 | ;
|
|---|
| 62 | ; update the file header node
|
|---|
| 63 | ;
|
|---|
| 64 | K D S:$D(DA)#2 D=DA S DA=X,X=DIX
|
|---|
| 65 | I $D(@(DIC_"0)")) S ^(0)=$P(^(0),U,1,2)_U_DA_U_($P(^(0),U,4)+1)
|
|---|
| 66 | N4 ; if compound index and we don't know internal value of .01, we'll prompt for it in ^DIE.
|
|---|
| 67 | I DINO01 D G:Y>0 D Q
|
|---|
| 68 | . D ^DICN1 I Y'>0 S:$G(DO(1)) DS(0)="1^" S (X,DIX)="" Q
|
|---|
| 69 | . S (X,DIX)=$P($G(@(DIC_DA_",0)")),U)
|
|---|
| 70 | . Q
|
|---|
| 71 | N5 ; If .01 is marked for auditing, update audit file
|
|---|
| 72 | D
|
|---|
| 73 | . I DO(2)'["a" Q:$P(^DD(+DO(2),.01,0),U,2)'["a" Q:^("AUDIT")["e"
|
|---|
| 74 | . D AUD^DIET
|
|---|
| 75 | ;
|
|---|
| 76 | ; index the .01 field of the new entry
|
|---|
| 77 | ;
|
|---|
| 78 | N DD S DD=0 D
|
|---|
| 79 | . N DIFILEI,DINDEX,DIVAL,DIENS,DISUBVAL
|
|---|
| 80 | . F S DD=$O(^DD(+DO(2),.01,1,DD)) Q:'DD D
|
|---|
| 81 | . . K % M %=X N X M X=% K %
|
|---|
| 82 | . . I ^DD(+DO(2),.01,1,DD,0)["TRIGGER"!(^(0)["BULL") D Q
|
|---|
| 83 | . . . N %RCR,DZ S %RCR="FIRE^DICN",DZ=^DD(+DO(2),.01,1,DD,1)
|
|---|
| 84 | . . . F %="D0","Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)=""
|
|---|
| 85 | . . . D STORLIST^%RCR Q
|
|---|
| 86 | . . M %=DIC N DIC M DIC=% K % M %=DA N DA M DA=% K % S %=DD N DD,D
|
|---|
| 87 | . . X ^DD(+DO(2),.01,1,%,1) Q
|
|---|
| 88 | . Q
|
|---|
| 89 | I $O(^DD("IX","F",+DO(2),.01,0)) D
|
|---|
| 90 | . K % M %=X N X M X=% K % M %=DIC N DIC M DIC=%
|
|---|
| 91 | . K % M %=DA N DA M DA=% K % M %=DO N DO M DO=% K % N DD,D
|
|---|
| 92 | . D INDEX^DIKC(+DO(2),DA_DIENS,.01,"","SC") Q
|
|---|
| 93 | ;
|
|---|
| 94 | N6 ; if we have lookup values to stuff, or DIC("DR"), or if the file has
|
|---|
| 95 | ; IDs or KEYS, go do DIE.
|
|---|
| 96 | ; Code will return at D if successful. We set output and go exit
|
|---|
| 97 | ;
|
|---|
| 98 | S Y=DA D
|
|---|
| 99 | . I $D(DIC("DR"))!($O(DISUBVAL(+DO(2),0)))!($O(^DD("KEY","B",+DO(2),0))) D ^DICN1 Q
|
|---|
| 100 | . Q:DIC(0)'["E"
|
|---|
| 101 | . I '$O(^DD(+DO(2),0,"ID",0)) Q
|
|---|
| 102 | . D ^DICN1 Q
|
|---|
| 103 | I Y'>0 S:$G(DO(1)) DS(0)="1^" Q
|
|---|
| 104 | ;
|
|---|
| 105 | ; Finish adding the new record.
|
|---|
| 106 | D S Y=DA_U_X_"^1" I $D(D)#2 S DA=D
|
|---|
| 107 | D R^DIC2 Q
|
|---|
| 108 | ;
|
|---|
| 109 | INCR S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | ;
|
|---|
| 113 | OUT I DIC(0)["Q" W $C(7)_$S('$D(DDS):" ??",1:"")
|
|---|
| 114 | S Y=-1 I $D(DO(1)),'$D(DTOUT) D A^DIC S DS(0)="1^" Q
|
|---|
| 115 | D Q^DIC2 Q
|
|---|
| 116 | ;
|
|---|
| 117 | LOCK(DIROOT,DIEN,DIRESULT) ;
|
|---|
| 118 | ;
|
|---|
| 119 | ; try to lock the record, and see if it's already there
|
|---|
| 120 | ; NEW
|
|---|
| 121 | ;
|
|---|
| 122 | D LOCK^DILF(DIROOT_"DIEN)") ;L @("+"_DIROOT_"DIEN):1") ;**147
|
|---|
| 123 | S DIRESULT='$D(@(DIROOT_"DIEN)"))&$T
|
|---|
| 124 | I 'DIRESULT L @("-"_DIROOT_"DIEN)")
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
