DICFIX1 ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes (cont.) ;15MAY2011
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
;
NXTNAM(DIVAL,DIPART,DINDEX,DISKIP,DIDONE) ;
; limited comma piece lookup, skip nonmatching names in index
N DIUTF8 D
.N X,Y S Y=$C(126),X=$G(^DD("OS",^DD("OS"),"HIGHESTCHAR")) X:X]"" X S DIUTF8=Y
I $P(DIVAL,",")=DIPART S DIVAL=DIPART_","_DIUTF8,DISKIP=1 Q ;UTH/SMH
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
; Else, skip the rest of the first names within current last name.
S DIVAL=DIPREC_","_DIUTF8,DISKIP=1 Q ;UTH/SMH
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICFIX1 1441 printed Oct 16, 2024@18:46:40 Page 2
DICFIX1 ;SEA/TOAD,SF/TKW-FileMan: Finder, Search Compound Indexes (cont.) ;15MAY2011
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 ;
NXTNAM(DIVAL,DIPART,DINDEX,DISKIP,DIDONE) ;
+1 ; limited comma piece lookup, skip nonmatching names in index
+2 NEW DIUTF8
Begin DoDot:1
+3 NEW X,Y
SET Y=$CHAR(126)
SET X=$GET(^DD("OS",^DD("OS"),"HIGHESTCHAR"))
if X]""
XECUTE X
SET DIUTF8=Y
End DoDot:1
+4 ;UTH/SMH
IF $PIECE(DIVAL,",")=DIPART
SET DIVAL=DIPART_","_DIUTF8
SET DISKIP=1
QUIT
+5 NEW DIPREC,DIPOSTC,DIPPOSTC
+6 SET DIPREC=$PIECE(DIVAL,",")
SET DIPOSTC=$PIECE(DIVAL,",",2)
+7 SET DIPPOSTC=DINDEX(DISUB,DITRXNO,"c")
+8 IF $$PREFIX(DIPOSTC,DIPPOSTC)
QUIT
+9 IF $$PREFIX(DIPPOSTC,DIPOSTC)
QUIT
+10 DO SKIP(.DISKIP,.DIVAL,DIPREC,DIPOSTC,DIPART,DIPPOSTC,.DINDEX)
+11 QUIT
+12 ;
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
End DoDot:1
QUIT
+6 ; Else, skip the rest of the first names within current last name.
+7 ;UTH/SMH
SET DIVAL=DIPREC_","_DIUTF8
SET DISKIP=1
QUIT
+8 ;
+9 ;
