source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICN0.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1DICN0 ;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 ;
5NEW ; 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 ;
21N1 ; 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 ;
33N2 ; 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 ;
57N3 ; 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)
66N4 ; 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
71N5 ; 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 ;
94N6 ; 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.
106D S Y=DA_U_X_"^1" I $D(D)#2 S DA=D
107 D R^DIC2 Q
108 ;
109INCR S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10
110 Q
111 ;
112 ;
113OUT 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 ;
117LOCK(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 ;
Note: See TracBrowser for help on using the repository browser.