Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICLIX1

DICLIX1.m

Go to the documentation of this file.
DICLIX1 ;SEA/TOAD,SF/TKW-FileMan: Lister, Search Compound Indexes (cont.) ;11/5/99  15:13 [ 04/02/2003   8:25 AM ]
 ;;22.0;VA FileMan;**1001**;APR 1, 2003
 ;;22.0;VA FileMan;**17**;Mar 30, 1999;
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
BLDTMP(DINDEX,DISCREEN,DIFLAGS,DIDENT) ; Build temporary index of external values when pointer/vp subscript is encountered.
 N DISUB,DIXSAV,DIX,DIDOUT S DIDOUT=0
 S DIX("AT")=DINDEX("AT") K @DINDEX(DIX("AT"),"ROOT")
 N I S I=$S(DIX("AT")=1:1,1:DIX("AT")-1)
 F DISUB=I:1:DINDEX("#")+1 D
 . S (DIXSAV(DISUB),DIX(DISUB))=DINDEX(DISUB)
 . I "VP"[$G(DINDEX(DISUB,"TYPE")) S DIX(DISUB)=""
 D BT1
 F DISUB=DINDEX("AT"):1:DINDEX("#")+1 S DINDEX(DISUB)=DIXSAV(DISUB)
 Q
 ;
BT1 N DISUB S DISUB=DIX("AT")
 N DIVAL,DISINT,DIDONE,DIPART,DIMORE S DISINT=DIX(DISUB),DIDONE=0
 F  D  Q:DIDONE
 . S DISINT=$O(@DINDEX(DISUB,"IXROOT")@(DISINT),DINDEX(DISUB,"WAY"))
 . S:DISINT="" DIDONE=1 Q:DIDONE
 . I DISUB'>DINDEX("#") D  Q
 . . S DIVAL=DISINT,DIPART=$G(DINDEX(DISUB,"PART")),DIMORE=$G(DINDEX(DISUB,"MORE?"))
 . . I DINDEX(DISUB,"TYPE")="V",$G(DISCREEN("V",DISUB))]"" D  Q:DIVAL=""
 . . . N G S G="^"_$P(DISINT,";",2) Q:G="^"
 . . . S:'$D(DINDEX(DISUB,"VP",G)) DIVAL="" Q
 . . I "VP"[DINDEX(DISUB,"TYPE") D  I DIVAL="" S DIDONE=1 Q
 . . . S DIVAL=$$EXTERNAL^DIDU(DINDEX(DISUB,"FILE"),DINDEX(DISUB,"FIELD"),"i",DIVAL)
 . . . Q:'$G(DIERR)
 . . . I DIFLAGS["h" K DIERR,^TMP("DIERR",$J) Q
 . . . S DIVAL="",DINDEX("DONE")=1 Q
 . . D CHK^DICLIX I DIDONE D  Q
 . . . I $G(DINDEX("DONE")) S DIDOUT=1 Q
 . . . S:DIVAL]"" DIDONE=0 Q
 . . I DISUB=1,"VP"[DINDEX(1,"TYPE") S @DINDEX(1,"ROOT")@(DIVAL)=DISINT
 . . S DINDEX(DISUB)=DIVAL,DIX(DISUB)=DISINT,DIX("AT")=DISUB+1
 . . D BT1
 . . S DIX("AT")=DISUB
 . . I $G(DIDOUT) S DIDONE=1
 . . Q
 . Q:DIDONE
 . I $G(DINDEX(DISUB,"TO")) D  Q:DIDONE
 . . D BACKPAST(DIFLAGS,.DINDEX,DISUB,DISINT,.DIDONE)
 . . S:DIDONE DIDOUT=1 Q
 . S @DINDEX(DISUB,"ROOT")@(DISINT)=""
 S DIX(DISUB)="" Q
 ;
BACKPAST(DIFLAGS,DINDEX,DISUB,DIVAL,DIDONE) ; Have we gone past TO value?  Lister only.
 N I,DIOUT S DIOUT=0
 F I=1:1:DISUB D  Q:DIOUT
 . N V S V=$S(I=DISUB:DIVAL,1:DINDEX(I))
 . I I=1,DIFLAGS'["p","PV"[DINDEX(1,"TYPE") S V=DINDEX(I,"EXT")
 . Q:V=DINDEX(I,"TO")
 . I DINDEX(I,"WAY")=1,DINDEX(I,"TO")]]V S DIOUT=1 Q
 . I DINDEX(I,"WAY")=-1,V]]DINDEX(I,"TO") S DIOUT=1 Q
 . S DIVAL="",(DIOUT,DIDONE,DINDEX("DONE"))=1 Q
 . Q
 Q:DIOUT
 S DIVAL="",(DIDONE,DINDEX("DONE"))=1 Q
 ;
 ;