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

DICLIX.m

Go to the documentation of this file. 
  1. DICLIX ;SEA/TOAD,SF/TKW-FileMan: Lister, Search Compound Indexes ;6/5/00  10:13 [ 04/02/2003   8:25 AM ]
  1.  ;;22.0;VA FileMan;**1001**;APR 1, 2003
  1.  ;;22.0;VA FileMan;**4,3**;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,DINDEX0,DIXV,DIC) ;
  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.  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.  . . I DISUB=1,$O(DIXV(0)) D LOWSUB
  1.  . . S DISKIP=0
  1.  . . I DIVAL'="",'$D(DINDEX(DISUB,"IXROOT")) D CHK Q:DISKIP
  1.  . . S:DIVAL="" DIDONE=1
  1.  . . Q:DIDONE
  1.  . . S DINDEX(DISUB)=DIVAL,DINDEX("AT")=DISUB+1
  1.  . . I $D(DINDEX("ROOTCNG",DISUB+1)) D BLDTMP^DICLIX1(.DINDEX,.DISCREEN,DIFLAGS,.DIDENT)
  1.  . . D WALK(.DIFLAGS,.DINDEX,.DIDENT,.DIFILE,.DIEN,DIFIEN,.DISCREEN,.DILIST,.DINDEX0,"",.DIC)
  1.  . . S DINDEX("AT")=DISUB
  1.  . . I $G(DINDEX("DONE"))!$G(DIERR) S DIDONE=1
  1.  . . Q
  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 DISKIPMN,DIMNEM S DISKIPMN=0 D  Q:DISKIPMN
  1.  . . I $D(@DINDEX(DISUB,"ROOT")@(DIVAL))#2 Q:'^(DIVAL)
  1.  . . E  Q:'$O(@DINDEX(DISUB,"ROOT")@(DIVAL,""))
  1.  . . I DIFLAGS["M" S DISKIPMN=1 Q
  1.  . . S DIMNEM="" Q
  1.  . I $G(DINDEX(DISUB,"TO")) D  Q:DIDONE
  1.  . . Q:$D(DINDEX(DISUB,"IXROOT"))
  1.  . . D BACKPAST^DICLIX1(DIFLAGS,.DINDEX,DISUB,DIVAL,.DIDONE) Q
  1.  . D TRY
  1.  . Q
  1. CLEAN ; clean up after loop, exit
  1.  S DINDEX(DISUB)=""
  1.  I DISUB>1,$G(DINDEX(DISUB,"PART"))]"" S DINDEX(DISUB)=DINDEX(DISUB,"FROM")
  1.  Q
  1.  ;
  1. CHK ; See whether we have a match or are at the end of the subscripts.
  1.  D MATCH I DIDONE,'$G(DINDEX("DONE")),DIMORE 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=""
  1.  I $P(DIVAL,$G(DIPART))'="" S DIDONE=1 Q
  1.  Q:$G(DINDEX(DISUB,"TO"))=""
  1.  I DIFLAGS["p" D BACKPAST^DICLIX1(DIFLAGS,.DINDEX0,DISUB,DIVAL,.DIDONE) Q
  1.  I $G(DINDEX(DISUB+1,"TO"))="" D BACKPAST^DICLIX1(DIFLAGS,.DINDEX,DISUB,DIVAL,.DIDONE)
  1.  Q
  1.  ;
  1. LOWSUB ; Find next subscript value from multiple pointed-to files
  1.  N I,DILOWNO,DILOWVAL S DILOWNO=+DIFILE("STACK"),DILOWVAL=DIVAL
  1.  I DILOWVAL="" D  I 'DILOWNO K DIXV Q
  1.  . K DIXV(DILOWNO),DIFILE("STACKEND",DILOWNO)
  1.  . S DILOWNO=$O(DIXV(0)),DILOWVAL=$G(DIXV(+DILOWNO,1,"NXTVAL"))
  1.  . Q
  1.  N J S J=DILOWNO
  1.  I DILOWVAL'="" F I=0:0 S I=$O(DIFILE("STACKEND",I)) Q:'I  I I'=J D
  1.  . I DINDEX(1,"WAY")=1,DILOWVAL']]DIXV(I,1,"NXTVAL") Q
  1.  . I DINDEX(1,"WAY")=-1,DIXV(I,1,"NXTVAL")']]DILOWVAL Q
  1.  . S DILOWNO=I,DILOWVAL=$G(DIXV(DILOWNO,1,"NXTVAL"))
  1.  . Q
  1.  I DILOWNO'=DIFILE("STACK") D
  1.  . I DIVAL'="" S DIXV(+DIFILE("STACK"),1,"NXTVAL")=DIVAL
  1.  . S DIFILE("STACK")=DILOWNO_U_DIFILE("STACKEND",DILOWNO)
  1.  . S DIVAL=DILOWVAL
  1.  . S DIFILE=+$P(DIFILE("STACK"),U,3)
  1.  . M DINDEX=DIXV(DILOWNO) Q
  1.  Q
  1.  ;
  1. TRY ; Apply screens to entry.  If passed, add entry to output.
  1.  S (DIEN,DINDEX(DISUB))=DIVAL
  1.  I DIFLAGS["p" D
  1.  . S DINDEX0(1,"EXT")=DINDEX(1)
  1.  . D BACKTRAK^DICL3(.DIFLAGS,.DIFILE,DIFILE("STACK"),.DIEN,DIFIEN,.DINDEX0,.DINDEX,.DIDENT,.DISCREEN,.DILIST)
  1.  . S:$G(DINDEX0("DONE")) (DIDONE,DINDEX("DONE"))=1 Q
  1.  I DIFLAGS'["p" D
  1.  . N DI0NODE S DI0NODE=$G(@DIFILE(DIFILE)@(DIEN,0))
  1.  . Q:$$SCREEN^DICL2(.DIFILE,.DIEN,DIFLAGS,DIFIEN,.DISCREEN,.DINDEX,DI0NODE)
  1.  . D ACCEPT^DICL2(.DIFILE,.DIEN,.DIFLAGS,DIFIEN,.DINDEX,.DIDENT,.DILIST,DI0NODE)
  1.  . Q
  1.  Q:$G(DIERR)!($G(DINDEX("DONE")))
  1.  I DIDENT(-1)=DIDENT(-1,"MAX") D
  1.  . I 'DIDENT(-1,"JUST LOOKING") S DIDONE=1,DINDEX("DONE")=1 Q
  1.  . ; If called from online DIC help ^DICQ, display list.
  1.  . Q:DIFLAGS'["h"
  1.  . K DTOUT,DUOUT S DICQ(0,"MAP")=DIDENT(-3)
  1.  . D DSP^DICQ1(.DINDEX,.DICQ,.DIC,.DIFILE)
  1.  . I $G(DTOUT)!($G(DUOUT)) S (DINDEX("DONE"),DIDONE)=1 Q
  1.  . S DILIST("ORDER")=$S(DINDEX("WAY")=1:0,1:DIDENT(-1,"MAX")+1)
  1.  . S DIDENT(-1)=0,DIDENT(-1,"JUST LOOKING")=0 Q
  1.  Q
  1.  ;
  1.  ;