source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICF2.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1DICF2 ;SEA/TOAD,SF/TKW-VA FileMan: Finder, Part 3 (All Indexes) ;12/17/99 08:24
2 ;;22.0;VA FileMan;**4,20**;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5CHKALL(DIFILE,DIEN,DIFIEN,DIFLAGS,DIVALUE,DISCREEN,DINUMBER,DIFORCE,DINDEX,DIDENT,DILIST,DIC,DIY,DIYX) ;
6 ; Loop through all indexes to be searched, perform data type
7 ; transforms on lookup values.
8 N DIOUT
9 I DIFLAGS["O",DIFLAGS'["p" S DIOUT=DIFLAGS N DIFLAGS S DIFLAGS=DIOUT_"X"
10 S DIOUT=0 N DISKIP
1141 F D Q:$G(DIERR)!($G(DINDEX("DONE")))!DIOUT
12 . S DISKIP=0
13 . N DILINK S DILINK=DIFILE_U_DINDEX
14 . I DINDEX="#" D
15 . . S DIFILE("CHAIN",DILINK)=""
16 . . Q:+$P(DIVALUE,"E")'=DIVALUE Q:'$D(@DIFILE(DIFILE)@(DIVALUE))
17 . . N DIEN S DIEN=DIVALUE D ENTRY^DICF1 Q
18 . I '$D(DIFILE("CHAIN",DILINK)) D K DIFILE("CHAIN",DILINK)
19 . . S DIFILE("CHAIN",DILINK)=""
20 . . D:DIFLAGS'["Q" PREPIX(.DIFILE,DIFLAGS,.DINDEX,.DIVALUE,.DISKIP)
21 . . I 'DISKIP D CHKONE^DICF3(.DIFLAGS,.DIVALUE,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
22 . . D CLEANIX(.DINDEX,.DIVALUE) Q
2343 . I $G(DIERR)!($G(DINDEX("DONE"))) Q
24 . I DIFLAGS["l" S (DIOUT,DINDEX("DONE"))=1 Q
25 . D NXTINDX(.DINDEX,.DIFORCE,.DIFILE,.DIFLAGS,.DIVALUE,DINUMBER)
26 . I DINDEX="" D Q:DINDEX=""
27 . . S DIOUT=1
28 . . Q:DIFLAGS'["O" Q:DIFLAGS'["X" Q:DIFLAGS["p" Q:DIDENT(-1)
29 . . S DIFLAGS=$TR(DIFLAGS,"X"),DIOUT=0,DIFORCE(1)=1
30 . . S DINDEX=$S(DIFLAGS["l":DINDEX("START"),DIFORCE:$P(DIFORCE(0),U),1:$$DINDEX^DICL(DIFILE,DIFLAGS))
31 . . I DINDEX="" S DIOUT=1 Q
32 . . D FIRSTIDX(.DINDEX,.DIFORCE,.DIFILE,DIFLAGS,.DIVALUE,DINUMBER)
33 . . Q
34 . D
35 . . N DICRSR S DICRSR=0
36 . . I DIFLAGS["P" D Q:'DICRSR
37 . . . F S DICRSR=$O(DIDENT(DICRSR)) Q:'DICRSR Q:$D(DIDENT(DICRSR,0,1,"E"))
38 . . . Q
39 . . Q:'$D(DIDENT(DICRSR,0,1,"E"))
40 . . N DISAVNO,DISAVENT S DISAVNO=DINDEX("#"),DINDEX("#")=1,DISAVENT=$G(DIDENT),DIDENT="IXE"
41 . . D THROW^DICU11(DIFLAGS,.DIDENT,"IXE",DICRSR,1,"E",.DINDEX,1)
42 . . S DINDEX("#")=DISAVNO,DIDENT=DISAVENT Q
43 . Q
44 Q
45 ;
46PREPIX(DIFILE,DIFLAGS,DINDEX,DIVALUE,DISKIP) ;
47 ; CHKALL--lookup index data type, add transform values to list
48 N DISUB,DITYPE
49 F DISUB=1:1:DINDEX("#") D:DIVALUE(DISUB)]"" Q:$G(DIERR)
50 . I $G(DINDEX("IXTYPE"))="S" D Q
51 . . N X S X=$$SOUNDEX^DICF5(DINDEX(DISUB)) Q:'X
52 . . S DIVALUE(DISUB,5)=X Q
53 . S DITYPE=DINDEX(DISUB,"TYPE")
54 . I DITYPE["F"!(DITYPE["N") D
55 . . Q:$G(DINDEX(DISUB,"TRANCODE"))=""
56 . . N X S X=DIVALUE(DISUB) X DINDEX(DISUB,"TRANCODE") Q:X=""
57 . . S DIVALUE(DISUB,5)=X
58 . . Q
59 . N DINODE S DINODE=$G(^DD(+DINDEX(DISUB,"FILE"),+DINDEX(DISUB,"FIELD"),0))
60 . I DITYPE["D" D PREPD^DICF5(DISUB,.DINDEX,DINODE,.DIVALUE) Q
61 . I DITYPE["S" D PREPS^DICF5(DIFLAGS,DISUB,.DINDEX,DINODE,.DIVALUE) Q
62 . I DITYPE'["P",DITYPE'["V" Q
63 . I DISUB'=1 D POINT^DICF5(DISUB,DIFLAGS,.DIFILE,.DINDEX,.DIVALUE,.DISCREEN) Q
64 . D POINT^DICF4(.DIFILE,.DIFLAGS,.DINDEX,.DIDENT,.DIEN,DIFIEN,.DISCREEN,.DIVALUE,.DIC,.DIFORCE)
65 . I '$D(DINDEX(1,"IXROOT"))!($G(DIERR)) S DISKIP=1
66 . I $G(DTOUT)!($G(DIROUT)) S (DISKIP,DINDEX("DONE"))=1
67 . Q:DISKIP
68 . Q:$G(DINDEX(1,"TRANCODE"))=""
69 . N DII,X
70 . S DII="" F S DII=$O(@DINDEX(1,"ROOT")@(DII)) Q:DII="" D
71 . . K @DINDEX(1,"ROOT")@(DII)
72 . . S X=$P(DII,"^",2) X DINDEX(1,"TRANCODE") Q:X=""
73 . . S X=$P(DII,"^")_"^"_X,@DINDEX(1,"ROOT")@(X)="" Q
74 . Q
75 Q
76 ;
77CLEANIX(DINDEX,DIVALUE) ;
78 ; CHKALL--clear transform values for this index from DIVALUE arrays
79 ; clear temporary list of pointed-to entries.
80 N I,DISUB
81 F DISUB=1:1:DINDEX("#") D
82 . I $G(DINDEX(DISUB,"IXROOT"))]"" D
83 . . I DISUB=1,DIFLAGS["l" S I=$O(@DINDEX(DISUB,"ROOT")@("")),DS("INT")=$P(I,U,2)
84 . . S I=$P(DINDEX(DISUB,"ROOT"),",""B"")",1) Q:I=""
85 . . K @(I_")") Q
86 . S I=4
87 . F S I=$O(DIVALUE(DISUB,I)) Q:'I K DIVALUE(DISUB,I)
88 . Q
89 Q
90 ;
91FIRSTIDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
92 ; Return data for starting index before second loop when flags["O"
93 D N3 Q
94 ;
95NXTINDX(DINDEX,DIFORCE,DIFILE,DIFLAGS,DIVALUE,DINUMBER) ;
96 ; Return next index
97 N D,DIGO,I,J,K,DIX1,DIX2,DIOK,DIOLDL
98 S D=DINDEX,I=$G(DINDEX("START")),K=$G(DINDEX("MAXSUB"))
99 D:DIFLAGS'["h"
100 . F J=1:1:DINDEX("#") S DIOLDL(J)=DINDEX(J,"LENGTH")
101 K DINDEX S DINDEX=D,DINDEX("WAY")=1
102 S:I]"" DINDEX("START")=I S:K]"" DINDEX("MAXSUB")=K
103 S (DIGO,DIOK)=0
104N1 I DIFORCE F D Q:DIOK!(DIGO)
105 . I DIFLAGS["M",DIFORCE(1)=1,$P(DIFORCE(0),U,2)="" S DIGO=1 Q
106 . S DIFORCE(1)=DIFORCE(1)+1,DINDEX=$P(DIFORCE(0),U,DIFORCE(1))
107 . I DINDEX="#",DIFLAGS'["l",DIFLAGS'["h" S DIOK=1 Q
108 . S:DINDEX=-1 DINDEX="" I DINDEX="" S DIOK=1 Q
109 . I $O(^DD(DIFILE,0,"IX",DINDEX,0)),$$IDXOK(DIFILE,DINDEX) S DIOK=1 Q
110 . S I=$O(^DD("IX","BB",DIFILE,DINDEX,0)) Q:'I
111 . S DIOK=1 Q
112N2 I ('DIFORCE)!DIGO D
113 . S (DIX1,DIX2)=DINDEX
114 . F S DIX1=$O(^DD(DIFILE,0,"IX",DIX1)) Q:DIX1="" Q:$$IDXOK(DIFILE,DIX1)
115 . S DIOK=0 F S DIX2=$O(^DD("IX","BB",DIFILE,DIX2)) Q:DIX2="" D Q:DIOK
116 . . S I=$O(^DD("IX","BB",DIFILE,DIX2,0)) Q:'I
117 . . Q:$P($G(^DD("IX",I,0)),U,14)'["L"
118 . . S J=$O(^DD("IX",I,11.1,"AC",1,0)) Q:'J Q:$G(^DD("IX",I,11.1,J,0))=""
119 . . S DIOK=1 Q
120 . I DIX1'="",DIX2=""!(DIX2]DIX1) S DINDEX=DIX1 Q
121 . S DINDEX=DIX2 Q
122 . Q
123N3 Q:DINDEX="" Q:DIFLAGS["h"
124 D INDEX^DICUIX(.DIFILE,DIFLAGS,.DINDEX,"",.DIVALUE,DINUMBER,.DISCREEN)
125 I DINDEX("#")>1 F D=1:1:DINDEX("#") S DIVALUE(D)=$G(DIVALUE(D))
126 N DINEWVAL S DINEWVAL=0 D
127 . N J F J=1:1:DINDEX("#") I DIVALUE(J)]"",DINDEX(J,"LENGTH")'=$G(DIOLDL(J)) S DINEWVAL=1 Q
128 . I DINEWVAL D XFORM^DICF1(DIFLAGS,.DIVALUE,.DISCREEN,.DINDEX)
129 Q
130 ;
131IDXOK(DIFILE,%) ; See whether selected index exists in 1 nodes of DD
132 N DIX,%Y,DD,X Q:%="" 0
133 S DIX=$O(^DD(DIFILE,0,"IX",%,0)) Q:'DIX 0
134 S %Y=$O(^DD(DIFILE,0,"IX",%,DIX,0)) Q:'%Y 0
135 F DD=0:0 S DD=$O(^DD(DIX,%Y,1,DD)) Q:'DD S X=$P($G(^(DD,0)),U,2) Q:X=%
136 Q:'DD 0
137 Q 1
138 ;
Note: See TracBrowser for help on using the repository browser.