| 1 | DICFIX1 ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes (cont.) ;2/20/98 09:53
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999;
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | NXTNAM(DIVAL,DIPART,DINDEX,DISKIP,DIDONE) ;
|
|---|
| 6 | ; limited comma piece lookup, skip nonmatching names in index
|
|---|
| 7 | I $P(DIVAL,",")=DIPART S DIVAL=DIPART_",~",DISKIP=1 Q
|
|---|
| 8 | N DIPREC,DIPOSTC,DIPPOSTC
|
|---|
| 9 | S DIPREC=$P(DIVAL,","),DIPOSTC=$P(DIVAL,",",2)
|
|---|
| 10 | S DIPPOSTC=DINDEX(DISUB,DITRXNO,"c")
|
|---|
| 11 | I $$PREFIX(DIPOSTC,DIPPOSTC) Q
|
|---|
| 12 | I $$PREFIX(DIPPOSTC,DIPOSTC) Q
|
|---|
| 13 | D SKIP(.DISKIP,.DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,.DINDEX)
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | PREFIX(DISTRING,DIPREFIX) ;
|
|---|
| 17 | Q $E(DISTRING,1,$L(DIPREFIX))=DIPREFIX
|
|---|
| 18 | ;
|
|---|
| 19 | SKIP(DISKIP,DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,DINDEX) ;
|
|---|
| 20 | ; Skip forward within index based on limited comma piecing
|
|---|
| 21 | I DIPPOSTC]DIPOSTC D Q
|
|---|
| 22 | . ; Current first name before starting first name, skip to starting first name
|
|---|
| 23 | . S DIVAL=DIPREC_","_DIPPOSTC
|
|---|
| 24 | . I '$D(@DINDEX(DISUB,"ROOT")@(DIVAL)) S DISKIP=1
|
|---|
| 25 | . Q
|
|---|
| 26 | ; Else, skip the rest of the first names within current last name.
|
|---|
| 27 | S DIVAL=DIPREC_",~",DISKIP=1 Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;
|
|---|
