| [613] | 1 | DICLIX1 ;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 | ;
|
|---|
| 5 | BLDTMP(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 | ;
|
|---|
| 16 | BT1 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 | ;
|
|---|
| 47 | BACKPAST(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 | ;
|
|---|
