source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DICFIX1.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1DICFIX1 ;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 ;
5NXTNAM(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 ;
16PREFIX(DISTRING,DIPREFIX) ;
17 Q $E(DISTRING,1,$L(DIPREFIX))=DIPREFIX
18 ;
19SKIP(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 ;
Note: See TracBrowser for help on using the repository browser.