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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1DICLIX1 ;SEA/TOAD,SF/TKW-FileMan: Lister, Search Compound Indexes (cont.) ;11/5/99 15:13
2 ;;22.0;VA FileMan;**17**;Mar 30, 1999;
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5BLDTMP(DINDEX,DISCREEN,DIFLAGS,DIDENT) ; Build temporary index of external values when pointer/vp subscript is encountered.
6 N DISUB,DIXSAV,DIX,DIDOUT S DIDOUT=0
7 S DIX("AT")=DINDEX("AT") K @DINDEX(DIX("AT"),"ROOT")
8 N I S I=$S(DIX("AT")=1:1,1:DIX("AT")-1)
9 F DISUB=I:1:DINDEX("#")+1 D
10 . S (DIXSAV(DISUB),DIX(DISUB))=DINDEX(DISUB)
11 . I "VP"[$G(DINDEX(DISUB,"TYPE")) S DIX(DISUB)=""
12 D BT1
13 F DISUB=DINDEX("AT"):1:DINDEX("#")+1 S DINDEX(DISUB)=DIXSAV(DISUB)
14 Q
15 ;
16BT1 N DISUB S DISUB=DIX("AT")
17 N DIVAL,DISINT,DIDONE,DIPART,DIMORE S DISINT=DIX(DISUB),DIDONE=0
18 F D Q:DIDONE
19 . S DISINT=$O(@DINDEX(DISUB,"IXROOT")@(DISINT),DINDEX(DISUB,"WAY"))
20 . S:DISINT="" DIDONE=1 Q:DIDONE
21 . I DISUB'>DINDEX("#") D Q
22 . . S DIVAL=DISINT,DIPART=$G(DINDEX(DISUB,"PART")),DIMORE=$G(DINDEX(DISUB,"MORE?"))
23 . . I DINDEX(DISUB,"TYPE")="V",$G(DISCREEN("V",DISUB))]"" D Q:DIVAL=""
24 . . . N G S G="^"_$P(DISINT,";",2) Q:G="^"
25 . . . S:'$D(DINDEX(DISUB,"VP",G)) DIVAL="" Q
26 . . I "VP"[DINDEX(DISUB,"TYPE") D I DIVAL="" S DIDONE=1 Q
27 . . . S DIVAL=$$EXTERNAL^DIDU(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),"i",DIVAL)
28 . . . Q:'$G(DIERR)
29 . . . I DIFLAGS["h" K DIERR,^TMP("DIERR",$J) Q
30 . . . S DIVAL="",DINDEX("DONE")=1 Q
31 . . D CHK^DICLIX I DIDONE D Q
32 . . . I $G(DINDEX("DONE")) S DIDOUT=1 Q
33 . . . S:DIVAL]"" DIDONE=0 Q
34 . . I DISUB=1,"VP"[DINDEX(1,"TYPE") S @DINDEX(1,"ROOT")@(DIVAL)=DISINT
35 . . S DINDEX(DISUB)=DIVAL,DIX(DISUB)=DISINT,DIX("AT")=DISUB+1
36 . . D BT1
37 . . S DIX("AT")=DISUB
38 . . I $G(DIDOUT) S DIDONE=1
39 . . Q
40 . Q:DIDONE
41 . I $G(DINDEX(DISUB,"TO")) D Q:DIDONE
42 . . D BACKPAST(DIFLAGS,.DINDEX,DISUB,DISINT,.DIDONE)
43 . . S:DIDONE DIDOUT=1 Q
44 . S @DINDEX(DISUB,"ROOT")@(DISINT)=""
45 S DIX(DISUB)="" Q
46 ;
47BACKPAST(DIFLAGS,DINDEX,DISUB,DIVAL,DIDONE) ; Have we gone past TO value? Lister only.
48 N I,DIOUT S DIOUT=0
49 F I=1:1:DISUB D Q:DIOUT
50 . N V S V=$S(I=DISUB:DIVAL,1:DINDEX(I))
51 . I I=1,DIFLAGS'["p","PV"[DINDEX(1,"TYPE") S V=DINDEX(I,"EXT")
52 . Q:V=DINDEX(I,"TO")
53 . I DINDEX(I,"WAY")=1,DINDEX(I,"TO")]]V S DIOUT=1 Q
54 . I DINDEX(I,"WAY")=-1,V]]DINDEX(I,"TO") S DIOUT=1 Q
55 . S DIVAL="",(DIOUT,DIDONE,DINDEX("DONE"))=1 Q
56 . Q
57 Q:DIOUT
58 S DIVAL="",(DIDONE,DINDEX("DONE"))=1 Q
59 ;
60 ;
Note: See TracBrowser for help on using the repository browser.