DICFIX1.m

DICFIX1 ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes (cont.) ;2/20/98  09:53

 ;;22.0;VA FileMan;;Mar 30, 1999;

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

NXTNAM(DIVAL,DIPART,DINDEX,DISKIP,DIDONE) ;

 ; limited comma piece lookup, skip nonmatching names in index

 I $P(DIVAL,",")=DIPART S DIVAL=DIPART_",~",DISKIP=1 Q

 N DIPREC,DIPOSTC,DIPPOSTC

 S DIPREC=$P(DIVAL,","),DIPOSTC=$P(DIVAL,",",2)

 S DIPPOSTC=DINDEX(DISUB,DITRXNO,"c")

 I $$PREFIX(DIPOSTC,DIPPOSTC) Q

 I $$PREFIX(DIPPOSTC,DIPOSTC) Q

 D SKIP(.DISKIP,.DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,.DINDEX)

 Q

 ;

PREFIX(DISTRING,DIPREFIX) ;

 Q $E(DISTRING,1,$L(DIPREFIX))=DIPREFIX

 ;

SKIP(DISKIP,DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,DINDEX) ;

 ; Skip forward within index based on limited comma piecing

 I DIPPOSTC]DIPOSTC D  Q

 . ; Current first name before starting first name, skip to starting first name

 . S DIVAL=DIPREC_","_DIPPOSTC

 . I '$D(@DINDEX(DISUB,"ROOT")@(DIVAL)) S DISKIP=1

 . Q

 ; Else, skip the rest of the first names within current last name.

 S DIVAL=DIPREC_",~",DISKIP=1 Q

 ;

 ;

DICFIX1   ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes (cont.) ;2/20/98  09:53

 +1       ;;22.0;VA FileMan;;Mar 30, 1999;

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

NXTNAM(DIVAL,DIPART,DINDEX,DISKIP,DIDONE) ;

 +1       ; limited comma piece lookup, skip nonmatching names in index

 +2        IF $PIECE(DIVAL,",")=DIPART

               SET DIVAL=DIPART_",~"

               SET DISKIP=1

               QUIT 

 +3        NEW DIPREC,DIPOSTC,DIPPOSTC

 +4        SET DIPREC=$PIECE(DIVAL,",")

           SET DIPOSTC=$PIECE(DIVAL,",",2)

 +5        SET DIPPOSTC=DINDEX(DISUB,DITRXNO,"c")

 +6        IF $$PREFIX(DIPOSTC,DIPPOSTC)

               QUIT 

 +7        IF $$PREFIX(DIPPOSTC,DIPOSTC)

               QUIT 

 +8        DO SKIP(.DISKIP,.DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,.DINDEX)

 +9        QUIT 

 +10      ;

PREFIX(DISTRING,DIPREFIX) ;

 +1        QUIT $EXTRACT(DISTRING,1,$LENGTH(DIPREFIX))=DIPREFIX

 +2       ;

SKIP(DISKIP,DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,DINDEX) ;

 +1       ; Skip forward within index based on limited comma piecing

 +2        IF DIPPOSTC]DIPOSTC

               Begin DoDot:1

 +3       ; Current first name before starting first name, skip to starting first name

 +4                SET DIVAL=DIPREC_","_DIPPOSTC

 +5                IF '$DATA(@DINDEX(DISUB,"ROOT")@(DIVAL))

                       SET DISKIP=1

 +6                QUIT 

               End DoDot:1

               QUIT 

 +7       ; Else, skip the rest of the first names within current last name.

 +8        SET DIVAL=DIPREC_",~"

           SET DISKIP=1

           QUIT 

 +9       ;

 +10      ;