127 lines
4.0 KiB
Mathematica
127 lines
4.0 KiB
Mathematica
DICN0 ;SFISC/GFT,XAK,SEA/TOAD/TKW-ADD NEW ENTRY ;10:39 AM 3 Apr 2006
|
|
;;22.0;VA FileMan;**31,48,56,147**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
NEW ; try to add a new record to the file
|
|
; called from FILE, ^DICN
|
|
;
|
|
N %,I,DDH,DI,DIE,DIK,DQ,DR,%H,%T,%DT,C,DIG,DIH,DIU,DIV,DISYS
|
|
;M %=DA N DA M DA=%
|
|
K % M %=X N X M X=% S %=+$G(D0) N D0 S:% D0=% K %
|
|
I '$G(DIFILEI)!($G(DINDEX("#"))="") N DINDEX,DIFILEI,DIENS D
|
|
. S DINDEX("#")=1,(DINDEX,DINDEX("START"))="B"
|
|
. D GETFILE^DIC0(.DIC,.DIFILEI,.DIENS) Q
|
|
G:DIFILEI="" OUT
|
|
I '$D(@(DIC_"0)")),'$D(DIC("P")),$E(DIC,1,6)'="^DOPT(" S DIC("P")=$$GETP^DIC0(DIFILEI)
|
|
D:'$D(DO) GETFA^DIC1(.DIC,.DO) I DO="0^-1" G OUT
|
|
S X=$G(X) I X="",DINDEX("#")>1 S X=$G(X(1))
|
|
I X="",(DIC(0)'["E"!(DINDEX("#")'>1)) G OUT
|
|
N DINO01 S DINO01=$S(X="":1,1:0) N DIX,DIY
|
|
;
|
|
N1 ; if LAYGO nodes are present, XECUTE them and verify they don't object
|
|
;
|
|
S Y=1 F DIX=0:0 D Q:DIX'>0 Q:'Y
|
|
. S DIX=$O(^DD(+DO(2),.01,"LAYGO",DIX)) Q:DIX'>0
|
|
. I $D(^DD(+DO(2),.01,"LAYGO",DIX,0)) X ^(0) S Y=$T
|
|
I 'Y G OUT
|
|
;
|
|
; if the file is in the middle of archiving, keep out
|
|
;
|
|
I $P($G(^DD($$FNO^DILIBF(+DO(2)),0,"DI")),U,2)["Y" D I Y G OUT
|
|
. S Y='$D(DIOVRD)&'$G(DIFROM)
|
|
;
|
|
N2 ; process DINUM
|
|
;
|
|
S DIX=X
|
|
I $D(DINUM) D
|
|
. S X=DINUM D I '$D(X) S Y=0,X=DIX Q
|
|
. . N DIX D N^DICN1 Q
|
|
. D LOCK(DIC,X,.Y)
|
|
;
|
|
; or process DIENTRY (numeric input that might be IEN LAYGO)
|
|
;
|
|
E I $D(DIENTRY) D
|
|
. S X=DIENTRY D I 'Y S X=DIX Q
|
|
. . N DIX D ASKP001^DICN1 Q
|
|
. D LOCK(DIC,X,.Y)
|
|
;
|
|
; or get a record number the usual way
|
|
;
|
|
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"
|
|
. F S X=X\DIY*DIY+DIY Q:'$D(@(DIC_"X)"))&$S('DIFAUD:1,1:+$O(^DIA(DIFAUD,"B",X_","))-X&'$D(^(X)))
|
|
. I $G(DUZ(0))="@"!$P(DO,U,2) N DIX D ASKP001^DICN1 Q:'Y
|
|
. D LOCK(DIC,X,.Y) Q:Y S Y="TRY NEXT"
|
|
;
|
|
I 'Y S Y=-1 D BAD^DIC1 Q
|
|
;
|
|
N3 ; add the new record at the IEN selected
|
|
;
|
|
S @(DIC_"X,0)")=DIX
|
|
L @("-"_DIC_"X)")
|
|
;
|
|
; update the file header node
|
|
;
|
|
K D S:$D(DA)#2 D=DA S DA=X,X=DIX
|
|
I $D(@(DIC_"0)")) S ^(0)=$P(^(0),U,1,2)_U_DA_U_($P(^(0),U,4)+1)
|
|
N4 ; if compound index and we don't know internal value of .01, we'll prompt for it in ^DIE.
|
|
I DINO01 D G:Y>0 D Q
|
|
. D ^DICN1 I Y'>0 S:$G(DO(1)) DS(0)="1^" S (X,DIX)="" Q
|
|
. S (X,DIX)=$P($G(@(DIC_DA_",0)")),U)
|
|
. Q
|
|
N5 ; If .01 is marked for auditing, update audit file
|
|
D
|
|
. I DO(2)'["a" Q:$P(^DD(+DO(2),.01,0),U,2)'["a" Q:^("AUDIT")["e"
|
|
. D AUD^DIET
|
|
;
|
|
; index the .01 field of the new entry
|
|
;
|
|
N DD S DD=0 D
|
|
. N DIFILEI,DINDEX,DIVAL,DIENS,DISUBVAL
|
|
. F S DD=$O(^DD(+DO(2),.01,1,DD)) Q:'DD D
|
|
. . K % M %=X N X M X=% K %
|
|
. . I ^DD(+DO(2),.01,1,DD,0)["TRIGGER"!(^(0)["BULL") D Q
|
|
. . . N %RCR,DZ S %RCR="FIRE^DICN",DZ=^DD(+DO(2),.01,1,DD,1)
|
|
. . . F %="D0","Y","DIC","DIU","DIV","DO","D","DD","DICR","X" S %RCR(%)=""
|
|
. . . D STORLIST^%RCR Q
|
|
. . M %=DIC N DIC M DIC=% K % M %=DA N DA M DA=% K % S %=DD N DD,D
|
|
. . X ^DD(+DO(2),.01,1,%,1) Q
|
|
. Q
|
|
I $O(^DD("IX","F",+DO(2),.01,0)) D
|
|
. K % M %=X N X M X=% K % M %=DIC N DIC M DIC=%
|
|
. K % M %=DA N DA M DA=% K % M %=DO N DO M DO=% K % N DD,D
|
|
. D INDEX^DIKC(+DO(2),DA_DIENS,.01,"","SC") Q
|
|
;
|
|
N6 ; if we have lookup values to stuff, or DIC("DR"), or if the file has
|
|
; IDs or KEYS, go do DIE.
|
|
; Code will return at D if successful. We set output and go exit
|
|
;
|
|
S Y=DA D
|
|
. I $D(DIC("DR"))!($O(DISUBVAL(+DO(2),0)))!($O(^DD("KEY","B",+DO(2),0))) D ^DICN1 Q
|
|
. Q:DIC(0)'["E"
|
|
. I '$O(^DD(+DO(2),0,"ID",0)) Q
|
|
. D ^DICN1 Q
|
|
I Y'>0 S:$G(DO(1)) DS(0)="1^" Q
|
|
;
|
|
; Finish adding the new record.
|
|
D S Y=DA_U_X_"^1" I $D(D)#2 S DA=D
|
|
D R^DIC2 Q
|
|
;
|
|
INCR S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10
|
|
Q
|
|
;
|
|
;
|
|
OUT I DIC(0)["Q" W $C(7)_$S('$D(DDS):" ??",1:"")
|
|
S Y=-1 I $D(DO(1)),'$D(DTOUT) D A^DIC S DS(0)="1^" Q
|
|
D Q^DIC2 Q
|
|
;
|
|
LOCK(DIROOT,DIEN,DIRESULT) ;
|
|
;
|
|
; try to lock the record, and see if it's already there
|
|
; NEW
|
|
;
|
|
D LOCK^DILF(DIROOT_"DIEN)") ;L @("+"_DIROOT_"DIEN):1") ;**147
|
|
S DIRESULT='$D(@(DIROOT_"DIEN)"))&$T
|
|
I 'DIRESULT L @("-"_DIROOT_"DIEN)")
|
|
Q
|
|
;
|