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

DICFIX.m

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