DICFIX ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes ;5/26/99  14:40
 ;;22.0;VA FileMan;**4**;Mar 30, 1999;
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
WALK(DIFLAGS,DINDEX,DIDENT,DIFILE,DIEN,DIFIEN,DISCREEN,DILIST,DIC,DIY,DIYX) ;
 ;
 ; a walker to traverse a compound index, taking actions
 ; DINDEX is an array describing the index and how to walk it
 ;
PREP ; prepare to loop through subscript
 ;
 N DISUB S DISUB=DINDEX("AT")
 N DIVAL S DIVAL=DINDEX(DISUB)
 N DIPART,DIMORE S DIPART=$G(DINDEX(DISUB,"PART")),DIMORE=+$G(DINDEX(DISUB,"MORE?"))
 N DITRXNO S DITRXNO=DIDENT(-4)
 I $G(DINDEX(DISUB,"USE")),DIVAL'="" D
 . S DIVAL=$O(@DINDEX(DISUB,"ROOT")@(DIVAL),-DINDEX(DISUB,"WAY"))
 ;
LOOP ; loop through subscripts
 ;
 N DIDONE,DISKIP S DIDONE=0 F  D  Q:DIDONE!$G(DIERR)
 . S DIVAL=$O(@DINDEX(DISUB,"ROOT")@(DIVAL),DINDEX(DISUB,"WAY"))
 .
DATA . ; if we're in the data subscripts, we need to walk further
 .
 . I DISUB'>DINDEX("#") D  Q
 . . S DISKIP=0
 . . I DIVAL'="",'$D(DINDEX(DISUB,"IXROOT")) D CHK Q:DISKIP
 . . S:DIVAL="" DIDONE=1
 . . I DIDONE Q:'DITRXNO  D  Q:DIDONE!(DISKIP)
 . . . S DITRXNO=$O(DINDEX(DISUB,DITRXNO)) Q:'DITRXNO
 . . . S (DIVAL,DIPART)=DINDEX(DISUB,DITRXNO)
 . . . I DITRXNO=3!(DITRXNO=4),DIDENT(-1)>DINDEX("TOTAL") S DISKIP=1
 . . . S DIDONE=0
 . . . Q
 . . S DINDEX(DISUB)=DIVAL,DINDEX("AT")=DISUB+1
 . . S DINDEX(DISUB,"FOUND")=DITRXNO,DIDENT(-4)=1
 . . I DISUB=1,$D(DINDEX(1,"IXROOT")) S DINDEX(1)=$P(DIVAL,U,2)
 . . D WALK(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DIC,.DIY,.DIYX)
 . . S DINDEX("AT")=DISUB
 . . S DIDENT(-4)=DITRXNO
 . . I DISUB=1,$D(DINDEX(1,"IXROOT")) S DINDEX(1)=DIVAL
 . . I $G(DINDEX("DONE"))!$G(DIERR) S DIDONE=1
 .
IEN . ; otherwise, we're in the IEN subscripts & need to process
 .
 . I DIVAL="" S DIDONE=1 Q
 . I DINDEX="B" N DIMNEM D
 . . I $D(@DINDEX(DISUB,"ROOT")@(DIVAL))#2 Q:'^(DIVAL)
 . . E  Q:'$O(@DINDEX(DISUB,"ROOT")@(DIVAL,""))
 . . S DIMNEM="" Q
 . D TRY
 . Q
CLEAN ; clean up after loop, exit
 S DINDEX(DISUB)=$S(DISUB<(DINDEX("#")+1):$G(DINDEX(DISUB,"FROM")),1:"")
 S DIDENT(-4)=1
 Q
 ;
