Annotation of freem_fileman/DICA.m, revision 1.1.1.1
1.1 snw 1: DICA ;SEA/TOAD-VA FileMan, Updater, Engine ;12/1/94 08:52 ;
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4:
5: ADD(DIFLAGS,DIFDA,DIEN,DIMSGA)
6:
7: ADDX ; Branch in from UPDATE^DIE
8: ; ENTRY POINT--add a new entry to a file
9: ; subroutine, DIEN passed by reference
10: I '$D(DIQUIET) N DIQUIET S DIQUIET=1
11: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
12: K ^TMP("DIADD",$J)
13: INPUT
14: ; initialize input parameters & check
15: N DIRULE S DIRULE="^TMP(""DICA"",$J)"
16: N DIFDAO
17: I $G(DIMSGA)'="" D
18: . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
19: S DIFLAGS=$G(DIFLAGS)
20: I $TR(DIFLAGS,"ESY")'="" D Q
21: . D ERR^DICA3(301,"","","",DIFLAGS),CLOSE
22: S DIFDA=$G(DIFDA) I $D(@DIFDA)<10 D Q
23: . D ERR^DICA3(202,"","","","FDA"),CLOSE
24: S DIFDAO=DIFDA
25: S DIEN=$G(DIEN) I DIEN="" S DIEN="DIDUMMY" N DIDUMMY
26: PRE
27: N DIOK S DIOK=1 D CHECK^DICA1(DIFLAGS,.DIFDA,DIEN,DIRULE,.DIOK)
28: I $G(DIERR) D CLOSE Q
29: I 'DIOK D ERR^DICA3(202,"","","","FDA"),CLOSE Q
30: SEQ
31: N DIENTRY,DIFILE,DIOUT1,DINEXT
32: S (DIOUT1,DINEXT)="" F D Q:DIOUT1
33: . S DINEXT=$O(@DIRULE@("NEXT",DINEXT)) I DINEXT="" S DIOUT1=1 Q
34: . X @DIRULE@("NEXT",DINEXT)
35: FILES .
36: . I $P($G(^DD($$FNO^DILIBF(DIFILE),0,"DI")),U,2)["Y" D Q
37: . . S DIOUT1=DIFLAGS'["Y"&'$D(DIOVRD)
38: . . I DIOUT1 D ERR^DICA3(405,DIFILE,"","",DIFILE)
39: ENTRIES .
40: . N DIDA,DIENP,DIOP,DIROOT,DISEQ
41: . S DIDA=$P(DIENTRY,",") I +DIDA=DIDA Q
42: . S DIENP=$$IEN(DIENTRY,"",DIRULE)
43: . S DIOP=$E(DIDA,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
44: . S DISEQ=$P(DIDA,DIOP,2)
45: FINDING .
46: . I DIOP["?" S DIOUT2=0 D I DIOUT2 Q
47: . . N DIFIND,DIFORMAT,DIGET,DIVALUE
48: . . S DIFORMAT=$S(DIFLAGS["E":"",1:"Q")
49: . . S DIGET=DIFDA
50: . . I DIFLAGS["E",DIOP="?" S DIGET=DIFDAO
51: . . S DIVALUE=$G(@DIGET@(DIFILE,DIENTRY,.01))
52: . . S DIFIND=$$FIND1^DIC(DIFILE,DIENP,DIFORMAT,DIVALUE)
53: . . I $D(DIERR) S DIOUT1=1,DIOUT2=1 Q
54: . . I DIOP="?+",'DIFIND Q
55: . . I 'DIFIND S DIOUT1=1,DIOUT2=1 D Q
56: . . . D ERR^DICA3(703,DIFILE,DIENTRY,"",DIVALUE)
57: . . S @DIEN@(DISEQ)=DIFIND
58: . . S @DIRULE@("IEN",DISEQ)=DIFIND
59: . . D SAVE S DIOUT2=1
60: ADDING .
61: . N DIENEW,DIKEY
62: . I $L(DIENP,",")>2 S DIOK=$$VMINUS9^DIEFU(DIFILE,DIENP) I 'DIOK D Q
63: . . S DIOUT1=1
64: . . D ERR^DICA3(602,DIFILE,$P(DIENP,",",$L(DIENP,",")-1))
65: . S DIROOT=$$ROOT^DIQGU(DIFILE,DIENP)
66: . D DA^DILF(DIENTRY,.DIENEW)
67: A1 . S DIENEW=$$IEN(DIENTRY,$G(@DIEN@(DISEQ)),DIRULE)
68: . S DIKEY=$G(@DIFDA@(DIFILE,DIENTRY,.01)) I DIKEY="" D Q
69: . . S DIOUT1=1 D ERR^DICA3(202,"","","","FDA")
70: . S DIOK=$$LAYGO(DIFILE,.DIENEW,DIKEY)
71: . I 'DIOK S DIOUT1=1 D Q
72: . . I '$G(DIERR) D ERR^DICA3(405,DIFILE,"","",DIFILE) Q
73: . . N DIENS S DIENS="New entry"
74: . . I $L(DIENEW,",")>2 S DIENS=DIENS_" under record: "_DIENEW
75: . . N DI1 S DI1="LAYGO Node on the new value '"_DIKEY_"'"
76: . . D ERR^DICA3(120,DIFILE,DIENS,.01,DI1)
77: . D CREATE^DICA3(DIFILE,.DIENEW,DIROOT,DIKEY)
78: . S DIENEW=+DIENEW
79: . I 'DIENEW S DIOUT1=1 Q
80: . L -@(DIROOT_"DIENEW)")
81: . S @DIEN@(DISEQ)=DIENEW
82: . S @DIRULE@("IEN",DISEQ)=DIENEW
83: . D SAVE
84:
85: FILER ; file the data for the new records
86: I '$D(DIERR),$D(@DIFDA) D
87: . D FILE^DIEF($S(DIFLAGS["S":"S",1:""),DIFDA,"",DIEN)
88: I '$D(DIERR),DIFLAGS'["S" K @DIFDAO
89: I $D(DIERR)!(DIFLAGS["S"),DIFLAGS'["E" D
90: . M @DIFDA=^TMP("DIADD",$J) K ^TMP("DIADD",$J)
91: D CLOSE
92: Q
93:
94: LAYGO(DIFILE,DIEN,DIKEY)
95: ; ADDING--return if LAYGO permitted
96: ; function, all by value
97: N DA,DIOK,DINODE,DIOUTS,X,Y,Y1
98: S DIOK=1,DINODE="",DIOUTS=0 F D I DIOUTS!'DIOK Q
99: . S DINODE=$O(^DD(DIFILE,.01,"LAYGO",DINODE))
100: . I DINODE'>0 S DIOUTS=1 Q
101: . I $D(^DD(DIFILE,.01,"LAYGO",DINODE,0))[0 Q
102: . S X=DIKEY M DA=DIEN S Y=$P(DA,","),Y1=DA,DA=$P(DA,",")
103: . I 1 X ^DD(DIFILE,.01,"LAYGO",DINODE,0) S DIOK=$T&'$G(DIERR)
104: Q DIOK
105:
106: SAVE I DIFLAGS'["E" D
107: . S ^TMP("DIADD",$J,DIFILE,DIENTRY,.01)=@DIFDA@(DIFILE,DIENTRY,.01)
108: K @DIFDA@(DIFILE,DIENTRY,.01)
109: Q
110:
111: IEN(DIENTRY,DIENF,DIRULE)
112: ; ADDING/FINDING--return translated IEN String
113: ; function, DIENTRY passed by value
114: N DIC,DIENEW,DIOP,DIP,DIPNEW,DISEQ
115: S DIENEW=""
116: S DIENF=$G(DIENF)
117: S DIP="" F DIC=1:1 D I DIP="" Q
118: . S DIP=$P(DIENTRY,",",DIC) I DIP="" Q
119: . D
120: . . I +DIP=DIP S DIPNEW=DIP Q
121: IEN1 . . I DIC=1 S DIPNEW=DIENF Q
122: . . S DIOP=$E(DIP,1,2) I DIOP'="?+" S DIOP=$E(DIOP)
123: . . S DISEQ=$P(DIP,DIOP,2,9999)
124: . . S DIPNEW=@DIRULE@("IEN",DISEQ)
125: . S $P(DIENEW,",",DIC)=DIPNEW
126: I DIENEW'="" S DIENEW=DIENEW_","
127: Q DIENEW
128:
129: CLOSE I $G(DIMSGA)'="" D CALLOUT^DIEFU(DIMSGA)
130: K @DIRULE
131: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DICA.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman