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

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
2 ;;22.0;VA FileMan;**11,147**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4LOAD(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
5LOADX ;
6 N DIEFIEN
7 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
8 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
9 I $G(DIEFDAS)']"" D BLD^DIALOG(202,"IENS","IENS") G OUT
10 I $E(DIEFDAS,$L(DIEFDAS))="," S DIEFIEN=DIEFDAS
11 E S DIEFIEN=$$IEN^DIEFU(.DIEFDAS)
12 I '$$VROOT^DIEFU(DIEFAR) G OUT
13 I '$$VFILE^DIEFU(DIEFF,"D") G OUT
14 S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFFLD) G:'DIEFFLD OUT
15 I $G(DIEFFLG)["R",'$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") G OUT
16 S @DIEFAR@(DIEFF,DIEFIEN,DIEFFLD)=DIEFVAL
17OUT I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
18 Q
19 ;
20FLDNUM(DIEFF,DIEFFDNM) ;
21FLDNUMX ;
22 I '$D(DIQUIET) N DIQUIET S DIQUIET=1
23 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
24 I '$$VFILE^DIEFU(DIEFF,"D") Q 0
25 N DIEFFNUM
26 I $D(^DD(DIEFF,"B",DIEFFDNM)) D Q DIEFFNUM
27 . S DIEFFNUM=$O(^DD(DIEFF,"B",DIEFFDNM,""))
28 . I $O(^DD(DIEFF,"B",DIEFFDNM,DIEFFNUM)) N P S P(1)=DIEFFDNM,P("FILE")=DIEFF D BLD^DIALOG(505,.P,.P) S DIEFFNUM=0
29 N P S P("FILE")=DIEFF,P(1)=DIEFFDNM D BLD^DIALOG(501,.P,.P)
30 Q 0
31 ;
32ADDCONV(DIEFIEN,DIEFADAR) ;
33 N I,DIEFNIEN,P
34 F I=1:1:$L(DIEFIEN,",")-1 D
35 . S P=$P(DIEFIEN,",",I)
36 . I P,$E(P)'="+" Q
37 . S DIEFNIEN=@DIEFADAR@($TR(P,"+?"))
38 . S $P(DIEFIEN,",",I)=DIEFNIEN
39 Q DIEFIEN
40 ;
41PUTDATA ;CODE TO ACTUALLY PUT THE DATA INTO THE NODE BEING EDITED. ALSO SAVES ORIGINAL VALUES. CALLED FROM DIEF.
42 I +DIEFSPOT D
43 . I DIEFNVAL[U D Q
44 . . S DIEFNG=1
45 . . N INT,EXT
46 . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
47 . . D BLD^DIALOG(714,.INT,.EXT)
48 . S DIEFOVAL=$P(DIEFFVAL,"^",DIEFSPOT)
49 . S $P(DIEFFVAL,"^",DIEFSPOT)=DIEFNVAL,DOREPL=1
50 E I $E(DIEFSPOT)="E" D
51 . N FR,TO,OLEN,NLEN
52 . S FR=$P($P(DIEFSPOT,"E",2),",",1),TO=$P(DIEFSPOT,",",2)
53 . S NLEN=$L(DIEFNVAL)
54 . I NLEN-1>(TO-FR) D Q
55 . . S DIEFNG=1
56 . . N INT,EXT
57 . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
58 . . D BLD^DIALOG(716,.INT,.EXT)
59 . S DIEFOVAL=$E(DIEFFVAL,FR,TO),OLEN=$L(DIEFOVAL)
60 . I $E(DIEFFVAL,TO+1,999)="" S $E(DIEFFVAL,FR,TO)=DIEFNVAL
61 . E S $E(DIEFFVAL,FR,TO)=DIEFNVAL_$J("",$S(OLEN>NLEN:OLEN-NLEN,1:0))
62 . S DOREPL=1
63 E I DIEFSPOT=0 D
64 . I $P($G(^DD(+$P(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)["W" D
65 . . I '$$VROOT^DIEFU(DIEFNVAL) Q
66 . . D PUTWP^DIEFW(DIEFFLAG,DIEFNVAL,DIEFNODE)
67 . E D
68 . . N INT,EXT
69 . . S (INT(1),EXT(1))="MULTIPLE",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
70 . . D BLD^DIALOG(520,.INT,.EXT)
71 . . S DIEFNG=1
72 E I DIEFSPOT=" " D
73 . N INT,EXT
74 . S (INT(1),EXT(1))="COMPUTED",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
75 . D BLD^DIALOG(520,.INT,.EXT)
76 . S DIEFNG=1
77 Q
78 ;
79LOCK ;
80 S (DIEFNOLK,DIEFLCKS)=0,DIEFF=""
81 F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D Q:DIEFNOLK
82 . I '$$VFILE^DIEFU(DIEFF,"D") S DIEFNOLK=1 Q
83 . S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV) Q:DIEFFREF=""
84 . S DIEFDAS=""
85 . F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D Q:DIEFNOLK
86 . . N DA
87 . . I '$$GOODIEN^DIEF(DIEFF,DIEFDAS,DIEFLEV,.DA,"D") S DIEFNOLK=1 Q
88 . . S DIEFLCKS=DIEFLCKS+1
89 . . S DIEFLOCK(DIEFLCKS)=$NA(@DIEFFREF@(DA))
90 . . D LOCK^DILF(DIEFLOCK(DIEFLCKS)) E D ;**147
91 . . . S DIEFNOLK=1
92 . . . N E S E("FILE")=DIEFF,E("IENS")=DIEFDAS D BLD^DIALOG(110,"",.E)
93 Q
94UNLOCK ;
95 N I
96 F I=1:1:DIEFLCKS L -@DIEFLOCK(I)
97 Q
98 ;
99RESTORE(DIKEY,DIEFTMP) ;Restore key fields to pre-edited values
100 ;DIKEY(rFile#,key#,iens) = "" : if key is not unique
101 ; = n : if key fields not assigned a value
102 ;DIKEY(rFile#,key#,iens,file,field) = levdiff : set if field not
103 ; assigned a value
104 N DIEFDA,DIEKK,DIRFIL,DIFIL,DIFLD,DIFLDI,DIIENS,DIIENSA,DIOLD,DILEVD
105 K DIEFDA
106 ;
107 ;Loop through root files and keys in DIKEY
108 S DIRFIL=0 F S DIRFIL=$O(DIKEY(DIRFIL)) Q:'DIRFIL D
109 . S DIEKK=0 F S DIEKK=$O(DIKEY(DIRFIL,DIEKK)) Q:'DIEKK D
110 .. Q:$D(^DD("KEY",DIEKK,0))[0
111 .. ;
112 .. ;Get fields in key
113 .. K DIFLD
114 .. S DIFLDI=0 F S DIFLDI=$O(^DD("KEY",DIEKK,2,DIFLDI)) Q:'DIFLDI D
115 ... S DIFLD=$P($G(^DD("KEY",DIEKK,2,DIFLDI,0)),U),DIFIL=$P($G(^(0)),U,2)
116 ... Q:'DIFLD!'DIFIL
117 ... S DIFLD(DIFIL,DIFLD)=""
118 .. ;
119 .. ;Loop through records in DIKEY
120 .. S DIIENS=" " S DIIENS=$O(DIKEY(DIRFIL,DIEKK,DIIENS)) Q:DIIENS="" D
121 ... ;
122 ... ;Generate error if key is not unique
123 ... D:DIKEY(DIRFIL,DIEKK,DIIENS)="" ERR740^DIEVK1(DIRFIL,DIEKK,DIIENS)
124 ... ;
125 ... ;Loop through files/fields in key
126 ... S DIFIL=0 F S DIFIL=$O(DIFLD(DIFIL)) Q:'DIFIL D
127 .... S DIFLD=0 F S DIFLD=$O(DIFLD(DIFIL,DIFLD)) Q:'DIFLD D
128 ..... Q:$D(^DD(DIFIL,DIFLD,0))[0
129 ..... ;
130 ..... ;Generate error if key field not assigned a value
131 ..... I $D(DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD))#2 D
132 ...... S (DILEVD,DIFLD(DIFIL,DIFLD))=+DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD)
133 ...... D ERR744^DIEVK1(DIFIL,DIFLD,DIEKK,$P(DIIENS,",",DILEVD+1,999))
134 ..... ;
135 ..... ;Set the FDA to restore the field to original value
136 ..... S DILEVD=DIFLD(DIFIL,DIFLD)
137 ..... S:DILEVD="" (DILEVD,DIFLD(DIFIL,DIFLD))=$$FLEVDIFF^DIKCU(DIRFIL,DIFIL)
138 ..... S DIIENSA=$P(DIIENS,",",DILEVD+1,999)
139 ..... Q:$D(@DIEFTMP@("V",DIFIL,DIIENSA,DIFLD,"O"))[0 S DIOLD=^("O")
140 ..... S DIEFDA(DIFIL,DIIENS,DIFLD)=DIOLD
141 ;
142 D:$D(DIEFDA) FILE^DIEF("U","DIEFDA")
143 Q
144 ;
145SKEYCHK(DIEFF,DIEFFLD,DIEFNVAL,DA,DIEFIEN,DIEFFXR) ;Check simple key
146 N DIEFKEY,DIEFK,DIEFKCHK
147 Q:'$D(^DD("KEY","F",DIEFF,DIEFFLD)) 1
148 I DIEFNVAL="" D NKEY(DIEFF,DIEFFLD,DIEFIEN) Q 0
149 Q:'$D(DIEFFXR) 1
150 S @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")=DIEFNVAL
151 S DIEFKCHK=$$KEYCHK^DIKK2(DIEFF,.DA,DIEFFLD,"DIEFFXR",DIEFIEN,"DIEFKEY","N")
152 K @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")
153 Q:DIEFKCHK 1
154 S DIEFK=0 F S DIEFK=$O(DIEFKEY(DIEFF,DIEFIEN,"K",DIEFK)) Q:'DIEFK D ERR740^DIEVK1(DIEFF,DIEFK,DIEFIEN)
155 Q 0
156 ;
157NKEY(DIEFF,DIEFFLD,DIEFIEN) ;Generate error message #742
158 N DIEFK
159 S DIEFK=0 F S DIEFK=$O(^DD("KEY","F",DIEFF,DIEFFLD,DIEFK)) Q:'DIEFK D
160 . S DIEFK(DIEFK)=""
161 S DIEFK=0 F S DIEFK=$O(DIEFK(DIEFK)) Q:'DIEFK D ERR742^DIEVK1(DIEFF,DIEFFLD,DIEFK,DIEFIEN)
162 Q
Note: See TracBrowser for help on using the repository browser.