CHK ; See whether we have a match or are at the end of the subscripts.
 I DISUB>1,"VP"[DINDEX(DISUB,"TYPE"),DIFLAGS'["Q" D  Q
 . N DIFL,DIFLD,DIV
 . S DIFL=DINDEX(DISUB,"FILE"),DIFLD=DINDEX(DISUB,"FIELD"),DIV=DIVAL
 . I DINDEX(DISUB,"TYPE")="V",$G(DISCREEN("V",DISUB))]"" D  Q:DISKIP
 . . N G S G="^"_$P(DIV,";",2) Q:G="^"
 . . S:'$D(DINDEX(DISUB,"VP",G)) DISKIP=1 Q
 . N DIVAL S DIVAL=$$EXTERNAL^DIDU(DIFL,DIFLD,"i",DIV)
 . I $G(DIERR),DIFLAGS["l" K DIERR,^TMP("DIERR",$J) S DIVAL=DIV
 . I DIVAL="" S DIDONE=1 Q
 . F DITRXNO=0:0 S DITRXNO=$O(DINDEX(DISUB,DITRXNO)) Q:'DITRXNO  D  Q:'DIDONE
 . . S DIPART=DINDEX(DISUB,DITRXNO),DIDONE=0
 . . D MATCH I DIDONE,'$G(DINDEX("DONE")),DIMORE,DIFLAGS'["X" D
 . . . S DIDONE=0 D FINDMORE^DICLIX0(DISUB,.DIVAL,DIPART,.DINDEX,.DIMORE) I DIVAL="" S DIDONE=1 Q
 . . . D MATCH Q
 . . Q:DIDONE
 . . S DINDEX(DISUB,"EXT")=$$EXTERNAL^DIDU(DIFL,DIFLD,"",DIV)
 . . I $G(DIERR),DIFLAGS["l" K DIERR,^TMP("DIERR",$J) S DINDEX(DISUB,"EXT")=DIV
 . . Q
 . I DIDONE S DIDONE=0,DISKIP=1
 . Q
 D MATCH I DIDONE,'$G(DINDEX("DONE")),DIMORE,DIFLAGS'["X" D
 . S DIDONE=0 D FINDMORE^DICLIX0(DISUB,.DIVAL,DIPART,.DINDEX,.DIMORE) I DIVAL="" S DIDONE=1 Q
 . D MATCH Q
 Q
 ;
MATCH ; No more subscripts or partial matches, or past our TO value?
 Q:DIVAL=""  I DIFLAGS["l",DINDEX(DISUB,DITRXNO)="" Q
 I DIFLAGS["X",DIVAL'=DINDEX(DISUB,DITRXNO) S DIDONE=1 Q
 I $P(DIVAL,$G(DIPART))'="" S DIDONE=1 Q
 I $G(DINDEX(DISUB,+DITRXNO,"c"))]"" D  Q:DIDONE!(DISKIP)
 . D NXTNAM^DICFIX1(.DIVAL,DIPART,.DINDEX,.DISKIP,.DIDONE) Q
 Q
 ;
TRY ; Apply screens to entry.  If passed, add entry to output.
 S (DIEN,DINDEX(DISUB))=DIVAL
 N DI0NODE S DI0NODE=$G(@DIFILE(DIFILE)@(DIEN,0))
 Q:$$SCREEN^DICL2(.DIFILE,.DIEN,DIFLAGS,DIFIEN,.DISCREEN,.DINDEX,DI0NODE)
 ; If called from ^DIC, special processing.
 I DIFLAGS["l" D DICLIST Q
 ; Else, add entry to output list.
 D ACCEPT^DICL2(.DIFILE,.DIEN,.DIFLAGS,DIFIEN,.DINDEX,.DIDENT,.DILIST,DI0NODE)
 Q:$G(DIERR)
 I DIDENT(-1)=DIDENT(-1,"MAX"),'DIDENT(-1,"JUST LOOKING") S DIDONE=1,DINDEX("DONE")=1
 Q
 ;
DICLIST ; Build output list when Finder is called from ^DIC.
 ; Display entries and allow selection if screen is filled.
 K DTOUT,DUOUT N D,DIX,DIFINDR,DIFILE,X,Y I DIC(0)["E" N DIQUIET
 S Y=DIEN,D=DINDEX,DIX=DINDEX(1),DIFINDR=1
 S X=$S("VP"[DINDEX(1,"TYPE"):DIX,1:DINDEX(1,DINDEX(1,"FOUND")))
 I "VP"[DINDEX(1,"TYPE") S DS(0,"DICRS")=1
 I "D"[DINDEX(1,"TYPE") S DS(0,"DIDA")=1
 D MN^DIC3 Q:'$T
 D K^DIC3
 I DS(0) S (DIDONE,DINDEX("DONE"))=1
 Q
 ;
 ;